Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / OpCodes.hs @ 95c0c0bc

History | View | Annotate | Download (17.7 kB)

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
     ])
189
  , ("OpClusterRedistConf", [])
190
  , ("OpClusterActivateMasterIp", [])
191
  , ("OpClusterDeactivateMasterIp", [])
192
  , ("OpQuery",
193
     [ pQueryWhat
194
     , pUseLocking
195
     , pQueryFields
196
     , pQueryFilter
197
     ])
198
  , ("OpQueryFields",
199
     [ pQueryWhat
200
     , pQueryFields
201
     ])
202
  , ("OpOobCommand",
203
     [ pNodeNames
204
     , pNodeUuids
205
     , pOobCommand
206
     , pOobTimeout
207
     , pIgnoreStatus
208
     , pPowerDelay
209
     ])
210
  , ("OpNodeRemove",
211
     [ pNodeName
212
     , pNodeUuid
213
     ])
214
  , ("OpNodeAdd",
215
     [ pNodeName
216
     , pHvState
217
     , pDiskState
218
     , pPrimaryIp
219
     , pSecondaryIp
220
     , pReadd
221
     , pNodeGroup
222
     , pMasterCapable
223
     , pVmCapable
224
     , pNdParams
225
    ])
226
  , ("OpNodeQuery", dOldQuery)
227
  , ("OpNodeQueryvols",
228
     [ pOutputFields
229
     , pNodes
230
     ])
231
  , ("OpNodeQueryStorage",
232
     [ pOutputFields
233
     , pStorageType
234
     , pNodes
235
     , pStorageName
236
     ])
237
  , ("OpNodeModifyStorage",
238
     [ pNodeName
239
     , pNodeUuid
240
     , pStorageType
241
     , pStorageName
242
     , pStorageChanges
243
     ])
244
  , ("OpRepairNodeStorage",
245
     [ pNodeName
246
     , pNodeUuid
247
     , pStorageType
248
     , pStorageName
249
     , pIgnoreConsistency
250
     ])
251
  , ("OpNodeSetParams",
252
     [ pNodeName
253
     , pNodeUuid
254
     , pForce
255
     , pHvState
256
     , pDiskState
257
     , pMasterCandidate
258
     , pOffline
259
     , pDrained
260
     , pAutoPromote
261
     , pMasterCapable
262
     , pVmCapable
263
     , pSecondaryIp
264
     , pNdParams
265
     , pPowered
266
     ])
267
  , ("OpNodePowercycle",
268
     [ pNodeName
269
     , pNodeUuid
270
     , pForce
271
     ])
272
  , ("OpNodeMigrate",
273
     [ pNodeName
274
     , pNodeUuid
275
     , pMigrationMode
276
     , pMigrationLive
277
     , pMigrationTargetNode
278
     , pMigrationTargetNodeUuid
279
     , pAllowRuntimeChgs
280
     , pIgnoreIpolicy
281
     , pIallocator
282
     ])
283
  , ("OpNodeEvacuate",
284
     [ pEarlyRelease
285
     , pNodeName
286
     , pNodeUuid
287
     , pRemoteNode
288
     , pRemoteNodeUuid
289
     , pIallocator
290
     , pEvacMode
291
     ])
292
  , ("OpInstanceCreate",
293
     [ pInstanceName
294
     , pForceVariant
295
     , pWaitForSync
296
     , pNameCheck
297
     , pIgnoreIpolicy
298
     , pInstBeParams
299
     , pInstDisks
300
     , pDiskTemplate
301
     , pFileDriver
302
     , pFileStorageDir
303
     , pInstHvParams
304
     , pHypervisor
305
     , pIallocator
306
     , pResetDefaults
307
     , pIpCheck
308
     , pIpConflictsCheck
309
     , pInstCreateMode
310
     , pInstNics
311
     , pNoInstall
312
     , pInstOsParams
313
     , pInstOs
314
     , pPrimaryNode
315
     , pPrimaryNodeUuid
316
     , pSecondaryNode
317
     , pSecondaryNodeUuid
318
     , pSourceHandshake
319
     , pSourceInstance
320
     , pSourceShutdownTimeout
321
     , pSourceX509Ca
322
     , pSrcNode
323
     , pSrcNodeUuid
324
     , pSrcPath
325
     , pStartInstance
326
     , pOpportunisticLocking
327
     , pInstTags
328
     ])
