diff --git a/htest/Test/Ganeti/Objects.hs b/htest/Test/Ganeti/Objects.hs index de21d0c15d4450186493465c41231dd6eaa3a624..aa4e16a0cf9ecca5e7522d6820cfe809c9011600 100644 --- a/htest/Test/Ganeti/Objects.hs +++ b/htest/Test/Ganeti/Objects.hs @@ -28,7 +28,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA module Test.Ganeti.Objects ( testObjects - , Hypervisor(..) , Node(..) , genEmptyCluster ) where @@ -51,8 +50,6 @@ import Ganeti.JSON -- * Arbitrary instances -$(genArbitrary ''Hypervisor) - $(genArbitrary ''PartialNDParams) instance Arbitrary Node where diff --git a/htest/Test/Ganeti/Types.hs b/htest/Test/Ganeti/Types.hs index f0ba40a616f3ab17d300732e74a2d46efac2e80a..d3dbd699686c3dbcd1624e312bd85d6698743ac3 100644 --- a/htest/Test/Ganeti/Types.hs +++ b/htest/Test/Ganeti/Types.hs @@ -32,6 +32,7 @@ module Test.Ganeti.Types , DiskTemplate(..) , InstanceStatus(..) , NonEmpty(..) + , Hypervisor(..) ) where import Data.List (sort) @@ -69,6 +70,8 @@ $(genArbitrary ''DdmSimple) $(genArbitrary ''CVErrorCode) +$(genArbitrary ''Hypervisor) + instance (Arbitrary a) => Arbitrary (Types.NonEmpty a) where arbitrary = do QuickCheck.NonEmpty lst <- arbitrary @@ -151,6 +154,10 @@ case_CVErrorCode_pyequiv = do all_hs_codes = sort $ map Types.cVErrorCodeToRaw [minBound..maxBound] assertEqual "for CVErrorCode equivalence" all_py_codes all_hs_codes +-- | Test 'Hypervisor' serialisation. +prop_Hypervisor_serialisation :: Hypervisor -> Property +prop_Hypervisor_serialisation = testSerialisation + testSuite "Types" [ 'prop_AllocPolicy_serialisation , 'prop_DiskTemplate_serialisation @@ -166,4 +173,5 @@ testSuite "Types" , 'prop_DdmSimple_serialisation , 'prop_CVErrorCode_serialisation , 'case_CVErrorCode_pyequiv + , 'prop_Hypervisor_serialisation ] diff --git a/htools/Ganeti/Config.hs b/htools/Ganeti/Config.hs index c2c6929057513839c0aac7330511960834c0bddd..2561cb000210a0b7248e788d041093335de2b547 100644 --- a/htools/Ganeti/Config.hs +++ b/htools/Ganeti/Config.hs @@ -59,6 +59,7 @@ import qualified Ganeti.Constants as C import Ganeti.Errors import Ganeti.JSON import Ganeti.Objects +import Ganeti.Types -- | Type alias for the link and ip map. type LinkIpMap = M.Map String (M.Map String String) diff --git a/htools/Ganeti/Objects.hs b/htools/Ganeti/Objects.hs index 021f9ed2225a42ff06961e8d9fb9fc6807ae60ba..1b98db35dcdde8b01e050e95062975b7fffd0743 100644 --- a/htools/Ganeti/Objects.hs +++ b/htools/Ganeti/Objects.hs @@ -50,7 +50,6 @@ module Ganeti.Objects , FilledBeParams(..) , fillBeParams , allBeParamFields - , Hypervisor(..) , AdminState(..) , adminStateFromRaw , Instance(..) @@ -329,19 +328,6 @@ $(buildObjectSerialisation "Disk" , defaultField [| DiskRdWr |] $ simpleField "mode" [t| DiskMode |] ]) --- * Hypervisor definitions - --- | This may be due to change when we add hypervisor parameters. -$(declareSADT "Hypervisor" - [ ( "Kvm", 'C.htKvm ) - , ( "XenPvm", 'C.htXenPvm ) - , ( "Chroot", 'C.htChroot ) - , ( "XenHvm", 'C.htXenHvm ) - , ( "Lxc", 'C.htLxc ) - , ( "Fake", 'C.htFake ) - ]) -$(makeJSONInstance ''Hypervisor) - -- * Instance definitions $(declareSADT "AdminState" diff --git a/htools/Ganeti/Rpc.hs b/htools/Ganeti/Rpc.hs index f328b0e0c8524bf331892154c1fb8c5558bfbe09..d20d4c0ca94f1bc19eedb3936efe2a864967002b 100644 --- a/htools/Ganeti/Rpc.hs +++ b/htools/Ganeti/Rpc.hs @@ -82,6 +82,7 @@ import qualified Ganeti.Path as P import qualified Ganeti.Constants as C import Ganeti.Objects import Ganeti.THH +import Ganeti.Types import Ganeti.Compat -- * Base RPC functionality and types diff --git a/htools/Ganeti/Types.hs b/htools/Ganeti/Types.hs index 99eceae14c7f02d56ebfaed7790f4c17bdd08be9..7869551088d7cfb6f3cf7f3d7f3db6a51abde2de 100644 --- a/htools/Ganeti/Types.hs +++ b/htools/Ganeti/Types.hs @@ -54,6 +54,7 @@ module Ganeti.Types , DdmSimple(..) , CVErrorCode(..) , cVErrorCodeToRaw + , Hypervisor(..) ) where import qualified Text.JSON as JSON @@ -206,3 +207,14 @@ $(THH.declareSADT "DdmSimple" , ("DdmSimpleRemove", 'C.ddmRemove) ]) $(THH.makeJSONInstance ''DdmSimple) + +-- | Hypervisor type definitions. +$(THH.declareSADT "Hypervisor" + [ ( "Kvm", 'C.htKvm ) + , ( "XenPvm", 'C.htXenPvm ) + , ( "Chroot", 'C.htChroot ) + , ( "XenHvm", 'C.htXenHvm ) + , ( "Lxc", 'C.htLxc ) + , ( "Fake", 'C.htFake ) + ]) +$(THH.makeJSONInstance ''Hypervisor)