Commit 6d558717 authored by Iustin Pop's avatar Iustin Pop
Browse files

Add types and parameters for OpInstanceCreate



This is a "big" opcode, so sending it separately.

A few types needed changing, and a few parameters were renamed to make
it more clear which are cluster-level and which are instance-level
parameters.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarHelga Velroyen <helgav@google.com>
parent c65621d7
......@@ -63,6 +63,8 @@ instance Arbitrary OpCodes.TagObject where
$(genArbitrary ''OpCodes.ReplaceDisksMode)
$(genArbitrary ''DiskAccess)
instance Arbitrary OpCodes.DiskIndex where
arbitrary = choose (0, C.maxDisks - 1) >>= OpCodes.mkDiskIndex
......@@ -70,6 +72,11 @@ instance Arbitrary INicParams where
arbitrary = INicParams <$> getMaybe genNameNE <*> getMaybe getName <*>
getMaybe genNameNE <*> getMaybe genNameNE
instance Arbitrary IDiskParams where
arbitrary = IDiskParams <$> arbitrary <*> arbitrary <*>
getMaybe genNameNE <*> getMaybe genNameNE <*>
getMaybe genNameNE
instance Arbitrary OpCodes.OpCode where
arbitrary = do
op_id <- elements OpCodes.allOpIDs
......@@ -169,6 +176,19 @@ instance Arbitrary OpCodes.OpCode where
"OP_NODE_EVACUATE" ->
OpCodes.OpNodeEvacuate <$> arbitrary <*> genNodeNameNE <*>
getMaybe genNodeNameNE <*> getMaybe genNameNE <*> arbitrary
"OP_INSTANCE_CREATE" ->
OpCodes.OpInstanceCreate <$> getFQDN <*> arbitrary <*>
arbitrary <*> arbitrary <*> arbitrary <*> pure emptyJSObject <*>
arbitrary <*> arbitrary <*> arbitrary <*> getMaybe genNameNE <*>
pure emptyJSObject <*> arbitrary <*> getMaybe genNameNE <*>
arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
arbitrary <*> arbitrary <*> pure emptyJSObject <*>
getMaybe genNameNE <*>
getMaybe genNodeNameNE <*> getMaybe genNodeNameNE <*>
getMaybe (pure []) <*> getMaybe genNodeNameNE <*>
arbitrary <*> getMaybe genNodeNameNE <*>
getMaybe genNodeNameNE <*> getMaybe genNameNE <*>
arbitrary <*> (genTags >>= mapM mkNonEmpty)
_ -> fail $ "Undefined arbitrary for opcode " ++ op_id
-- * Helper functions
......
......@@ -56,6 +56,12 @@ instance (Arbitrary a, Ord a, Num a, Show a) =>
(QuickCheck.Positive i) <- arbitrary
Types.mkPositive i
instance (Arbitrary a, Ord a, Num a, Show a) =>
Arbitrary (Types.NonNegative a) where
arbitrary = do
(QuickCheck.NonNegative i) <- arbitrary
Types.mkNonNegative i
instance (Arbitrary a) => Arbitrary (Types.NonEmpty a) where
arbitrary = do
QuickCheck.NonEmpty lst <- arbitrary
......@@ -85,6 +91,8 @@ $(genArbitrary ''NodeEvacMode)
$(genArbitrary ''FileDriver)
$(genArbitrary ''InstCreateMode)
-- * Properties
prop_AllocPolicy_serialisation :: AllocPolicy -> Property
......@@ -182,6 +190,10 @@ prop_NodeEvacMode_serialisation = testSerialisation
prop_FileDriver_serialisation :: FileDriver -> Property
prop_FileDriver_serialisation = testSerialisation
-- | Test 'InstCreate' serialisation.
prop_InstCreateMode_serialisation :: InstCreateMode -> Property
prop_InstCreateMode_serialisation = testSerialisation
testSuite "Types"
[ 'prop_AllocPolicy_serialisation
, 'prop_DiskTemplate_serialisation
......@@ -202,4 +214,5 @@ testSuite "Types"
, 'prop_StorageType_serialisation
, 'prop_NodeEvacMode_serialisation
, 'prop_FileDriver_serialisation
, 'prop_InstCreateMode_serialisation
]
......@@ -128,7 +128,7 @@ $(genOpCode "OpCode"
, pClusterHvParams
, pClusterBeParams
, pOsHvp
, pOsParams
, pClusterOsParams
, pDiskParams
, pCandidatePoolSize
, pUidPool
......@@ -241,6 +241,39 @@ $(genOpCode "OpCode"
, pIallocator
, pEvacMode
])
, ("OpInstanceCreate",
[ pInstanceName
, pForceVariant
, pWaitForSync
, pNameCheck
, pIgnoreIpolicy
, pInstBeParams
, pInstDisks
, pDiskTemplate
, pFileDriver
, pFileStorageDir
, pInstHvParams
, pHypervisor
, pIallocator
, pResetDefaults
, pIpCheck
, pIpConflictsCheck
, pInstCreateMode
, pInstNics
, pNoInstall
, pInstOsParams
, pInstOs
, pPrimaryNode
, pSecondaryNode
, pSourceHandshake
, pSourceInstance
, pSourceShutdownTimeout
, pSourceX509Ca
, pSrcNode
, pSrcPath
, pStartInstance
, pInstTags
])
])
-- | Returns the OP_ID for a given opcode value.
......
......@@ -41,6 +41,7 @@ module Ganeti.OpParams
, DiskIndex
, mkDiskIndex
, unDiskIndex
, DiskAccess(..)
, INicParams(..)
, IDiskParams(..)
, pInstanceName
......@@ -68,6 +69,8 @@ module Ganeti.OpParams
, pGroupNodeParams
, pQueryWhat
, pEarlyRelease
, pIpCheck
, pIpConflictsCheck
, pNoRemember
, pMigrationTargetNode
, pStartupPaused
......@@ -82,12 +85,21 @@ module Ganeti.OpParams
, pDiskState
, pIgnoreIpolicy
, pAllowRuntimeChgs
, pInstDisks
, pDiskTemplate
, pFileDriver
, pFileStorageDir
, pVgName
, pEnabledHypervisors
, pHypervisor
, pClusterHvParams
, pInstHvParams
, pClusterBeParams
, pInstBeParams
, pResetDefaults
, pOsHvp
, pOsParams
, pClusterOsParams
, pInstOsParams
, pCandidatePoolSize
, pUidPool
, pAddUids
......@@ -95,6 +107,7 @@ module Ganeti.OpParams
, pMaintainNodeHealth
, pPreallocWipeDisks
, pNicParams
, pInstNics
, pNdParams
, pIpolicy
, pDrbdHelper
......@@ -129,13 +142,27 @@ module Ganeti.OpParams
, pIallocator
, pRemoteNode
, pEvacMode
, pInstCreateMode
, pNoInstall
, pInstOs
, pPrimaryNode
, pSecondaryNode
, pSourceHandshake
, pSourceInstance
, pSourceShutdownTimeout
, pSourceX509Ca
, pSrcNode
, pSrcPath
, pStartInstance
, pInstTags
) where
import qualified Data.Set as Set
import Text.JSON (readJSON, showJSON, JSON, JSValue(..), fromJSString,
JSObject)
JSObject, toJSObject)
import Text.JSON.Pretty (pp_value)
import Ganeti.BasicTypes
import qualified Ganeti.Constants as C
import Ganeti.THH
import Ganeti.JSON
......@@ -176,6 +203,18 @@ optionalNEStringField = optionalField . flip simpleField [t| NonEmptyString |]
-- | Unchecked dict, should be replaced by a better definition.
type UncheckedDict = JSObject JSValue
-- | Unchecked list, shoild be replaced by a better definition.
type UncheckedList = [JSValue]
-- | Function to force a non-negative value, without returning via a
-- monad. This is needed for, and should be used /only/ in the case of
-- forcing constants. In case the constant is wrong (< 0), this will
-- become a runtime error.
forceNonNeg :: (Num a, Ord a, Show a) => a -> NonNegative a
forceNonNeg i = case mkNonNegative i of
Ok n -> n
Bad msg -> error msg
-- ** Tags
-- | Data type representing what items do the tag operations apply to.
......@@ -279,13 +318,13 @@ $(buildObject "INicParams" "inic"
, optionalField $ simpleField C.inicLink [t| NonEmptyString |]
])
-- | Disk modification definition.
-- | Disk modification definition. FIXME: disksize should be VTYPE_UNIT.
$(buildObject "IDiskParams" "idisk"
[ simpleField C.idiskSize [t| Int |] -- FIXME: VTYPE_UNIT
, simpleField C.idiskMode [t| DiskAccess |]
, simpleField C.idiskAdopt [t| NonEmptyString |]
, simpleField C.idiskVg [t| NonEmptyString |]
, simpleField C.idiskMetavg [t| NonEmptyString |]
[ optionalField $ simpleField C.idiskSize [t| Int |]
, optionalField $ simpleField C.idiskMode [t| DiskAccess |]
, optionalField $ simpleField C.idiskAdopt [t| NonEmptyString |]
, optionalField $ simpleField C.idiskVg [t| NonEmptyString |]
, optionalField $ simpleField C.idiskMetavg [t| NonEmptyString |]
])
-- * Parameters
......@@ -400,7 +439,13 @@ pQueryWhat = simpleField "what" [t| Qlang.QueryTypeOp |]
pEarlyRelease :: Field
pEarlyRelease = defaultFalse "early_release"
-- _PIpCheckDoc = "Whether to ensure instance's IP address is inactive"
-- | Whether to ensure instance's IP address is inactive.
pIpCheck :: Field
pIpCheck = defaultTrue "ip_check"
-- | Check for conflicting IPs.
pIpConflictsCheck :: Field
pIpConflictsCheck = defaultTrue "conflicts_check"
-- | Do not remember instance state changes.
pNoRemember :: Field
......@@ -475,7 +520,22 @@ type TestClusterOsList = [TestClusterOsListItem]
-- Utility type for NIC definitions.
--type TestNicDef = INicParams
--type TDiskParams = IDiskParams
-- | List of instance disks.
pInstDisks :: Field
pInstDisks = renameField "instDisks" $ simpleField "disks" [t| [IDiskParams] |]
-- | Instance disk template.
pDiskTemplate :: Field
pDiskTemplate = simpleField "disk_template" [t| DiskTemplate |]
-- | File driver.
pFileDriver :: Field
pFileDriver = optionalField $ simpleField "file_driver" [t| FileDriver |]
-- | Directory for storing file-backed disks.
pFileStorageDir :: Field
pFileStorageDir = optionalNEStringField "file_storage_dir"
-- | Volume group name.
pVgName :: Field
......@@ -487,25 +547,59 @@ pEnabledHypervisors =
optionalField $
simpleField "enabled_hypervisors" [t| NonEmpty Hypervisor |]
-- | Selected hypervisor for an instance.
pHypervisor :: Field
pHypervisor =
optionalField $
simpleField "hypervisor" [t| Hypervisor |]
-- | Cluster-wide hypervisor parameters, hypervisor-dependent.
pClusterHvParams :: Field
pClusterHvParams =
renameField "ClusterHvParams" .
optionalField $
simpleField "hvparams" [t| Container UncheckedDict |]
-- | Instance hypervisor parameters.
pInstHvParams :: Field
pInstHvParams =
renameField "InstHvParams" .
defaultField [| toJSObject [] |] $
simpleField "hvparams" [t| UncheckedDict |]
-- | Cluster-wide beparams.
pClusterBeParams :: Field
pClusterBeParams = optionalField $ simpleField "beparams" [t| UncheckedDict |]
pClusterBeParams =
renameField "ClusterBeParams" .
optionalField $ simpleField "beparams" [t| UncheckedDict |]
-- | Instance beparams.
pInstBeParams :: Field
pInstBeParams =
renameField "InstBeParams" .
defaultField [| toJSObject [] |] $
simpleField "beparams" [t| UncheckedDict |]
-- | Reset instance parameters to default if equal.
pResetDefaults :: Field
pResetDefaults = defaultFalse "identify_defaults"
-- | Cluster-wide per-OS hypervisor parameter defaults.
pOsHvp :: Field
pOsHvp = optionalField $ simpleField "os_hvp" [t| Container UncheckedDict |]
-- | Cluster-wide OS parameter defaults.
pOsParams :: Field
pOsParams =
pClusterOsParams :: Field
pClusterOsParams =
renameField "clusterOsParams" .
optionalField $ simpleField "osparams" [t| Container UncheckedDict |]
-- | Instance OS parameters.
pInstOsParams :: Field
pInstOsParams =
renameField "instOsParams" . defaultField [| toJSObject [] |] $
simpleField "osparams" [t| UncheckedDict |]
-- | Candidate pool size.
pCandidatePoolSize :: Field
pCandidatePoolSize =
......@@ -538,6 +632,10 @@ pPreallocWipeDisks = optionalField $ booleanField "prealloc_wipe_disks"
pNicParams :: Field
pNicParams = optionalField $ simpleField "nicparams" [t| INicParams |]
-- | Instance NIC definitions.
pInstNics :: Field
pInstNics = simpleField "nics" [t| [INicParams] |]
-- | Cluster-wide node parameter defaults.
pNdParams :: Field
pNdParams = optionalField $ simpleField "ndparams" [t| UncheckedDict |]
......@@ -685,3 +783,64 @@ pRemoteNode = optionalNEStringField "remote_node"
-- | Node evacuation mode.
pEvacMode :: Field
pEvacMode = renameField "EvacMode" $ simpleField "mode" [t| NodeEvacMode |]
-- | Instance creation mode.
pInstCreateMode :: Field
pInstCreateMode =
renameField "InstCreateMode" $ simpleField "mode" [t| InstCreateMode |]
-- | Do not install the OS (will disable automatic start).
pNoInstall :: Field
pNoInstall = optionalField $ booleanField "no_install"
-- | OS type for instance installation.
pInstOs :: Field
pInstOs = optionalNEStringField "os_type"
-- | Primary node for an instance.
pPrimaryNode :: Field
pPrimaryNode = optionalNEStringField "pnode"
-- | Secondary node for an instance.
pSecondaryNode :: Field
pSecondaryNode = optionalNEStringField "snode"
-- | Signed handshake from source (remote import only).
pSourceHandshake :: Field
pSourceHandshake =
optionalField $ simpleField "source_handshake" [t| UncheckedList |]
-- | Source instance name (remote import only).
pSourceInstance :: Field
pSourceInstance = optionalNEStringField "source_instance_name"
-- | How long source instance was given to shut down (remote import only).
-- FIXME: non-negative int, whereas the constant is a plain int.
pSourceShutdownTimeout :: Field
pSourceShutdownTimeout =
defaultField [| forceNonNeg C.defaultShutdownTimeout |] $
simpleField "source_shutdown_timeout" [t| NonNegative Int |]
-- | Source X509 CA in PEM format (remote import only).
pSourceX509Ca :: Field
pSourceX509Ca = optionalNEStringField "source_x509_ca"
-- | Source node for import.
pSrcNode :: Field
pSrcNode = optionalNEStringField "src_node"
-- | Source directory for import.
pSrcPath :: Field
pSrcPath = optionalNEStringField "src_path"
-- | Whether to start instance after creation.
pStartInstance :: Field
pStartInstance = defaultTrue "start"
-- | Instance tags. FIXME: unify/simplify with pTags, once that
-- migrates to NonEmpty String.
pInstTags :: Field
pInstTags =
renameField "InstTags" .
defaultField [| [] |] $
simpleField "tags" [t| [NonEmptyString] |]
......@@ -60,6 +60,7 @@ module Ganeti.Types
, StorageType(..)
, NodeEvacMode(..)
, FileDriver(..)
, InstCreateMode(..)
) where
import qualified Text.JSON as JSON
......@@ -259,3 +260,11 @@ $(THH.declareSADT "FileDriver"
, ("FileBlktap", 'C.fdBlktap)
])
$(THH.makeJSONInstance ''FileDriver)
-- | The instance create mode.
$(THH.declareSADT "InstCreateMode"
[ ("InstCreate", 'C.instanceCreate)
, ("InstImport", 'C.instanceImport)
, ("InstRemoteImport", 'C.instanceRemoteImport)
])
$(THH.makeJSONInstance ''InstCreateMode)
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