Commit 34af39e8 authored by Jose A. Lopes's avatar Jose A. Lopes
Browse files

Add Python opcode generation



* add Python opcode generation to Template Haskell
* fix all the opcodes and parameters, including their types and
  documentation
* update Luxi to reflect the other changes.
Signed-off-by: default avatarJose A. Lopes <jabolopes@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent 1446d00b
......@@ -164,8 +164,8 @@ def _BuildOpcodeParams(op_id, include, exclude, alias):
if include is not None and name not in include:
continue
has_default = default is not ht.NoDefault
has_test = not (test is None or test is ht.NoType)
has_default = default is not None or default is not ht.NoDefault
has_test = test is not None or test is not ht.NoType
buf = StringIO()
buf.write("``%s``" % (rapi_name,))
......
......@@ -184,7 +184,7 @@ class LUInstanceShutdown(LogicalUnit):
"""
env = BuildInstanceHookEnvByObject(self, self.instance)
env["TIMEOUT"] = self.op.timeout
env["SHUTDOWN_TIMEOUT"] = self.op.shutdown_timeout
return env
def BuildHooksNodes(self):
......@@ -230,9 +230,10 @@ class LUInstanceShutdown(LogicalUnit):
assert self.op.ignore_offline_nodes
self.LogInfo("Primary node offline, marked instance as stopped")
else:
result = self.rpc.call_instance_shutdown(self.instance.primary_node,
self.instance,
self.op.timeout, self.op.reason)
result = self.rpc.call_instance_shutdown(
self.instance.primary_node,
self.instance,
self.op.shutdown_timeout, self.op.reason)
msg = result.fail_msg
if msg:
self.LogWarning("Could not shutdown instance: %s", msg)
......
......@@ -144,7 +144,9 @@ $(genLuxiOp "LuxiOp"
)
, (luxiReqQueryClusterInfo, [])
, (luxiReqQueryTags,
[ pTagsObject ])
[ pTagsObject
, simpleField "name" [t| String |]
])
, (luxiReqSubmitJob,
[ simpleField "job" [t| [MetaOpCode] |] ]
)
......@@ -399,8 +401,7 @@ decodeCall (LuxiCall call args) =
return $ QueryConfigValues fields
ReqQueryTags -> do
(kind, name) <- fromJVal args
item <- tagObjectFrom kind name
return $ QueryTags item
return $ QueryTags kind name
ReqCancelJob -> do
[jid] <- fromJVal args
return $ CancelJob jid
......
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExistentialQuantification, TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Implementation of the opcodes.
......@@ -26,7 +27,8 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-}
module Ganeti.OpCodes
( OpCode(..)
( pyClasses
, OpCode(..)
, TagObject(..)
, tagObjectFrom
, encodeTagObject
......@@ -47,115 +49,185 @@ module Ganeti.OpCodes
, setOpPriority
) where
import Data.Maybe (fromMaybe)
import Text.JSON (readJSON, JSON, JSValue, makeObj)
import Text.JSON (readJSON, JSObject, JSON, JSValue(..), makeObj, fromJSObject)
import qualified Text.JSON
import Ganeti.THH
import qualified Ganeti.Hs2Py.OpDoc as OpDoc
import Ganeti.OpParams
import Ganeti.Types (OpSubmitPriority(..), fromNonEmpty)
import Ganeti.Types
import Ganeti.Query.Language (queryTypeOpToRaw)
import Data.List (intercalate)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Ganeti.Constants as C
instance PyValue Bool
instance PyValue Int
instance PyValue Double
instance PyValue Char
instance (PyValue a, PyValue b) => PyValue (a, b) where
showValue (x, y) = show (showValue x, showValue y)
instance PyValue a => PyValue [a] where
showValue xs = show (map showValue xs)
instance PyValue a => PyValue (Set a) where
showValue s = showValue (Set.toList s)
instance (PyValue k, PyValue a) => PyValue (Map k a) where
showValue mp =
"{" ++ intercalate ", " (map showPair (Map.assocs mp)) ++ "}"
where showPair (k, x) = show k ++ ":" ++ show x
instance PyValue DiskIndex where
showValue = showValue . unDiskIndex
instance PyValue IDiskParams where
showValue _ = error "OpCodes.showValue(IDiskParams): unhandled case"
instance PyValue RecreateDisksInfo where
showValue RecreateDisksAll = "[]"
showValue (RecreateDisksIndices is) = showValue is
showValue (RecreateDisksParams is) = showValue is
instance PyValue a => PyValue (SetParamsMods a) where
showValue SetParamsEmpty = "[]"
showValue _ = error "OpCodes.showValue(SetParamsMods): unhandled case"
instance PyValue a => PyValue (NonNegative a) where
showValue = showValue . fromNonNegative
instance PyValue a => PyValue (NonEmpty a) where
showValue = showValue . fromNonEmpty
-- FIXME: should use the 'toRaw' function instead of being harcoded or
-- perhaps use something similar to the NonNegative type instead of
-- using the declareSADT
instance PyValue ExportMode where
showValue ExportModeLocal = show C.exportModeLocal
showValue ExportModeRemove = show C.exportModeLocal
instance PyValue CVErrorCode where
showValue = cVErrorCodeToRaw
instance PyValue VerifyOptionalChecks where
showValue = verifyOptionalChecksToRaw
instance PyValue INicParams where
showValue = error "instance PyValue INicParams: not implemented"
instance PyValue a => PyValue (JSObject a) where
showValue obj =
"{" ++ intercalate ", " (map showPair (fromJSObject obj)) ++ "}"
where showPair (k, v) = show k ++ ":" ++ showValue v
instance PyValue JSValue where
showValue (JSObject obj) = showValue obj
showValue x = show x
type JobIdListOnly = [(Bool, Either String JobId)]
type InstanceMultiAllocResponse =
([(Bool, Either String JobId)], NonEmptyString)
type QueryFieldDef =
(NonEmptyString, NonEmptyString, TagKind, NonEmptyString)
type QueryResponse =
([QueryFieldDef], [[(QueryResultCode, JSValue)]])
type QueryFieldsResponse = [QueryFieldDef]
-- | OpCode representation.
--
-- We only implement a subset of Ganeti opcodes: those which are actually used
-- in the htools codebase.
$(genOpCode "OpCode"
[ ("OpTestDelay",
[ pDelayDuration
, pDelayOnMaster
, pDelayOnNodes
, pDelayOnNodeUuids
, pDelayRepeat
])
, ("OpInstanceReplaceDisks",
[ pInstanceName
, pInstanceUuid
, pEarlyRelease
, pIgnoreIpolicy
, pReplaceDisksMode
, pReplaceDisksList
, pRemoteNode
, pRemoteNodeUuid
, pIallocator
])
, ("OpInstanceFailover",
[ pInstanceName
, pInstanceUuid
, pShutdownTimeout
, pIgnoreConsistency
, pMigrationTargetNode
, pMigrationTargetNodeUuid
, pIgnoreIpolicy
, pIallocator
])
, ("OpInstanceMigrate",
[ pInstanceName
, pInstanceUuid
, pMigrationMode
, pMigrationLive
, pMigrationTargetNode
, pMigrationTargetNodeUuid
, pAllowRuntimeChgs
, pIgnoreIpolicy
, pMigrationCleanup
, pIallocator
, pAllowFailover
])
, ("OpTagsGet",
[ pTagsObject
, pUseLocking
])
, ("OpTagsSearch",
[ pTagSearchPattern ])
, ("OpTagsSet",
[ pTagsObject
, pTagsList
])
, ("OpTagsDel",
[ pTagsObject
, pTagsList
])
, ("OpClusterPostInit", [])
, ("OpClusterDestroy", [])
, ("OpClusterQuery", [])
[ ("OpClusterPostInit",
[t| Bool |],
OpDoc.opClusterPostInit,
[],
[])
, ("OpClusterDestroy",
[t| NonEmptyString |],
OpDoc.opClusterDestroy,
[],
[])
, ("OpClusterQuery",
[t| JSObject JSValue |],
OpDoc.opClusterQuery,
[],
[])
, ("OpClusterVerify",
[t| JobIdListOnly |],
OpDoc.opClusterVerify,
[ pDebugSimulateErrors
, pErrorCodes
, pSkipChecks
, pIgnoreErrors
, pVerbose
, pOptGroupName
])
],
[])
, ("OpClusterVerifyConfig",
[t| Bool |],
OpDoc.opClusterVerifyConfig,
[ pDebugSimulateErrors
, pErrorCodes
, pIgnoreErrors
, pVerbose
])
],
[])
, ("OpClusterVerifyGroup",
[t| Bool |],
OpDoc.opClusterVerifyGroup,
[ pGroupName
, pDebugSimulateErrors
, pErrorCodes
, pSkipChecks
, pIgnoreErrors
, pVerbose
])
, ("OpClusterVerifyDisks", [])
],
"group_name")
, ("OpClusterVerifyDisks",
[t| JobIdListOnly |],
OpDoc.opClusterVerifyDisks,
[],
[])
, ("OpGroupVerifyDisks",
[t| (Map String String, [String], Map String [[String]]) |],
OpDoc.opGroupVerifyDisks,
[ pGroupName
])
],
"group_name")
, ("OpClusterRepairDiskSizes",
[t| [(NonEmptyString, NonNegative Int, NonEmptyString, NonNegative Int)]|],
OpDoc.opClusterRepairDiskSizes,
[ pInstances
])
],
[])
, ("OpClusterConfigQuery",
[t| [JSValue] |],
OpDoc.opClusterConfigQuery,
[ pOutputFields
])
],
[])
, ("OpClusterRename",
[t| NonEmptyString |],
OpDoc.opClusterRename,
[ pName
])
],
"name")
, ("OpClusterSetParams",
[t| () |],
OpDoc.opClusterSetParams,
[ pForce
, pHvState
, pDiskState
......@@ -173,8 +245,8 @@ $(genOpCode "OpCode"
, pMaintainNodeHealth
, pPreallocWipeDisks
, pNicParams
, pNdParams
, pIpolicy
, withDoc "Cluster-wide node parameter defaults" pNdParams
, withDoc "Cluster-wide ipolicy specs" pIpolicy
, pDrbdHelper
, pDefaultIAllocator
, pMasterNetdev
......@@ -186,33 +258,73 @@ $(genOpCode "OpCode"
, pEnabledDiskTemplates
, pModifyEtcHosts
, pGlobalFileStorageDir
])
, ("OpClusterRedistConf", [])
, ("OpClusterActivateMasterIp", [])
, ("OpClusterDeactivateMasterIp", [])
],
[])
, ("OpClusterRedistConf",
[t| () |],
OpDoc.opClusterRedistConf,
[],
[])
, ("OpClusterActivateMasterIp",
[t| () |],
OpDoc.opClusterActivateMasterIp,
[],
[])
, ("OpClusterDeactivateMasterIp",
[t| () |],
OpDoc.opClusterDeactivateMasterIp,
[],
[])
, ("OpQuery",
[t| QueryResponse |],
OpDoc.opQuery,
[ pQueryWhat
, pUseLocking
, pQueryFields
, pQueryFilter
])
],
"what")
, ("OpQueryFields",
[t| QueryFieldsResponse |],
OpDoc.opQueryFields,
[ pQueryWhat
, pQueryFields
])
, pQueryFieldsFields
],
"what")
, ("OpOobCommand",
[t| [[(QueryResultCode, JSValue)]] |],
OpDoc.opOobCommand,
[ pNodeNames
, pNodeUuids
, withDoc "List of node UUIDs to run the OOB command against" pNodeUuids
, pOobCommand
, pOobTimeout
, pIgnoreStatus
, pPowerDelay
])
],
[])
, ("OpRestrictedCommand",
[t| [(Bool, String)] |],
OpDoc.opRestrictedCommand,
[ pUseLocking
, withDoc
"Nodes on which the command should be run (at least one)"
pRequiredNodes
, withDoc
"Node UUIDs on which the command should be run (at least one)"
pRequiredNodeUuids
, pRestrictedCommand
],
[])
, ("OpNodeRemove",
[t| () |],
OpDoc.opNodeRemove,
[ pNodeName
, pNodeUuid
])
],
"node_name")
, ("OpNodeAdd",
[t| () |],
OpDoc.opNodeAdd,
[ pNodeName
, pHvState
, pDiskState
......@@ -223,40 +335,64 @@ $(genOpCode "OpCode"
, pMasterCapable
, pVmCapable
, pNdParams
])
, ("OpNodeQuery", dOldQuery)
],
"node_name")
, ("OpNodeQuery",
[t| [[JSValue]] |],
OpDoc.opNodeQuery,
[ pOutputFields
, withDoc "Empty list to query all nodes, node names otherwise" pNames
, pUseLocking
],
[])
, ("OpNodeQueryvols",
[t| [JSValue] |],
OpDoc.opNodeQueryvols,
[ pOutputFields
, pNodes
])
, withDoc "Empty list to query all nodes, node names otherwise" pNodes
],
[])
, ("OpNodeQueryStorage",
[t| [[JSValue]] |],
OpDoc.opNodeQueryStorage,
[ pOutputFields
, pStorageType
, pNodes
, withDoc
"Empty list to query all, list of names to query otherwise"
pNodes
, pStorageName
])
],
[])
, ("OpNodeModifyStorage",
[t| () |],
OpDoc.opNodeModifyStorage,
[ pNodeName
, pNodeUuid
, pStorageType
, pStorageName
, pStorageChanges
])
],
"node_name")
, ("OpRepairNodeStorage",
[t| () |],
OpDoc.opRepairNodeStorage,
[ pNodeName
, pNodeUuid
, pStorageType
, pStorageName
, pIgnoreConsistency
])
],
"node_name")
, ("OpNodeSetParams",
[t| [(NonEmptyString, JSValue)] |],
OpDoc.opNodeSetParams,
[ pNodeName
, pNodeUuid
, pForce
, pHvState
, pDiskState
, pMasterCandidate
, pOffline
, withDoc "Whether to mark the node offline" pOffline
, pDrained
, pAutoPromote
, pMasterCapable
......@@ -264,13 +400,19 @@ $(genOpCode "OpCode"
, pSecondaryIp
, pNdParams
, pPowered
])
],
"node_name")
, ("OpNodePowercycle",
[t| Maybe NonEmptyString |],
OpDoc.opNodePowercycle,
[ pNodeName
, pNodeUuid
, pForce
])
],
"node_name")
, ("OpNodeMigrate",
[t| JobIdListOnly |],
OpDoc.opNodeMigrate,
[ pNodeName
, pNodeUuid
, pMigrationMode
......@@ -280,8 +422,11 @@ $(genOpCode "OpCode"
, pAllowRuntimeChgs
, pIgnoreIpolicy
, pIallocator
])
],
"node_name")
, ("OpNodeEvacuate",
[t| JobIdListOnly |],
OpDoc.opNodeEvacuate,
[ pEarlyRelease
, pNodeName
, pNodeUuid
......@@ -289,13 +434,17 @@ $(genOpCode "OpCode"
, pRemoteNodeUuid
, pIallocator
, pEvacMode
])
],
"node_name")
, ("OpInstanceCreate",
[t| [NonEmptyString] |],
OpDoc.opInstanceCreate,
[ pInstanceName
, pForceVariant
, pWaitForSync
, pNameCheck
, pIgnoreIpolicy
, pOpportunisticLocking
, pInstBeParams
, pInstDisks
, pDiskTemplate
......@@ -324,35 +473,49 @@ $(genOpCode "OpCode"
, pSrcNodeUuid
, pSrcPath
, pStartInstance
, pOpportunisticLocking
, pInstTags
])
],
"instance_name")
, ("OpInstanceMultiAlloc",
[ pIallocator
[t| InstanceMultiAllocResponse |],
OpDoc.opInstanceMultiAlloc,
[ pOpportunisticLocking
, pIallocator
, pMultiAllocInstances
, pOpportunisticLocking
])
],
[])
, ("OpInstanceReinstall",
[t| () |],
OpDoc.opInstanceReinstall,
[ pInstanceName
, pInstanceUuid
, pForceVariant
, pInstOs
, pTempOsParams
])
],
"instance_name")
, ("OpInstanceRemove",
[t| () |],
OpDoc.opInstanceRemove,
[ pInstanceName
, pInstanceUuid
, pShutdownTimeout
, pIgnoreFailures
])
],
"instance_name")
, ("OpInstanceRename",
[t| NonEmptyString |],
OpDoc.opInstanceRename,
[ pInstanceName
, pInstanceUuid
, pNewName
, withDoc "New instance name" pNewName
, pNameCheck
, pIpCheck
])
],
[])
, ("OpInstanceStartup",
[t| () |],
OpDoc.opInstanceStartup,
[ pInstanceName
, pInstanceUuid
, pForce
......@@ -361,23 +524,75 @@ $(genOpCode "OpCode"
, pTempBeParams
, pNoRemember
, pStartupPaused
])
],
"instance_name")
, ("OpInstanceShutdown",
[t| () |],
OpDoc.opInstanceShutdown,
[ pInstanceName
, pInstanceUuid
, pForce
, pIgnoreOfflineNodes
, pShutdownTimeout'
, pShutdownTimeout
, pNoRemember
])
],
"instance_name")
, ("OpInstanceReboot",
[t| () |],
OpDoc.opInstanceReboot,
[ pInstanceName
, pInstanceUuid
, pShutdownTimeout
, pIgnoreSecondaries
, pRebootType
])
],