Hi, From the commit message I understand that networks should always have the reservations bitarrays. Is that correct? Have you had the chance to see this thread:
https://groups.google.com/forum/#!msg/ganeti-devel/PFSQ-jS3ZSo/6QcG57JY_1cJ In a nutshell we want to abstract pools from networks and make them optional, so that we can decouple the L2 from L3 information and have L2 only networks. I know that implementing such a thing will require a lot of changes in the Haskell part (since wconfd came into play). I am just mentioning this now in case something here (in this patch series) breaks the design really bad. Thanks, dimara PS: Haven't seen the patch yet. Just commenting on the commit message. * 'Petr Pudlak' via ganeti-devel <[email protected]> [2014-07-04 13:18:03 +0200]: > .. in Haskell and work with BitArrays directly. > > Having a separate data type AdderssPool doesn't help, as it should be > always present; if a network doesn't have the table of reservations we > want to add the table anyway. > (Unlike in Python, where AddressPool modifies its corresponding Network > object.) > > Add functions for making reservations on a Network object. > > Signed-off-by: Petr Pudlak <[email protected]> > --- > src/Ganeti/Constants.hs | 13 +++ > src/Ganeti/Network.hs | 220 > ++++++++++++++++++++++++++++++----------- > src/Ganeti/Objects.hs | 8 +- > src/Ganeti/Query/Network.hs | 8 +- > test/hs/Test/Ganeti/Network.hs | 100 +++++-------------- > test/hs/Test/Ganeti/Objects.hs | 12 +-- > 6 files changed, 215 insertions(+), 146 deletions(-) > > diff --git a/src/Ganeti/Constants.hs b/src/Ganeti/Constants.hs > index 832c86c..7761f7d 100644 > --- a/src/Ganeti/Constants.hs > +++ b/src/Ganeti/Constants.hs > @@ -5009,3 +5009,16 @@ helperVmShutdown = 2 * 60 * 60 > -- speed of 1/5 of the max speed of current drives. > zeroingTimeoutPerMib :: Double > zeroingTimeoutPerMib = 1.0 / (100.0 / 5.0) > + > +-- * Networking > + > +-- The minimum size of a network. > +ipv4NetworkMinSize :: Int > +ipv4NetworkMinSize = 30 > + > +-- The maximum size of a network. > +-- > +-- FIXME: This limit is for performance reasons. Remove when refactoring > +-- for performance tuning was successful. > +ipv4NetworkMaxSize :: Int > +ipv4NetworkMaxSize = 30 > diff --git a/src/Ganeti/Network.hs b/src/Ganeti/Network.hs > index 5106213..832cba0 100644 > --- a/src/Ganeti/Network.hs > +++ b/src/Ganeti/Network.hs > @@ -1,3 +1,5 @@ > +{-# LANGUAGE RankNTypes #-} > + > {-| Implementation of the Ganeti network objects. > > This is does not (yet) cover all methods that are provided in the > @@ -27,79 +29,183 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, > Boston, MA > -} > > module Ganeti.Network > - ( AddressPool(..) > - , createAddressPool > - , bitStringToBitVector > - , allReservations > + ( PoolPart(..) > + , netIpv4NumHosts > , getReservedCount > , getFreeCount > , isFull > , getMap > - , networkIsValid > + , isReserved > + , reserve > + , release > + , findFree > + , allReservations > + , reservations > + , extReservations > ) where > > -import qualified Data.Vector.Unboxed as V > +import Control.Monad > +import Control.Monad.Error > +import Control.Monad.State > +import Data.Function (on) > > +import Ganeti.BasicTypes > +import qualified Ganeti.Constants as C > +import Ganeti.Lens > import Ganeti.Objects > +import Ganeti.Objects.Lens > +import qualified Ganeti.Objects.BitArray as BA > > --- | An address pool, holding a network plus internal and external > --- reservations. > -data AddressPool = AddressPool { network :: Network, > - reservations :: V.Vector Bool, > - extReservations :: V.Vector Bool } > - deriving (Show) > - > --- | Create an address pool from a network. > -createAddressPool :: Network -> Maybe AddressPool > -createAddressPool n > - | networkIsValid n = > - let res = maybeStr2BitVec $ networkReservations n > - ext_res = maybeStr2BitVec $ networkExtReservations n > - in Just AddressPool { reservations = res > - , extReservations = ext_res > - , network = n } > - | otherwise = Nothing > - > --- | Checks the consistency of the network object. So far, only checks the > --- length of the reservation strings. > -networkIsValid :: Network -> Bool > -networkIsValid n = > - sameLength (networkReservations n) (networkExtReservations n) > - > --- | Checks if two maybe strings are both nothing or of equal length. > -sameLength :: Maybe String -> Maybe String -> Bool > -sameLength Nothing Nothing = True > -sameLength (Just s1) (Just s2) = length s1 == length s2 > -sameLength _ _ = False > - > --- | Converts a maybe bit string to a bit vector. Returns an empty bit > vector on > --- nothing. > -maybeStr2BitVec :: Maybe String -> V.Vector Bool > -maybeStr2BitVec (Just s) = bitStringToBitVector s > -maybeStr2BitVec Nothing = V.fromList ([]::[Bool]) > - > --- | Converts a string to a bit vector. The character '0' is interpreted > --- as 'False', all others as 'True'. > -bitStringToBitVector :: String -> V.Vector Bool > -bitStringToBitVector = V.fromList . map (/= '0') > +ipv4NumHosts :: (Integral n) => n -> Integer > +ipv4NumHosts mask = 2^(32 - mask) > + > +ipv4NetworkMinNumHosts :: Integer > +ipv4NetworkMinNumHosts = ipv4NumHosts C.ipv4NetworkMinSize > + > +ipv4NetworkMaxNumHosts :: Integer > +ipv4NetworkMaxNumHosts = ipv4NumHosts C.ipv4NetworkMaxSize > + > +data PoolPart = PoolInstances | PoolExt > + > +poolLens :: PoolPart -> Lens' Network (Maybe BA.BitArray) > +poolLens PoolInstances = networkReservationsL > +poolLens PoolExt = networkExtReservationsL > + > +netIpv4NumHosts :: Network -> Integer > +netIpv4NumHosts = ipv4NumHosts . ip4netMask . networkNetwork > + > +-- | Creates a new bit array pool of the appropriate size > +newPool :: (MonadError e m, Error e) => Network -> m BA.BitArray > +newPool net = do > + let numhosts = netIpv4NumHosts net > + when (numhosts > ipv4NetworkMaxNumHosts) . failError $ > + "A big network with " ++ show numhosts ++ " host(s) is currently" > + ++ " not supported, please specify at most a /" > + ++ show ipv4NetworkMaxNumHosts ++ " network" > + when (numhosts < ipv4NetworkMinNumHosts) . failError $ > + "A network with only " ++ show numhosts ++ " host(s) is too small," > + ++ " please specify at least a /" > + ++ show ipv4NetworkMinNumHosts ++ " network" > + return $ BA.zeroes (fromInteger numhosts) > + > +-- | A helper function that creates a bit array pool, of it's missing. > +orNewPool :: (MonadError e m, Error e) > + => Network -> Maybe BA.BitArray -> m BA.BitArray > +orNewPool net = maybe (newPool net) return > + > +withPool :: (MonadError e m, Error e) > + => PoolPart -> (Network -> BA.BitArray -> m (a, BA.BitArray)) > + -> StateT Network m a > +withPool part f = StateT $ \n -> mapMOf2 (poolLens part) (f' n) n > + where > + f' net = liftM (over _2 Just) . f net <=< orNewPool net > + > +withPool_ :: (MonadError e m, Error e) > + => PoolPart -> (Network -> BA.BitArray -> m BA.BitArray) > + -> Network -> m Network > +withPool_ part f = execStateT $ withPool part ((liftM ((,) ()) .) . f) > + > +readPool :: PoolPart -> Network -> Maybe BA.BitArray > +readPool = view . poolLens > + > +readPoolE :: (MonadError e m, Error e) > + => PoolPart -> Network -> m BA.BitArray > +readPoolE part net = orNewPool net (readPool part net) > + > +readAllE :: (MonadError e m, Error e) > + => Network -> m BA.BitArray > +readAllE net = do > + res <- orNewPool net $ networkReservations net > + ext <- orNewPool net $ networkExtReservations net > + return $ res BA.-|- ext > + > +reservations :: Network -> Maybe BA.BitArray > +reservations = readPool PoolInstances > + > +extReservations :: Network -> Maybe BA.BitArray > +extReservations = readPool PoolExt > > -- | Get a bit vector of all reservations (internal and external) combined. > -allReservations :: AddressPool -> V.Vector Bool > -allReservations a = V.zipWith (||) (reservations a) (extReservations a) > +allReservations :: Network -> Maybe BA.BitArray > +allReservations a = (BA.-|-) `liftM` reservations a `ap` extReservations a > > -- | Get the count of reserved addresses. > -getReservedCount :: AddressPool -> Int > -getReservedCount = V.length . V.filter (== True) . allReservations > +getReservedCount :: Network -> Int > +getReservedCount = maybe 0 BA.count1 . allReservations > > -- | Get the count of free addresses. > -getFreeCount :: AddressPool -> Int > -getFreeCount = V.length . V.filter (== False) . allReservations > +getFreeCount :: Network -> Int > +getFreeCount = maybe 0 BA.count0 . allReservations > > -- | Check whether the network is full. > -isFull :: AddressPool -> Bool > -isFull = V.and . allReservations > +isFull :: Network -> Bool > +isFull = (0 ==) . getFreeCount > > -- | Return a textual representation of the network's occupation status. > -getMap :: AddressPool -> String > -getMap = V.toList . V.map mapPixel . allReservations > - where mapPixel c = if c then 'X' else '.' > +getMap :: Network -> String > +getMap = maybe "" (BA.asString '.' 'X') . allReservations > + > +-- * Functions used for manipulating the reservations > + > +-- | Returns an address index wrt a network. > +-- Fails if the address isn't in the network range. > +addrIndex :: (MonadError e m, Error e) => Ip4Address -> Network -> m Int > +addrIndex addr net = do > + let n = networkNetwork net > + i = on (-) ip4AddressToNumber addr (ip4netAddr n) > + when ((i < 0) || (i >= ipv4NumHosts (ip4netMask n))) . failError > + $ "Address '" ++ show addr ++ "' not in the network '" ++ show net ++ "'" > + return $ fromInteger i > + > +-- | Returns an address of a given index wrt a network. > +-- Fails if the index isn't in the network range. > +addrAt :: (MonadError e m, Error e) => Int -> Network -> m Ip4Address > +addrAt i net | (i' < 0) || (i' >= ipv4NumHosts (ip4netMask n)) = > + failError $ "Requested index " ++ show i > + ++ " outside the range of network '" ++ show net ++ "'" > + | otherwise = > + return $ ip4AddressFromNumber (ip4AddressToNumber (ip4netAddr n) + i') > + where > + n = networkNetwork net > + i' = toInteger i > + > +-- | Checks if a given address is reserved. > +-- Fails if the address isn't in the network range. > +isReserved :: (MonadError e m, Error e) => > + PoolPart -> Ip4Address -> Network -> m Bool > +isReserved part addr net = > + (BA.!) `liftM` readPoolE part net `ap` addrIndex addr net > + > +-- | Marks an address as used. > +reserve :: (MonadError e m, Error e) => > + PoolPart -> Ip4Address -> Network -> m Network > +reserve part addr = > + withPool_ part $ \net ba -> do > + idx <- addrIndex addr net > + let addrs = show addr > + when (ba BA.! idx) . failError $ case part of > + PoolExt -> "IP " ++ addrs ++ " is already externally reserved" > + PoolInstances -> "IP " ++ addrs ++ " is already used by an instance" > + BA.setAt idx True ba > + > +-- | Marks an address as unused. > +release :: (MonadError e m, Error e) => > + PoolPart -> Ip4Address -> Network -> m Network > +release part addr = > + withPool_ part $ \net ba -> do > + idx <- addrIndex addr net > + let addrs = show addr > + unless (ba BA.! idx) . failError $ case part of > + PoolExt -> "IP " ++ addrs ++ " is not externally reserved" > + PoolInstances -> "IP " ++ addrs ++ " is not used by an instance" > + BA.setAt idx False ba > + > +-- | Get the first free address in the network > +-- that satisfies a given predicate. > +findFree :: (MonadError e m, Error e) > + => (Ip4Address -> Bool) -> Network -> m (Maybe Ip4Address) > +findFree p net = readAllE net >>= BA.foldr f (return Nothing) > + where > + addrAtEither = addrAt :: Int -> Network -> Either String Ip4Address > + f False i _ | Right a <- addrAtEither i net, p a = return (Just a) > + f _ _ x = x > diff --git a/src/Ganeti/Objects.hs b/src/Ganeti/Objects.hs > index 730a39b..1817537 100644 > --- a/src/Ganeti/Objects.hs > +++ b/src/Ganeti/Objects.hs > @@ -120,6 +120,7 @@ import qualified AutoConf > import qualified Ganeti.Constants as C > import qualified Ganeti.ConstantUtils as ConstantUtils > import Ganeti.JSON > +import qualified Ganeti.Objects.BitArray as BA > import Ganeti.Types > import Ganeti.THH > import Ganeti.THH.Field > @@ -241,6 +242,9 @@ instance JSON Ip4Network where > > -- FIXME: Not all types might be correct here, since they > -- haven't been exhaustively deduced from the python code yet. > +-- > +-- FIXME: When parsing, check that the ext_reservations and reservations > +-- have the same length > $(buildObject "Network" "network" $ > [ simpleField "name" [t| NonEmptyString |] > , optionalField $ > @@ -253,9 +257,9 @@ $(buildObject "Network" "network" $ > , optionalField $ > simpleField "gateway6" [t| String |] > , optionalField $ > - simpleField "reservations" [t| String |] > + simpleField "reservations" [t| BA.BitArray |] > , optionalField $ > - simpleField "ext_reservations" [t| String |] > + simpleField "ext_reservations" [t| BA.BitArray |] > ] > ++ uuidFields > ++ timeStampFields > diff --git a/src/Ganeti/Query/Network.hs b/src/Ganeti/Query/Network.hs > index 3a4a31b..19bf140 100644 > --- a/src/Ganeti/Query/Network.hs > +++ b/src/Ganeti/Query/Network.hs > @@ -61,14 +61,14 @@ networkFields = > FieldSimple (rsMaybeUnavail . networkMacPrefix), QffNormal) > , (FieldDefinition "free_count" "FreeCount" QFTNumber "Number of available\ > \ addresses", > - FieldSimple (rsMaybeNoData . fmap getFreeCount . createAddressPool), > + FieldSimple (rsNormal . getFreeCount), > QffNormal) > , (FieldDefinition "map" "Map" QFTText "Actual mapping", > - FieldSimple (rsMaybeNoData . fmap getMap . createAddressPool), > + FieldSimple (rsNormal . getMap), > QffNormal) > , (FieldDefinition "reserved_count" "ReservedCount" QFTNumber > "Number of reserved addresses", > - FieldSimple (rsMaybeNoData . fmap getReservedCount . createAddressPool), > + FieldSimple (rsNormal . getReservedCount), > QffNormal) > , (FieldDefinition "group_list" "GroupList" QFTOther > "List of nodegroups (group name, NIC mode, NIC link)", > @@ -175,5 +175,5 @@ getReservations net = > getExtReservationsString :: Network -> ResultEntry > getExtReservationsString net = > let addrs = getReservations (networkNetwork net) > - (fromMaybe "" $ networkExtReservations net) > + (maybe "" show $ networkExtReservations net) > in rsNormal . intercalate ", " $ map show addrs > diff --git a/test/hs/Test/Ganeti/Network.hs b/test/hs/Test/Ganeti/Network.hs > index 57793ca..58fee6f 100644 > --- a/test/hs/Test/Ganeti/Network.hs > +++ b/test/hs/Test/Ganeti/Network.hs > @@ -6,72 +6,22 @@ module Test.Ganeti.Network > , genBitStringMaxLen > ) where > > +import Data.Maybe (fromMaybe) > + > import Test.QuickCheck > > import Ganeti.Network as Network > import Ganeti.Objects as Objects > +import Ganeti.Objects.BitArray as BA > > -import Test.Ganeti.Objects > - ( genBitStringMaxLen > - , genValidNetwork ) > -import Test.Ganeti.TestHelper > +import Test.Ganeti.Objects ( genBitStringMaxLen ) > import Test.Ganeti.TestCommon > - > -import qualified Data.Vector.Unboxed as V > - > --- * Generators and arbitrary instances > - > --- | Generates address pools. The size of the network is intentionally > --- decoupled from the size of the bit vectors, to avoid slowing down > --- the tests by generating unnecessary bit strings. > -genAddressPool :: Int -> Gen AddressPool > -genAddressPool maxLenBitVec = do > - -- Generating networks with netmask of minimum /24 to avoid too long > - -- bit strings being generated. > - net <- genValidNetwork > - lenBitVec <- choose (0, maxLenBitVec) > - res <- genBitVector lenBitVec > - ext_res <- genBitVector lenBitVec > - return AddressPool { network = net > - , reservations = res > - , extReservations = ext_res } > - > --- | Generates an arbitrary bit vector of the given length. > -genBitVector :: Int -> Gen (V.Vector Bool) > -genBitVector len = do > - boolList <- vector len::Gen [Bool] > - return $ V.fromList boolList > - > -instance Arbitrary AddressPool where > - arbitrary = genAddressPool ((2::Int)^(8::Int)) > +import Test.Ganeti.TestHelper > > -- * Test cases > > --- | Check the mapping of bit strings to bit vectors > -prop_bitStringToBitVector :: Property > -prop_bitStringToBitVector = > - forAll (genBitStringMaxLen 256) $ \bs -> > - let bitList = V.toList $ Network.bitStringToBitVector bs > - bitCharList = Prelude.zip bitList bs > - in Prelude.all checkBit bitCharList > - > --- | Check whether an element of a bit vector is consistent with an element > --- of a bit string (containing '0' and '1' characters). > -checkBit :: (Bool, Char) -> Bool > -checkBit (False, '0') = True > -checkBit (True, '1') = True > -checkBit _ = False > - > --- | Check creation of an address pool when a network is given. > -prop_createAddressPool :: Objects.Network -> Property > -prop_createAddressPool n = > - let valid = networkIsValid n > - in case createAddressPool n of > - Just _ -> True ==? valid > - Nothing -> False ==? valid > - > -- | Check that the address pool's properties are calculated correctly. > -prop_addressPoolProperties :: AddressPool -> Property > +prop_addressPoolProperties :: Network -> Property > prop_addressPoolProperties a = > conjoin > [ printTestCase > @@ -93,40 +43,38 @@ prop_addressPoolProperties a = > show a) (checkGetMap a) > ] > > +-- | Checks for the subset relation on 'Maybe' values. > +subsetMaybe :: Maybe BitArray -> Maybe BitArray -> Bool > +subsetMaybe (Just x) (Just y) = subset x y > +subsetMaybe x y = x == y -- only if they're both Nothing > + > -- | Check that all internally reserved ips are included in > 'allReservations'. > -allReservationsSubsumesInternal :: AddressPool -> Bool > +allReservationsSubsumesInternal :: Network -> Bool > allReservationsSubsumesInternal a = > - bitVectorSubsumes (allReservations a) (reservations a) > + reservations a `subsetMaybe` allReservations a > > -- | Check that all externally reserved ips are included in > 'allReservations'. > -allReservationsSubsumesExternal :: AddressPool -> Bool > +allReservationsSubsumesExternal :: Network -> Bool > allReservationsSubsumesExternal a = > - bitVectorSubsumes (allReservations a) (extReservations a) > - > --- | Checks if one bit vector subsumes the other one. > -bitVectorSubsumes :: V.Vector Bool -> V.Vector Bool -> Bool > -bitVectorSubsumes v1 v2 = V.and $ > - V.zipWith (\a b -> not b || a) v1 v2 > + extReservations a `subsetMaybe` allReservations a > > -- | Check that the counts of free and reserved ips add up. > -checkCounts :: AddressPool -> Bool > +checkCounts :: Network -> Property > checkCounts a = > - let res = reservations a > - in V.length res == getFreeCount a + getReservedCount a > + netIpv4NumHosts a ==? toInteger (getFreeCount a + getReservedCount a) > > -- | Check that the detection of a full network works correctly. > -checkIsFull :: AddressPool -> Bool > -checkIsFull a = isFull a == V.notElem False (allReservations a) > +checkIsFull :: Network -> Property > +checkIsFull a = > + isFull a ==? maybe True (and . toList) (allReservations a) > > -- | Check that the map representation of the network corresponds to the > -- network's reservations. > -checkGetMap :: AddressPool -> Bool > +checkGetMap :: Network -> Property > checkGetMap a = > - allReservations a == V.fromList (Prelude.map (== 'X') (getMap a)) > + fromMaybe BA.empty (allReservations a) > + ==? fromList (Prelude.map (== 'X') (getMap a)) > > testSuite "Network" > - [ 'prop_bitStringToBitVector > - , 'prop_createAddressPool > - , 'prop_addressPoolProperties > + [ 'prop_addressPoolProperties > ] > - > diff --git a/test/hs/Test/Ganeti/Objects.hs b/test/hs/Test/Ganeti/Objects.hs > index 8377a31..f3c224f 100644 > --- a/test/hs/Test/Ganeti/Objects.hs > +++ b/test/hs/Test/Ganeti/Objects.hs > @@ -61,6 +61,7 @@ import Test.Ganeti.Types () > import qualified Ganeti.Constants as C > import Ganeti.Network > import Ganeti.Objects as Objects > +import qualified Ganeti.Objects.BitArray as BA > import Ganeti.JSON > import Ganeti.Types > > @@ -283,12 +284,12 @@ genValidNetwork = do > return n > > -- | Generate an arbitrary string consisting of '0' and '1' of the given > length. > -genBitString :: Int -> Gen String > -genBitString len = vectorOf len (elements "01") > +genBitString :: Int -> Gen BA.BitArray > +genBitString len = BA.fromList `liftM` vectorOf len (elements [False, True]) > > -- | Generate an arbitrary string consisting of '0' and '1' of the maximum > given > -- length. > -genBitStringMaxLen :: Int -> Gen String > +genBitStringMaxLen :: Int -> Gen BA.BitArray > genBitStringMaxLen maxLen = choose (0, maxLen) >>= genBitString > > -- | Generator for config data with an empty cluster (no instances), > @@ -448,10 +449,7 @@ casePyCompatNetworks = do > -- to be compared against the same properties generated by the python code. > getNetworkProperties :: Network -> (Int, Int, Network) > getNetworkProperties net = > - let maybePool = createAddressPool net > - in case maybePool of > - (Just pool) -> (getFreeCount pool, getReservedCount pool, net) > - Nothing -> (-1, -1, net) > + (getFreeCount net, getReservedCount net, net) > > -- | Tests the compatibility between Haskell-serialized node groups and their > -- python-decoded and encoded version. > -- > 2.0.0.526.g5318336
signature.asc
Description: Digital signature
