Commit c2d3219b authored by Iustin Pop's avatar Iustin Pop
Browse files

Complete the instance OpCodes and parameters



Only the original instance opcodes (used in htools) are left
non-converted to only parameter style; they'll be cleaned up later,
once the htools codebase itself migrates to safer types.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarHelga Velroyen <helgav@google.com>
parent 08f31176
......@@ -77,6 +77,23 @@ instance Arbitrary IDiskParams where
getMaybe genNameNE <*> getMaybe genNameNE <*>
getMaybe genNameNE
instance Arbitrary RecreateDisksInfo where
arbitrary = oneof [ pure RecreateDisksAll
, RecreateDisksIndices <$> arbitrary
, RecreateDisksParams <$> arbitrary
]
instance Arbitrary DdmOldChanges where
arbitrary = oneof [ DdmOldIndex <$> arbitrary
, DdmOldMod <$> arbitrary
]
instance (Arbitrary a) => Arbitrary (SetParamsMods a) where
arbitrary = oneof [ pure SetParamsEmpty
, SetParamsDeprecated <$> arbitrary
, SetParamsNew <$> arbitrary
]
instance Arbitrary OpCodes.OpCode where
arbitrary = do
op_id <- elements OpCodes.allOpIDs
......@@ -189,6 +206,53 @@ instance Arbitrary OpCodes.OpCode where
arbitrary <*> getMaybe genNodeNameNE <*>
getMaybe genNodeNameNE <*> getMaybe genNameNE <*>
arbitrary <*> (genTags >>= mapM mkNonEmpty)
"OP_INSTANCE_MULTI_ALLOC" ->
OpCodes.OpInstanceMultiAlloc <$> getMaybe genNameNE <*> pure []
"OP_INSTANCE_REINSTALL" ->
OpCodes.OpInstanceReinstall <$> getFQDN <*> arbitrary <*>
getMaybe genNameNE <*> getMaybe (pure emptyJSObject)
"OP_INSTANCE_REMOVE" ->
OpCodes.OpInstanceRemove <$> getFQDN <*> arbitrary <*> arbitrary
"OP_INSTANCE_RENAME" ->
OpCodes.OpInstanceRename <$> getFQDN <*> genNodeNameNE <*>
arbitrary <*> arbitrary
"OP_INSTANCE_STARTUP" ->
OpCodes.OpInstanceStartup <$> getFQDN <*> arbitrary <*> arbitrary <*>
pure emptyJSObject <*> pure emptyJSObject <*>
arbitrary <*> arbitrary
"OP_INSTANCE_SHUTDOWN" ->
OpCodes.OpInstanceShutdown <$> getFQDN <*> arbitrary <*>
arbitrary <*> arbitrary
"OP_INSTANCE_REBOOT" ->
OpCodes.OpInstanceReboot <$> getFQDN <*> arbitrary <*>
arbitrary <*> arbitrary
"OP_INSTANCE_MOVE" ->
OpCodes.OpInstanceMove <$> getFQDN <*> arbitrary <*> arbitrary <*>
genNodeNameNE <*> arbitrary
"OP_INSTANCE_CONSOLE" -> OpCodes.OpInstanceConsole <$> getFQDN
"OP_INSTANCE_ACTIVATE_DISKS" ->
OpCodes.OpInstanceActivateDisks <$> getFQDN <*>
arbitrary <*> arbitrary
"OP_INSTANCE_DEACTIVATE_DISKS" ->
OpCodes.OpInstanceDeactivateDisks <$> getFQDN <*> arbitrary
"OP_INSTANCE_RECREATE_DISKS" ->
OpCodes.OpInstanceRecreateDisks <$> getFQDN <*> arbitrary <*>
genNodeNamesNE <*> getMaybe genNameNE
"OP_INSTANCE_QUERY_DATA" ->
OpCodes.OpInstanceQueryData <$> arbitrary <*>
genNodeNamesNE <*> arbitrary
"OP_INSTANCE_SET_PARAMS" ->
OpCodes.OpInstanceSetParams <$> getFQDN <*> arbitrary <*>
arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
pure emptyJSObject <*> arbitrary <*> pure emptyJSObject <*>
arbitrary <*> getMaybe genNodeNameNE <*> getMaybe genNameNE <*>
pure emptyJSObject <*> arbitrary <*> arbitrary <*> arbitrary
"OP_INSTANCE_GROW_DISK" ->
OpCodes.OpInstanceGrowDisk <$> getFQDN <*> arbitrary <*>
arbitrary <*> arbitrary <*> arbitrary
"OP_INSTANCE_CHANGE_GROUP" ->
OpCodes.OpInstanceChangeGroup <$> getFQDN <*> arbitrary <*>
getMaybe genNameNE <*> getMaybe (resize maxNodes (listOf genNameNE))
_ -> fail $ "Undefined arbitrary for opcode " ++ op_id
-- * Helper functions
......
......@@ -79,6 +79,8 @@ $(genArbitrary ''VerifyOptionalChecks)
$(genArbitrary ''DdmSimple)
$(genArbitrary ''DdmFull)
$(genArbitrary ''CVErrorCode)
$(genArbitrary ''Hypervisor)
......@@ -93,6 +95,8 @@ $(genArbitrary ''FileDriver)
$(genArbitrary ''InstCreateMode)
$(genArbitrary ''RebootType)
-- * Properties
prop_AllocPolicy_serialisation :: AllocPolicy -> Property
......@@ -159,6 +163,10 @@ prop_VerifyOptionalChecks_serialisation = testSerialisation
prop_DdmSimple_serialisation :: DdmSimple -> Property
prop_DdmSimple_serialisation = testSerialisation
-- | Tests 'DdmFull' serialisation.
prop_DdmFull_serialisation :: DdmFull -> Property
prop_DdmFull_serialisation = testSerialisation
-- | Tests 'CVErrorCode' serialisation.
prop_CVErrorCode_serialisation :: CVErrorCode -> Property
prop_CVErrorCode_serialisation = testSerialisation
......@@ -194,6 +202,10 @@ prop_FileDriver_serialisation = testSerialisation
prop_InstCreateMode_serialisation :: InstCreateMode -> Property
prop_InstCreateMode_serialisation = testSerialisation
-- | Test 'RebootType' serialisation.
prop_RebootType_serialisation :: RebootType -> Property
prop_RebootType_serialisation = testSerialisation
testSuite "Types"
[ 'prop_AllocPolicy_serialisation
, 'prop_DiskTemplate_serialisation
......@@ -207,6 +219,7 @@ testSuite "Types"
, 'prop_MigrationMode_serialisation
, 'prop_VerifyOptionalChecks_serialisation
, 'prop_DdmSimple_serialisation
, 'prop_DdmFull_serialisation
, 'prop_CVErrorCode_serialisation
, 'case_CVErrorCode_pyequiv
, 'prop_Hypervisor_serialisation
......@@ -215,4 +228,5 @@ testSuite "Types"
, 'prop_NodeEvacMode_serialisation
, 'prop_FileDriver_serialisation
, 'prop_InstCreateMode_serialisation
, 'prop_RebootType_serialisation
]
......@@ -274,6 +274,108 @@ $(genOpCode "OpCode"
, pStartInstance
, pInstTags
])
, ("OpInstanceMultiAlloc",
[ pIallocator
, pMultiAllocInstances
])
, ("OpInstanceReinstall",
[ pInstanceName
, pForceVariant
, pInstOs
, pTempOsParams
])
, ("OpInstanceRemove",
[ pInstanceName
, pShutdownTimeout
, pIgnoreFailures
])
, ("OpInstanceRename",
[ pInstanceName
, pNewName
, pNameCheck
, pIpCheck
])
, ("OpInstanceStartup",
[ pInstanceName
, pForce
, pIgnoreOfflineNodes
, pTempHvParams
, pTempBeParams
, pNoRemember
, pStartupPaused
])
, ("OpInstanceShutdown",
[ pInstanceName
, pIgnoreOfflineNodes
, pShutdownTimeout'
, pNoRemember
])
, ("OpInstanceReboot",
[ pInstanceName
, pShutdownTimeout
, pIgnoreSecondaries
, pRebootType
])
, ("OpInstanceMove",
[ pInstanceName
, pShutdownTimeout
, pIgnoreIpolicy
, pMoveTargetNode
, pIgnoreConsistency
])
, ("OpInstanceConsole",
[ pInstanceName ])
, ("OpInstanceActivateDisks",
[ pInstanceName
, pIgnoreDiskSize
, pWaitForSyncFalse
])
, ("OpInstanceDeactivateDisks",
[ pInstanceName
, pForce
])
, ("OpInstanceRecreateDisks",
[ pInstanceName
, pRecreateDisksInfo
, pNodes
, pIallocator
])
, ("OpInstanceQueryData",
[ pUseLocking
, pInstances
, pStatic
])
, ("OpInstanceSetParams",
[ pInstanceName
, pForce
, pForceVariant
, pIgnoreIpolicy
, pInstParamsNicChanges
, pInstParamsDiskChanges
, pInstBeParams
, pRuntimeMem
, pInstHvParams
, pDiskTemplate
, pRemoteNode
, pOsNameChange
, pInstOsParams
, pWaitForSync
, pOffline
, pIpConflictsCheck
])
, ("OpInstanceGrowDisk",
[ pInstanceName
, pWaitForSync
, pDiskIndex
, pDiskChgAmount
, pDiskChgAbsolute
])
, ("OpInstanceChangeGroup",
[ pInstanceName
, pEarlyRelease
, pIallocator
, pTargetGroups
])
])
-- | Returns the OP_ID for a given opcode value.
......
......@@ -44,6 +44,9 @@ module Ganeti.OpParams
, DiskAccess(..)
, INicParams(..)
, IDiskParams(..)
, RecreateDisksInfo(..)
, DdmOldChanges(..)
, SetParamsMods(..)
, pInstanceName
, pInstances
, pName
......@@ -51,6 +54,7 @@ module Ganeti.OpParams
, pTagsObject
, pOutputFields
, pShutdownTimeout
, pShutdownTimeout'
, pForce
, pIgnoreOfflineNodes
, pNodeName
......@@ -73,6 +77,7 @@ module Ganeti.OpParams
, pIpConflictsCheck
, pNoRemember
, pMigrationTargetNode
, pMoveTargetNode
, pStartupPaused
, pVerbose
, pDebugSimulateErrors
......@@ -155,11 +160,32 @@ module Ganeti.OpParams
, pSrcPath
, pStartInstance
, pInstTags
, pMultiAllocInstances
, pTempOsParams
, pTempHvParams
, pTempBeParams
, pIgnoreFailures
, pNewName
, pIgnoreSecondaries
, pRebootType
, pIgnoreDiskSize
, pRecreateDisksInfo
, pStatic
, pInstParamsNicChanges
, pInstParamsDiskChanges
, pRuntimeMem
, pOsNameChange
, pDiskIndex
, pDiskChgAmount
, pDiskChgAbsolute
, pTargetGroups
) where
import Control.Monad (liftM)
import qualified Data.Set as Set
import Text.JSON (readJSON, showJSON, JSON, JSValue(..), fromJSString,
JSObject, toJSObject)
import qualified Text.JSON
import Text.JSON.Pretty (pp_value)
import Ganeti.BasicTypes
......@@ -327,6 +353,74 @@ $(buildObject "IDiskParams" "idisk"
, optionalField $ simpleField C.idiskMetavg [t| NonEmptyString |]
])
-- | Disk changes type for OpInstanceRecreateDisks. This is a bit
-- strange, because the type in Python is something like Either
-- [DiskIndex] [DiskChanges], but we can't represent the type of an
-- empty list in JSON, so we have to add a custom case for the empty
-- list.
data RecreateDisksInfo
= RecreateDisksAll
| RecreateDisksIndices (NonEmpty DiskIndex)
| RecreateDisksParams (NonEmpty (DiskIndex, IDiskParams))
deriving (Eq, Read, Show)
readRecreateDisks :: JSValue -> Text.JSON.Result RecreateDisksInfo
readRecreateDisks (JSArray []) = return RecreateDisksAll
readRecreateDisks v =
case readJSON v::Text.JSON.Result [DiskIndex] of
Text.JSON.Ok indices -> liftM RecreateDisksIndices (mkNonEmpty indices)
_ -> case readJSON v::Text.JSON.Result [(DiskIndex, IDiskParams)] of
Text.JSON.Ok params -> liftM RecreateDisksParams (mkNonEmpty params)
_ -> fail $ "Can't parse disk information as either list of disk"
++ " indices or list of disk parameters; value recevied:"
++ show (pp_value v)
instance JSON RecreateDisksInfo where
readJSON = readRecreateDisks
showJSON RecreateDisksAll = showJSON ()
showJSON (RecreateDisksIndices idx) = showJSON idx
showJSON (RecreateDisksParams params) = showJSON params
-- | Simple type for old-style ddm changes.
data DdmOldChanges = DdmOldIndex (NonNegative Int)
| DdmOldMod DdmSimple
deriving (Eq, Read, Show)
readDdmOldChanges :: JSValue -> Text.JSON.Result DdmOldChanges
readDdmOldChanges v =
case readJSON v::Text.JSON.Result (NonNegative Int) of
Text.JSON.Ok nn -> return $ DdmOldIndex nn
_ -> case readJSON v::Text.JSON.Result DdmSimple of
Text.JSON.Ok ddms -> return $ DdmOldMod ddms
_ -> fail $ "Can't parse value '" ++ show (pp_value v) ++ "' as"
++ " either index or modification"
instance JSON DdmOldChanges where
showJSON (DdmOldIndex i) = showJSON i
showJSON (DdmOldMod m) = showJSON m
readJSON = readDdmOldChanges
-- | Instance disk or nic modifications.
data SetParamsMods a
= SetParamsEmpty
| SetParamsDeprecated (NonEmpty (DdmOldChanges, a))
| SetParamsNew (NonEmpty (DdmFull, Int, a))
deriving (Eq, Read, Show)
-- | Custom deserialiser for 'SetParamsMods'.
readSetParams :: (JSON a) => JSValue -> Text.JSON.Result (SetParamsMods a)
readSetParams (JSArray []) = return SetParamsEmpty
readSetParams v =
case readJSON v::Text.JSON.Result [(DdmOldChanges, JSValue)] of
Text.JSON.Ok _ -> liftM SetParamsDeprecated $ readJSON v
_ -> liftM SetParamsNew $ readJSON v
instance (JSON a) => JSON (SetParamsMods a) where
showJSON SetParamsEmpty = showJSON ()
showJSON (SetParamsDeprecated v) = showJSON v
showJSON (SetParamsNew v) = showJSON v
readJSON = readSetParams
-- * Parameters
-- | A required instance name (for single-instance LUs).
......@@ -357,9 +451,17 @@ pOutputFields = simpleField "output_fields" [t| [NonEmptyString] |]
-- | How long to wait for instance to shut down.
pShutdownTimeout :: Field
pShutdownTimeout = defaultField [| C.defaultShutdownTimeout |] $
pShutdownTimeout = defaultField [| forceNonNeg C.defaultShutdownTimeout |] $
simpleField "shutdown_timeout" [t| NonNegative Int |]
-- | Another name for the shutdown timeout, because we like to be
-- inconsistent.
pShutdownTimeout' :: Field
pShutdownTimeout' =
renameField "InstShutdownTimeout" .
defaultField [| forceNonNeg C.defaultShutdownTimeout |] $
simpleField "timeout" [t| NonNegative Int |]
-- | Whether to force the operation.
pForce :: Field
pForce = defaultFalse "force"
......@@ -455,6 +557,12 @@ pNoRemember = defaultFalse "no_remember"
pMigrationTargetNode :: Field
pMigrationTargetNode = optionalNEStringField "target_node"
-- | Target node for instance move (required).
pMoveTargetNode :: Field
pMoveTargetNode =
renameField "MoveTargetNode" $
simpleField "target_node" [t| NonEmptyString |]
-- | Pause instance at startup.
pStartupPaused :: Field
pStartupPaused = defaultFalse "startup_paused"
......@@ -591,15 +699,36 @@ pOsHvp = optionalField $ simpleField "os_hvp" [t| Container UncheckedDict |]
-- | Cluster-wide OS parameter defaults.
pClusterOsParams :: Field
pClusterOsParams =
renameField "clusterOsParams" .
renameField "ClusterOsParams" .
optionalField $ simpleField "osparams" [t| Container UncheckedDict |]
-- | Instance OS parameters.
pInstOsParams :: Field
pInstOsParams =
renameField "instOsParams" . defaultField [| toJSObject [] |] $
renameField "InstOsParams" . defaultField [| toJSObject [] |] $
simpleField "osparams" [t| UncheckedDict |]
-- | Temporary OS parameters (currently only in reinstall, might be
-- added to install as well).
pTempOsParams :: Field
pTempOsParams =
renameField "TempOsParams" .
optionalField $ simpleField "osparams" [t| UncheckedDict |]
-- | Temporary hypervisor parameters, hypervisor-dependent.
pTempHvParams :: Field
pTempHvParams =
renameField "TempHvParams" .
defaultField [| toJSObject [] |] $
simpleField "hvparams" [t| UncheckedDict |]
-- | Temporary backend parameters.
pTempBeParams :: Field
pTempBeParams =
renameField "TempBeParams" .
defaultField [| toJSObject [] |] $
simpleField "beparams" [t| UncheckedDict |]
-- | Candidate pool size.
pCandidatePoolSize :: Field
pCandidatePoolSize =
......@@ -844,3 +973,81 @@ pInstTags =
renameField "InstTags" .
defaultField [| [] |] $
simpleField "tags" [t| [NonEmptyString] |]
-- | Unchecked list of OpInstanceCreate, used in OpInstanceMultiAlloc.
pMultiAllocInstances :: Field
pMultiAllocInstances =
renameField "InstMultiAlloc" .
defaultField [| [] |] $
simpleField "instances"[t| UncheckedList |]
-- | Ignore failures parameter.
pIgnoreFailures :: Field
pIgnoreFailures = defaultFalse "ignore_failures"
-- | New instance or cluster name.
pNewName :: Field
pNewName = simpleField "new_name" [t| NonEmptyString |]
-- | Whether to start the instance even if secondary disks are failing.
pIgnoreSecondaries :: Field
pIgnoreSecondaries = defaultFalse "ignore_secondaries"
-- | How to reboot the instance.
pRebootType :: Field
pRebootType = simpleField "reboot_type" [t| RebootType |]
-- | Whether to ignore recorded disk size.
pIgnoreDiskSize :: Field
pIgnoreDiskSize = defaultFalse "ignore_size"
-- | Disk list for recreate disks.
pRecreateDisksInfo :: Field
pRecreateDisksInfo =
renameField "RecreateDisksInfo" .
defaultField [| RecreateDisksAll |] $
simpleField "disks" [t| RecreateDisksInfo |]
-- | Whether to only return configuration data without querying nodes.
pStatic :: Field
pStatic = defaultFalse "static"
-- | InstanceSetParams NIC changes.
pInstParamsNicChanges :: Field
pInstParamsNicChanges =
renameField "InstNicChanges" .
defaultField [| SetParamsEmpty |] $
simpleField "nics" [t| SetParamsMods INicParams |]
-- | InstanceSetParams Disk changes.
pInstParamsDiskChanges :: Field
pInstParamsDiskChanges =
renameField "InstDiskChanges" .
defaultField [| SetParamsEmpty |] $
simpleField "disks" [t| SetParamsMods IDiskParams |]
-- | New runtime memory.
pRuntimeMem :: Field
pRuntimeMem = optionalField $ simpleField "runtime_mem" [t| Positive Int |]
-- | Change the instance's OS without reinstalling the instance
pOsNameChange :: Field
pOsNameChange = optionalNEStringField "os_name"
-- | Disk index for e.g. grow disk.
pDiskIndex :: Field
pDiskIndex = renameField "DiskIndex " $ simpleField "disk" [t| DiskIndex |]
-- | Disk amount to add or grow to.
pDiskChgAmount :: Field
pDiskChgAmount =
renameField "DiskChgAmount" $ simpleField "amount" [t| NonNegative Int |]
-- | Whether the amount parameter is an absolute target or a relative one.
pDiskChgAbsolute :: Field
pDiskChgAbsolute = renameField "DiskChkAbsolute" $ defaultFalse "absolute"
-- | Destination group names or UUIDs (defaults to \"all but current group\".
pTargetGroups :: Field
pTargetGroups =
optionalField $ simpleField "target_groups" [t| [NonEmptyString] |]
......@@ -53,6 +53,7 @@ module Ganeti.Types
, MigrationMode(..)
, VerifyOptionalChecks(..)
, DdmSimple(..)
, DdmFull(..)
, CVErrorCode(..)
, cVErrorCodeToRaw
, Hypervisor(..)
......@@ -61,6 +62,7 @@ module Ganeti.Types
, NodeEvacMode(..)
, FileDriver(..)
, InstCreateMode(..)
, RebootType(..)
) where
import qualified Text.JSON as JSON
......@@ -217,6 +219,14 @@ $(THH.declareSADT "DdmSimple"
])
$(THH.makeJSONInstance ''DdmSimple)
-- | Dynamic device modification, all operations version.
$(THH.declareSADT "DdmFull"
[ ("DdmFullAdd", 'C.ddmAdd)
, ("DdmFullRemove", 'C.ddmRemove)
, ("DdmFullModify", 'C.ddmModify)
])
$(THH.makeJSONInstance ''DdmFull)
-- | Hypervisor type definitions.
$(THH.declareSADT "Hypervisor"
[ ( "Kvm", 'C.htKvm )
......@@ -268,3 +278,11 @@ $(THH.declareSADT "InstCreateMode"
, ("InstRemoteImport", 'C.instanceRemoteImport)
])
$(THH.makeJSONInstance ''InstCreateMode)
-- | Reboot type.
$(THH.declareSADT "RebootType"
[ ("RebootSoft", 'C.instanceRebootSoft)
, ("RebootHard", 'C.instanceRebootHard)
, ("RebootFull", 'C.instanceRebootFull)
])
$(THH.makeJSONInstance ''RebootType)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment