Synnefo » snf-ganeti

{-# LANGUAGE TemplateHaskell #-}

{-| Implementation of opcodes parameters.

These are defined in a separate module only due to TemplateHaskell

stage restrictions - expressions defined in the current module can't

be passed to splices. So we have to either parameters/repeat each

parameter definition multiple times, or separate them into this

module.

-}

{-

Copyright (C) 2012 Google Inc.

All rights reserved.

Redistribution and use in source and binary forms, with or without

modification, are permitted provided that the following conditions are

met:

1. Redistributions of source code must retain the above copyright notice,

this list of conditions and the following disclaimer.

2. Redistributions in binary form must reproduce the above copyright

notice, this list of conditions and the following disclaimer in the

documentation and/or other materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS

IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR

PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR

CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,

EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR

PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF

LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING

NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS

SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

-}

module Ganeti.OpParams

  ( ReplaceDisksMode(..)

  , DiskIndex

  , mkDiskIndex

  , unDiskIndex

  , DiskAccess(..)

  , INicParams(..)

  , IDiskParams(..)

  , RecreateDisksInfo(..)

  , DdmOldChanges(..)

  , SetParamsMods(..)

  , ExportTarget(..)

  , pInstanceName

  , pInstanceUuid

  , pInstances

  , pName

  , pTagsList

  , pTagsObject

  , pTagsName

  , pOutputFields

  , pShutdownTimeout

  , pShutdownTimeout'

  , pShutdownInstance

  , pForce

  , pIgnoreOfflineNodes

  , pNodeName

  , pNodeUuid

  , pNodeNames

  , pNodeUuids

  , pGroupName

  , pMigrationMode

  , pMigrationLive

  , pMigrationCleanup

  , pForceVariant

  , pWaitForSync

  , pWaitForSyncFalse

  , pIgnoreConsistency

  , pStorageName

  , pUseLocking

  , pOpportunisticLocking

  , pNameCheck

  , pNodeGroupAllocPolicy

  , pGroupNodeParams

  , pQueryWhat

  , pEarlyRelease

  , pIpCheck

  , pIpConflictsCheck

  , pNoRemember

  , pMigrationTargetNode

  , pMigrationTargetNodeUuid

  , pMoveTargetNode

  , pMoveTargetNodeUuid

  , pStartupPaused

  , pVerbose

  , pDebugSimulateErrors

  , pErrorCodes

  , pSkipChecks

  , pIgnoreErrors

  , pOptGroupName

  , pGroupDiskParams

  , pHvState

  , pDiskState

  , pIgnoreIpolicy

  , pHotplug

  , pHotplugIfPossible

  , pAllowRuntimeChgs

  , pInstDisks

  , pDiskTemplate

  , pOptDiskTemplate

  , pFileDriver

  , pFileStorageDir

  , pClusterFileStorageDir

  , pClusterSharedFileStorageDir

  , pVgName

  , pEnabledHypervisors

  , pHypervisor

  , pClusterHvParams

  , pInstHvParams

  , pClusterBeParams

  , pInstBeParams

  , pResetDefaults

  , pOsHvp

  , pClusterOsParams

  , pInstOsParams

  , pCandidatePoolSize

  , pUidPool

  , pAddUids

  , pRemoveUids

  , pMaintainNodeHealth

  , pModifyEtcHosts

  , pPreallocWipeDisks

  , pNicParams

  , pInstNics

  , pNdParams

  , pIpolicy

  , pDrbdHelper

  , pDefaultIAllocator

  , pMasterNetdev

  , pMasterNetmask

  , pReservedLvs

  , pHiddenOs

  , pBlacklistedOs

  , pUseExternalMipScript

  , pQueryFields

  , pQueryFilter

  , pQueryFieldsFields

  , pOobCommand

  , pOobTimeout

  , pIgnoreStatus

  , pPowerDelay

  , pPrimaryIp

  , pSecondaryIp

  , pReadd

  , pNodeGroup

  , pMasterCapable

  , pVmCapable

  , pNames

  , pNodes

  , pRequiredNodes

  , pRequiredNodeUuids

  , pStorageType

  , pStorageTypeOptional

  , pStorageChanges

  , pMasterCandidate

  , pOffline

  , pDrained

  , pAutoPromote

  , pPowered

  , pIallocator

  , pRemoteNode

  , pRemoteNodeUuid

  , pEvacMode

  , pInstCreateMode

  , pNoInstall

  , pInstOs

  , pPrimaryNode

  , pPrimaryNodeUuid

  , pSecondaryNode

  , pSecondaryNodeUuid

  , pSourceHandshake

  , pSourceInstance

  , pSourceShutdownTimeout

  , pSourceX509Ca

  , pSrcNode

  , pSrcNodeUuid

  , pSrcPath

  , pStartInstance

  , pInstTags

  , pMultiAllocInstances

  , pTempOsParams

  , pTempHvParams

  , pTempBeParams

  , pIgnoreFailures

  , pNewName

  , pIgnoreSecondaries

  , pRebootType

  , pIgnoreDiskSize

  , pRecreateDisksInfo

  , pStatic

  , pInstParamsNicChanges

  , pInstParamsDiskChanges

  , pRuntimeMem

  , pOsNameChange

  , pDiskIndex

  , pDiskChgAmount

  , pDiskChgAbsolute

  , pTargetGroups

  , pExportMode

  , pExportTargetNode

  , pExportTargetNodeUuid

  , pRemoveInstance

  , pIgnoreRemoveFailures

  , pX509KeyName

  , pX509DestCA

  , pTagSearchPattern

  , pRestrictedCommand

  , pReplaceDisksMode

  , pReplaceDisksList

  , pAllowFailover

  , pForceFailover

  , pDelayDuration

  , pDelayOnMaster

  , pDelayOnNodes

  , pDelayOnNodeUuids

  , pDelayRepeat

  , pDelayNoLocks

  , pIAllocatorDirection

  , pIAllocatorMode

  , pIAllocatorReqName

  , pIAllocatorNics

  , pIAllocatorDisks

  , pIAllocatorMemory

  , pIAllocatorVCpus

  , pIAllocatorOs

  , pIAllocatorInstances

  , pIAllocatorEvacMode

  , pIAllocatorSpindleUse

  , pIAllocatorCount

  , pJQueueNotifyWaitLock

  , pJQueueNotifyExec

  , pJQueueLogMessages

  , pJQueueFail

  , pTestDummyResult

  , pTestDummyMessages

  , pTestDummyFail

  , pTestDummySubmitJobs

  , pNetworkName

  , pNetworkAddress4

  , pNetworkGateway4

  , pNetworkAddress6

  , pNetworkGateway6

  , pNetworkMacPrefix

  , pNetworkAddRsvdIps

  , pNetworkRemoveRsvdIps

  , pNetworkMode

  , pNetworkLink

  , pNetworkVlan

  , pDryRun

  , pDebugLevel

  , pOpPriority

  , pDependencies

  , pComment

  , pReason

  , pSequential

  , pEnabledDiskTemplates

  ) where

import Control.Monad (liftM)

import Text.JSON (JSON, JSValue(..), JSObject (..), readJSON, showJSON,

                  fromJSString, toJSObject)

import qualified Text.JSON

import Text.JSON.Pretty (pp_value)

import Ganeti.BasicTypes

import qualified Ganeti.Constants as C

import Ganeti.THH

import Ganeti.JSON

import Ganeti.Types

import qualified Ganeti.Query.Language as Qlang

-- * Helper functions and types

-- | Build a boolean field.

booleanField :: String -> Field

booleanField = flip simpleField [t| Bool |]

-- | Default a field to 'False'.

defaultFalse :: String -> Field

defaultFalse = defaultField [| False |] . booleanField

-- | Default a field to 'True'.

defaultTrue :: String -> Field

defaultTrue = defaultField [| True |] . booleanField

-- | An alias for a 'String' field.

stringField :: String -> Field

stringField = flip simpleField [t| String |]

-- | An alias for an optional string field.

optionalStringField :: String -> Field

optionalStringField = optionalField . stringField

-- | An alias for an optional non-empty string field.

optionalNEStringField :: String -> Field

optionalNEStringField = optionalField . flip simpleField [t| NonEmptyString |]

-- | 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

-- ** Disks

-- | Disk index type (embedding constraints on the index value via a

-- smart constructor).

newtype DiskIndex = DiskIndex { unDiskIndex :: Int }

  deriving (Show, Eq, Ord)

-- | Smart constructor for 'DiskIndex'.

mkDiskIndex :: (Monad m) => Int -> m DiskIndex

mkDiskIndex i | i >= 0 && i < C.maxDisks = return (DiskIndex i)

              | otherwise = fail $ "Invalid value for disk index '" ++

                            show i ++ "', required between 0 and " ++

                            show C.maxDisks

instance JSON DiskIndex where

  readJSON v = readJSON v >>= mkDiskIndex

  showJSON = showJSON . unDiskIndex

-- ** I* param types

-- | Type holding disk access modes.

$(declareSADT "DiskAccess"

  [ ("DiskReadOnly",  'C.diskRdonly)

  , ("DiskReadWrite", 'C.diskRdwr)

  ])

$(makeJSONInstance ''DiskAccess)

-- | NIC modification definition.

$(buildObject "INicParams" "inic"

  [ optionalField $ simpleField C.inicMac    [t| NonEmptyString |]

  , optionalField $ simpleField C.inicIp     [t| String         |]

  , optionalField $ simpleField C.inicMode   [t| NonEmptyString |]

  , optionalField $ simpleField C.inicLink   [t| NonEmptyString |]

  , optionalField $ simpleField C.inicName   [t| NonEmptyString |]

  , optionalField $ simpleField C.inicVlan   [t| NonEmptyString |]

  , optionalField $ simpleField C.inicBridge [t| NonEmptyString |]

  ])

-- | Disk modification definition. FIXME: disksize should be VTYPE_UNIT.

$(buildObject "IDiskParams" "idisk"

  [ 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 |]

  , optionalField $ simpleField C.idiskName   [t| NonEmptyString |]

  , optionalField $ simpleField C.idiskProvider [t| NonEmptyString |]

  , optionalField $ simpleField C.idiskAccess   [t| NonEmptyString |]

  , andRestArguments "opaque"

  ])

-- | 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, 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 received:"

                ++ 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, 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, 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

-- | Custom type for target_node parameter of OpBackupExport, which

-- varies depending on mode. FIXME: this uses an [JSValue] since

-- we don't care about individual rows (just like the Python code

-- tests). But the proper type could be parsed if we wanted.

data ExportTarget = ExportTargetLocal NonEmptyString

                  | ExportTargetRemote [JSValue]

                    deriving (Eq, Show)

-- | Custom reader for 'ExportTarget'.

readExportTarget :: JSValue -> Text.JSON.Result ExportTarget

readExportTarget (JSString s) = liftM ExportTargetLocal $

                                mkNonEmpty (fromJSString s)

readExportTarget (JSArray arr) = return $ ExportTargetRemote arr

readExportTarget v = fail $ "Invalid value received for 'target_node': " ++

                     show (pp_value v)

instance JSON ExportTarget where

  showJSON (ExportTargetLocal s)  = showJSON s

  showJSON (ExportTargetRemote l) = showJSON l

  readJSON = readExportTarget

-- * Common opcode parameters

pDryRun :: Field

pDryRun =

  withDoc "Run checks only, don't execute" .

  optionalField $ booleanField "dry_run"

pDebugLevel :: Field

pDebugLevel =

  withDoc "Debug level" .

  optionalField $ simpleField "debug_level" [t| NonNegative Int |]

pOpPriority :: Field

pOpPriority =

  withDoc "Opcode priority. Note: python uses a separate constant,\

          \ we're using the actual value we know it's the default" .

  defaultField [| OpPrioNormal |] $

  simpleField "priority" [t| OpSubmitPriority |]

pDependencies :: Field

pDependencies =

  withDoc "Job dependencies" .

  optionalNullSerField $ simpleField "depends" [t| [JobDependency] |]

pComment :: Field

pComment =

  withDoc "Comment field" .

  optionalNullSerField $ stringField "comment"

pReason :: Field

pReason =

  withDoc "Reason trail field" $

  simpleField C.opcodeReason [t| ReasonTrail |]

pSequential :: Field

pSequential =

  withDoc "Sequential job execution" $

  defaultFalse C.opcodeSequential

-- * Parameters

pDebugSimulateErrors :: Field

pDebugSimulateErrors =

  withDoc "Whether to simulate errors (useful for debugging)" $

  defaultFalse "debug_simulate_errors"

pErrorCodes :: Field

pErrorCodes = 

  withDoc "Error codes" $

  defaultFalse "error_codes"

pSkipChecks :: Field

pSkipChecks = 

  withDoc "Which checks to skip" .

  defaultField [| emptyListSet |] $

  simpleField "skip_checks" [t| ListSet VerifyOptionalChecks |]

pIgnoreErrors :: Field

pIgnoreErrors =

  withDoc "List of error codes that should be treated as warnings" .

  defaultField [| emptyListSet |] $

  simpleField "ignore_errors" [t| ListSet CVErrorCode |]

pVerbose :: Field

pVerbose =

  withDoc "Verbose mode" $

  defaultFalse "verbose"

pOptGroupName :: Field

pOptGroupName =

  withDoc "Optional group name" .

  renameField "OptGroupName" .

  optionalField $ simpleField "group_name" [t| NonEmptyString |]

pGroupName :: Field

pGroupName =

  withDoc "Group name" $

  simpleField "group_name" [t| NonEmptyString |]

-- | Whether to hotplug device.

pHotplug :: Field

pHotplug = defaultFalse "hotplug"

pHotplugIfPossible :: Field

pHotplugIfPossible = defaultFalse "hotplug_if_possible"

pInstances :: Field

pInstances =

  withDoc "List of instances" .

  defaultField [| [] |] $

  simpleField "instances" [t| [NonEmptyString] |]

pOutputFields :: Field

pOutputFields =

  withDoc "Selected output fields" $

  simpleField "output_fields" [t| [NonEmptyString] |]

pName :: Field

pName =

  withDoc "A generic name" $

  simpleField "name" [t| NonEmptyString |]

pForce :: Field

pForce =

  withDoc "Whether to force the operation" $

  defaultFalse "force"

pHvState :: Field

pHvState =

  withDoc "Set hypervisor states" .

  optionalField $ simpleField "hv_state" [t| JSObject JSValue |]

pDiskState :: Field

pDiskState =

  withDoc "Set disk states" .

  optionalField $ simpleField "disk_state" [t| JSObject JSValue |]

-- | Cluster-wide default directory for storing file-backed disks.

pClusterFileStorageDir :: Field

pClusterFileStorageDir =

  renameField "ClusterFileStorageDir" $

  optionalStringField "file_storage_dir"

-- | Cluster-wide default directory for storing shared-file-backed disks.

pClusterSharedFileStorageDir :: Field

pClusterSharedFileStorageDir =

  renameField "ClusterSharedFileStorageDir" $

  optionalStringField "shared_file_storage_dir"

-- | Volume group name.

pVgName :: Field

pVgName =

  withDoc "Volume group name" $

  optionalStringField "vg_name"

pEnabledHypervisors :: Field

pEnabledHypervisors =

  withDoc "List of enabled hypervisors" .

  optionalField $

  simpleField "enabled_hypervisors" [t| [Hypervisor] |]

pClusterHvParams :: Field

pClusterHvParams =

  withDoc "Cluster-wide hypervisor parameters, hypervisor-dependent" .

  renameField "ClusterHvParams" .

  optionalField $

  simpleField "hvparams" [t| GenericContainer String (JSObject JSValue) |]

pClusterBeParams :: Field

pClusterBeParams =

  withDoc "Cluster-wide backend parameter defaults" .

  renameField "ClusterBeParams" .

  optionalField $ simpleField "beparams" [t| JSObject JSValue |]

pOsHvp :: Field

pOsHvp =

  withDoc "Cluster-wide per-OS hypervisor parameter defaults" .

  optionalField $

  simpleField "os_hvp" [t| GenericContainer String (JSObject JSValue) |]

pClusterOsParams :: Field

pClusterOsParams =

  withDoc "Cluster-wide OS parameter defaults" .

  renameField "ClusterOsParams" .

  optionalField $

  simpleField "osparams" [t| GenericContainer String (JSObject JSValue) |]

pGroupDiskParams :: Field

pGroupDiskParams =

  withDoc "Disk templates' parameter defaults" .

  optionalField $

  simpleField "diskparams"

              [t| GenericContainer DiskTemplate (JSObject JSValue) |]

pCandidatePoolSize :: Field

pCandidatePoolSize =

  withDoc "Master candidate pool size" .

  optionalField $ simpleField "candidate_pool_size" [t| Positive Int |]

pUidPool :: Field

pUidPool =

  withDoc "Set UID pool, must be list of lists describing UID ranges\

          \ (two items, start and end inclusive)" .

  optionalField $ simpleField "uid_pool" [t| [(Int, Int)] |]

pAddUids :: Field

pAddUids =

  withDoc "Extend UID pool, must be list of lists describing UID\

          \ ranges (two items, start and end inclusive)" .

  optionalField $ simpleField "add_uids" [t| [(Int, Int)] |]

pRemoveUids :: Field

pRemoveUids =

  withDoc "Shrink UID pool, must be list of lists describing UID\

          \ ranges (two items, start and end inclusive) to be removed" .

  optionalField $ simpleField "remove_uids" [t| [(Int, Int)] |]

pMaintainNodeHealth :: Field

pMaintainNodeHealth =

  withDoc "Whether to automatically maintain node health" .

  optionalField $ booleanField "maintain_node_health"

-- | Whether to modify and keep in sync the @/etc/hosts@ files of nodes.

pModifyEtcHosts :: Field

pModifyEtcHosts = optionalField $ booleanField "modify_etc_hosts"

-- | Whether to wipe disks before allocating them to instances.

pPreallocWipeDisks :: Field

pPreallocWipeDisks =

  withDoc "Whether to wipe disks before allocating them to instances" .

  optionalField $ booleanField "prealloc_wipe_disks"

pNicParams :: Field

pNicParams =

  withDoc "Cluster-wide NIC parameter defaults" .

  optionalField $ simpleField "nicparams" [t| INicParams |]

pIpolicy :: Field

pIpolicy =

  withDoc "Ipolicy specs" .

  optionalField $ simpleField "ipolicy" [t| JSObject JSValue |]

pDrbdHelper :: Field

pDrbdHelper =

  withDoc "DRBD helper program" $

  optionalStringField "drbd_helper"

pDefaultIAllocator :: Field

pDefaultIAllocator =

  withDoc "Default iallocator for cluster" $

  optionalStringField "default_iallocator"

pMasterNetdev :: Field

pMasterNetdev =

  withDoc "Master network device" $

  optionalStringField "master_netdev"

pMasterNetmask :: Field

pMasterNetmask =

  withDoc "Netmask of the master IP" .

  optionalField $ simpleField "master_netmask" [t| NonNegative Int |]

pReservedLvs :: Field

pReservedLvs =

  withDoc "List of reserved LVs" .

  optionalField $ simpleField "reserved_lvs" [t| [NonEmptyString] |]

pHiddenOs :: Field

pHiddenOs =

  withDoc "Modify list of hidden operating systems: each modification\

          \ must have two items, the operation and the OS name; the operation\

          \ can be add or remove" .

  optionalField $ simpleField "hidden_os" [t| [(DdmSimple, NonEmptyString)] |]

pBlacklistedOs :: Field

pBlacklistedOs =

  withDoc "Modify list of blacklisted operating systems: each\

          \ modification must have two items, the operation and the OS name;\

          \ the operation can be add or remove" .

  optionalField $

  simpleField "blacklisted_os" [t| [(DdmSimple, NonEmptyString)] |]

pUseExternalMipScript :: Field

pUseExternalMipScript =

  withDoc "Whether to use an external master IP address setup script" .

  optionalField $ booleanField "use_external_mip_script"

pEnabledDiskTemplates :: Field

pEnabledDiskTemplates =

  withDoc "List of enabled disk templates" .

  optionalField $

  simpleField "enabled_disk_templates" [t| [DiskTemplate] |]

pQueryWhat :: Field

pQueryWhat =

  withDoc "Resource(s) to query for" $

  simpleField "what" [t| Qlang.QueryTypeOp |]

pUseLocking :: Field

pUseLocking =

  withDoc "Whether to use synchronization" $

  defaultFalse "use_locking"

pQueryFields :: Field

pQueryFields =

  withDoc "Requested fields" $

  simpleField "fields" [t| [NonEmptyString] |]

pQueryFilter :: Field

pQueryFilter =

  withDoc "Query filter" .

  optionalField $ simpleField "qfilter" [t| [JSValue] |]

pQueryFieldsFields :: Field

pQueryFieldsFields =

  withDoc "Requested fields; if not given, all are returned" .

  renameField "QueryFieldsFields" $

  optionalField pQueryFields

pNodeNames :: Field

pNodeNames =

  withDoc "List of node names to run the OOB command against" .

  defaultField [| [] |] $ simpleField "node_names" [t| [NonEmptyString] |]

pNodeUuids :: Field

pNodeUuids =

  withDoc "List of node UUIDs" .

  optionalField $ simpleField "node_uuids" [t| [NonEmptyString] |]

pOobCommand :: Field

pOobCommand =

  withDoc "OOB command to run" $

  simpleField "command" [t| OobCommand |]

pOobTimeout :: Field

pOobTimeout =

  withDoc "Timeout before the OOB helper will be terminated" .

  defaultField [| C.oobTimeout |] $

  simpleField "timeout" [t| Int |]

pIgnoreStatus :: Field

pIgnoreStatus =

  withDoc "Ignores the node offline status for power off" $

  defaultFalse "ignore_status"

pPowerDelay :: Field

pPowerDelay =

  -- FIXME: we can't use the proper type "NonNegative Double", since

  -- the default constant is a plain Double, not a non-negative one.

  -- And trying to fix the constant introduces a cyclic import.

  withDoc "Time in seconds to wait between powering on nodes" .

  defaultField [| C.oobPowerDelay |] $

  simpleField "power_delay" [t| Double |]

pRequiredNodes :: Field

pRequiredNodes =

  withDoc "Required list of node names" .

  renameField "ReqNodes " $ simpleField "nodes" [t| [NonEmptyString] |]

pRequiredNodeUuids :: Field

pRequiredNodeUuids =

  withDoc "Required list of node UUIDs" .

  renameField "ReqNodeUuids " . optionalField $

  simpleField "node_uuids" [t| [NonEmptyString] |]

pRestrictedCommand :: Field

pRestrictedCommand =

  withDoc "Restricted command name" .

  renameField "RestrictedCommand" $

  simpleField "command" [t| NonEmptyString |]

pNodeName :: Field

pNodeName =

  withDoc "A required node name (for single-node LUs)" $

  simpleField "node_name" [t| NonEmptyString |]

pNodeUuid :: Field

pNodeUuid =

  withDoc "A node UUID (for single-node LUs)" .

  optionalField $ simpleField "node_uuid" [t| NonEmptyString |]

pPrimaryIp :: Field

pPrimaryIp =

  withDoc "Primary IP address" .

  optionalField $

  simpleField "primary_ip" [t| NonEmptyString |]

pSecondaryIp :: Field

pSecondaryIp =

  withDoc "Secondary IP address" $

  optionalNEStringField "secondary_ip"

pReadd :: Field

pReadd =

  withDoc "Whether node is re-added to cluster" $

  defaultFalse "readd"

pNodeGroup :: Field

pNodeGroup =

  withDoc "Initial node group" $

  optionalNEStringField "group"

pMasterCapable :: Field

pMasterCapable =

  withDoc "Whether node can become master or master candidate" .

  optionalField $ booleanField "master_capable"

pVmCapable :: Field

pVmCapable =

  withDoc "Whether node can host instances" .

  optionalField $ booleanField "vm_capable"

pNdParams :: Field

pNdParams =

  withDoc "Node parameters" .

  renameField "genericNdParams" .

  optionalField $ simpleField "ndparams" [t| JSObject JSValue |]

pNames :: Field

pNames =

  withDoc "List of names" .

  defaultField [| [] |] $ simpleField "names" [t| [NonEmptyString] |]

pNodes :: Field

pNodes =

  withDoc "List of nodes" .

  defaultField [| [] |] $ simpleField "nodes" [t| [NonEmptyString] |]

pStorageType :: Field

pStorageType =

  withDoc "Storage type" $ simpleField "storage_type" [t| StorageType |]

pStorageTypeOptional :: Field

pStorageTypeOptional =

  withDoc "Storage type" .

  renameField "StorageTypeOptional" .

  optionalField $ simpleField "storage_type" [t| StorageType |]

pStorageName :: Field

pStorageName =

  withDoc "Storage name" .

  renameField "StorageName" .

  optionalField $ simpleField "name" [t| NonEmptyString |]

pStorageChanges :: Field

pStorageChanges =

  withDoc "Requested storage changes" $

  simpleField "changes" [t| JSObject JSValue |]

pIgnoreConsistency :: Field

pIgnoreConsistency =

  withDoc "Whether to ignore disk consistency" $

  defaultFalse "ignore_consistency"

pMasterCandidate :: Field

pMasterCandidate =

  withDoc "Whether the node should become a master candidate" .

  optionalField $ booleanField "master_candidate"

pOffline :: Field

pOffline =

  withDoc "Whether to mark the node or instance offline" .

  optionalField $ booleanField "offline"

pDrained ::Field

pDrained =

  withDoc "Whether to mark the node as drained" .

  optionalField $ booleanField "drained"

pAutoPromote :: Field

pAutoPromote =

  withDoc "Whether node(s) should be promoted to master candidate if\

          \ necessary" $

  defaultFalse "auto_promote"

pPowered :: Field

pPowered =

  withDoc "Whether the node should be marked as powered" .

  optionalField $ booleanField "powered"

pMigrationMode :: Field

pMigrationMode =

  withDoc "Migration type (live/non-live)" .

  renameField "MigrationMode" .

  optionalField $

  simpleField "mode" [t| MigrationMode |]

pMigrationLive :: Field

pMigrationLive =

  withDoc "Obsolete \'live\' migration mode (do not use)" .

  renameField "OldLiveMode" . optionalField $ booleanField "live"

pMigrationTargetNode :: Field

pMigrationTargetNode =

  withDoc "Target node for instance migration/failover" $

  optionalNEStringField "target_node"

pMigrationTargetNodeUuid :: Field

pMigrationTargetNodeUuid =

  withDoc "Target node UUID for instance migration/failover" $

  optionalNEStringField "target_node_uuid"

pAllowRuntimeChgs :: Field

pAllowRuntimeChgs =

  withDoc "Whether to allow runtime changes while migrating" $

  defaultTrue "allow_runtime_changes"

pIgnoreIpolicy :: Field

pIgnoreIpolicy =

  withDoc "Whether to ignore ipolicy violations" $

  defaultFalse "ignore_ipolicy"

pIallocator :: Field

pIallocator =

  withDoc "Iallocator for deciding the target node for shared-storage\

          \ instances" $

  optionalNEStringField "iallocator"

pEarlyRelease :: Field

pEarlyRelease =

  withDoc "Whether to release locks as soon as possible" $

  defaultFalse "early_release"

pRemoteNode :: Field

pRemoteNode =

  withDoc "New secondary node" $