code.grnet.gr Git - ganeti-local/blob - htest/Test/Ganeti/Network.hs

   1 {-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3
   4 module Test.Ganeti.Network
   5   ( testNetwork
   6   ) where
   7
   8 import Test.QuickCheck
   9
  10 import Control.Monad
  11
  12 import Ganeti.Network as Network
  13 import Ganeti.Objects as Objects
  14 import Ganeti.Types
  15
  16 import Test.Ganeti.Query.Language (genJSValue)
  17 import Test.Ganeti.TestHelper
  18 import Test.Ganeti.TestCommon
  19
  20 import qualified Data.Vector.Bit as B
  21 import qualified Data.Vector.Unboxed as V
  22 import qualified Data.Set as S
  23
  24 -- * Generators and arbitrary instances
  25
  26 -- | Generate an arbitrary string consisting of '0' and '1' of the given length.
  27 genBitString :: Int -> Gen String
  28 genBitString len = vectorOf len (elements "01")
  29
  30 -- | Generate an arbitrary string consisting of '0' and '1' of the maximum given
  31 -- length.
  32 genBitStringMaxLen :: Int -> Gen String
  33 genBitStringMaxLen maxLen = choose (0, maxLen) >>= genBitString
  34
  35 -- | Generates an arbitrary bit vector of the given length.
  36 genBitVector :: Int -> Gen B.BitVector
  37 genBitVector len = do
  38   boolList <- vector len::Gen [Bool]
  39   return $ V.fromList boolList
  40
  41 -- | Generates a network instance with bit vectors of the given lengths for
  42 -- reservations and external reservations.
  43 genValidNetwork :: Int -> Gen Objects.Network
  44 genValidNetwork maxLenBitStr = do
  45   lenBitStr <- choose (0, maxLenBitStr)
  46   name <- genName >>= mkNonEmpty
  47   network_type <- genMaybe genNetworkType
  48   mac_prefix <- genMaybe genName
  49   family <- arbitrary
  50   net <- genName >>= mkNonEmpty
  51   net6 <- genMaybe genName
  52   gateway <- genMaybe genName
  53   gateway6 <- genMaybe genName
  54   size <- genMaybe genJSValue
  55   res <- liftM Just (genBitString lenBitStr)
  56   ext_res <- liftM Just (genBitString lenBitStr)
  57   let n = Network name network_type mac_prefix family net net6 gateway
  58           gateway6 size res ext_res 0 S.empty
  59   return n
  60
  61 -- | Generates an arbitrary network type.
  62 genNetworkType :: Gen NetworkType
  63 genNetworkType = elements [ PrivateNetwork, PublicNetwork ]
  64
  65 -- | Network instances are generated arbitrarily only with short bit strings to
  66 -- not slow down the test execution too much.
  67 instance Arbitrary Objects.Network where
  68   arbitrary = genValidNetwork 256
  69
  70 -- | Generates address pools. The size of the network is intentionally
  71 -- decoupled from the size of the bit vectors, to avoid slowing down
  72 -- the tests by generating unnecessary bit strings.
  73 genAddressPool :: Int -> Gen AddressPool
  74 genAddressPool maxLenBitVec = do
  75   net <- arbitrary
  76   lenBitVec <- choose (0, maxLenBitVec)
  77   res <- genBitVector lenBitVec
  78   ext_res <- genBitVector lenBitVec
  79   return AddressPool { network = net
  80                      , reservations = res
  81                      , extReservations = ext_res }
  82
  83 instance Arbitrary AddressPool where
  84   arbitrary = genAddressPool ((2::Int)^(8::Int))
  85
  86 -- * Test cases
  87
  88 -- | Check the mapping of bit strings to bit vectors
  89 prop_bitStringToBitVector :: Property
  90 prop_bitStringToBitVector =
  91   forAll (genBitStringMaxLen 256) $ \bs ->
  92   let bitList = V.toList $ Network.bitStringToBitVector bs
  93       bitCharList = Prelude.zip bitList bs
  94   in  Prelude.all checkBit bitCharList
  95
  96 -- | Check whether an element of a bit vector is consistent with an element
  97 -- of a bit string (containing '0' and '1' characters).
  98 checkBit :: (Bool, Char) -> Bool
  99 checkBit (False, '0') = True
 100 checkBit (True, '1') = True
 101 checkBit _ = False
 102
 103 -- | Check creation of an address pool when a network is given.
 104 prop_createAddressPool :: Objects.Network -> Property
 105 prop_createAddressPool n =
 106   let valid = networkIsValid n
 107   in  case createAddressPool n of
 108         Just _ -> True ==? valid
 109         Nothing -> False ==? valid
 110
 111 -- | Check that the address pool's properties are calculated correctly.
 112 prop_addressPoolProperties :: AddressPool -> Property
 113 prop_addressPoolProperties a =
 114   conjoin
 115     [ printTestCase
 116         ("Not all reservations are included in 'allReservations' of " ++
 117          "address pool:" ++ show a) (allReservationsSubsumesInternal a)
 118     , printTestCase
 119         ("Not all external reservations are covered by 'allReservations' " ++
 120          "of address pool: " ++ show a)
 121         (allReservationsSubsumesExternal a)
 122     , printTestCase
 123         ("The counts of free and reserved addresses do not add up for " ++
 124          "address pool: " ++ show a)
 125         (checkCounts a)
 126     , printTestCase
 127         ("'isFull' wrongly classified the status of the address pool: " ++
 128          show a) (checkIsFull a)
 129     , printTestCase
 130         ("Network map is inconsistent with reservations of address pool: " ++
 131          show a) (checkGetMap a)
 132     ]
 133
 134 -- | Check that all internally reserved ips are included in 'allReservations'.
 135 allReservationsSubsumesInternal :: AddressPool -> Bool
 136 allReservationsSubsumesInternal a =
 137   bitVectorSubsumes (allReservations a) (reservations a)
 138
 139 -- | Check that all externally reserved ips are included in 'allReservations'.
 140 allReservationsSubsumesExternal :: AddressPool -> Bool
 141 allReservationsSubsumesExternal a =
 142   bitVectorSubsumes (allReservations a) (extReservations a)
 143
 144 -- | Checks if one bit vector subsumes the other one.
 145 bitVectorSubsumes :: B.BitVector -> B.BitVector -> Bool
 146 bitVectorSubsumes v1 v2 = V.and $
 147                           V.zipWith (\a b -> if b then a else True) v1 v2
 148
 149 -- | Check that the counts of free and reserved ips add up.
 150 checkCounts :: AddressPool -> Bool
 151 checkCounts a =
 152   let res = reservations a
 153   in  V.length res == getFreeCount a + getReservedCount a
 154
 155 -- | Check that the detection of a full network works correctly.
 156 checkIsFull :: AddressPool -> Bool
 157 checkIsFull a = isFull a == V.notElem False (allReservations a)
 158
 159 -- | Check that the map representation of the network corresponds to the
 160 -- network's reservations.
 161 checkGetMap :: AddressPool -> Bool
 162 checkGetMap a =
 163   allReservations a == V.fromList (Prelude.map (== 'X') (getMap a))
 164
 165 testSuite "Network"
 166   [ 'prop_bitStringToBitVector
 167   , 'prop_createAddressPool
 168   , 'prop_addressPoolProperties
 169   ]
 170