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