From fa23de0bc6a59316fdc624cc854bf9fb446c371c Mon Sep 17 00:00:00 2001
From: Helga Velroyen <helgav@google.com>
Date: Thu, 6 Dec 2012 19:35:44 +0100
Subject: [PATCH] Revert "Network and address pool"
This reverts commit b9a616e132af9bba718d2da8c94eeec7af886814, which
depends on the "bitvec" library. We need to investigate a bit further that
dependency, as it in turns depends on "vector" 0.9.1 or *below*, since
0.10.* removed support for Data.Vector.Unboxed.Safe which it uses.
Signed-off-by: Helga Velroyen <helgav@google.com>
Signed-off-by: Guido Trotter <ultrotter@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>
---
Makefile.am | 2 -
htest/Test/Ganeti/Network.hs | 170 ----------------------------
htest/Test/Ganeti/Objects.hs | 35 ------
htest/Test/Ganeti/Query/Language.hs | 1 -
htest/test.hs | 2 -
htools/Ganeti/Network.hs | 104 -----------------
htools/Ganeti/Objects.hs | 37 ------
7 files changed, 351 deletions(-)
delete mode 100644 htest/Test/Ganeti/Network.hs
delete mode 100644 htools/Ganeti/Network.hs
diff --git a/Makefile.am b/Makefile.am
index 86e41141b..6c2275bd9 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -481,7 +481,6 @@ 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 \
@@ -524,7 +523,6 @@ 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 \
diff --git a/htest/Test/Ganeti/Network.hs b/htest/Test/Ganeti/Network.hs
deleted file mode 100644
index 085b92c48..000000000
--- a/htest/Test/Ganeti/Network.hs
+++ /dev/null
@@ -1,170 +0,0 @@
-{-# 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.Bit as B
-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 B.BitVector
-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 :: B.BitVector -> B.BitVector -> Bool
-bitVectorSubsumes v1 v2 = V.and $
- V.zipWith (\a b -> if b then a else True) 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
- ]
-
diff --git a/htest/Test/Ganeti/Objects.hs b/htest/Test/Ganeti/Objects.hs
index 7e3e9919f..66b704299 100644
--- a/htest/Test/Ganeti/Objects.hs
+++ b/htest/Test/Ganeti/Objects.hs
@@ -38,7 +38,6 @@ 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 ()
@@ -163,35 +162,6 @@ 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
@@ -252,10 +222,6 @@ 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 =
@@ -265,7 +231,6 @@ testSuite "Objects"
[ 'prop_fillDict
, 'prop_Disk_serialisation
, 'prop_Inst_serialisation
- , 'prop_Network_serialisation
, 'prop_Node_serialisation
, 'prop_Config_serialisation
]
diff --git a/htest/Test/Ganeti/Query/Language.hs b/htest/Test/Ganeti/Query/Language.hs
index 7934edb52..01a96d520 100644
--- a/htest/Test/Ganeti/Query/Language.hs
+++ b/htest/Test/Ganeti/Query/Language.hs
@@ -29,7 +29,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Test.Ganeti.Query.Language
( testQuery_Language
, genFilter
- , genJSValue
) where
import Test.QuickCheck
diff --git a/htest/test.hs b/htest/test.hs
index 0a31d3dcc..486b0a906 100644
--- a/htest/test.hs
+++ b/htest/test.hs
@@ -52,7 +52,6 @@ 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
@@ -101,7 +100,6 @@ allTests =
, testJSON
, testJobs
, testLuxi
- , testNetwork
, testObjects
, testOpCodes
, testQuery_Filter
diff --git a/htools/Ganeti/Network.hs b/htools/Ganeti/Network.hs
deleted file mode 100644
index 4c209f02c..000000000
--- a/htools/Ganeti/Network.hs
+++ /dev/null
@@ -1,104 +0,0 @@
-{-| 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.Bit as B
-import qualified Data.Vector.Unboxed as V
-
-import Ganeti.Objects
-
-data AddressPool = AddressPool { network :: Network,
- reservations :: B.BitVector,
- extReservations :: B.BitVector }
- 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 -> B.BitVector
-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 -> B.BitVector
-bitStringToBitVector = V.fromList . map (/= '0')
-
--- | Get a bit vector of all reservations (internal and external) combined.
-allReservations :: AddressPool -> B.BitVector
-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 '.'
-
diff --git a/htools/Ganeti/Objects.hs b/htools/Ganeti/Objects.hs
index 18ca6dfe1..a3e9980d8 100644
--- a/htools/Ganeti/Objects.hs
+++ b/htools/Ganeti/Objects.hs
@@ -87,7 +87,6 @@ module Ganeti.Objects
, TagsObject(..)
, DictObject(..) -- re-exported from THH
, TagSet -- re-exported from THH
- , Network(..)
) where
import Data.List (foldl')
@@ -591,39 +590,3 @@ $(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
-
--
GitLab