* Petr Pudlák <[email protected]> [2014-07-04 15:04:22 +0200]:

> Hi Dimitris,
> 
> yes, you're right, I didn't realize this patch could make the
> implementation of the design harder.
> 
> Actually, before this patch series, networks always had a reservation pool.
> If an AddressPool objects was created for a network, it filled the
> reservation fields if they were missing.
> 
> One thing that we could do is to keep the AddressPool abstraction with
> instance and external reservations, and instead of having the two fields in
> the Network object, replace them with this AddressPool object. This would
> require more changes in the Python code, but it'd be better for the future
> refactoring. What do you think?
> 

Well, what I have is mind is something like the following Network object:

net1 {
  subnets [
    uuid1 {
        name: subnet1
        cidr: 192.0.2.0/24
        pools: [
          {range: {start: 192.0.2.10, end:192.0.2.15, size: 5}, reservations: 
00000, name:pool1}
          ]
        reserved: [192.0.2.15]
        }
    ]
  }

but this is something (as you said) to be implemented in the future.

All I want to say is that the pool should be a separate entity and not merged
inside the network object. With the desing doc in mind, don't you agree on
this?

dimara

>   Petr
> 
> 
> On Fri, Jul 4, 2014 at 2:42 PM, Dimitris Aragiorgis <[email protected]> wrote:
> 
> > 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
> >

Attachment: signature.asc
Description: Digital signature

Reply via email to