code.grnet.gr Git - ganeti-local/blob - src/Ganeti/OpCodes.hs

   1 {-# LANGUAGE ExistentialQuantification, TemplateHaskell #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3
   4 {-| Implementation of the opcodes.
   5
   6 -}
   7
   8 {-
   9
  10 Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
  11
  12 This program is free software; you can redistribute it and/or modify
  13 it under the terms of the GNU General Public License as published by
  14 the Free Software Foundation; either version 2 of the License, or
  15 (at your option) any later version.
  16
  17 This program is distributed in the hope that it will be useful, but
  18 WITHOUT ANY WARRANTY; without even the implied warranty of
  19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 General Public License for more details.
  21
  22 You should have received a copy of the GNU General Public License
  23 along with this program; if not, write to the Free Software
  24 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  25 02110-1301, USA.
  26
  27 -}
  28
  29 module Ganeti.OpCodes
  30   ( pyClasses
  31   , OpCode(..)
  32   , ReplaceDisksMode(..)
  33   , DiskIndex
  34   , mkDiskIndex
  35   , unDiskIndex
  36   , opID
  37   , allOpIDs
  38   , allOpFields
  39   , opSummary
  40   , CommonOpParams(..)
  41   , defOpParams
  42   , MetaOpCode(..)
  43   , wrapOpCode
  44   , setOpComment
  45   , setOpPriority
  46   ) where
  47
  48 import Text.JSON (readJSON, JSObject, JSON, JSValue(..), makeObj, fromJSObject)
  49 import qualified Text.JSON
  50
  51 import Ganeti.THH
  52
  53 import qualified Ganeti.Hs2Py.OpDoc as OpDoc
  54 import Ganeti.OpParams
  55 import Ganeti.PyValueInstances ()
  56 import Ganeti.Types
  57 import Ganeti.Query.Language (queryTypeOpToRaw)
  58
  59 import Data.List (intercalate)
  60 import Data.Map (Map)
  61
  62 import qualified Ganeti.Constants as C
  63
  64 instance PyValue DiskIndex where
  65   showValue = showValue . unDiskIndex
  66
  67 instance PyValue IDiskParams where
  68   showValue _ = error "OpCodes.showValue(IDiskParams): unhandled case"
  69
  70 instance PyValue RecreateDisksInfo where
  71   showValue RecreateDisksAll = "[]"
  72   showValue (RecreateDisksIndices is) = showValue is
  73   showValue (RecreateDisksParams is) = showValue is
  74
  75 instance PyValue a => PyValue (SetParamsMods a) where
  76   showValue SetParamsEmpty = "[]"
  77   showValue _ = error "OpCodes.showValue(SetParamsMods): unhandled case"
  78
  79 instance PyValue a => PyValue (NonNegative a) where
  80   showValue = showValue . fromNonNegative
  81
  82 instance PyValue a => PyValue (NonEmpty a) where
  83   showValue = showValue . fromNonEmpty
  84
  85 -- FIXME: should use the 'toRaw' function instead of being harcoded or
  86 -- perhaps use something similar to the NonNegative type instead of
  87 -- using the declareSADT
  88 instance PyValue ExportMode where
  89   showValue ExportModeLocal = show C.exportModeLocal
  90   showValue ExportModeRemote = show C.exportModeLocal
  91
  92 instance PyValue CVErrorCode where
  93   showValue = cVErrorCodeToRaw
  94
  95 instance PyValue VerifyOptionalChecks where
  96   showValue = verifyOptionalChecksToRaw
  97
  98 instance PyValue INicParams where
  99   showValue = error "instance PyValue INicParams: not implemented"
 100
 101 instance PyValue a => PyValue (JSObject a) where
 102   showValue obj =
 103     "{" ++ intercalate ", " (map showPair (fromJSObject obj)) ++ "}"
 104     where showPair (k, v) = show k ++ ":" ++ showValue v
 105
 106 instance PyValue JSValue where
 107   showValue (JSObject obj) = showValue obj
 108   showValue x = show x
 109
 110 type JobIdListOnly = [(Bool, Either String JobId)]
 111
 112 type InstanceMultiAllocResponse =
 113   ([(Bool, Either String JobId)], NonEmptyString)
 114
 115 type QueryFieldDef =
 116   (NonEmptyString, NonEmptyString, TagKind, NonEmptyString)
 117
 118 type QueryResponse =
 119   ([QueryFieldDef], [[(QueryResultCode, JSValue)]])
 120
 121 type QueryFieldsResponse = [QueryFieldDef]
 122
 123 -- | OpCode representation.
 124 --
 125 -- We only implement a subset of Ganeti opcodes: those which are actually used
 126 -- in the htools codebase.
 127 $(genOpCode "OpCode"
 128   [ ("OpClusterPostInit",
 129      [t| Bool |],
 130      OpDoc.opClusterPostInit,
 131      [],
 132      [])
 133   , ("OpClusterDestroy",
 134      [t| NonEmptyString |],
 135      OpDoc.opClusterDestroy,
 136      [],
 137      [])
 138   , ("OpClusterQuery",
 139      [t| JSObject JSValue |],
 140      OpDoc.opClusterQuery,
 141      [],
 142      [])
 143   , ("OpClusterVerify",
 144      [t| JobIdListOnly |],
 145      OpDoc.opClusterVerify,
 146      [ pDebugSimulateErrors
 147      , pErrorCodes
 148      , pSkipChecks
 149      , pIgnoreErrors
 150      , pVerbose
 151      , pOptGroupName
 152      ],
 153      [])
 154   , ("OpClusterVerifyConfig",
 155      [t| Bool |],
 156      OpDoc.opClusterVerifyConfig,
 157      [ pDebugSimulateErrors
 158      , pErrorCodes
 159      , pIgnoreErrors
 160      , pVerbose
 161      ],
 162      [])
 163   , ("OpClusterVerifyGroup",
 164      [t| Bool |],
 165      OpDoc.opClusterVerifyGroup,
 166      [ pGroupName
 167      , pDebugSimulateErrors
 168      , pErrorCodes
 169      , pSkipChecks
 170      , pIgnoreErrors
 171      , pVerbose
 172      ],
 173      "group_name")
 174   , ("OpClusterVerifyDisks",
 175      [t| JobIdListOnly |],
 176      OpDoc.opClusterVerifyDisks,
 177      [],
 178      [])
 179   , ("OpGroupVerifyDisks",
 180      [t| (Map String String, [String], Map String [[String]]) |],
 181      OpDoc.opGroupVerifyDisks,
 182      [ pGroupName
 183      ],
 184      "group_name")
 185   , ("OpClusterRepairDiskSizes",
 186      [t| [(NonEmptyString, NonNegative Int, NonEmptyString, NonNegative Int)]|],
 187      OpDoc.opClusterRepairDiskSizes,
 188      [ pInstances
 189      ],
 190      [])
 191   , ("OpClusterConfigQuery",
 192      [t| [JSValue] |],
 193      OpDoc.opClusterConfigQuery,
 194      [ pOutputFields
 195      ],
 196      [])
 197   , ("OpClusterRename",
 198       [t| NonEmptyString |],
 199       OpDoc.opClusterRename,
 200      [ pName
 201      ],
 202      "name")
 203   , ("OpClusterSetParams",
 204      [t| () |],
 205      OpDoc.opClusterSetParams,
 206      [ pForce
 207      , pHvState
 208      , pDiskState
 209      , pVgName
 210      , pEnabledHypervisors
 211      , pClusterHvParams
 212      , pClusterBeParams
 213      , pOsHvp
 214      , pClusterOsParams
 215      , pDiskParams
 216      , pCandidatePoolSize
 217      , pUidPool
 218      , pAddUids
 219      , pRemoveUids
 220      , pMaintainNodeHealth
 221      , pPreallocWipeDisks
 222      , pNicParams
 223      , withDoc "Cluster-wide node parameter defaults" pNdParams
 224      , withDoc "Cluster-wide ipolicy specs" pIpolicy
 225      , pDrbdHelper
 226      , pDefaultIAllocator
 227      , pMasterNetdev
 228      , pMasterNetmask
 229      , pReservedLvs
 230      , pHiddenOs
 231      , pBlacklistedOs
 232      , pUseExternalMipScript
 233      , pEnabledDiskTemplates
 234      , pModifyEtcHosts
 235      , pClusterFileStorageDir
 236      , pClusterSharedFileStorageDir
 237      ],
 238      [])
 239   , ("OpClusterRedistConf",
 240      [t| () |],
 241      OpDoc.opClusterRedistConf,
 242      [],
 243      [])
 244   , ("OpClusterActivateMasterIp",
 245      [t| () |],
 246      OpDoc.opClusterActivateMasterIp,
 247      [],
 248      [])
 249   , ("OpClusterDeactivateMasterIp",
 250      [t| () |],
 251      OpDoc.opClusterDeactivateMasterIp,
 252      [],
 253      [])
 254   , ("OpQuery",
 255      [t| QueryResponse |],
 256      OpDoc.opQuery,
 257      [ pQueryWhat
 258      , pUseLocking
 259      , pQueryFields
 260      , pQueryFilter
 261      ],
 262      "what")
 263   , ("OpQueryFields",
 264      [t| QueryFieldsResponse |],
 265      OpDoc.opQueryFields,
 266      [ pQueryWhat
 267      , pQueryFieldsFields
 268      ],
 269      "what")
 270   , ("OpOobCommand",
 271      [t| [[(QueryResultCode, JSValue)]] |],
 272      OpDoc.opOobCommand,
 273      [ pNodeNames
 274      , withDoc "List of node UUIDs to run the OOB command against" pNodeUuids
 275      , pOobCommand
 276      , pOobTimeout
 277      , pIgnoreStatus
 278      , pPowerDelay
 279      ],
 280      [])
 281   , ("OpRestrictedCommand",
 282      [t| [(Bool, String)] |],
 283      OpDoc.opRestrictedCommand,
 284      [ pUseLocking
 285      , withDoc
 286        "Nodes on which the command should be run (at least one)"
 287        pRequiredNodes
 288      , withDoc
 289        "Node UUIDs on which the command should be run (at least one)"
 290        pRequiredNodeUuids
 291      , pRestrictedCommand
 292      ],
 293      [])
 294   , ("OpNodeRemove",
 295      [t| () |],
 296       OpDoc.opNodeRemove,
 297      [ pNodeName
 298      , pNodeUuid
 299      ],
 300      "node_name")
 301   , ("OpNodeAdd",
 302      [t| () |],
 303       OpDoc.opNodeAdd,
 304      [ pNodeName
 305      , pHvState
 306      , pDiskState
 307      , pPrimaryIp
 308      , pSecondaryIp
 309      , pReadd
 310      , pNodeGroup
 311      , pMasterCapable
 312      , pVmCapable
 313      , pNdParams
 314      ],
 315      "node_name")
 316   , ("OpNodeQuery",
 317      [t| [[JSValue]] |],
 318      OpDoc.opNodeQuery,
 319      [ pOutputFields
 320      , withDoc "Empty list to query all nodes, node names otherwise" pNames
 321      , pUseLocking
 322      ],
 323      [])
 324   , ("OpNodeQueryvols",
 325      [t| [JSValue] |],
 326      OpDoc.opNodeQueryvols,
 327      [ pOutputFields
 328      , withDoc "Empty list to query all nodes, node names otherwise" pNodes
 329      ],
 330      [])
 331   , ("OpNodeQueryStorage",
 332      [t| [[JSValue]] |],
 333      OpDoc.opNodeQueryStorage,
 334      [ pOutputFields
 335      , pStorageType
 336      , withDoc
 337        "Empty list to query all, list of names to query otherwise"
 338        pNodes
 339      , pStorageName
 340      ],
 341      [])
 342   , ("OpNodeModifyStorage",
 343      [t| () |],
 344      OpDoc.opNodeModifyStorage,
 345      [ pNodeName
 346      , pNodeUuid
 347      , pStorageType
 348      , pStorageName
 349      , pStorageChanges
 350      ],
 351      "node_name")
 352   , ("OpRepairNodeStorage",
 353       [t| () |],
 354       OpDoc.opRepairNodeStorage,
 355      [ pNodeName
 356      , pNodeUuid
 357      , pStorageType
 358      , pStorageName
 359      , pIgnoreConsistency
 360      ],
 361      "node_name")
 362   , ("OpNodeSetParams",
 363      [t| [(NonEmptyString, JSValue)] |],
 364      OpDoc.opNodeSetParams,
 365      [ pNodeName
 366      , pNodeUuid
 367      , pForce
 368      , pHvState
 369      , pDiskState
 370      , pMasterCandidate
 371      , withDoc "Whether to mark the node offline" pOffline
 372      , pDrained
 373      , pAutoPromote
 374      , pMasterCapable
 375      , pVmCapable
 376      , pSecondaryIp
 377      , pNdParams
 378      , pPowered
 379      ],
 380      "node_name")
 381   , ("OpNodePowercycle",
 382      [t| Maybe NonEmptyString |],
 383      OpDoc.opNodePowercycle,
 384      [ pNodeName
 385      , pNodeUuid
 386      , pForce
 387      ],
 388      "node_name")
 389   , ("OpNodeMigrate",
 390      [t| JobIdListOnly |],
 391      OpDoc.opNodeMigrate,
 392      [ pNodeName
 393      , pNodeUuid
 394      , pMigrationMode
 395      , pMigrationLive
 396      , pMigrationTargetNode
 397      , pMigrationTargetNodeUuid
 398      , pAllowRuntimeChgs
 399      , pIgnoreIpolicy
 400      , pIallocator
 401      ],
 402      "node_name")
 403   , ("OpNodeEvacuate",
 404      [t| JobIdListOnly |],
 405      OpDoc.opNodeEvacuate,
 406      [ pEarlyRelease
 407      , pNodeName
 408      , pNodeUuid
 409      , pRemoteNode
 410      , pRemoteNodeUuid
 411      , pIallocator
 412      , pEvacMode
 413      ],
 414      "node_name")
 415   , ("OpInstanceCreate",
 416      [t| [NonEmptyString] |],
 417      OpDoc.opInstanceCreate,
 418      [ pInstanceName
 419      , pForceVariant
 420      , pWaitForSync
 421      , pNameCheck
 422      , pIgnoreIpolicy
 423      , pOpportunisticLocking
 424      , pInstBeParams
 425      , pInstDisks
 426      , pOptDiskTemplate
 427      , pFileDriver
 428      , pFileStorageDir
 429      , pInstHvParams
 430      , pHypervisor
 431      , pIallocator
 432      , pResetDefaults
 433      , pIpCheck
 434      , pIpConflictsCheck
 435      , pInstCreateMode
 436      , pInstNics
 437      , pNoInstall
 438      , pInstOsParams
 439      , pInstOs
 440      , pPrimaryNode
 441      , pPrimaryNodeUuid
 442      , pSecondaryNode
 443      , pSecondaryNodeUuid
 444      , pSourceHandshake
 445      , pSourceInstance
 446      , pSourceShutdownTimeout
 447      , pSourceX509Ca
 448      , pSrcNode
 449      , pSrcNodeUuid
 450      , pSrcPath
 451      , pStartInstance
 452      , pInstTags
 453      ],
 454      "instance_name")
 455   , ("OpInstanceMultiAlloc",
 456      [t| InstanceMultiAllocResponse |],
 457      OpDoc.opInstanceMultiAlloc,
 458      [ pOpportunisticLocking
 459      , pIallocator
 460      , pMultiAllocInstances
 461      ],
 462      [])
 463   , ("OpInstanceReinstall",
 464      [t| () |],
 465      OpDoc.opInstanceReinstall,
 466      [ pInstanceName
 467      , pInstanceUuid
 468      , pForceVariant
 469      , pInstOs
 470      , pTempOsParams
 471      ],
 472      "instance_name")
 473   , ("OpInstanceRemove",
 474      [t| () |],
 475      OpDoc.opInstanceRemove,
 476      [ pInstanceName
 477      , pInstanceUuid
 478      , pShutdownTimeout
 479      , pIgnoreFailures
 480      ],
 481      "instance_name")
 482   , ("OpInstanceRename",
 483      [t| NonEmptyString |],
 484      OpDoc.opInstanceRename,
 485      [ pInstanceName
 486      , pInstanceUuid
 487      , withDoc "New instance name" pNewName
 488      , pNameCheck
 489      , pIpCheck
 490      ],
 491      [])
 492   , ("OpInstanceStartup",
 493      [t| () |],
 494      OpDoc.opInstanceStartup,
 495      [ pInstanceName
 496      , pInstanceUuid
 497      , pForce
 498      , pIgnoreOfflineNodes
 499      , pTempHvParams
 500      , pTempBeParams
 501      , pNoRemember
 502      , pStartupPaused
 503      ],
 504      "instance_name")
 505   , ("OpInstanceShutdown",
 506      [t| () |],
 507      OpDoc.opInstanceShutdown,
 508      [ pInstanceName
 509      , pInstanceUuid
 510      , pForce
 511      , pIgnoreOfflineNodes
 512      , pShutdownTimeout'
 513      , pNoRemember
 514      ],
 515      "instance_name")
 516   , ("OpInstanceReboot",
 517      [t| () |],
 518      OpDoc.opInstanceReboot,
 519      [ pInstanceName
 520      , pInstanceUuid
 521      , pShutdownTimeout
 522      , pIgnoreSecondaries
 523      , pRebootType
 524      ],
 525      "instance_name")
 526   , ("OpInstanceReplaceDisks",
 527      [t| () |],
 528      OpDoc.opInstanceReplaceDisks,
 529      [ pInstanceName
 530      , pInstanceUuid
 531      , pEarlyRelease
 532      , pIgnoreIpolicy
 533      , pReplaceDisksMode
 534      , pReplaceDisksList
 535      , pRemoteNode
 536      , pRemoteNodeUuid
 537      , pIallocator
 538      ],
 539      "instance_name")
 540   , ("OpInstanceFailover",
 541      [t| () |],
 542      OpDoc.opInstanceFailover,
 543      [ pInstanceName
 544      , pInstanceUuid
 545      , pShutdownTimeout
 546      , pIgnoreConsistency
 547      , pMigrationTargetNode
 548      , pMigrationTargetNodeUuid
 549      , pIgnoreIpolicy
 550      , pMigrationCleanup
 551      , pIallocator
 552      ],
 553      "instance_name")
 554   , ("OpInstanceMigrate",
 555      [t| () |],
 556      OpDoc.opInstanceMigrate,
 557      [ pInstanceName
 558      , pInstanceUuid
 559      , pMigrationMode
 560      , pMigrationLive
 561      , pMigrationTargetNode
 562      , pMigrationTargetNodeUuid
 563      , pAllowRuntimeChgs
 564      , pIgnoreIpolicy
 565      , pMigrationCleanup
 566      , pIallocator
 567      , pAllowFailover
 568      ],
 569      "instance_name")
 570   , ("OpInstanceMove",
 571      [t| () |],
 572      OpDoc.opInstanceMove,
 573      [ pInstanceName
 574      , pInstanceUuid
 575      , pShutdownTimeout
 576      , pIgnoreIpolicy
 577      , pMoveTargetNode
 578      , pMoveTargetNodeUuid
 579      , pIgnoreConsistency
 580      ],
 581      "instance_name")
 582   , ("OpInstanceConsole",
 583      [t| JSObject JSValue |],
 584      OpDoc.opInstanceConsole,
 585      [ pInstanceName
 586      , pInstanceUuid
 587      ],
 588      "instance_name")
 589   , ("OpInstanceActivateDisks",
 590      [t| [(NonEmptyString, NonEmptyString, NonEmptyString)] |],
 591      OpDoc.opInstanceActivateDisks,
 592      [ pInstanceName
 593      , pInstanceUuid
 594      , pIgnoreDiskSize
 595      , pWaitForSyncFalse
 596      ],
 597      "instance_name")
 598   , ("OpInstanceDeactivateDisks",
 599      [t| () |],
 600      OpDoc.opInstanceDeactivateDisks,
 601      [ pInstanceName
 602      , pInstanceUuid
 603      , pForce
 604      ],
 605      "instance_name")
 606   , ("OpInstanceRecreateDisks",
 607      [t| () |],
 608      OpDoc.opInstanceRecreateDisks,
 609      [ pInstanceName
 610      , pInstanceUuid
 611      , pRecreateDisksInfo
 612      , withDoc "New instance nodes, if relocation is desired" pNodes
 613      , withDoc "New instance node UUIDs, if relocation is desired" pNodeUuids
 614      , pIallocator
 615      ],
 616      "instance_name")
 617   , ("OpInstanceQuery",
 618      [t| [[JSValue]] |],
 619      OpDoc.opInstanceQuery,
 620      [ pOutputFields
 621      , pUseLocking
 622      , withDoc
 623        "Empty list to query all instances, instance names otherwise"
 624        pNames
 625      ],
 626      [])
 627   , ("OpInstanceQueryData",
 628      [t| JSObject (JSObject JSValue) |],
 629      OpDoc.opInstanceQueryData,
 630      [ pUseLocking
 631      , pInstances
 632      , pStatic
 633      ],
 634      [])
 635   , ("OpInstanceSetParams",
 636       [t| [(NonEmptyString, JSValue)] |],
 637       OpDoc.opInstanceSetParams,
 638      [ pInstanceName
 639      , pInstanceUuid
 640      , pForce
 641      , pForceVariant
 642      , pIgnoreIpolicy
 643      , pInstParamsNicChanges
 644      , pInstParamsDiskChanges
 645      , pInstBeParams
 646      , pRuntimeMem
 647      , pInstHvParams
 648      , pOptDiskTemplate
 649      , pPrimaryNode
 650      , pPrimaryNodeUuid
 651      , withDoc "Secondary node (used when changing disk template)" pRemoteNode
 652      , withDoc
 653        "Secondary node UUID (used when changing disk template)"
 654        pRemoteNodeUuid
 655      , pOsNameChange
 656      , pInstOsParams
 657      , pWaitForSync
 658      , withDoc "Whether to mark the instance as offline" pOffline
 659      , pIpConflictsCheck
 660      ],
 661      "instance_name")
 662   , ("OpInstanceGrowDisk",
 663      [t| () |],
 664      OpDoc.opInstanceGrowDisk,
 665      [ pInstanceName
 666      , pInstanceUuid
 667      , pWaitForSync
 668      , pDiskIndex
 669      , pDiskChgAmount
 670      , pDiskChgAbsolute
 671      ],
 672      "instance_name")
 673   , ("OpInstanceChangeGroup",
 674      [t| JobIdListOnly |],
 675      OpDoc.opInstanceChangeGroup,
 676      [ pInstanceName
 677      , pInstanceUuid
 678      , pEarlyRelease
 679      , pIallocator
 680      , pTargetGroups
 681      ],
 682      "instance_name")
 683   , ("OpGroupAdd",
 684      [t| () |],
 685      OpDoc.opGroupAdd,
 686      [ pGroupName
 687      , pNodeGroupAllocPolicy
 688      , pGroupNodeParams
 689      , pDiskParams
 690      , pHvState
 691      , pDiskState
 692      , withDoc "Group-wide ipolicy specs" pIpolicy
 693      ],
 694      "group_name")
 695   , ("OpGroupAssignNodes",
 696      [t| () |],
 697      OpDoc.opGroupAssignNodes,
 698      [ pGroupName
 699      , pForce
 700      , withDoc "List of nodes to assign" pRequiredNodes
 701      , withDoc "List of node UUIDs to assign" pRequiredNodeUuids
 702      ],
 703      "group_name")
 704   , ("OpGroupQuery",
 705      [t| [[JSValue]] |],
 706      OpDoc.opGroupQuery,
 707      [ pOutputFields
 708      , withDoc "Empty list to query all groups, group names otherwise" pNames
 709      ],
 710      [])
 711   , ("OpGroupSetParams",
 712      [t| [(NonEmptyString, JSValue)] |],
 713      OpDoc.opGroupSetParams,
 714      [ pGroupName
 715      , pNodeGroupAllocPolicy
 716      , pGroupNodeParams
 717      , pDiskParams
 718      , pHvState
 719      , pDiskState
 720      , withDoc "Group-wide ipolicy specs" pIpolicy
 721      ],
 722      "group_name")
 723   , ("OpGroupRemove",
 724      [t| () |],
 725      OpDoc.opGroupRemove,
 726      [ pGroupName
 727      ],
 728      "group_name")
 729   , ("OpGroupRename",
 730      [t| NonEmptyString |],
 731      OpDoc.opGroupRename,
 732      [ pGroupName
 733      , withDoc "New group name" pNewName
 734      ],
 735      [])
 736   , ("OpGroupEvacuate",
 737      [t| JobIdListOnly |],
 738      OpDoc.opGroupEvacuate,
 739      [ pGroupName
 740      , pEarlyRelease
 741      , pIallocator
 742      , pTargetGroups
 743      ],
 744      "group_name")
 745   , ("OpOsDiagnose",
 746      [t| [[JSValue]] |],
 747      OpDoc.opOsDiagnose,
 748      [ pOutputFields
 749      , withDoc "Which operating systems to diagnose" pNames
 750      ],
 751      [])
 752   , ("OpExtStorageDiagnose",
 753      [t| [[JSValue]] |],
 754      OpDoc.opExtStorageDiagnose,
 755      [ pOutputFields
 756      , withDoc "Which ExtStorage Provider to diagnose" pNames
 757      ],
 758      [])
 759   , ("OpBackupQuery",
 760      [t| JSObject (Either Bool [NonEmptyString]) |],
 761      OpDoc.opBackupQuery,
 762      [ pUseLocking
 763      , withDoc "Empty list to query all nodes, node names otherwise" pNodes
 764      ],
 765      [])
 766   , ("OpBackupPrepare",
 767      [t| Maybe (JSObject JSValue) |],
 768      OpDoc.opBackupPrepare,
 769      [ pInstanceName
 770      , pInstanceUuid
 771      , pExportMode
 772      ],
 773      "instance_name")
 774   , ("OpBackupExport",
 775      [t| (Bool, [Bool]) |],
 776      OpDoc.opBackupExport,
 777      [ pInstanceName
 778      , pInstanceUuid
 779      , pShutdownTimeout
 780      , pExportTargetNode
 781      , pExportTargetNodeUuid
 782      , pShutdownInstance
 783      , pRemoveInstance
 784      , pIgnoreRemoveFailures
 785      , defaultField [| ExportModeLocal |] pExportMode
 786      , pX509KeyName
 787      , pX509DestCA
 788      ],
 789      "instance_name")
 790   , ("OpBackupRemove",
 791      [t| () |],
 792      OpDoc.opBackupRemove,
 793      [ pInstanceName
 794      , pInstanceUuid
 795      ],
 796      "instance_name")
 797   , ("OpTagsGet",
 798      [t| [NonEmptyString] |],
 799      OpDoc.opTagsGet,
 800      [ pTagsObject
 801      , pUseLocking
 802      , withDoc "Name of object to retrieve tags from" pTagsName
 803      ],
 804      "name")
 805   , ("OpTagsSearch",
 806      [t| [(NonEmptyString, NonEmptyString)] |],
 807      OpDoc.opTagsSearch,
 808      [ pTagSearchPattern
 809      ],
 810      "pattern")
 811   , ("OpTagsSet",
 812      [t| () |],
 813      OpDoc.opTagsSet,
 814      [ pTagsObject
 815      , pTagsList
 816      , withDoc "Name of object where tag(s) should be added" pTagsName
 817      ],
 818      [])
 819   , ("OpTagsDel",
 820      [t| () |],
 821      OpDoc.opTagsDel,
 822      [ pTagsObject
 823      , pTagsList
 824      , withDoc "Name of object where tag(s) should be deleted" pTagsName
 825      ],
 826      [])
 827   , ("OpTestDelay",
 828      [t| () |],
 829      OpDoc.opTestDelay,
 830      [ pDelayDuration
 831      , pDelayOnMaster
 832      , pDelayOnNodes
 833      , pDelayOnNodeUuids
 834      , pDelayRepeat
 835      ],
 836      "duration")
 837   , ("OpTestAllocator",
 838      [t| String |],
 839      OpDoc.opTestAllocator,
 840      [ pIAllocatorDirection
 841      , pIAllocatorMode
 842      , pIAllocatorReqName
 843      , pIAllocatorNics
 844      , pIAllocatorDisks
 845      , pHypervisor
 846      , pIallocator
 847      , pInstTags
 848      , pIAllocatorMemory
 849      , pIAllocatorVCpus
 850      , pIAllocatorOs
 851      , pDiskTemplate
 852      , pIAllocatorInstances
 853      , pIAllocatorEvacMode
 854      , pTargetGroups
 855      , pIAllocatorSpindleUse
 856      , pIAllocatorCount
 857      ],
 858      "iallocator")
 859   , ("OpTestJqueue",
 860      [t| Bool |],
 861      OpDoc.opTestJqueue,
 862      [ pJQueueNotifyWaitLock
 863      , pJQueueNotifyExec
 864      , pJQueueLogMessages
 865      , pJQueueFail
 866      ],
 867      [])
 868   , ("OpTestDummy",
 869      [t| () |],
 870      OpDoc.opTestDummy,
 871      [ pTestDummyResult
 872      , pTestDummyMessages
 873      , pTestDummyFail
 874      , pTestDummySubmitJobs
 875      ],
 876      [])
 877   , ("OpNetworkAdd",
 878      [t| () |],
 879      OpDoc.opNetworkAdd,
 880      [ pNetworkName
 881      , pNetworkAddress4
 882      , pNetworkGateway4
 883      , pNetworkAddress6
 884      , pNetworkGateway6
 885      , pNetworkMacPrefix
 886      , pNetworkAddRsvdIps
 887      , pIpConflictsCheck
 888      , withDoc "Network tags" pInstTags
 889      ],
 890      "network_name")
 891   , ("OpNetworkRemove",
 892      [t| () |],
 893      OpDoc.opNetworkRemove,
 894      [ pNetworkName
 895      , pForce
 896      ],
 897      "network_name")
 898   , ("OpNetworkSetParams",
 899      [t| () |],
 900      OpDoc.opNetworkSetParams,
 901      [ pNetworkName
 902      , pNetworkGateway4
 903      , pNetworkAddress6
 904      , pNetworkGateway6
 905      , pNetworkMacPrefix
 906      , withDoc "Which external IP addresses to reserve" pNetworkAddRsvdIps
 907      , pNetworkRemoveRsvdIps
 908      ],
 909      "network_name")
 910   , ("OpNetworkConnect",
 911      [t| () |],
 912      OpDoc.opNetworkConnect,
 913      [ pGroupName
 914      , pNetworkName
 915      , pNetworkMode
 916      , pNetworkLink
 917      , pIpConflictsCheck
 918      ],
 919      "network_name")
 920   , ("OpNetworkDisconnect",
 921      [t| () |],
 922      OpDoc.opNetworkDisconnect,
 923      [ pGroupName
 924      , pNetworkName
 925      ],
 926      "network_name")
 927   , ("OpNetworkQuery",
 928      [t| [[JSValue]] |],
 929      OpDoc.opNetworkQuery,
 930      [ pOutputFields
 931      , pUseLocking
 932      , withDoc "Empty list to query all groups, group names otherwise" pNames
 933      ],
 934      [])
 935   ])
 936
 937 -- | Returns the OP_ID for a given opcode value.
 938 $(genOpID ''OpCode "opID")
 939
 940 -- | A list of all defined/supported opcode IDs.
 941 $(genAllOpIDs ''OpCode "allOpIDs")
 942
 943 instance JSON OpCode where
 944   readJSON = loadOpCode
 945   showJSON = saveOpCode
 946
 947 -- | Generates the summary value for an opcode.
 948 opSummaryVal :: OpCode -> Maybe String
 949 opSummaryVal OpClusterVerifyGroup { opGroupName = s } = Just (fromNonEmpty s)
 950 opSummaryVal OpGroupVerifyDisks { opGroupName = s } = Just (fromNonEmpty s)
 951 opSummaryVal OpClusterRename { opName = s } = Just (fromNonEmpty s)
 952 opSummaryVal OpQuery { opWhat = s } = Just (queryTypeOpToRaw s)
 953 opSummaryVal OpQueryFields { opWhat = s } = Just (queryTypeOpToRaw s)
 954 opSummaryVal OpNodeRemove { opNodeName = s } = Just (fromNonEmpty s)
 955 opSummaryVal OpNodeAdd { opNodeName = s } = Just (fromNonEmpty s)
 956 opSummaryVal OpNodeModifyStorage { opNodeName = s } = Just (fromNonEmpty s)
 957 opSummaryVal OpRepairNodeStorage  { opNodeName = s } = Just (fromNonEmpty s)
 958 opSummaryVal OpNodeSetParams { opNodeName = s } = Just (fromNonEmpty s)
 959 opSummaryVal OpNodePowercycle { opNodeName = s } = Just (fromNonEmpty s)
 960 opSummaryVal OpNodeMigrate { opNodeName = s } = Just (fromNonEmpty s)
 961 opSummaryVal OpNodeEvacuate { opNodeName = s } = Just (fromNonEmpty s)
 962 opSummaryVal OpInstanceCreate { opInstanceName = s } = Just s
 963 opSummaryVal OpInstanceReinstall { opInstanceName = s } = Just s
 964 opSummaryVal OpInstanceRemove { opInstanceName = s } = Just s
 965 -- FIXME: instance rename should show both names; currently it shows none
 966 -- opSummaryVal OpInstanceRename { opInstanceName = s } = Just s
 967 opSummaryVal OpInstanceStartup { opInstanceName = s } = Just s
 968 opSummaryVal OpInstanceShutdown { opInstanceName = s } = Just s
 969 opSummaryVal OpInstanceReboot { opInstanceName = s } = Just s
 970 opSummaryVal OpInstanceReplaceDisks { opInstanceName = s } = Just s
 971 opSummaryVal OpInstanceFailover { opInstanceName = s } = Just s
 972 opSummaryVal OpInstanceMigrate { opInstanceName = s } = Just s
 973 opSummaryVal OpInstanceMove { opInstanceName = s } = Just s
 974 opSummaryVal OpInstanceConsole { opInstanceName = s } = Just s
 975 opSummaryVal OpInstanceActivateDisks { opInstanceName = s } = Just s
 976 opSummaryVal OpInstanceDeactivateDisks { opInstanceName = s } = Just s
 977 opSummaryVal OpInstanceRecreateDisks { opInstanceName = s } = Just s
 978 opSummaryVal OpInstanceSetParams { opInstanceName = s } = Just s
 979 opSummaryVal OpInstanceGrowDisk { opInstanceName = s } = Just s
 980 opSummaryVal OpInstanceChangeGroup { opInstanceName = s } = Just s
 981 opSummaryVal OpGroupAdd { opGroupName = s } = Just (fromNonEmpty s)
 982 opSummaryVal OpGroupAssignNodes { opGroupName = s } = Just (fromNonEmpty s)
 983 opSummaryVal OpGroupSetParams { opGroupName = s } = Just (fromNonEmpty s)
 984 opSummaryVal OpGroupRemove { opGroupName = s } = Just (fromNonEmpty s)
 985 opSummaryVal OpGroupEvacuate { opGroupName = s } = Just (fromNonEmpty s)
 986 opSummaryVal OpBackupPrepare { opInstanceName = s } = Just s
 987 opSummaryVal OpBackupExport { opInstanceName = s } = Just s
 988 opSummaryVal OpBackupRemove { opInstanceName = s } = Just s
 989 opSummaryVal OpTagsGet { opKind = s } = Just (show s)
 990 opSummaryVal OpTagsSearch { opTagSearchPattern = s } = Just (fromNonEmpty s)
 991 opSummaryVal OpTestDelay { opDelayDuration = d } = Just (show d)
 992 opSummaryVal OpTestAllocator { opIallocator = s } =
 993   -- FIXME: Python doesn't handle None fields well, so we have behave the same
 994   Just $ maybe "None" fromNonEmpty s
 995 opSummaryVal OpNetworkAdd { opNetworkName = s} = Just (fromNonEmpty s)
 996 opSummaryVal OpNetworkRemove { opNetworkName = s} = Just (fromNonEmpty s)
 997 opSummaryVal OpNetworkSetParams { opNetworkName = s} = Just (fromNonEmpty s)
 998 opSummaryVal OpNetworkConnect { opNetworkName = s} = Just (fromNonEmpty s)
 999 opSummaryVal OpNetworkDisconnect { opNetworkName = s} = Just (fromNonEmpty s)
1000 opSummaryVal _ = Nothing
1001
1002 -- | Computes the summary of the opcode.
1003 opSummary :: OpCode -> String
1004 opSummary op =
1005   case opSummaryVal op of
1006     Nothing -> op_suffix
1007     Just s -> op_suffix ++ "(" ++ s ++ ")"
1008   where op_suffix = drop 3 $ opID op
1009
1010 -- | Generic\/common opcode parameters.
1011 $(buildObject "CommonOpParams" "op"
1012   [ pDryRun
1013   , pDebugLevel
1014   , pOpPriority
1015   , pDependencies
1016   , pComment
1017   , pReason
1018   ])
1019
1020 -- | Default common parameter values.
1021 defOpParams :: CommonOpParams
1022 defOpParams =
1023   CommonOpParams { opDryRun     = Nothing
1024                  , opDebugLevel = Nothing
1025                  , opPriority   = OpPrioNormal
1026                  , opDepends    = Nothing
1027                  , opComment    = Nothing
1028                  , opReason     = []
1029                  }
1030
1031 -- | The top-level opcode type.
1032 data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams
1033                              , metaOpCode :: OpCode
1034                              } deriving (Show, Eq)
1035
1036 -- | JSON serialisation for 'MetaOpCode'.
1037 showMeta :: MetaOpCode -> JSValue
1038 showMeta (MetaOpCode params op) =
1039   let objparams = toDictCommonOpParams params
1040       objop = toDictOpCode op
1041   in makeObj (objparams ++ objop)
1042
1043 -- | JSON deserialisation for 'MetaOpCode'
1044 readMeta :: JSValue -> Text.JSON.Result MetaOpCode
1045 readMeta v = do
1046   meta <- readJSON v
1047   op <- readJSON v
1048   return $ MetaOpCode meta op
1049
1050 instance JSON MetaOpCode where
1051   showJSON = showMeta
1052   readJSON = readMeta
1053
1054 -- | Wraps an 'OpCode' with the default parameters to build a
1055 -- 'MetaOpCode'.
1056 wrapOpCode :: OpCode -> MetaOpCode
1057 wrapOpCode = MetaOpCode defOpParams
1058
1059 -- | Sets the comment on a meta opcode.
1060 setOpComment :: String -> MetaOpCode -> MetaOpCode
1061 setOpComment comment (MetaOpCode common op) =
1062   MetaOpCode (common { opComment = Just comment}) op
1063
1064 -- | Sets the priority on a meta opcode.
1065 setOpPriority :: OpSubmitPriority -> MetaOpCode -> MetaOpCode
1066 setOpPriority prio (MetaOpCode common op) =
1067   MetaOpCode (common { opPriority = prio }) op