From a3f023175022b68041d1e31763712ec60d5c5d36 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Sat, 24 Nov 2012 22:35:07 +0100
Subject: [PATCH] Complete the Test opcodes
This adds the OpTestAllocator, OpTestJqueue and OpTestDummy
opcodes. The OpTestAllocator seems to need some cleanup (on the Python
side), for now we implement it as is. As for the other two, while not
used in production, we should have full coverage for them as well.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Helga Velroyen <helgav@google.com>
---
htest/Test/Ganeti/OpCodes.hs | 14 ++++
htest/Test/Ganeti/Types.hs | 22 ++++++
htools/Ganeti/OpCodes.hs | 31 ++++++++
htools/Ganeti/OpParams.hs | 139 ++++++++++++++++++++++++++++++++++-
htools/Ganeti/Types.hs | 20 +++++
5 files changed, 224 insertions(+), 2 deletions(-)
diff --git a/htest/Test/Ganeti/OpCodes.hs b/htest/Test/Ganeti/OpCodes.hs
index 61ffd4abe..b1cac62b0 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 d7e959f71..4bd0acdfd 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 151b5e938..560e00f54 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 4039c8925..3cc5c8c71 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 170d13f8e..659a8045a 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)
--
GitLab