Commit 76a0266e authored by Helga Velroyen's avatar Helga Velroyen

Network and address pool (again)

Implementation of the network objects and address pool. Functionality
as in the reverted commit b9a616e1, but
now using only the vector library and not the bit-vector library.
Tested with vector library version 0.9 and 0.10., which are
also installed on the buildbot machines now.
Signed-off-by: default avatarHelga Velroyen <helgav@google.com>
Reviewed-by: default avatarIustin Pop <iustin@google.com>
parent 9eac61f8
......@@ -481,6 +481,7 @@ HS_LIB_SRCS = \
htools/Ganeti/Jobs.hs \
htools/Ganeti/Logging.hs \
htools/Ganeti/Luxi.hs \
htools/Ganeti/Network.hs \
htools/Ganeti/Objects.hs \
htools/Ganeti/OpCodes.hs \
htools/Ganeti/OpParams.hs \
......@@ -523,6 +524,7 @@ HS_TEST_SRCS = \
htest/Test/Ganeti/JSON.hs \
htest/Test/Ganeti/Jobs.hs \
htest/Test/Ganeti/Luxi.hs \
htest/Test/Ganeti/Network.hs \
htest/Test/Ganeti/Objects.hs \
htest/Test/Ganeti/OpCodes.hs \
htest/Test/Ganeti/Query/Filter.hs \
......
{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Test.Ganeti.Network
( testNetwork
) where
import Test.QuickCheck
import Control.Monad
import Ganeti.Network as Network
import Ganeti.Objects as Objects
import Ganeti.Types
import Test.Ganeti.Query.Language (genJSValue)
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import qualified Data.Vector.Unboxed as V
import qualified Data.Set as S
-- * Generators and arbitrary instances
-- | Generate an arbitrary string consisting of '0' and '1' of the given length.
genBitString :: Int -> Gen String
genBitString len = vectorOf len (elements "01")
-- | Generate an arbitrary string consisting of '0' and '1' of the maximum given
-- length.
genBitStringMaxLen :: Int -> Gen String
genBitStringMaxLen maxLen = choose (0, maxLen) >>= genBitString
-- | 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
-- | Generates a network instance with bit vectors of the given lengths for
-- reservations and external reservations.
genValidNetwork :: Int -> Gen Objects.Network
genValidNetwork maxLenBitStr = do
lenBitStr <- choose (0, maxLenBitStr)
name <- genName >>= mkNonEmpty
network_type <- genMaybe genNetworkType
mac_prefix <- genMaybe genName
family <- arbitrary
net <- genName >>= mkNonEmpty
net6 <- genMaybe genName
gateway <- genMaybe genName
gateway6 <- genMaybe genName
size <- genMaybe genJSValue
res <- liftM Just (genBitString lenBitStr)
ext_res <- liftM Just (genBitString lenBitStr)
let n = Network name network_type mac_prefix family net net6 gateway
gateway6 size res ext_res 0 S.empty
return n
-- | Generates an arbitrary network type.
genNetworkType :: Gen NetworkType
genNetworkType = elements [ PrivateNetwork, PublicNetwork ]
-- | Network instances are generated arbitrarily only with short bit strings to
-- not slow down the test execution too much.
instance Arbitrary Objects.Network where
arbitrary = genValidNetwork 256
-- | 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
net <- arbitrary
lenBitVec <- choose (0, maxLenBitVec)
res <- genBitVector lenBitVec
ext_res <- genBitVector lenBitVec
return AddressPool { network = net
, reservations = res
, extReservations = ext_res }
instance Arbitrary AddressPool where
arbitrary = genAddressPool ((2::Int)^(8::Int))
-- * 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 a =
conjoin
[ printTestCase
("Not all reservations are included in 'allReservations' of " ++
"address pool:" ++ show a) (allReservationsSubsumesInternal a)
, printTestCase
("Not all external reservations are covered by 'allReservations' " ++
"of address pool: " ++ show a)
(allReservationsSubsumesExternal a)
, printTestCase
("The counts of free and reserved addresses do not add up for " ++
"address pool: " ++ show a)
(checkCounts a)
, printTestCase
("'isFull' wrongly classified the status of the address pool: " ++
show a) (checkIsFull a)
, printTestCase
("Network map is inconsistent with reservations of address pool: " ++
show a) (checkGetMap a)
]
-- | Check that all internally reserved ips are included in 'allReservations'.
allReservationsSubsumesInternal :: AddressPool -> Bool
allReservationsSubsumesInternal a =
bitVectorSubsumes (allReservations a) (reservations a)
-- | Check that all externally reserved ips are included in 'allReservations'.
allReservationsSubsumesExternal :: AddressPool -> 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
-- | Check that the counts of free and reserved ips add up.
checkCounts :: AddressPool -> Bool
checkCounts a =
let res = reservations a
in V.length res == 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)
-- | Check that the map representation of the network corresponds to the
-- network's reservations.
checkGetMap :: AddressPool -> Bool
checkGetMap a =
allReservations a == V.fromList (Prelude.map (== 'X') (getMap a))
testSuite "Network"
[ 'prop_bitStringToBitVector
, 'prop_createAddressPool
, 'prop_addressPoolProperties
]
......@@ -38,6 +38,7 @@ import Control.Applicative
import qualified Data.Map as Map
import qualified Data.Set as Set
import Test.Ganeti.Query.Language (genJSValue)
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.Types ()
......@@ -162,6 +163,35 @@ instance Arbitrary TagSet where
$(genArbitrary ''Cluster)
instance Arbitrary Network where
arbitrary = Network <$>
-- name
arbitrary
-- network_type
<*> arbitrary
-- mac_prefix
<*> arbitrary
-- family
<*> arbitrary
-- network
<*> arbitrary
-- network6
<*> arbitrary
-- gateway
<*> arbitrary
-- gateway6
<*> arbitrary
-- size
<*> genMaybe genJSValue
-- reservations
<*> arbitrary
-- external reservations
<*> arbitrary
-- serial
<*> arbitrary
-- tags
<*> (Set.fromList <$> genTags)
-- | Generator for config data with an empty cluster (no instances),
-- with N defined nodes.
genEmptyCluster :: Int -> Gen ConfigData
......@@ -222,6 +252,10 @@ prop_Node_serialisation = testSerialisation
prop_Inst_serialisation :: Instance -> Property
prop_Inst_serialisation = testSerialisation
-- | Check that network serialisation is idempotent.
prop_Network_serialisation :: Network -> Property
prop_Network_serialisation = testSerialisation
-- | Check config serialisation.
prop_Config_serialisation :: Property
prop_Config_serialisation =
......@@ -231,6 +265,7 @@ testSuite "Objects"
[ 'prop_fillDict
, 'prop_Disk_serialisation
, 'prop_Inst_serialisation
, 'prop_Network_serialisation
, 'prop_Node_serialisation
, 'prop_Config_serialisation
]
......@@ -29,6 +29,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Test.Ganeti.Query.Language
( testQuery_Language
, genFilter
, genJSValue
) where
import Test.QuickCheck
......
......@@ -52,6 +52,7 @@ import Test.Ganeti.HTools.Types
import Test.Ganeti.JSON
import Test.Ganeti.Jobs
import Test.Ganeti.Luxi
import Test.Ganeti.Network
import Test.Ganeti.Objects
import Test.Ganeti.OpCodes
import Test.Ganeti.Query.Filter
......@@ -100,6 +101,7 @@ allTests =
, testJSON
, testJobs
, testLuxi
, testNetwork
, testObjects
, testOpCodes
, testQuery_Filter
......
{-| Implementation of the Ganeti network objects.
This is does not (yet) cover all methods that are provided in the
corresponding python implementation (network.py).
-}
{-
Copyright (C) 2011, 2012 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.
-}
module Ganeti.Network
( AddressPool(..)
, createAddressPool
, bitStringToBitVector
, allReservations
, getReservedCount
, getFreeCount
, isFull
, getMap
, networkIsValid
) where
import qualified Data.Vector.Unboxed as V
import Ganeti.Objects
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')
-- | Get a bit vector of all reservations (internal and external) combined.
allReservations :: AddressPool -> V.Vector Bool
allReservations a = V.zipWith (||) (reservations a) (extReservations a)
-- | Get the count of reserved addresses.
getReservedCount :: AddressPool -> Int
getReservedCount = V.length . V.filter (== True) . allReservations
-- | Get the count of free addresses.
getFreeCount :: AddressPool -> Int
getFreeCount = V.length . V.filter (== False) . allReservations
-- | Check whether the network is full.
isFull :: AddressPool -> Bool
isFull = V.and . allReservations
-- | 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 '.'
......@@ -87,6 +87,7 @@ module Ganeti.Objects
, TagsObject(..)
, DictObject(..) -- re-exported from THH
, TagSet -- re-exported from THH
, Network(..)
) where
import Data.List (foldl')
......@@ -590,3 +591,39 @@ $(buildObject "ConfigData" "config" $
instance SerialNoObject ConfigData where
serialOf = configSerial
-- * Network definitions
-- FIXME: Not all types might be correct here, since they
-- haven't been exhaustively deduced from the python code yet.
$(buildObject "Network" "network" $
[ simpleField "name" [t| NonEmptyString |]
, optionalField $
simpleField "network_type" [t| NetworkType |]
, optionalField $
simpleField "mac_prefix" [t| String |]
, optionalField $
simpleField "family" [t| Int |]
, simpleField "network" [t| NonEmptyString |]
, optionalField $
simpleField "network6" [t| String |]
, optionalField $
simpleField "gateway" [t| String |]
, optionalField $
simpleField "gateway6" [t| String |]
, optionalField $
simpleField "size" [t| J.JSValue |]
, optionalField $
simpleField "reservations" [t| String |]
, optionalField $
simpleField "ext_reservations" [t| String |]
]
++ serialFields
++ tagsFields)
instance SerialNoObject Network where
serialOf = networkSerial
instance TagsObject Network where
tagsOf = networkTags
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment