diff --git a/htest/Test/Ganeti/Types.hs b/htest/Test/Ganeti/Types.hs index 23f84a55771c3a3c62689ad88609c9dfb4fbf631..e3774dbcc0b834b8900bf705088d44d9ec32046c 100644 --- a/htest/Test/Ganeti/Types.hs +++ b/htest/Test/Ganeti/Types.hs @@ -72,8 +72,12 @@ $(genArbitrary ''CVErrorCode) $(genArbitrary ''Hypervisor) +$(genArbitrary ''OobCommand) + $(genArbitrary ''StorageType) +$(genArbitrary ''NodeEvacMode) + instance (Arbitrary a) => Arbitrary (Types.NonEmpty a) where arbitrary = do QuickCheck.NonEmpty lst <- arbitrary @@ -160,10 +164,18 @@ case_CVErrorCode_pyequiv = do prop_Hypervisor_serialisation :: Hypervisor -> Property prop_Hypervisor_serialisation = testSerialisation +-- | Test 'OobCommand' serialisation. +prop_OobCommand_serialisation :: OobCommand -> Property +prop_OobCommand_serialisation = testSerialisation + -- | Test 'StorageType' serialisation. prop_StorageType_serialisation :: StorageType -> Property prop_StorageType_serialisation = testSerialisation +-- | Test 'NodeEvacMode' serialisation. +prop_NodeEvacMode_serialisation :: NodeEvacMode -> Property +prop_NodeEvacMode_serialisation = testSerialisation + testSuite "Types" [ 'prop_AllocPolicy_serialisation , 'prop_DiskTemplate_serialisation @@ -180,5 +192,7 @@ testSuite "Types" , 'prop_CVErrorCode_serialisation , 'case_CVErrorCode_pyequiv , 'prop_Hypervisor_serialisation + , 'prop_OobCommand_serialisation , 'prop_StorageType_serialisation + , 'prop_NodeEvacMode_serialisation ] diff --git a/htools/Ganeti/Types.hs b/htools/Ganeti/Types.hs index 1b47085069f02d14cc0a519a6297246f82b42c03..4420d47aa5d1beaa900178381afec00d85d623fc 100644 --- a/htools/Ganeti/Types.hs +++ b/htools/Ganeti/Types.hs @@ -49,13 +49,16 @@ module Ganeti.Types , NonEmpty , fromNonEmpty , mkNonEmpty + , NonEmptyString , MigrationMode(..) , VerifyOptionalChecks(..) , DdmSimple(..) , CVErrorCode(..) , cVErrorCodeToRaw , Hypervisor(..) + , OobCommand(..) , StorageType(..) + , NodeEvacMode(..) ) where import qualified Text.JSON as JSON @@ -107,6 +110,9 @@ instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where showJSON = JSON.showJSON . fromNonEmpty readJSON v = JSON.readJSON v >>= mkNonEmpty +-- | A simple type alias for non-empty strings. +type NonEmptyString = NonEmpty Char + -- * Ganeti types -- | Instance disk template type. @@ -220,6 +226,16 @@ $(THH.declareSADT "Hypervisor" ]) $(THH.makeJSONInstance ''Hypervisor) +-- | Oob command type. +$(THH.declareSADT "OobCommand" + [ ("OobHealth", 'C.oobHealth) + , ("OobPowerCycle", 'C.oobPowerCycle) + , ("OobPowerOff", 'C.oobPowerOff) + , ("OobPowerOn", 'C.oobPowerOn) + , ("OobPowerStatus", 'C.oobPowerStatus) + ]) +$(THH.makeJSONInstance ''OobCommand) + -- | Storage type. $(THH.declareSADT "StorageType" [ ("StorageFile", 'C.stFile) @@ -227,3 +243,11 @@ $(THH.declareSADT "StorageType" , ("StorageLvmVg", 'C.stLvmVg) ]) $(THH.makeJSONInstance ''StorageType) + +-- | Node evac modes. +$(THH.declareSADT "NodeEvacMode" + [ ("NEvacPrimary", 'C.iallocatorNevacPri) + , ("NEvacSecondary", 'C.iallocatorNevacSec) + , ("NEvacAll", 'C.iallocatorNevacAll) + ]) +$(THH.makeJSONInstance ''NodeEvacMode)