diff --git a/htest/Test/Ganeti/OpCodes.hs b/htest/Test/Ganeti/OpCodes.hs index 61ffd4abed455f560be05996801e2db7d937c03f..b1cac62b07b452ff4fd67fedbe3326d66f7a6e28 100644 --- a/htest/Test/Ganeti/OpCodes.hs +++ b/htest/Test/Ganeti/OpCodes.hs @@ -294,6 +294,20 @@ instance Arbitrary OpCodes.OpCode where getMaybe (pure []) <*> getMaybe genNameNE "OP_BACKUP_REMOVE" -> OpCodes.OpBackupRemove <$> getFQDN + "OP_TEST_ALLOCATOR" -> + OpCodes.OpTestAllocator <$> arbitrary <*> arbitrary <*> + genNameNE <*> pure [] <*> pure [] <*> + arbitrary <*> getMaybe genNameNE <*> + (genTags >>= mapM mkNonEmpty) <*> + arbitrary <*> arbitrary <*> getMaybe genNameNE <*> + arbitrary <*> getMaybe genNodeNamesNE <*> arbitrary <*> + getMaybe genNamesNE <*> arbitrary <*> arbitrary + "OP_TEST_JQUEUE" -> + OpCodes.OpTestJqueue <$> arbitrary <*> arbitrary <*> + resize 20 (listOf getFQDN) <*> arbitrary + "OP_TEST_DUMMY" -> + OpCodes.OpTestDummy <$> pure J.JSNull <*> pure J.JSNull <*> + pure J.JSNull <*> pure J.JSNull _ -> fail $ "Undefined arbitrary for opcode " ++ op_id -- * Helper functions diff --git a/htest/Test/Ganeti/Types.hs b/htest/Test/Ganeti/Types.hs index d7e959f71887119ac6756e447bc71d452ea6e42b..4bd0acdfdae6f506a818dcb604134d9a2490ebac 100644 --- a/htest/Test/Ganeti/Types.hs +++ b/htest/Test/Ganeti/Types.hs @@ -99,6 +99,10 @@ $(genArbitrary ''RebootType) $(genArbitrary ''ExportMode) +$(genArbitrary ''IAllocatorTestDir) + +$(genArbitrary ''IAllocatorMode) + -- * Properties prop_AllocPolicy_serialisation :: AllocPolicy -> Property @@ -212,6 +216,21 @@ prop_RebootType_serialisation = testSerialisation prop_ExportMode_serialisation :: ExportMode -> Property prop_ExportMode_serialisation = testSerialisation +-- | Test 'IAllocatorTestDir' serialisation. +prop_IAllocatorTestDir_serialisation :: IAllocatorTestDir -> Property +prop_IAllocatorTestDir_serialisation = testSerialisation + +-- | Test 'IAllocatorMode' serialisation. +prop_IAllocatorMode_serialisation :: IAllocatorMode -> Property +prop_IAllocatorMode_serialisation = testSerialisation + +-- | Tests equivalence with Python, based on Constants.hs code. +case_IAllocatorMode_pyequiv :: Assertion +case_IAllocatorMode_pyequiv = do + let all_py_codes = sort C.validIallocatorModes + all_hs_codes = sort $ map Types.iAllocatorModeToRaw [minBound..maxBound] + assertEqual "for IAllocatorMode equivalence" all_py_codes all_hs_codes + testSuite "Types" [ 'prop_AllocPolicy_serialisation , 'prop_DiskTemplate_serialisation @@ -236,4 +255,7 @@ testSuite "Types" , 'prop_InstCreateMode_serialisation , 'prop_RebootType_serialisation , 'prop_ExportMode_serialisation + , 'prop_IAllocatorTestDir_serialisation + , 'prop_IAllocatorMode_serialisation + , 'case_IAllocatorMode_pyequiv ] diff --git a/htools/Ganeti/OpCodes.hs b/htools/Ganeti/OpCodes.hs index 151b5e93878f87282430204b65e65516c05c3f0f..560e00f541636a54e40f6a69b427e83d6eff2914 100644 --- a/htools/Ganeti/OpCodes.hs +++ b/htools/Ganeti/OpCodes.hs @@ -445,6 +445,37 @@ $(genOpCode "OpCode" ]) , ("OpBackupRemove", [ pInstanceName ]) + , ("OpTestAllocator", + [ pIAllocatorDirection + , pIAllocatorMode + , pIAllocatorReqName + , pIAllocatorNics + , pIAllocatorDisks + , pHypervisor + , pIallocator + , pInstTags + , pIAllocatorMemory + , pIAllocatorVCpus + , pIAllocatorOs + , pDiskTemplate + , pIAllocatorInstances + , pIAllocatorEvacMode + , pTargetGroups + , pIAllocatorSpindleUse + , pIAllocatorCount + ]) + , ("OpTestJqueue", + [ pJQueueNotifyWaitLock + , pJQueueNotifyExec + , pJQueueLogMessages + , pJQueueFail + ]) + , ("OpTestDummy", + [ pTestDummyResult + , pTestDummyMessages + , pTestDummyFail + , pTestDummySubmitJobs + ]) ]) -- | Returns the OP_ID for a given opcode value. diff --git a/htools/Ganeti/OpParams.hs b/htools/Ganeti/OpParams.hs index 4039c892581d6a14f20260ebab0aff2b95231e82..3cc5c8c7198c8c790d454fe7894a7220e07a6400 100644 --- a/htools/Ganeti/OpParams.hs +++ b/htools/Ganeti/OpParams.hs @@ -189,6 +189,26 @@ module Ganeti.OpParams , pX509DestCA , pTagSearchPattern , pDelayRepeat + , pIAllocatorDirection + , pIAllocatorMode + , pIAllocatorReqName + , pIAllocatorNics + , pIAllocatorDisks + , pIAllocatorMemory + , pIAllocatorVCpus + , pIAllocatorOs + , pIAllocatorInstances + , pIAllocatorEvacMode + , pIAllocatorSpindleUse + , pIAllocatorCount + , pJQueueNotifyWaitLock + , pJQueueNotifyExec + , pJQueueLogMessages + , pJQueueFail + , pTestDummyResult + , pTestDummyMessages + , pTestDummyFail + , pTestDummySubmitJobs ) where import Control.Monad (liftM) @@ -233,8 +253,8 @@ optionalStringField = optionalField . stringField optionalNEStringField :: String -> Field optionalNEStringField = optionalField . flip simpleField [t| NonEmptyString |] ---- | Unchecked value, should be replaced by a better definition. ---- type UncheckedValue = JSValue +-- | Unchecked value, should be replaced by a better definition. +type UncheckedValue = JSValue -- | Unchecked dict, should be replaced by a better definition. type UncheckedDict = JSObject JSValue @@ -1121,9 +1141,124 @@ pTagSearchPattern :: Field pTagSearchPattern = renameField "TagSearchPattern" $ simpleField "pattern" [t| NonEmptyString |] +-- * Test opcode parameters + -- | Repeat parameter for OpTestDelay. pDelayRepeat :: Field pDelayRepeat = renameField "DelayRepeat" . defaultField [| forceNonNeg (0::Int) |] $ simpleField "repeat" [t| NonNegative Int |] + +-- | IAllocator test direction. +pIAllocatorDirection :: Field +pIAllocatorDirection = + renameField "IAllocatorDirection" $ + simpleField "direction" [t| IAllocatorTestDir |] + +-- | IAllocator test mode. +pIAllocatorMode :: Field +pIAllocatorMode = + renameField "IAllocatorMode" $ + simpleField "mode" [t| IAllocatorMode |] + +-- | IAllocator target name (new instance, node to evac, etc.). +pIAllocatorReqName :: Field +pIAllocatorReqName = + renameField "IAllocatorReqName" $ simpleField "name" [t| NonEmptyString |] + +-- | Custom OpTestIAllocator nics. +pIAllocatorNics :: Field +pIAllocatorNics = + renameField "IAllocatorNics" $ simpleField "nics" [t| [UncheckedDict] |] + +-- | Custom OpTestAllocator disks. +pIAllocatorDisks :: Field +pIAllocatorDisks = + renameField "IAllocatorDisks" $ simpleField "disks" [t| UncheckedList |] + +-- | IAllocator memory field. +pIAllocatorMemory :: Field +pIAllocatorMemory = + renameField "IAllocatorMem" . + optionalField $ + simpleField "memory" [t| NonNegative Int |] + +-- | IAllocator vcpus field. +pIAllocatorVCpus :: Field +pIAllocatorVCpus = + renameField "IAllocatorVCpus" . + optionalField $ + simpleField "vcpus" [t| NonNegative Int |] + +-- | IAllocator os field. +pIAllocatorOs :: Field +pIAllocatorOs = renameField "IAllocatorOs" $ optionalNEStringField "os" + +-- | IAllocator instances field. +pIAllocatorInstances :: Field +pIAllocatorInstances = + renameField "IAllocatorInstances " . + optionalField $ + simpleField "instances" [t| [NonEmptyString] |] + +-- | IAllocator evac mode. +pIAllocatorEvacMode :: Field +pIAllocatorEvacMode = + renameField "IAllocatorEvacMode" . + optionalField $ + simpleField "evac_mode" [t| NodeEvacMode |] + +-- | IAllocator spindle use. +pIAllocatorSpindleUse :: Field +pIAllocatorSpindleUse = + renameField "IAllocatorSpindleUse" . + defaultField [| forceNonNeg (1::Int) |] $ + simpleField "spindle_use" [t| NonNegative Int |] + +-- | IAllocator count field. +pIAllocatorCount :: Field +pIAllocatorCount = + renameField "IAllocatorCount" . + defaultField [| forceNonNeg (1::Int) |] $ + simpleField "count" [t| NonNegative Int |] + +-- | 'OpTestJqueue' notify_waitlock. +pJQueueNotifyWaitLock :: Field +pJQueueNotifyWaitLock = defaultFalse "notify_waitlock" + +-- | 'OpTestJQueue' notify_exec. +pJQueueNotifyExec :: Field +pJQueueNotifyExec = defaultFalse "notify_exec" + +-- | 'OpTestJQueue' log_messages. +pJQueueLogMessages :: Field +pJQueueLogMessages = + defaultField [| [] |] $ simpleField "log_messages" [t| [String] |] + +-- | 'OpTestJQueue' fail attribute. +pJQueueFail :: Field +pJQueueFail = + renameField "JQueueFail" $ defaultFalse "fail" + +-- | 'OpTestDummy' result field. +pTestDummyResult :: Field +pTestDummyResult = + renameField "TestDummyResult" $ simpleField "result" [t| UncheckedValue |] + +-- | 'OpTestDummy' messages field. +pTestDummyMessages :: Field +pTestDummyMessages = + renameField "TestDummyMessages" $ + simpleField "messages" [t| UncheckedValue |] + +-- | 'OpTestDummy' fail field. +pTestDummyFail :: Field +pTestDummyFail = + renameField "TestDummyFail" $ simpleField "fail" [t| UncheckedValue |] + +-- | 'OpTestDummy' submit_jobs field. +pTestDummySubmitJobs :: Field +pTestDummySubmitJobs = + renameField "TestDummySubmitJobs" $ + simpleField "submit_jobs" [t| UncheckedValue |] diff --git a/htools/Ganeti/Types.hs b/htools/Ganeti/Types.hs index 170d13f8e48a591df9c89c6ce7b5bd342de1ef88..659a8045a5fb19eccd17c365e77373f3ed0a011f 100644 --- a/htools/Ganeti/Types.hs +++ b/htools/Ganeti/Types.hs @@ -64,6 +64,9 @@ module Ganeti.Types , InstCreateMode(..) , RebootType(..) , ExportMode(..) + , IAllocatorTestDir(..) + , IAllocatorMode(..) + , iAllocatorModeToRaw ) where import qualified Text.JSON as JSON @@ -294,3 +297,20 @@ $(THH.declareSADT "ExportMode" , ("ExportModeRemove", 'C.exportModeRemote) ]) $(THH.makeJSONInstance ''ExportMode) + +-- | IAllocator run types (OpTestIAllocator). +$(THH.declareSADT "IAllocatorTestDir" + [ ("IAllocatorDirIn", 'C.iallocatorDirIn) + , ("IAllocatorDirOut", 'C.iallocatorDirOut) + ]) +$(THH.makeJSONInstance ''IAllocatorTestDir) + +-- | IAllocator mode. FIXME: use this in "HTools.Backend.IAlloc". +$(THH.declareSADT "IAllocatorMode" + [ ("IAllocatorAlloc", 'C.iallocatorModeAlloc) + , ("IAllocatorMultiAlloc", 'C.iallocatorModeMultiAlloc) + , ("IAllocatorReloc", 'C.iallocatorModeReloc) + , ("IAllocatorNodeEvac", 'C.iallocatorModeNodeEvac) + , ("IAllocatorChangeGroup", 'C.iallocatorModeChgGroup) + ]) +$(THH.makeJSONInstance ''IAllocatorMode)