329
  , ("OpInstanceMultiAlloc",
330
     [ pIallocator
331
     , pMultiAllocInstances
332
     , pOpportunisticLocking
333
     ])
334
  , ("OpInstanceReinstall",
335
     [ pInstanceName
336
     , pInstanceUuid
337
     , pForceVariant
338
     , pInstOs
339
     , pTempOsParams
340
     ])
341
  , ("OpInstanceRemove",
342
     [ pInstanceName
343
     , pInstanceUuid
344
     , pShutdownTimeout
345
     , pIgnoreFailures
346
     ])
347
  , ("OpInstanceRename",
348
     [ pInstanceName
349
     , pInstanceUuid
350
     , pNewName
351
     , pNameCheck
352
     , pIpCheck
353
     ])
354
  , ("OpInstanceStartup",
355
     [ pInstanceName
356
     , pInstanceUuid
357
     , pForce
358
     , pIgnoreOfflineNodes
359
     , pTempHvParams
360
     , pTempBeParams
361
     , pNoRemember
362
     , pStartupPaused
363
     ])
364
  , ("OpInstanceShutdown",
365
     [ pInstanceName
366
     , pInstanceUuid
367
     , pForce
368
     , pIgnoreOfflineNodes
369
     , pShutdownTimeout'
370
     , pNoRemember
371
     ])
372
  , ("OpInstanceReboot",
373
     [ pInstanceName
374
     , pInstanceUuid
375
     , pShutdownTimeout
376
     , pIgnoreSecondaries
377
     , pRebootType
378
     ])
379
  , ("OpInstanceMove",
380
     [ pInstanceName
381
     , pInstanceUuid
382
     , pShutdownTimeout
383
     , pIgnoreIpolicy
384
     , pMoveTargetNode
385
     , pMoveTargetNodeUuid
386
     , pIgnoreConsistency
387
     ])
388
  , ("OpInstanceConsole",
389
     [ pInstanceName
390
     , pInstanceUuid
391
     ])
392
  , ("OpInstanceActivateDisks",
393
     [ pInstanceName
394
     , pInstanceUuid
395
     , pIgnoreDiskSize
396
     , pWaitForSyncFalse
397
     ])
398
  , ("OpInstanceDeactivateDisks",
399
     [ pInstanceName
400
     , pInstanceUuid
401
     , pForce
402
     ])
403
  , ("OpInstanceRecreateDisks",
404
     [ pInstanceName
405
     , pInstanceUuid
406
     , pRecreateDisksInfo
407
     , pNodes
408
     , pNodeUuids
409
     , pIallocator
410
     ])
411
  , ("OpInstanceQuery", dOldQuery)
412
  , ("OpInstanceQueryData",
413
     [ pUseLocking
414
     , pInstances
415
     , pStatic
416
     ])
417
  , ("OpInstanceSetParams",
418
     [ pInstanceName
419
     , pInstanceUuid
420
     , pForce
421
     , pForceVariant
422
     , pIgnoreIpolicy
423
     , pInstParamsNicChanges
424
     , pInstParamsDiskChanges
425
     , pInstBeParams
426
     , pRuntimeMem
427
     , pInstHvParams
428
     , pOptDiskTemplate
429
     , pPrimaryNode
430
     , pPrimaryNodeUuid
431
     , pRemoteNode
432
     , pRemoteNodeUuid
433
     , pOsNameChange
434
     , pInstOsParams
435
     , pWaitForSync
436
     , pOffline
437
     , pIpConflictsCheck
438
     , pHotplug
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