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, 2014 Google Inc.

This program is free software; you can redistribute it and/or modify

it under the terms of the GNU General Public License as published by

the Free Software Foundation; either version 2 of the License, or

(at your option) any later version.

This program is distributed in the hope that it will be useful, but

WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

General Public License for more details.

You should have received a copy of the GNU General Public License

along with this program; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA

02110-1301, USA.

-}

module Ganeti.OpParams

  ( ReplaceDisksMode(..)

  , DiskIndex

  , mkDiskIndex

  , unDiskIndex

  , DiskAccess(..)

  , INicParams(..)

  , IDiskParams(..)

  , RecreateDisksInfo(..)

  , DdmOldChanges(..)

  , SetParamsMods(..)

  , ExportTarget(..)

  , pInstanceName

  , pInstanceCommunication

  , pOptInstanceCommunication

  , 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

  , pMoveCompress

  , pBackupCompress

  , pStartupPaused

  , pVerbose

  , pDebugSimulateErrors

  , pErrorCodes

  , pSkipChecks

  , pIgnoreErrors

  , pOptGroupName

  , pDiskParams

  , pHvState

  , pDiskState

  , pIgnoreIpolicy

  , pHotplug

  , pHotplugIfPossible

  , pAllowRuntimeChgs

  , pInstDisks

  , pDiskTemplate

  , pOptDiskTemplate

  , pFileDriver

  , pFileStorageDir

  , pClusterFileStorageDir

  , pClusterSharedFileStorageDir

  , pClusterGlusterStorageDir

  , pInstanceCommunicationNetwork

  , pVgName

  , pEnabledHypervisors

  , pHypervisor

  , pClusterHvParams

  , pInstHvParams

  , pClusterBeParams

  , pInstBeParams

  , pResetDefaults

  , pOsHvp

  , pClusterOsParams

  , pClusterOsParamsPrivate

  , pInstOsParams

  , pInstOsParamsPrivate

  , pInstOsParamsSecret

  , pCandidatePoolSize

  , pMaxRunningJobs

  , pUidPool

  , pAddUids

  , pRemoveUids

  , pMaintainNodeHealth

  , pModifyEtcHosts

  , pPreallocWipeDisks

  , pNicParams

  , pInstNics

  , pNdParams

  , pIpolicy

  , pDrbdHelper

  , pDefaultIAllocator

  , pDefaultIAllocatorParams

  , pMasterNetdev

  , pMasterNetmask

  , pReservedLvs

  , pHiddenOs

  , pBlacklistedOs

  , pUseExternalMipScript

  , pQueryFields

  , pQueryFilter

  , pQueryFieldsFields

  , pOobCommand

  , pOobTimeout

  , pIgnoreStatus

  , pPowerDelay

  , pPrimaryIp

  , pSecondaryIp

  , pReadd

  , pNodeGroup

  , pMasterCapable

  , pVmCapable

  , pNames

  , pNodes

  , pRequiredNodes

  , pRequiredNodeUuids

  , pStorageType

  , pOptStorageType

  , 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

  , pTempOsParamsPrivate

  , pTempOsParamsSecret

  , 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

  , pDelayDuration

  , pDelayOnMaster

  , pDelayOnNodes

  , pDelayOnNodeUuids

  , pDelayRepeat

  , pDelayInterruptible

  , 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

  , pDryRun

  , pDebugLevel

  , pOpPriority

  , pDependencies

  , pComment

  , pReason

  , pEnabledDiskTemplates

  ) where

import Control.Monad (liftM, mplus)

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.THH.Field

import Ganeti.Utils

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

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

  ])

-- | Disk modification definition.

$(buildObject "IDiskParams" "idisk"

  [ specialNumericalField 'parseUnitAssumeBinary . 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.idiskSpindles [t| Int          |]

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

  | SetParamsNewName (NonEmpty (DdmFull, String, a))

    deriving (Eq, Show)

-- | Custom deserialiser for 'SetParamsMods'.

readSetParams :: (JSON a) => JSValue -> Text.JSON.Result (SetParamsMods a)

readSetParams (JSArray []) = return SetParamsEmpty

readSetParams v =

  liftM SetParamsDeprecated (readJSON v)

  `mplus` liftM SetParamsNew (readJSON v)

  `mplus` liftM SetParamsNewName (readJSON v)

instance (JSON a) => JSON (SetParamsMods a) where

  showJSON SetParamsEmpty = showJSON ()

  showJSON (SetParamsDeprecated v) = showJSON v

  showJSON (SetParamsNew v) = showJSON v

  showJSON (SetParamsNewName 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 |]

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

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

pClusterGlusterStorageDir :: Field

pClusterGlusterStorageDir =

  renameField "ClusterGlusterStorageDir" $

  optionalStringField "gluster_storage_dir"

pInstanceCommunicationNetwork :: Field

pInstanceCommunicationNetwork =

  optionalStringField "instance_communication_network"

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

pClusterOsParamsPrivate :: Field

pClusterOsParamsPrivate =

  withDoc "Cluster-wide private OS parameter defaults" .

  renameField "ClusterOsParamsPrivate" .

  optionalField $

  -- This field needs an unique name to aid Python deserialization

  simpleField "osparams_private_cluster"

    [t| GenericContainer String (JSObject (Private JSValue)) |]

pDiskParams :: Field

pDiskParams =

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

pMaxRunningJobs :: Field

pMaxRunningJobs =

  withDoc "Maximal number of jobs to run simultaneously" .

  optionalField $ simpleField "max_running_jobs" [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"

pDefaultIAllocatorParams :: Field

pDefaultIAllocatorParams =

  withDoc "Default iallocator parameters for cluster" . optionalField

    $ simpleField "default_iallocator_params" [t| JSObject JSValue |]

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

pOptStorageType :: Field

pOptStorageType =

  withDoc "Storage type" .

  renameField "OptStorageType" .

  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"