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

   1 {-# LANGUAGE TemplateHaskell #-}
   2
   3 {-| Implementation of the opcodes.
   4
   5 -}
   6
   7 {-
   8
   9 Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
  10
  11 This program is free software; you can redistribute it and/or modify
  12 it under the terms of the GNU General Public License as published by
  13 the Free Software Foundation; either version 2 of the License, or
  14 (at your option) any later version.
  15
  16 This program is distributed in the hope that it will be useful, but
  17 WITHOUT ANY WARRANTY; without even the implied warranty of
  18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 General Public License for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with this program; if not, write to the Free Software
  23 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  24 02110-1301, USA.
  25
  26 -}
  27
  28 module Ganeti.OpCodes
  29   ( OpCode(..)
  30   , TagObject(..)
  31   , tagObjectFrom
  32   , encodeTagObject
  33   , decodeTagObject
  34   , ReplaceDisksMode(..)
  35   , DiskIndex
  36   , mkDiskIndex
  37   , unDiskIndex
  38   , opID
  39   , allOpIDs
  40   , allOpFields
  41   , opSummary
  42   , CommonOpParams(..)
  43   , defOpParams
  44   , MetaOpCode(..)
  45   , wrapOpCode
  46   , setOpComment
  47   , setOpPriority
  48   ) where
  49
  50 import Data.Maybe (fromMaybe)
  51 import Text.JSON (readJSON, JSON, JSValue, makeObj)
  52 import qualified Text.JSON
  53
  54 import Ganeti.THH
  55
  56 import Ganeti.OpParams
  57 import Ganeti.Types (OpSubmitPriority(..), fromNonEmpty)
  58 import Ganeti.Query.Language (queryTypeOpToRaw)
  59
  60 -- | OpCode representation.
  61 --
  62 -- We only implement a subset of Ganeti opcodes: those which are actually used
  63 -- in the htools codebase.
  64 $(genOpCode "OpCode"
  65   [ ("OpTestDelay",
  66      [ pDelayDuration
  67      , pDelayOnMaster
  68      , pDelayOnNodes
  69      , pDelayOnNodeUuids
  70      , pDelayRepeat
  71      ])
  72   , ("OpInstanceReplaceDisks",
  73      [ pInstanceName
  74      , pInstanceUuid
  75      , pEarlyRelease
  76      , pIgnoreIpolicy
  77      , pReplaceDisksMode
  78      , pReplaceDisksList
  79      , pRemoteNode
  80      , pRemoteNodeUuid
  81      , pIallocator
  82      ])
  83   , ("OpInstanceFailover",
  84      [ pInstanceName
  85      , pInstanceUuid
  86      , pShutdownTimeout
  87      , pIgnoreConsistency
  88      , pMigrationTargetNode
  89      , pMigrationTargetNodeUuid
  90      , pIgnoreIpolicy
  91      , pIallocator
  92      , pMigrationCleanup
  93      ])
  94   , ("OpInstanceMigrate",
  95      [ pInstanceName
  96      , pInstanceUuid
  97      , pMigrationMode
  98      , pMigrationLive
  99      , pMigrationTargetNode
 100      , pMigrationTargetNodeUuid
 101      , pAllowRuntimeChgs
 102      , pIgnoreIpolicy
 103      , pMigrationCleanup
 104      , pIallocator
 105      , pAllowFailover
 106      ])
 107   , ("OpTagsGet",
 108      [ pTagsObject
 109      , pUseLocking
 110      ])
 111   , ("OpTagsSearch",
 112      [ pTagSearchPattern ])
 113   , ("OpTagsSet",
 114      [ pTagsObject
 115      , pTagsList
 116      ])
 117   , ("OpTagsDel",
 118      [ pTagsObject
 119      , pTagsList
 120      ])
 121   , ("OpClusterPostInit", [])
 122   , ("OpClusterDestroy", [])
 123   , ("OpClusterQuery", [])
 124   , ("OpClusterVerify",
 125      [ pDebugSimulateErrors
 126      , pErrorCodes
 127      , pSkipChecks
 128      , pIgnoreErrors
 129      , pVerbose
 130      , pOptGroupName
 131      ])
 132   , ("OpClusterVerifyConfig",
 133      [ pDebugSimulateErrors
 134      , pErrorCodes
 135      , pIgnoreErrors
 136      , pVerbose
 137      ])
 138   , ("OpClusterVerifyGroup",
 139      [ pGroupName
 140      , pDebugSimulateErrors
 141      , pErrorCodes
 142      , pSkipChecks
 143      , pIgnoreErrors
 144      , pVerbose
 145      ])
 146   , ("OpClusterVerifyDisks", [])
 147   , ("OpGroupVerifyDisks",
 148      [ pGroupName
 149      ])
 150   , ("OpClusterRepairDiskSizes",
 151      [ pInstances
 152      ])
 153   , ("OpClusterConfigQuery",
 154      [ pOutputFields
 155      ])
 156   , ("OpClusterRename",
 157      [ pName
 158      ])
 159   , ("OpClusterSetParams",
 160      [ pForce
 161      , pHvState
 162      , pDiskState
 163      , pVgName
 164      , pEnabledHypervisors
 165      , pClusterHvParams
 166      , pClusterBeParams
 167      , pOsHvp
 168      , pClusterOsParams
 169      , pDiskParams
 170      , pCandidatePoolSize
 171      , pUidPool
 172      , pAddUids
 173      , pRemoveUids
 174      , pMaintainNodeHealth
 175      , pPreallocWipeDisks
 176      , pNicParams
 177      , pNdParams
 178      , pIpolicy
 179      , pDrbdHelper
 180      , pDefaultIAllocator
 181      , pMasterNetdev
 182      , pMasterNetmask
 183      , pReservedLvs
 184      , pHiddenOs
 185      , pBlacklistedOs
 186      , pUseExternalMipScript
 187      , pEnabledDiskTemplates
 188      , pModifyEtcHosts
 189      , pGlobalFileStorageDir
 190      , pGlobalSharedFileStorageDir
 191      ])
 192   , ("OpClusterRedistConf", [])
 193   , ("OpClusterActivateMasterIp", [])
 194   , ("OpClusterDeactivateMasterIp", [])
 195   , ("OpQuery",
 196      [ pQueryWhat
 197      , pUseLocking
 198      , pQueryFields
 199      , pQueryFilter
 200      ])
 201   , ("OpQueryFields",
 202      [ pQueryWhat
 203      , pQueryFields
 204      ])
 205   , ("OpOobCommand",
 206      [ pNodeNames
 207      , pNodeUuids
 208      , pOobCommand
 209      , pOobTimeout
 210      , pIgnoreStatus
 211      , pPowerDelay
 212      ])
 213   , ("OpNodeRemove",
 214      [ pNodeName
 215      , pNodeUuid
 216      ])
 217   , ("OpNodeAdd",
 218      [ pNodeName
 219      , pHvState
 220      , pDiskState
 221      , pPrimaryIp
 222      , pSecondaryIp
 223      , pReadd
 224      , pNodeGroup
 225      , pMasterCapable
 226      , pVmCapable
 227      , pNdParams
 228     ])
 229   , ("OpNodeQuery", dOldQuery)
 230   , ("OpNodeQueryvols",
 231      [ pOutputFields
 232      , pNodes
 233      ])
 234   , ("OpNodeQueryStorage",
 235      [ pOutputFields
 236      , pStorageType
 237      , pNodes
 238      , pStorageName
 239      ])
 240   , ("OpNodeModifyStorage",
 241      [ pNodeName
 242      , pNodeUuid
 243      , pStorageType
 244      , pStorageName
 245      , pStorageChanges
 246      ])
 247   , ("OpRepairNodeStorage",
 248      [ pNodeName
 249      , pNodeUuid
 250      , pStorageType
 251      , pStorageName
 252      , pIgnoreConsistency
 253      ])
 254   , ("OpNodeSetParams",
 255      [ pNodeName
 256      , pNodeUuid
 257      , pForce
 258      , pHvState
 259      , pDiskState
 260      , pMasterCandidate
 261      , pOffline
 262      , pDrained
 263      , pAutoPromote
 264      , pMasterCapable
 265      , pVmCapable
 266      , pSecondaryIp
 267      , pNdParams
 268      , pPowered
 269      ])
 270   , ("OpNodePowercycle",
 271      [ pNodeName
 272      , pNodeUuid
 273      , pForce
 274      ])
 275   , ("OpNodeMigrate",
 276      [ pNodeName
 277      , pNodeUuid
 278      , pMigrationMode
 279      , pMigrationLive
 280      , pMigrationTargetNode
 281      , pMigrationTargetNodeUuid
 282      , pAllowRuntimeChgs
 283      , pIgnoreIpolicy
 284      , pIallocator
 285      ])
 286   , ("OpNodeEvacuate",
 287      [ pEarlyRelease
 288      , pNodeName
 289      , pNodeUuid
 290      , pRemoteNode
 291      , pRemoteNodeUuid
 292      , pIallocator
 293      , pEvacMode
 294      ])
 295   , ("OpInstanceCreate",
 296      [ pInstanceName
 297      , pForceVariant
 298      , pWaitForSync
 299      , pNameCheck
 300      , pIgnoreIpolicy
 301      , pInstBeParams
 302      , pInstDisks
 303      , pDiskTemplate
 304      , pFileDriver
 305      , pFileStorageDir
 306      , pInstHvParams
 307      , pHypervisor
 308      , pIallocator
 309      , pResetDefaults
 310      , pIpCheck
 311      , pIpConflictsCheck
 312      , pInstCreateMode
 313      , pInstNics
 314      , pNoInstall
 315      , pInstOsParams
 316      , pInstOs
 317      , pPrimaryNode
 318      , pPrimaryNodeUuid
 319      , pSecondaryNode
 320      , pSecondaryNodeUuid
 321      , pSourceHandshake
 322      , pSourceInstance
 323      , pSourceShutdownTimeout
 324      , pSourceX509Ca
 325      , pSrcNode
 326      , pSrcNodeUuid
 327      , pSrcPath
 328      , pStartInstance
 329      , pOpportunisticLocking
 330      , pInstTags
 331      ])
 332   , ("OpInstanceMultiAlloc",
 333      [ pIallocator
 334      , pMultiAllocInstances
 335      , pOpportunisticLocking
 336      ])
 337   , ("OpInstanceReinstall",
 338      [ pInstanceName
 339      , pInstanceUuid
 340      , pForceVariant
 341      , pInstOs
 342      , pTempOsParams
 343      ])
 344   , ("OpInstanceRemove",
 345      [ pInstanceName
 346      , pInstanceUuid
 347      , pShutdownTimeout
 348      , pIgnoreFailures
 349      ])
 350   , ("OpInstanceRename",
 351      [ pInstanceName
 352      , pInstanceUuid
 353      , pNewName
 354      , pNameCheck
 355      , pIpCheck
 356      ])
 357   , ("OpInstanceStartup",
 358      [ pInstanceName
 359      , pInstanceUuid
 360      , pForce
 361      , pIgnoreOfflineNodes
 362      , pTempHvParams
 363      , pTempBeParams
 364      , pNoRemember
 365      , pStartupPaused
 366      ])
 367   , ("OpInstanceShutdown",
 368      [ pInstanceName
 369      , pInstanceUuid
 370      , pForce
 371      , pIgnoreOfflineNodes
 372      , pShutdownTimeout'
 373      , pNoRemember
 374      ])
 375   , ("OpInstanceReboot",
 376      [ pInstanceName
 377      , pInstanceUuid
 378      , pShutdownTimeout
 379      , pIgnoreSecondaries
 380      , pRebootType
 381      ])
 382   , ("OpInstanceMove",
 383      [ pInstanceName
 384      , pInstanceUuid
 385      , pShutdownTimeout
 386      , pIgnoreIpolicy
 387      , pMoveTargetNode
 388      , pMoveTargetNodeUuid
 389      , pIgnoreConsistency
 390      ])
 391   , ("OpInstanceConsole",
 392      [ pInstanceName
 393      , pInstanceUuid
 394      ])
 395   , ("OpInstanceActivateDisks",
 396      [ pInstanceName
 397      , pInstanceUuid
 398      , pIgnoreDiskSize
 399      , pWaitForSyncFalse
 400      ])
 401   , ("OpInstanceDeactivateDisks",
 402      [ pInstanceName
 403      , pInstanceUuid
 404      , pForce
 405      ])
 406   , ("OpInstanceRecreateDisks",
 407      [ pInstanceName
 408      , pInstanceUuid
 409      , pRecreateDisksInfo
 410      , pNodes
 411      , pNodeUuids
 412      , pIallocator
 413      ])
 414   , ("OpInstanceQuery", dOldQuery)
 415   , ("OpInstanceQueryData",
 416      [ pUseLocking
 417      , pInstances
 418      , pStatic
 419      ])
 420   , ("OpInstanceSetParams",
 421      [ pInstanceName
 422      , pInstanceUuid
 423      , pForce
 424      , pForceVariant
 425      , pIgnoreIpolicy
 426      , pInstParamsNicChanges
 427      , pInstParamsDiskChanges
 428      , pInstBeParams
 429      , pRuntimeMem
 430      , pInstHvParams
 431      , pOptDiskTemplate
 432      , pPrimaryNode
 433      , pPrimaryNodeUuid
 434      , pRemoteNode
 435      , pRemoteNodeUuid
 436      , pOsNameChange
 437      , pInstOsParams
 438      , pWaitForSync
 439      , pOffline
 440      , pIpConflictsCheck
 441      ])
 442   , ("OpInstanceGrowDisk",
 443      [ pInstanceName
 444      , pInstanceUuid
 445      , pWaitForSync
 446      , pDiskIndex
 447      , pDiskChgAmount
 448      , pDiskChgAbsolute
 449      ])
 450   , ("OpInstanceChangeGroup",
 451      [ pInstanceName
 452      , pInstanceUuid
 453      , pEarlyRelease
 454      , pIallocator
 455      , pTargetGroups
 456      ])
 457   , ("OpGroupAdd",
 458      [ pGroupName
 459      , pNodeGroupAllocPolicy
 460      , pGroupNodeParams
 461      , pDiskParams
 462      , pHvState
 463      , pDiskState
 464      , pIpolicy
 465      ])
 466   , ("OpGroupAssignNodes",
 467      [ pGroupName
 468      , pForce
 469      , pRequiredNodes
 470      , pRequiredNodeUuids
 471      ])
 472   , ("OpGroupQuery", dOldQueryNoLocking)
 473   , ("OpGroupSetParams",
 474      [ pGroupName
 475      , pNodeGroupAllocPolicy
 476      , pGroupNodeParams
 477      , pDiskParams
 478      , pHvState
 479      , pDiskState
 480      , pIpolicy
 481      ])
 482   , ("OpGroupRemove",
 483      [ pGroupName ])
 484   , ("OpGroupRename",
 485      [ pGroupName
 486      , pNewName
 487      ])
 488   , ("OpGroupEvacuate",
 489      [ pGroupName
 490      , pEarlyRelease
 491      , pIallocator
 492      , pTargetGroups
 493      ])
 494   , ("OpOsDiagnose",
 495      [ pOutputFields
 496      , pNames ])
 497   , ("OpExtStorageDiagnose",
 498      [ pOutputFields
 499      , pNames ])
 500   , ("OpBackupQuery",
 501      [ pUseLocking
 502      , pNodes
 503      ])
 504   , ("OpBackupPrepare",
 505      [ pInstanceName
 506      , pInstanceUuid
 507      , pExportMode
 508      ])
 509   , ("OpBackupExport",
 510      [ pInstanceName
 511      , pInstanceUuid
 512      , pShutdownTimeout
 513      , pExportTargetNode
 514      , pExportTargetNodeUuid
 515      , pShutdownInstance
 516      , pRemoveInstance
 517      , pIgnoreRemoveFailures
 518      , pExportMode
 519      , pX509KeyName
 520      , pX509DestCA
 521      ])
 522   , ("OpBackupRemove",
 523      [ pInstanceName
 524      , pInstanceUuid
 525      ])
 526   , ("OpTestAllocator",
 527      [ pIAllocatorDirection
 528      , pIAllocatorMode
 529      , pIAllocatorReqName
 530      , pIAllocatorNics
 531      , pIAllocatorDisks
 532      , pHypervisor
 533      , pIallocator
 534      , pInstTags
 535      , pIAllocatorMemory
 536      , pIAllocatorVCpus
 537      , pIAllocatorOs
 538      , pDiskTemplate
 539      , pIAllocatorInstances
 540      , pIAllocatorEvacMode
 541      , pTargetGroups
 542      , pIAllocatorSpindleUse
 543      , pIAllocatorCount
 544      ])
 545   , ("OpTestJqueue",
 546      [ pJQueueNotifyWaitLock
 547      , pJQueueNotifyExec
 548      , pJQueueLogMessages
 549      , pJQueueFail
 550      ])
 551   , ("OpTestDummy",
 552      [ pTestDummyResult
 553      , pTestDummyMessages
 554      , pTestDummyFail
 555      , pTestDummySubmitJobs
 556      ])
 557   , ("OpNetworkAdd",
 558      [ pNetworkName
 559      , pNetworkAddress4
 560      , pNetworkGateway4
 561      , pNetworkAddress6
 562      , pNetworkGateway6
 563      , pNetworkMacPrefix
 564      , pNetworkAddRsvdIps
 565      , pIpConflictsCheck
 566      , pInstTags
 567      ])
 568   , ("OpNetworkRemove",
 569      [ pNetworkName
 570      , pForce
 571      ])
 572   , ("OpNetworkSetParams",
 573      [ pNetworkName
 574      , pNetworkGateway4
 575      , pNetworkAddress6
 576      , pNetworkGateway6
 577      , pNetworkMacPrefix
 578      , pNetworkAddRsvdIps
 579      , pNetworkRemoveRsvdIps
 580      ])
 581   , ("OpNetworkConnect",
 582      [ pGroupName
 583      , pNetworkName
 584      , pNetworkMode
 585      , pNetworkLink
 586      , pIpConflictsCheck
 587      ])
 588   , ("OpNetworkDisconnect",
 589      [ pGroupName
 590      , pNetworkName
 591      ])
 592   , ("OpNetworkQuery", dOldQuery)
 593   , ("OpRestrictedCommand",
 594      [ pUseLocking
 595      , pRequiredNodes
 596      , pRequiredNodeUuids
 597      , pRestrictedCommand
 598      ])
 599   ])
 600
 601 -- | Returns the OP_ID for a given opcode value.
 602 $(genOpID ''OpCode "opID")
 603
 604 -- | A list of all defined/supported opcode IDs.
 605 $(genAllOpIDs ''OpCode "allOpIDs")
 606
 607 instance JSON OpCode where
 608   readJSON = loadOpCode
 609   showJSON = saveOpCode
 610
 611 -- | Generates the summary value for an opcode.
 612 opSummaryVal :: OpCode -> Maybe String
 613 opSummaryVal OpClusterVerifyGroup { opGroupName = s } = Just (fromNonEmpty s)
 614 opSummaryVal OpGroupVerifyDisks { opGroupName = s } = Just (fromNonEmpty s)
 615 opSummaryVal OpClusterRename { opName = s } = Just (fromNonEmpty s)
 616 opSummaryVal OpQuery { opWhat = s } = Just (queryTypeOpToRaw s)
 617 opSummaryVal OpQueryFields { opWhat = s } = Just (queryTypeOpToRaw s)
 618 opSummaryVal OpNodeRemove { opNodeName = s } = Just (fromNonEmpty s)
 619 opSummaryVal OpNodeAdd { opNodeName = s } = Just (fromNonEmpty s)
 620 opSummaryVal OpNodeModifyStorage { opNodeName = s } = Just (fromNonEmpty s)
 621 opSummaryVal OpRepairNodeStorage  { opNodeName = s } = Just (fromNonEmpty s)
 622 opSummaryVal OpNodeSetParams { opNodeName = s } = Just (fromNonEmpty s)
 623 opSummaryVal OpNodePowercycle { opNodeName = s } = Just (fromNonEmpty s)
 624 opSummaryVal OpNodeMigrate { opNodeName = s } = Just (fromNonEmpty s)
 625 opSummaryVal OpNodeEvacuate { opNodeName = s } = Just (fromNonEmpty s)
 626 opSummaryVal OpInstanceCreate { opInstanceName = s } = Just s
 627 opSummaryVal OpInstanceReinstall { opInstanceName = s } = Just s
 628 opSummaryVal OpInstanceRemove { opInstanceName = s } = Just s
 629 -- FIXME: instance rename should show both names; currently it shows none
 630 -- opSummaryVal OpInstanceRename { opInstanceName = s } = Just s
 631 opSummaryVal OpInstanceStartup { opInstanceName = s } = Just s
 632 opSummaryVal OpInstanceShutdown { opInstanceName = s } = Just s
 633 opSummaryVal OpInstanceReboot { opInstanceName = s } = Just s
 634 opSummaryVal OpInstanceReplaceDisks { opInstanceName = s } = Just s
 635 opSummaryVal OpInstanceFailover { opInstanceName = s } = Just s
 636 opSummaryVal OpInstanceMigrate { opInstanceName = s } = Just s
 637 opSummaryVal OpInstanceMove { opInstanceName = s } = Just s
 638 opSummaryVal OpInstanceConsole { opInstanceName = s } = Just s
 639 opSummaryVal OpInstanceActivateDisks { opInstanceName = s } = Just s
 640 opSummaryVal OpInstanceDeactivateDisks { opInstanceName = s } = Just s
 641 opSummaryVal OpInstanceRecreateDisks { opInstanceName = s } = Just s
 642 opSummaryVal OpInstanceSetParams { opInstanceName = s } = Just s
 643 opSummaryVal OpInstanceGrowDisk { opInstanceName = s } = Just s
 644 opSummaryVal OpInstanceChangeGroup { opInstanceName = s } = Just s
 645 opSummaryVal OpGroupAdd { opGroupName = s } = Just (fromNonEmpty s)
 646 opSummaryVal OpGroupAssignNodes { opGroupName = s } = Just (fromNonEmpty s)
 647 opSummaryVal OpGroupSetParams { opGroupName = s } = Just (fromNonEmpty s)
 648 opSummaryVal OpGroupRemove { opGroupName = s } = Just (fromNonEmpty s)
 649 opSummaryVal OpGroupEvacuate { opGroupName = s } = Just (fromNonEmpty s)
 650 opSummaryVal OpBackupPrepare { opInstanceName = s } = Just s
 651 opSummaryVal OpBackupExport { opInstanceName = s } = Just s
 652 opSummaryVal OpBackupRemove { opInstanceName = s } = Just s
 653 opSummaryVal OpTagsGet { opKind = k } =
 654   Just . fromMaybe "None" $ tagNameOf k
 655 opSummaryVal OpTagsSearch { opTagSearchPattern = s } = Just (fromNonEmpty s)
 656 opSummaryVal OpTestDelay { opDelayDuration = d } = Just (show d)
 657 opSummaryVal OpTestAllocator { opIallocator = s } =
 658   -- FIXME: Python doesn't handle None fields well, so we have behave the same
 659   Just $ maybe "None" fromNonEmpty s
 660 opSummaryVal OpNetworkAdd { opNetworkName = s} = Just (fromNonEmpty s)
 661 opSummaryVal OpNetworkRemove { opNetworkName = s} = Just (fromNonEmpty s)
 662 opSummaryVal OpNetworkSetParams { opNetworkName = s} = Just (fromNonEmpty s)
 663 opSummaryVal OpNetworkConnect { opNetworkName = s} = Just (fromNonEmpty s)
 664 opSummaryVal OpNetworkDisconnect { opNetworkName = s} = Just (fromNonEmpty s)
 665 opSummaryVal _ = Nothing
 666
 667 -- | Computes the summary of the opcode.
 668 opSummary :: OpCode -> String
 669 opSummary op =
 670   case opSummaryVal op of
 671     Nothing -> op_suffix
 672     Just s -> op_suffix ++ "(" ++ s ++ ")"
 673   where op_suffix = drop 3 $ opID op
 674
 675 -- | Generic\/common opcode parameters.
 676 $(buildObject "CommonOpParams" "op"
 677   [ pDryRun
 678   , pDebugLevel
 679   , pOpPriority
 680   , pDependencies
 681   , pComment
 682   , pReason
 683   ])
 684
 685 -- | Default common parameter values.
 686 defOpParams :: CommonOpParams
 687 defOpParams =
 688   CommonOpParams { opDryRun     = Nothing
 689                  , opDebugLevel = Nothing
 690                  , opPriority   = OpPrioNormal
 691                  , opDepends    = Nothing
 692                  , opComment    = Nothing
 693                  , opReason     = []
 694                  }
 695
 696 -- | The top-level opcode type.
 697 data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams
 698                              , metaOpCode :: OpCode
 699                              } deriving (Show, Eq)
 700
 701 -- | JSON serialisation for 'MetaOpCode'.
 702 showMeta :: MetaOpCode -> JSValue
 703 showMeta (MetaOpCode params op) =
 704   let objparams = toDictCommonOpParams params
 705       objop = toDictOpCode op
 706   in makeObj (objparams ++ objop)
 707
 708 -- | JSON deserialisation for 'MetaOpCode'
 709 readMeta :: JSValue -> Text.JSON.Result MetaOpCode
 710 readMeta v = do
 711   meta <- readJSON v
 712   op <- readJSON v
 713   return $ MetaOpCode meta op
 714
 715 instance JSON MetaOpCode where
 716   showJSON = showMeta
 717   readJSON = readMeta
 718
 719 -- | Wraps an 'OpCode' with the default parameters to build a
 720 -- 'MetaOpCode'.
 721 wrapOpCode :: OpCode -> MetaOpCode
 722 wrapOpCode = MetaOpCode defOpParams
 723
 724 -- | Sets the comment on a meta opcode.
 725 setOpComment :: String -> MetaOpCode -> MetaOpCode
 726 setOpComment comment (MetaOpCode common op) =
 727   MetaOpCode (common { opComment = Just comment}) op
 728
 729 -- | Sets the priority on a meta opcode.
 730 setOpPriority :: OpSubmitPriority -> MetaOpCode -> MetaOpCode
 731 setOpPriority prio (MetaOpCode common op) =
 732   MetaOpCode (common { opPriority = prio }) op