code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/OpParams.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2
   3 {-| Implementation of opcodes parameters.
   4
   5 These are defined in a separate module only due to TemplateHaskell
   6 stage restrictions - expressions defined in the current module can't
   7 be passed to splices. So we have to either parameters/repeat each
   8 parameter definition multiple times, or separate them into this
   9 module.
  10
  11 -}
  12
  13 {-
  14
  15 Copyright (C) 2012 Google Inc.
  16
  17 This program is free software; you can redistribute it and/or modify
  18 it under the terms of the GNU General Public License as published by
  19 the Free Software Foundation; either version 2 of the License, or
  20 (at your option) any later version.
  21
  22 This program is distributed in the hope that it will be useful, but
  23 WITHOUT ANY WARRANTY; without even the implied warranty of
  24 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  25 General Public License for more details.
  26
  27 You should have received a copy of the GNU General Public License
  28 along with this program; if not, write to the Free Software
  29 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  30 02110-1301, USA.
  31
  32 -}
  33
  34 module Ganeti.OpParams
  35   ( TagType(..)
  36   , TagObject(..)
  37   , tagObjectFrom
  38   , decodeTagObject
  39   , encodeTagObject
  40   , ReplaceDisksMode(..)
  41   , DiskIndex
  42   , mkDiskIndex
  43   , unDiskIndex
  44   , DiskAccess(..)
  45   , INicParams(..)
  46   , IDiskParams(..)
  47   , RecreateDisksInfo(..)
  48   , DdmOldChanges(..)
  49   , SetParamsMods(..)
  50   , ExportTarget(..)
  51   , pInstanceName
  52   , pInstances
  53   , pName
  54   , pTagsList
  55   , pTagsObject
  56   , pOutputFields
  57   , pShutdownTimeout
  58   , pShutdownTimeout'
  59   , pForce
  60   , pIgnoreOfflineNodes
  61   , pNodeName
  62   , pNodeNames
  63   , pGroupName
  64   , pMigrationMode
  65   , pMigrationLive
  66   , pForceVariant
  67   , pWaitForSync
  68   , pWaitForSyncFalse
  69   , pIgnoreConsistency
  70   , pStorageName
  71   , pUseLocking
  72   , pNameCheck
  73   , pNodeGroupAllocPolicy
  74   , pGroupNodeParams
  75   , pQueryWhat
  76   , pEarlyRelease
  77   , pIpCheck
  78   , pIpConflictsCheck
  79   , pNoRemember
  80   , pMigrationTargetNode
  81   , pMoveTargetNode
  82   , pStartupPaused
  83   , pVerbose
  84   , pDebugSimulateErrors
  85   , pErrorCodes
  86   , pSkipChecks
  87   , pIgnoreErrors
  88   , pOptGroupName
  89   , pDiskParams
  90   , pHvState
  91   , pDiskState
  92   , pIgnoreIpolicy
  93   , pAllowRuntimeChgs
  94   , pInstDisks
  95   , pDiskTemplate
  96   , pFileDriver
  97   , pFileStorageDir
  98   , pVgName
  99   , pEnabledHypervisors
 100   , pHypervisor
 101   , pClusterHvParams
 102   , pInstHvParams
 103   , pClusterBeParams
 104   , pInstBeParams
 105   , pResetDefaults
 106   , pOsHvp
 107   , pClusterOsParams
 108   , pInstOsParams
 109   , pCandidatePoolSize
 110   , pUidPool
 111   , pAddUids
 112   , pRemoveUids
 113   , pMaintainNodeHealth
 114   , pPreallocWipeDisks
 115   , pNicParams
 116   , pInstNics
 117   , pNdParams
 118   , pIpolicy
 119   , pDrbdHelper
 120   , pDefaultIAllocator
 121   , pMasterNetdev
 122   , pMasterNetmask
 123   , pReservedLvs
 124   , pHiddenOs
 125   , pBlacklistedOs
 126   , pUseExternalMipScript
 127   , pQueryFields
 128   , pQueryFilter
 129   , pOobCommand
 130   , pOobTimeout
 131   , pIgnoreStatus
 132   , pPowerDelay
 133   , pPrimaryIp
 134   , pSecondaryIp
 135   , pReadd
 136   , pNodeGroup
 137   , pMasterCapable
 138   , pVmCapable
 139   , pNames
 140   , pNodes
 141   , pRequiredNodes
 142   , pStorageType
 143   , pStorageChanges
 144   , pMasterCandidate
 145   , pOffline
 146   , pDrained
 147   , pAutoPromote
 148   , pPowered
 149   , pIallocator
 150   , pRemoteNode
 151   , pEvacMode
 152   , pInstCreateMode
 153   , pNoInstall
 154   , pInstOs
 155   , pPrimaryNode
 156   , pSecondaryNode
 157   , pSourceHandshake
 158   , pSourceInstance
 159   , pSourceShutdownTimeout
 160   , pSourceX509Ca
 161   , pSrcNode
 162   , pSrcPath
 163   , pStartInstance
 164   , pInstTags
 165   , pMultiAllocInstances
 166   , pTempOsParams
 167   , pTempHvParams
 168   , pTempBeParams
 169   , pIgnoreFailures
 170   , pNewName
 171   , pIgnoreSecondaries
 172   , pRebootType
 173   , pIgnoreDiskSize
 174   , pRecreateDisksInfo
 175   , pStatic
 176   , pInstParamsNicChanges
 177   , pInstParamsDiskChanges
 178   , pRuntimeMem
 179   , pOsNameChange
 180   , pDiskIndex
 181   , pDiskChgAmount
 182   , pDiskChgAbsolute
 183   , pTargetGroups
 184   , pExportMode
 185   , pExportTargetNode
 186   , pRemoveInstance
 187   , pIgnoreRemoveFailures
 188   , pX509KeyName
 189   , pX509DestCA
 190   ) where
 191
 192 import Control.Monad (liftM)
 193 import qualified Data.Set as Set
 194 import Text.JSON (readJSON, showJSON, JSON, JSValue(..), fromJSString,
 195                   JSObject, toJSObject)
 196 import qualified Text.JSON
 197 import Text.JSON.Pretty (pp_value)
 198
 199 import Ganeti.BasicTypes
 200 import qualified Ganeti.Constants as C
 201 import Ganeti.THH
 202 import Ganeti.JSON
 203 import Ganeti.Types
 204 import qualified Ganeti.Query.Language as Qlang
 205
 206 -- * Helper functions and types
 207
 208 -- * Type aliases
 209
 210 -- | Build a boolean field.
 211 booleanField :: String -> Field
 212 booleanField = flip simpleField [t| Bool |]
 213
 214 -- | Default a field to 'False'.
 215 defaultFalse :: String -> Field
 216 defaultFalse = defaultField [| False |] . booleanField
 217
 218 -- | Default a field to 'True'.
 219 defaultTrue :: String -> Field
 220 defaultTrue = defaultField [| True |] . booleanField
 221
 222 -- | An alias for a 'String' field.
 223 stringField :: String -> Field
 224 stringField = flip simpleField [t| String |]
 225
 226 -- | An alias for an optional string field.
 227 optionalStringField :: String -> Field
 228 optionalStringField = optionalField . stringField
 229
 230 -- | An alias for an optional non-empty string field.
 231 optionalNEStringField :: String -> Field
 232 optionalNEStringField = optionalField . flip simpleField [t| NonEmptyString |]
 233
 234 --- | Unchecked value, should be replaced by a better definition.
 235 --- type UncheckedValue = JSValue
 236
 237 -- | Unchecked dict, should be replaced by a better definition.
 238 type UncheckedDict = JSObject JSValue
 239
 240 -- | Unchecked list, shoild be replaced by a better definition.
 241 type UncheckedList = [JSValue]
 242
 243 -- | Function to force a non-negative value, without returning via a
 244 -- monad. This is needed for, and should be used /only/ in the case of
 245 -- forcing constants. In case the constant is wrong (< 0), this will
 246 -- become a runtime error.
 247 forceNonNeg :: (Num a, Ord a, Show a) => a -> NonNegative a
 248 forceNonNeg i = case mkNonNegative i of
 249                   Ok n -> n
 250                   Bad msg -> error msg
 251
 252 -- ** Tags
 253
 254 -- | Data type representing what items do the tag operations apply to.
 255 $(declareSADT "TagType"
 256   [ ("TagTypeInstance", 'C.tagInstance)
 257   , ("TagTypeNode",     'C.tagNode)
 258   , ("TagTypeGroup",    'C.tagNodegroup)
 259   , ("TagTypeCluster",  'C.tagCluster)
 260   ])
 261 $(makeJSONInstance ''TagType)
 262
 263 -- | Data type holding a tag object (type and object name).
 264 data TagObject = TagInstance String
 265                | TagNode     String
 266                | TagGroup    String
 267                | TagCluster
 268                deriving (Show, Read, Eq)
 269
 270 -- | Tag type for a given tag object.
 271 tagTypeOf :: TagObject -> TagType
 272 tagTypeOf (TagInstance {}) = TagTypeInstance
 273 tagTypeOf (TagNode     {}) = TagTypeNode
 274 tagTypeOf (TagGroup    {}) = TagTypeGroup
 275 tagTypeOf (TagCluster  {}) = TagTypeCluster
 276
 277 -- | Gets the potential tag object name.
 278 tagNameOf :: TagObject -> Maybe String
 279 tagNameOf (TagInstance s) = Just s
 280 tagNameOf (TagNode     s) = Just s
 281 tagNameOf (TagGroup    s) = Just s
 282 tagNameOf  TagCluster     = Nothing
 283
 284 -- | Builds a 'TagObject' from a tag type and name.
 285 tagObjectFrom :: (Monad m) => TagType -> JSValue -> m TagObject
 286 tagObjectFrom TagTypeInstance (JSString s) =
 287   return . TagInstance $ fromJSString s
 288 tagObjectFrom TagTypeNode     (JSString s) = return . TagNode $ fromJSString s
 289 tagObjectFrom TagTypeGroup    (JSString s) = return . TagGroup $ fromJSString s
 290 tagObjectFrom TagTypeCluster   JSNull      = return TagCluster
 291 tagObjectFrom t v =
 292   fail $ "Invalid tag type/name combination: " ++ show t ++ "/" ++
 293          show (pp_value v)
 294
 295 -- | Name of the tag \"name\" field.
 296 tagNameField :: String
 297 tagNameField = "name"
 298
 299 -- | Custom encoder for 'TagObject' as represented in an opcode.
 300 encodeTagObject :: TagObject -> (JSValue, [(String, JSValue)])
 301 encodeTagObject t = ( showJSON (tagTypeOf t)
 302                     , [(tagNameField, maybe JSNull showJSON (tagNameOf t))] )
 303
 304 -- | Custom decoder for 'TagObject' as represented in an opcode.
 305 decodeTagObject :: (Monad m) => [(String, JSValue)] -> JSValue -> m TagObject
 306 decodeTagObject obj kind = do
 307   ttype <- fromJVal kind
 308   tname <- fromObj obj tagNameField
 309   tagObjectFrom ttype tname
 310
 311 -- ** Disks
 312
 313 -- | Replace disks type.
 314 $(declareSADT "ReplaceDisksMode"
 315   [ ("ReplaceOnPrimary",    'C.replaceDiskPri)
 316   , ("ReplaceOnSecondary",  'C.replaceDiskSec)
 317   , ("ReplaceNewSecondary", 'C.replaceDiskChg)
 318   , ("ReplaceAuto",         'C.replaceDiskAuto)
 319   ])
 320 $(makeJSONInstance ''ReplaceDisksMode)
 321
 322 -- | Disk index type (embedding constraints on the index value via a
 323 -- smart constructor).
 324 newtype DiskIndex = DiskIndex { unDiskIndex :: Int }
 325   deriving (Show, Read, Eq, Ord)
 326
 327 -- | Smart constructor for 'DiskIndex'.
 328 mkDiskIndex :: (Monad m) => Int -> m DiskIndex
 329 mkDiskIndex i | i >= 0 && i < C.maxDisks = return (DiskIndex i)
 330               | otherwise = fail $ "Invalid value for disk index '" ++
 331                             show i ++ "', required between 0 and " ++
 332                             show C.maxDisks
 333
 334 instance JSON DiskIndex where
 335   readJSON v = readJSON v >>= mkDiskIndex
 336   showJSON = showJSON . unDiskIndex
 337
 338 -- ** I* param types
 339
 340 -- | Type holding disk access modes.
 341 $(declareSADT "DiskAccess"
 342   [ ("DiskReadOnly",  'C.diskRdonly)
 343   , ("DiskReadWrite", 'C.diskRdwr)
 344   ])
 345 $(makeJSONInstance ''DiskAccess)
 346
 347 -- | NIC modification definition.
 348 $(buildObject "INicParams" "inic"
 349   [ optionalField $ simpleField C.inicMac  [t| NonEmptyString |]
 350   , optionalField $ simpleField C.inicIp   [t| String         |]
 351   , optionalField $ simpleField C.inicMode [t| NonEmptyString |]
 352   , optionalField $ simpleField C.inicLink [t| NonEmptyString |]
 353   ])
 354
 355 -- | Disk modification definition. FIXME: disksize should be VTYPE_UNIT.
 356 $(buildObject "IDiskParams" "idisk"
 357   [ optionalField $ simpleField C.idiskSize   [t| Int            |]
 358   , optionalField $ simpleField C.idiskMode   [t| DiskAccess     |]
 359   , optionalField $ simpleField C.idiskAdopt  [t| NonEmptyString |]
 360   , optionalField $ simpleField C.idiskVg     [t| NonEmptyString |]
 361   , optionalField $ simpleField C.idiskMetavg [t| NonEmptyString |]
 362   ])
 363
 364 -- | Disk changes type for OpInstanceRecreateDisks. This is a bit
 365 -- strange, because the type in Python is something like Either
 366 -- [DiskIndex] [DiskChanges], but we can't represent the type of an
 367 -- empty list in JSON, so we have to add a custom case for the empty
 368 -- list.
 369 data RecreateDisksInfo
 370   = RecreateDisksAll
 371   | RecreateDisksIndices (NonEmpty DiskIndex)
 372   | RecreateDisksParams (NonEmpty (DiskIndex, IDiskParams))
 373     deriving (Eq, Read, Show)
 374
 375 readRecreateDisks :: JSValue -> Text.JSON.Result RecreateDisksInfo
 376 readRecreateDisks (JSArray []) = return RecreateDisksAll
 377 readRecreateDisks v =
 378   case readJSON v::Text.JSON.Result [DiskIndex] of
 379     Text.JSON.Ok indices -> liftM RecreateDisksIndices (mkNonEmpty indices)
 380     _ -> case readJSON v::Text.JSON.Result [(DiskIndex, IDiskParams)] of
 381            Text.JSON.Ok params -> liftM RecreateDisksParams (mkNonEmpty params)
 382            _ -> fail $ "Can't parse disk information as either list of disk"
 383                 ++ " indices or list of disk parameters; value recevied:"
 384                 ++ show (pp_value v)
 385
 386 instance JSON RecreateDisksInfo where
 387   readJSON = readRecreateDisks
 388   showJSON  RecreateDisksAll            = showJSON ()
 389   showJSON (RecreateDisksIndices idx)   = showJSON idx
 390   showJSON (RecreateDisksParams params) = showJSON params
 391
 392 -- | Simple type for old-style ddm changes.
 393 data DdmOldChanges = DdmOldIndex (NonNegative Int)
 394                    | DdmOldMod DdmSimple
 395                      deriving (Eq, Read, Show)
 396
 397 readDdmOldChanges :: JSValue -> Text.JSON.Result DdmOldChanges
 398 readDdmOldChanges v =
 399   case readJSON v::Text.JSON.Result (NonNegative Int) of
 400     Text.JSON.Ok nn -> return $ DdmOldIndex nn
 401     _ -> case readJSON v::Text.JSON.Result DdmSimple of
 402            Text.JSON.Ok ddms -> return $ DdmOldMod ddms
 403            _ -> fail $ "Can't parse value '" ++ show (pp_value v) ++ "' as"
 404                 ++ " either index or modification"
 405
 406 instance JSON DdmOldChanges where
 407   showJSON (DdmOldIndex i) = showJSON i
 408   showJSON (DdmOldMod m)   = showJSON m
 409   readJSON = readDdmOldChanges
 410
 411 -- | Instance disk or nic modifications.
 412 data SetParamsMods a
 413   = SetParamsEmpty
 414   | SetParamsDeprecated (NonEmpty (DdmOldChanges, a))
 415   | SetParamsNew (NonEmpty (DdmFull, Int, a))
 416     deriving (Eq, Read, Show)
 417
 418 -- | Custom deserialiser for 'SetParamsMods'.
 419 readSetParams :: (JSON a) => JSValue -> Text.JSON.Result (SetParamsMods a)
 420 readSetParams (JSArray []) = return SetParamsEmpty
 421 readSetParams v =
 422   case readJSON v::Text.JSON.Result [(DdmOldChanges, JSValue)] of
 423     Text.JSON.Ok _ -> liftM SetParamsDeprecated $ readJSON v
 424     _ -> liftM SetParamsNew $ readJSON v
 425
 426 instance (JSON a) => JSON (SetParamsMods a) where
 427   showJSON SetParamsEmpty = showJSON ()
 428   showJSON (SetParamsDeprecated v) = showJSON v
 429   showJSON (SetParamsNew v) = showJSON v
 430   readJSON = readSetParams
 431
 432 -- | Custom type for target_node parameter of OpBackupExport, which
 433 -- varies depending on mode. FIXME: this uses an UncheckedList since
 434 -- we don't care about individual rows (just like the Python code
 435 -- tests). But the proper type could be parsed if we wanted.
 436 data ExportTarget = ExportTargetLocal NonEmptyString
 437                   | ExportTargetRemote UncheckedList
 438                     deriving (Eq, Read, Show)
 439
 440 -- | Custom reader for 'ExportTarget'.
 441 readExportTarget :: JSValue -> Text.JSON.Result ExportTarget
 442 readExportTarget (JSString s) = liftM ExportTargetLocal $
 443                                 mkNonEmpty (fromJSString s)
 444 readExportTarget (JSArray arr) = return $ ExportTargetRemote arr
 445 readExportTarget v = fail $ "Invalid value received for 'target_node': " ++
 446                      show (pp_value v)
 447
 448 instance JSON ExportTarget where
 449   showJSON (ExportTargetLocal s)  = showJSON s
 450   showJSON (ExportTargetRemote l) = showJSON l
 451   readJSON = readExportTarget
 452
 453 -- * Parameters
 454
 455 -- | A required instance name (for single-instance LUs).
 456 pInstanceName :: Field
 457 pInstanceName = simpleField "instance_name" [t| String |]
 458
 459 -- | A list of instances.
 460 pInstances :: Field
 461 pInstances = defaultField [| [] |] $
 462              simpleField "instances" [t| [NonEmptyString] |]
 463
 464 -- | A generic name.
 465 pName :: Field
 466 pName = simpleField "name" [t| NonEmptyString |]
 467
 468 -- | Tags list.
 469 pTagsList :: Field
 470 pTagsList = simpleField "tags" [t| [String] |]
 471
 472 -- | Tags object.
 473 pTagsObject :: Field
 474 pTagsObject = customField 'decodeTagObject 'encodeTagObject $
 475               simpleField "kind" [t| TagObject |]
 476
 477 -- | Selected output fields.
 478 pOutputFields :: Field
 479 pOutputFields = simpleField "output_fields" [t| [NonEmptyString] |]
 480
 481 -- | How long to wait for instance to shut down.
 482 pShutdownTimeout :: Field
 483 pShutdownTimeout = defaultField [| forceNonNeg C.defaultShutdownTimeout |] $
 484                    simpleField "shutdown_timeout" [t| NonNegative Int |]
 485
 486 -- | Another name for the shutdown timeout, because we like to be
 487 -- inconsistent.
 488 pShutdownTimeout' :: Field
 489 pShutdownTimeout' =
 490   renameField "InstShutdownTimeout" .
 491   defaultField [| forceNonNeg C.defaultShutdownTimeout |] $
 492   simpleField "timeout" [t| NonNegative Int |]
 493
 494 -- | Whether to force the operation.
 495 pForce :: Field
 496 pForce = defaultFalse "force"
 497
 498 -- | Whether to ignore offline nodes.
 499 pIgnoreOfflineNodes :: Field
 500 pIgnoreOfflineNodes = defaultFalse "ignore_offline_nodes"
 501
 502 -- | A required node name (for single-node LUs).
 503 pNodeName :: Field
 504 pNodeName = simpleField "node_name" [t| NonEmptyString |]
 505
 506 -- | List of nodes.
 507 pNodeNames :: Field
 508 pNodeNames =
 509   defaultField [| [] |] $ simpleField "node_names" [t| [NonEmptyString] |]
 510
 511 -- | A required node group name (for single-group LUs).
 512 pGroupName :: Field
 513 pGroupName = simpleField "group_name" [t| NonEmptyString |]
 514
 515 -- | Migration type (live\/non-live).
 516 pMigrationMode :: Field
 517 pMigrationMode =
 518   renameField "MigrationMode" .
 519   optionalField $
 520   simpleField "mode" [t| MigrationMode |]
 521
 522 -- | Obsolete \'live\' migration mode (boolean).
 523 pMigrationLive :: Field
 524 pMigrationLive =
 525   renameField "OldLiveMode" . optionalField $ booleanField "live"
 526
 527 -- | Whether to force an unknown OS variant.
 528 pForceVariant :: Field
 529 pForceVariant = defaultFalse "force_variant"
 530
 531 -- | Whether to wait for the disk to synchronize.
 532 pWaitForSync :: Field
 533 pWaitForSync = defaultTrue "wait_for_sync"
 534
 535 -- | Whether to wait for the disk to synchronize (defaults to false).
 536 pWaitForSyncFalse :: Field
 537 pWaitForSyncFalse = defaultField [| False |] pWaitForSync
 538
 539 -- | Whether to ignore disk consistency
 540 pIgnoreConsistency :: Field
 541 pIgnoreConsistency = defaultFalse "ignore_consistency"
 542
 543 -- | Storage name.
 544 pStorageName :: Field
 545 pStorageName =
 546   renameField "StorageName" $ simpleField "name" [t| NonEmptyString |]
 547
 548 -- | Whether to use synchronization.
 549 pUseLocking :: Field
 550 pUseLocking = defaultFalse "use_locking"
 551
 552 -- | Whether to check name.
 553 pNameCheck :: Field
 554 pNameCheck = defaultTrue "name_check"
 555
 556 -- | Instance allocation policy.
 557 pNodeGroupAllocPolicy :: Field
 558 pNodeGroupAllocPolicy = optionalField $
 559                         simpleField "alloc_policy" [t| AllocPolicy |]
 560
 561 -- | Default node parameters for group.
 562 pGroupNodeParams :: Field
 563 pGroupNodeParams = optionalField $ simpleField "ndparams" [t| UncheckedDict |]
 564
 565 -- | Resource(s) to query for.
 566 pQueryWhat :: Field
 567 pQueryWhat = simpleField "what" [t| Qlang.QueryTypeOp |]
 568
 569 -- | Whether to release locks as soon as possible.
 570 pEarlyRelease :: Field
 571 pEarlyRelease = defaultFalse "early_release"
 572
 573 -- | Whether to ensure instance's IP address is inactive.
 574 pIpCheck :: Field
 575 pIpCheck = defaultTrue "ip_check"
 576
 577 -- | Check for conflicting IPs.
 578 pIpConflictsCheck :: Field
 579 pIpConflictsCheck = defaultTrue "conflicts_check"
 580
 581 -- | Do not remember instance state changes.
 582 pNoRemember :: Field
 583 pNoRemember = defaultFalse "no_remember"
 584
 585 -- | Target node for instance migration/failover.
 586 pMigrationTargetNode :: Field
 587 pMigrationTargetNode = optionalNEStringField "target_node"
 588
 589 -- | Target node for instance move (required).
 590 pMoveTargetNode :: Field
 591 pMoveTargetNode =
 592   renameField "MoveTargetNode" $
 593   simpleField "target_node" [t| NonEmptyString |]
 594
 595 -- | Pause instance at startup.
 596 pStartupPaused :: Field
 597 pStartupPaused = defaultFalse "startup_paused"
 598
 599 -- | Verbose mode.
 600 pVerbose :: Field
 601 pVerbose = defaultFalse "verbose"
 602
 603 -- ** Parameters for cluster verification
 604
 605 -- | Whether to simulate errors (useful for debugging).
 606 pDebugSimulateErrors :: Field
 607 pDebugSimulateErrors = defaultFalse "debug_simulate_errors"
 608
 609 -- | Error codes.
 610 pErrorCodes :: Field
 611 pErrorCodes = defaultFalse "error_codes"
 612
 613 -- | Which checks to skip.
 614 pSkipChecks :: Field
 615 pSkipChecks = defaultField [| Set.empty |] $
 616               simpleField "skip_checks" [t| Set.Set VerifyOptionalChecks |]
 617
 618 -- | List of error codes that should be treated as warnings.
 619 pIgnoreErrors :: Field
 620 pIgnoreErrors = defaultField [| Set.empty |] $
 621                 simpleField "ignore_errors" [t| Set.Set CVErrorCode |]
 622
 623 -- | Optional group name.
 624 pOptGroupName :: Field
 625 pOptGroupName = renameField "OptGroupName" .
 626                 optionalField $ simpleField "group_name" [t| NonEmptyString |]
 627
 628 -- | Disk templates' parameter defaults.
 629 pDiskParams :: Field
 630 pDiskParams = optionalField $
 631               simpleField "diskparams" [t| GenericContainer DiskTemplate
 632                                            UncheckedDict |]
 633
 634 -- * Parameters for node resource model
 635
 636 -- | Set hypervisor states.
 637 pHvState :: Field
 638 pHvState = optionalField $ simpleField "hv_state" [t| UncheckedDict |]
 639
 640 -- | Set disk states.
 641 pDiskState :: Field
 642 pDiskState = optionalField $ simpleField "disk_state" [t| UncheckedDict |]
 643
 644 -- | Whether to ignore ipolicy violations.
 645 pIgnoreIpolicy :: Field
 646 pIgnoreIpolicy = defaultFalse "ignore_ipolicy"
 647
 648 -- | Allow runtime changes while migrating.
 649 pAllowRuntimeChgs :: Field
 650 pAllowRuntimeChgs = defaultTrue "allow_runtime_changes"
 651
 652 -- | Utility type for OpClusterSetParams.
 653 type TestClusterOsListItem = (DdmSimple, NonEmptyString)
 654
 655 -- | Utility type of OsList.
 656 type TestClusterOsList = [TestClusterOsListItem]
 657
 658 -- Utility type for NIC definitions.
 659 --type TestNicDef = INicParams
 660
 661 -- | List of instance disks.
 662 pInstDisks :: Field
 663 pInstDisks = renameField "instDisks" $ simpleField "disks" [t| [IDiskParams] |]
 664
 665 -- | Instance disk template.
 666 pDiskTemplate :: Field
 667 pDiskTemplate = simpleField "disk_template" [t| DiskTemplate |]
 668
 669 -- | File driver.
 670 pFileDriver :: Field
 671 pFileDriver = optionalField $ simpleField "file_driver" [t| FileDriver |]
 672
 673 -- | Directory for storing file-backed disks.
 674 pFileStorageDir :: Field
 675 pFileStorageDir = optionalNEStringField "file_storage_dir"
 676
 677 -- | Volume group name.
 678 pVgName :: Field
 679 pVgName = optionalStringField "vg_name"
 680
 681 -- | List of enabled hypervisors.
 682 pEnabledHypervisors :: Field
 683 pEnabledHypervisors =
 684   optionalField $
 685   simpleField "enabled_hypervisors" [t| NonEmpty Hypervisor |]
 686
 687 -- | Selected hypervisor for an instance.
 688 pHypervisor :: Field
 689 pHypervisor =
 690   optionalField $
 691   simpleField "hypervisor" [t| Hypervisor |]
 692
 693 -- | Cluster-wide hypervisor parameters, hypervisor-dependent.
 694 pClusterHvParams :: Field
 695 pClusterHvParams =
 696   renameField "ClusterHvParams" .
 697   optionalField $
 698   simpleField "hvparams" [t| Container UncheckedDict |]
 699
 700 -- | Instance hypervisor parameters.
 701 pInstHvParams :: Field
 702 pInstHvParams =
 703   renameField "InstHvParams" .
 704   defaultField [| toJSObject [] |] $
 705   simpleField "hvparams" [t| UncheckedDict |]
 706
 707 -- | Cluster-wide beparams.
 708 pClusterBeParams :: Field
 709 pClusterBeParams =
 710   renameField "ClusterBeParams" .
 711   optionalField $ simpleField "beparams" [t| UncheckedDict |]
 712
 713 -- | Instance beparams.
 714 pInstBeParams :: Field
 715 pInstBeParams =
 716   renameField "InstBeParams" .
 717   defaultField [| toJSObject [] |] $
 718   simpleField "beparams" [t| UncheckedDict |]
 719
 720 -- | Reset instance parameters to default if equal.
 721 pResetDefaults :: Field
 722 pResetDefaults = defaultFalse "identify_defaults"
 723
 724 -- | Cluster-wide per-OS hypervisor parameter defaults.
 725 pOsHvp :: Field
 726 pOsHvp = optionalField $ simpleField "os_hvp" [t| Container UncheckedDict |]
 727
 728 -- | Cluster-wide OS parameter defaults.
 729 pClusterOsParams :: Field
 730 pClusterOsParams =
 731   renameField "ClusterOsParams" .
 732   optionalField $ simpleField "osparams" [t| Container UncheckedDict |]
 733
 734 -- | Instance OS parameters.
 735 pInstOsParams :: Field
 736 pInstOsParams =
 737   renameField "InstOsParams" . defaultField [| toJSObject [] |] $
 738   simpleField "osparams" [t| UncheckedDict |]
 739
 740 -- | Temporary OS parameters (currently only in reinstall, might be
 741 -- added to install as well).
 742 pTempOsParams :: Field
 743 pTempOsParams =
 744   renameField "TempOsParams" .
 745   optionalField $ simpleField "osparams" [t| UncheckedDict |]
 746
 747 -- | Temporary hypervisor parameters, hypervisor-dependent.
 748 pTempHvParams :: Field
 749 pTempHvParams =
 750   renameField "TempHvParams" .
 751   defaultField [| toJSObject [] |] $
 752   simpleField "hvparams" [t| UncheckedDict |]
 753
 754 -- | Temporary backend parameters.
 755 pTempBeParams :: Field
 756 pTempBeParams =
 757   renameField "TempBeParams" .
 758   defaultField [| toJSObject [] |] $
 759   simpleField "beparams" [t| UncheckedDict |]
 760
 761 -- | Candidate pool size.
 762 pCandidatePoolSize :: Field
 763 pCandidatePoolSize =
 764   optionalField $ simpleField "candidate_pool_size" [t| Positive Int |]
 765
 766 -- | Set UID pool, must be list of lists describing UID ranges (two
 767 -- items, start and end inclusive.
 768 pUidPool :: Field
 769 pUidPool = optionalField $ simpleField "uid_pool" [t| [[(Int, Int)]] |]
 770
 771 -- | Extend UID pool, must be list of lists describing UID ranges (two
 772 -- items, start and end inclusive.
 773 pAddUids :: Field
 774 pAddUids = optionalField $ simpleField "add_uids" [t| [[(Int, Int)]] |]
 775
 776 -- | Shrink UID pool, must be list of lists describing UID ranges (two
 777 -- items, start and end inclusive) to be removed.
 778 pRemoveUids :: Field
 779 pRemoveUids = optionalField $ simpleField "remove_uids" [t| [[(Int, Int)]] |]
 780
 781 -- | Whether to automatically maintain node health.
 782 pMaintainNodeHealth :: Field
 783 pMaintainNodeHealth = optionalField $ booleanField "maintain_node_health"
 784
 785 -- | Whether to wipe disks before allocating them to instances.
 786 pPreallocWipeDisks :: Field
 787 pPreallocWipeDisks = optionalField $ booleanField "prealloc_wipe_disks"
 788
 789 -- | Cluster-wide NIC parameter defaults.
 790 pNicParams :: Field
 791 pNicParams = optionalField $ simpleField "nicparams" [t| INicParams |]
 792
 793 -- | Instance NIC definitions.
 794 pInstNics :: Field
 795 pInstNics = simpleField "nics" [t| [INicParams] |]
 796
 797 -- | Cluster-wide node parameter defaults.
 798 pNdParams :: Field
 799 pNdParams = optionalField $ simpleField "ndparams" [t| UncheckedDict |]
 800
 801 -- | Cluster-wide ipolicy specs.
 802 pIpolicy :: Field
 803 pIpolicy = optionalField $ simpleField "ipolicy" [t| UncheckedDict |]
 804
 805 -- | DRBD helper program.
 806 pDrbdHelper :: Field
 807 pDrbdHelper = optionalStringField "drbd_helper"
 808
 809 -- | Default iallocator for cluster.
 810 pDefaultIAllocator :: Field
 811 pDefaultIAllocator = optionalStringField "default_iallocator"
 812
 813 -- | Master network device.
 814 pMasterNetdev :: Field
 815 pMasterNetdev = optionalStringField "master_netdev"
 816
 817 -- | Netmask of the master IP.
 818 pMasterNetmask :: Field
 819 pMasterNetmask = optionalField $ simpleField "master_netmask" [t| Int |]
 820
 821 -- | List of reserved LVs.
 822 pReservedLvs :: Field
 823 pReservedLvs =
 824   optionalField $ simpleField "reserved_lvs" [t| [NonEmptyString] |]
 825
 826 -- | Modify list of hidden operating systems: each modification must
 827 -- have two items, the operation and the OS name; the operation can be
 828 -- add or remove.
 829 pHiddenOs :: Field
 830 pHiddenOs = optionalField $ simpleField "hidden_os" [t| TestClusterOsList |]
 831
 832 -- | Modify list of blacklisted operating systems: each modification
 833 -- must have two items, the operation and the OS name; the operation
 834 -- can be add or remove.
 835 pBlacklistedOs :: Field
 836 pBlacklistedOs =
 837   optionalField $ simpleField "blacklisted_os" [t| TestClusterOsList |]
 838
 839 -- | Whether to use an external master IP address setup script.
 840 pUseExternalMipScript :: Field
 841 pUseExternalMipScript = optionalField $ booleanField "use_external_mip_script"
 842
 843 -- | Requested fields.
 844 pQueryFields :: Field
 845 pQueryFields = simpleField "fields" [t| [NonEmptyString] |]
 846
 847 -- | Query filter.
 848 pQueryFilter :: Field
 849 pQueryFilter = simpleField "qfilter" [t| Qlang.Filter String |]
 850
 851 -- | OOB command to run.
 852 pOobCommand :: Field
 853 pOobCommand = simpleField "command" [t| OobCommand |]
 854
 855 -- | Timeout before the OOB helper will be terminated.
 856 pOobTimeout :: Field
 857 pOobTimeout =
 858   defaultField [| C.oobTimeout |] $ simpleField "timeout" [t| Int |]
 859
 860 -- | Ignores the node offline status for power off.
 861 pIgnoreStatus :: Field
 862 pIgnoreStatus = defaultFalse "ignore_status"
 863
 864 -- | Time in seconds to wait between powering on nodes.
 865 pPowerDelay :: Field
 866 pPowerDelay =
 867   -- FIXME: we can't use the proper type "NonNegative Double", since
 868   -- the default constant is a plain Double, not a non-negative one.
 869   defaultField [| C.oobPowerDelay |] $
 870   simpleField "power_delay" [t| Double |]
 871
 872 -- | Primary IP address.
 873 pPrimaryIp :: Field
 874 pPrimaryIp = optionalStringField "primary_ip"
 875
 876 -- | Secondary IP address.
 877 pSecondaryIp :: Field
 878 pSecondaryIp = optionalNEStringField "secondary_ip"
 879
 880 -- | Whether node is re-added to cluster.
 881 pReadd :: Field
 882 pReadd = defaultFalse "readd"
 883
 884 -- | Initial node group.
 885 pNodeGroup :: Field
 886 pNodeGroup = optionalNEStringField "group"
 887
 888 -- | Whether node can become master or master candidate.
 889 pMasterCapable :: Field
 890 pMasterCapable = optionalField $ booleanField "master_capable"
 891
 892 -- | Whether node can host instances.
 893 pVmCapable :: Field
 894 pVmCapable = optionalField $ booleanField "vm_capable"
 895
 896 -- | List of names.
 897 pNames :: Field
 898 pNames = defaultField [| [] |] $ simpleField "names" [t| [NonEmptyString] |]
 899
 900 -- | List of node names.
 901 pNodes :: Field
 902 pNodes = defaultField [| [] |] $ simpleField "nodes" [t| [NonEmptyString] |]
 903
 904 -- | Required list of node names.
 905 pRequiredNodes :: Field
 906 pRequiredNodes =
 907   renameField "ReqNodes " $ simpleField "nodes" [t| [NonEmptyString] |]
 908
 909 -- | Storage type.
 910 pStorageType :: Field
 911 pStorageType = simpleField "storage_type" [t| StorageType |]
 912
 913 -- | Storage changes (unchecked).
 914 pStorageChanges :: Field
 915 pStorageChanges = simpleField "changes" [t| UncheckedDict |]
 916
 917 -- | Whether the node should become a master candidate.
 918 pMasterCandidate :: Field
 919 pMasterCandidate = optionalField $ booleanField "master_candidate"
 920
 921 -- | Whether the node should be marked as offline.
 922 pOffline :: Field
 923 pOffline = optionalField $ booleanField "offline"
 924
 925 -- | Whether the node should be marked as drained.
 926 pDrained ::Field
 927 pDrained = optionalField $ booleanField "drained"
 928
 929 -- | Whether node(s) should be promoted to master candidate if necessary.
 930 pAutoPromote :: Field
 931 pAutoPromote = defaultFalse "auto_promote"
 932
 933 -- | Whether the node should be marked as powered
 934 pPowered :: Field
 935 pPowered = optionalField $ booleanField "powered"
 936
 937 -- | Iallocator for deciding the target node for shared-storage
 938 -- instances during migrate and failover.
 939 pIallocator :: Field
 940 pIallocator = optionalNEStringField "iallocator"
 941
 942 -- | New secondary node.
 943 pRemoteNode :: Field
 944 pRemoteNode = optionalNEStringField "remote_node"
 945
 946 -- | Node evacuation mode.
 947 pEvacMode :: Field
 948 pEvacMode = renameField "EvacMode" $ simpleField "mode" [t| NodeEvacMode |]
 949
 950 -- | Instance creation mode.
 951 pInstCreateMode :: Field
 952 pInstCreateMode =
 953   renameField "InstCreateMode" $ simpleField "mode" [t| InstCreateMode |]
 954
 955 -- | Do not install the OS (will disable automatic start).
 956 pNoInstall :: Field
 957 pNoInstall = optionalField $ booleanField "no_install"
 958
 959 -- | OS type for instance installation.
 960 pInstOs :: Field
 961 pInstOs = optionalNEStringField "os_type"
 962
 963 -- | Primary node for an instance.
 964 pPrimaryNode :: Field
 965 pPrimaryNode = optionalNEStringField "pnode"
 966
 967 -- | Secondary node for an instance.
 968 pSecondaryNode :: Field
 969 pSecondaryNode = optionalNEStringField "snode"
 970
 971 -- | Signed handshake from source (remote import only).
 972 pSourceHandshake :: Field
 973 pSourceHandshake =
 974   optionalField $ simpleField "source_handshake" [t| UncheckedList |]
 975
 976 -- | Source instance name (remote import only).
 977 pSourceInstance :: Field
 978 pSourceInstance = optionalNEStringField "source_instance_name"
 979
 980 -- | How long source instance was given to shut down (remote import only).
 981 -- FIXME: non-negative int, whereas the constant is a plain int.
 982 pSourceShutdownTimeout :: Field
 983 pSourceShutdownTimeout =
 984   defaultField [| forceNonNeg C.defaultShutdownTimeout |] $
 985   simpleField "source_shutdown_timeout" [t| NonNegative Int |]
 986
 987 -- | Source X509 CA in PEM format (remote import only).
 988 pSourceX509Ca :: Field
 989 pSourceX509Ca = optionalNEStringField "source_x509_ca"
 990
 991 -- | Source node for import.
 992 pSrcNode :: Field
 993 pSrcNode = optionalNEStringField "src_node"
 994
 995 -- | Source directory for import.
 996 pSrcPath :: Field
 997 pSrcPath = optionalNEStringField "src_path"
 998
 999 -- | Whether to start instance after creation.
1000 pStartInstance :: Field
1001 pStartInstance = defaultTrue "start"
1002
1003 -- | Instance tags. FIXME: unify/simplify with pTags, once that
1004 -- migrates to NonEmpty String.
1005 pInstTags :: Field
1006 pInstTags =
1007   renameField "InstTags" .
1008   defaultField [| [] |] $
1009   simpleField "tags" [t| [NonEmptyString] |]
1010
1011 -- | Unchecked list of OpInstanceCreate, used in OpInstanceMultiAlloc.
1012 pMultiAllocInstances :: Field
1013 pMultiAllocInstances =
1014   renameField "InstMultiAlloc" .
1015   defaultField [| [] |] $
1016   simpleField "instances"[t| UncheckedList |]
1017
1018 -- | Ignore failures parameter.
1019 pIgnoreFailures :: Field
1020 pIgnoreFailures = defaultFalse "ignore_failures"
1021
1022 -- | New instance or cluster name.
1023 pNewName :: Field
1024 pNewName = simpleField "new_name" [t| NonEmptyString |]
1025
1026 -- | Whether to start the instance even if secondary disks are failing.
1027 pIgnoreSecondaries :: Field
1028 pIgnoreSecondaries = defaultFalse "ignore_secondaries"
1029
1030 -- | How to reboot the instance.
1031 pRebootType :: Field
1032 pRebootType = simpleField "reboot_type" [t| RebootType |]
1033
1034 -- | Whether to ignore recorded disk size.
1035 pIgnoreDiskSize :: Field
1036 pIgnoreDiskSize = defaultFalse "ignore_size"
1037
1038 -- | Disk list for recreate disks.
1039 pRecreateDisksInfo :: Field
1040 pRecreateDisksInfo =
1041   renameField "RecreateDisksInfo" .
1042   defaultField [| RecreateDisksAll |] $
1043   simpleField "disks" [t| RecreateDisksInfo |]
1044
1045 -- | Whether to only return configuration data without querying nodes.
1046 pStatic :: Field
1047 pStatic = defaultFalse "static"
1048
1049 -- | InstanceSetParams NIC changes.
1050 pInstParamsNicChanges :: Field
1051 pInstParamsNicChanges =
1052   renameField "InstNicChanges" .
1053   defaultField [| SetParamsEmpty |] $
1054   simpleField "nics" [t| SetParamsMods INicParams |]
1055
1056 -- | InstanceSetParams Disk changes.
1057 pInstParamsDiskChanges :: Field
1058 pInstParamsDiskChanges =
1059   renameField "InstDiskChanges" .
1060   defaultField [| SetParamsEmpty |] $
1061   simpleField "disks" [t| SetParamsMods IDiskParams |]
1062
1063 -- | New runtime memory.
1064 pRuntimeMem :: Field
1065 pRuntimeMem = optionalField $ simpleField "runtime_mem" [t| Positive Int |]
1066
1067 -- | Change the instance's OS without reinstalling the instance
1068 pOsNameChange :: Field
1069 pOsNameChange = optionalNEStringField "os_name"
1070
1071 -- | Disk index for e.g. grow disk.
1072 pDiskIndex :: Field
1073 pDiskIndex = renameField "DiskIndex " $ simpleField "disk" [t| DiskIndex |]
1074
1075 -- | Disk amount to add or grow to.
1076 pDiskChgAmount :: Field
1077 pDiskChgAmount =
1078   renameField "DiskChgAmount" $ simpleField "amount" [t| NonNegative Int |]
1079
1080 -- | Whether the amount parameter is an absolute target or a relative one.
1081 pDiskChgAbsolute :: Field
1082 pDiskChgAbsolute = renameField "DiskChkAbsolute" $ defaultFalse "absolute"
1083
1084 -- | Destination group names or UUIDs (defaults to \"all but current group\".
1085 pTargetGroups :: Field
1086 pTargetGroups =
1087   optionalField $ simpleField "target_groups" [t| [NonEmptyString] |]
1088
1089 -- | Export mode field.
1090 pExportMode :: Field
1091 pExportMode =
1092   renameField "ExportMode" $ simpleField "mode" [t| ExportMode |]
1093
1094 -- | Export target_node field, depends on mode.
1095 pExportTargetNode :: Field
1096 pExportTargetNode =
1097   renameField "ExportTarget" $
1098   simpleField "target_node" [t| ExportTarget |]
1099
1100 -- | Whether to remove instance after export.
1101 pRemoveInstance :: Field
1102 pRemoveInstance = defaultFalse "remove_instance"
1103
1104 -- | Whether to ignore failures while removing instances.
1105 pIgnoreRemoveFailures :: Field
1106 pIgnoreRemoveFailures = defaultFalse "ignore_remove_failures"
1107
1108 -- | Name of X509 key (remote export only).
1109 pX509KeyName :: Field
1110 pX509KeyName = optionalField $ simpleField "x509_key_name" [t| UncheckedList |]
1111
1112 -- | Destination X509 CA (remote export only).
1113 pX509DestCA :: Field
1114 pX509DestCA = optionalNEStringField "destination_x509_ca"