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