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

   1 {-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3
   4 module Test.Ganeti.Network
   5   ( testNetwork
   6   , genBitStringMaxLen
   7   ) where
   8
   9 import Test.QuickCheck
  10
  11 import Ganeti.Network as Network
  12 import Ganeti.Objects as Objects
  13
  14 import Test.Ganeti.Objects
  15   ( genBitStringMaxLen
  16   , genValidNetwork )
  17 import Test.Ganeti.TestHelper
  18 import Test.Ganeti.TestCommon
  19
  20 import qualified Data.Vector.Unboxed as V
  21
  22 -- * Generators and arbitrary instances
  23
  24 -- | Generates address pools. The size of the network is intentionally
  25 -- decoupled from the size of the bit vectors, to avoid slowing down
  26 -- the tests by generating unnecessary bit strings.
  27 genAddressPool :: Int -> Gen AddressPool
  28 genAddressPool maxLenBitVec = do
  29   -- Generating networks with netmask of minimum /24 to avoid too long
  30   -- bit strings being generated.
  31   net <- genValidNetwork
  32   lenBitVec <- choose (0, maxLenBitVec)
  33   res <- genBitVector lenBitVec
  34   ext_res <- genBitVector lenBitVec
  35   return AddressPool { network = net
  36                      , reservations = res
  37                      , extReservations = ext_res }
  38
  39 -- | Generates an arbitrary bit vector of the given length.
  40 genBitVector :: Int -> Gen (V.Vector Bool)
  41 genBitVector len = do
  42   boolList <- vector len::Gen [Bool]
  43   return $ V.fromList boolList
  44
  45 instance Arbitrary AddressPool where
  46   arbitrary = genAddressPool ((2::Int)^(8::Int))
  47
  48 -- * Test cases
  49
  50 -- | Check the mapping of bit strings to bit vectors
  51 prop_bitStringToBitVector :: Property
  52 prop_bitStringToBitVector =
  53   forAll (genBitStringMaxLen 256) $ \bs ->
  54   let bitList = V.toList $ Network.bitStringToBitVector bs
  55       bitCharList = Prelude.zip bitList bs
  56   in  Prelude.all checkBit bitCharList
  57
  58 -- | Check whether an element of a bit vector is consistent with an element
  59 -- of a bit string (containing '0' and '1' characters).
  60 checkBit :: (Bool, Char) -> Bool
  61 checkBit (False, '0') = True
  62 checkBit (True, '1') = True
  63 checkBit _ = False
  64
  65 -- | Check creation of an address pool when a network is given.
  66 prop_createAddressPool :: Objects.Network -> Property
  67 prop_createAddressPool n =
  68   let valid = networkIsValid n
  69   in  case createAddressPool n of
  70         Just _ -> True ==? valid
  71         Nothing -> False ==? valid
  72
  73 -- | Check that the address pool's properties are calculated correctly.
  74 prop_addressPoolProperties :: AddressPool -> Property
  75 prop_addressPoolProperties a =
  76   conjoin
  77     [ printTestCase
  78         ("Not all reservations are included in 'allReservations' of " ++
  79          "address pool:" ++ show a) (allReservationsSubsumesInternal a)
  80     , printTestCase
  81         ("Not all external reservations are covered by 'allReservations' " ++
  82          "of address pool: " ++ show a)
  83         (allReservationsSubsumesExternal a)
  84     , printTestCase
  85         ("The counts of free and reserved addresses do not add up for " ++
  86          "address pool: " ++ show a)
  87         (checkCounts a)
  88     , printTestCase
  89         ("'isFull' wrongly classified the status of the address pool: " ++
  90          show a) (checkIsFull a)
  91     , printTestCase
  92         ("Network map is inconsistent with reservations of address pool: " ++
  93          show a) (checkGetMap a)
  94     ]
  95
  96 -- | Check that all internally reserved ips are included in 'allReservations'.
  97 allReservationsSubsumesInternal :: AddressPool -> Bool
  98 allReservationsSubsumesInternal a =
  99   bitVectorSubsumes (allReservations a) (reservations a)
 100
 101 -- | Check that all externally reserved ips are included in 'allReservations'.
 102 allReservationsSubsumesExternal :: AddressPool -> Bool
 103 allReservationsSubsumesExternal a =
 104   bitVectorSubsumes (allReservations a) (extReservations a)
 105
 106 -- | Checks if one bit vector subsumes the other one.
 107 bitVectorSubsumes :: V.Vector Bool -> V.Vector Bool -> Bool
 108 bitVectorSubsumes v1 v2 = V.and $
 109                           V.zipWith (\a b -> not b || a) v1 v2
 110
 111 -- | Check that the counts of free and reserved ips add up.
 112 checkCounts :: AddressPool -> Bool
 113 checkCounts a =
 114   let res = reservations a
 115   in  V.length res == getFreeCount a + getReservedCount a
 116
 117 -- | Check that the detection of a full network works correctly.
 118 checkIsFull :: AddressPool -> Bool
 119 checkIsFull a = isFull a == V.notElem False (allReservations a)
 120
 121 -- | Check that the map representation of the network corresponds to the
 122 -- network's reservations.
 123 checkGetMap :: AddressPool -> Bool
 124 checkGetMap a =
 125   allReservations a == V.fromList (Prelude.map (== 'X') (getMap a))
 126
 127 testSuite "Network"
 128   [ 'prop_bitStringToBitVector
 129   , 'prop_createAddressPool
 130   , 'prop_addressPoolProperties
 131   ]
 132