Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / OpCodes.hs @ 7002d873

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
     ])
188
  , ("OpClusterRedistConf", [])
189
  , ("OpClusterActivateMasterIp", [])
190
  , ("OpClusterDeactivateMasterIp", [])
191
  , ("OpQuery",
192
     [ pQueryWhat
193
     , pUseLocking
194
     , pQueryFields
195
     , pQueryFilter
196
     ])
197
  , ("OpQueryFields",
198
     [ pQueryWhat
199
     , pQueryFields
200
     ])
201
  , ("OpOobCommand",
202
     [ pNodeNames
203
     , pNodeUuids
204
     , pOobCommand
205
     , pOobTimeout
206
     , pIgnoreStatus
207
     , pPowerDelay
208
     ])
209
  , ("OpNodeRemove",
210
     [ pNodeName
211
     , pNodeUuid
212
     ])
213
  , ("OpNodeAdd",
214
     [ pNodeName
215
     , pHvState
216
     , pDiskState
217
     , pPrimaryIp
218
     , pSecondaryIp
219
     , pReadd
220
     , pNodeGroup
221
     , pMasterCapable
222
     , pVmCapable
223
     , pNdParams
224
    ])
225
  , ("OpNodeQuery", dOldQuery)
226
  , ("OpNodeQueryvols",
227
     [ pOutputFields
228
     , pNodes
229
     ])
230
  , ("OpNodeQueryStorage",
231
     [ pOutputFields
232
     , pStorageType
233
     , pNodes
234
     , pStorageName
235
     ])
236
  , ("OpNodeModifyStorage",
237
     [ pNodeName
238
     , pNodeUuid
239
     , pStorageType
240
     , pStorageName
241
     , pStorageChanges
242
     ])
243
  , ("OpRepairNodeStorage",
244
     [ pNodeName
245
     , pNodeUuid
246
     , pStorageType
247
     , pStorageName
248
     , pIgnoreConsistency
249
     ])
250
  , ("OpNodeSetParams",
251
     [ pNodeName
252
     , pNodeUuid
253
     , pForce
254
     , pHvState
255
     , pDiskState
256
     , pMasterCandidate
257
     , pOffline
258
     , pDrained
259
     , pAutoPromote
260
     , pMasterCapable
261
     , pVmCapable
262
     , pSecondaryIp
263
     , pNdParams
264
     , pPowered
265
     ])
266
  , ("OpNodePowercycle",
267
     [ pNodeName
268
     , pNodeUuid
269
     , pForce
270
     ])
271
  , ("OpNodeMigrate",
272
     [ pNodeName
273
     , pNodeUuid
274
     , pMigrationMode
275
     , pMigrationLive
276
     , pMigrationTargetNode
277
     , pMigrationTargetNodeUuid
278
     , pAllowRuntimeChgs
279
     , pIgnoreIpolicy
280
     , pIallocator
281
     ])
282
  , ("OpNodeEvacuate",
283
     [ pEarlyRelease
284
     , pNodeName
285
     , pNodeUuid
286
     , pRemoteNode
287
     , pRemoteNodeUuid
288
     , pIallocator
289
     , pEvacMode
290
     ])
291
  , ("OpInstanceCreate",
292
     [ pInstanceName
293
     , pForceVariant
294
     , pWaitForSync
295
     , pNameCheck
296
     , pIgnoreIpolicy
297
     , pInstBeParams
298
     , pInstDisks
299
     , pDiskTemplate
300
     , pFileDriver
301
     , pFileStorageDir
302
     , pInstHvParams
303
     , pHypervisor
304
     , pIallocator
305
     , pResetDefaults
306
     , pIpCheck
307
     , pIpConflictsCheck
308
     , pInstCreateMode
309
     , pInstNics
310
     , pNoInstall
311
     , pInstOsParams
312
     , pInstOs
313
     , pPrimaryNode
314
     , pPrimaryNodeUuid
315
     , pSecondaryNode
316
     , pSecondaryNodeUuid
317
     , pSourceHandshake
318
     , pSourceInstance
319
     , pSourceShutdownTimeout
320
     , pSourceX509Ca
321
     , pSrcNode
322
     , pSrcNodeUuid
323
     , pSrcPath
324
     , pStartInstance
325
     , pOpportunisticLocking
326
     , pInstTags
327
     ])
328
  , ("OpInstanceMultiAlloc",
329
     [ pIallocator
330
     , pMultiAllocInstances
331
     , pOpportunisticLocking
332
     ])
333
  , ("OpInstanceReinstall",
334
     [ pInstanceName
335
     , pInstanceUuid
336
     , pForceVariant
337
     , pInstOs
338
     , pTempOsParams
339
     ])
340
  , ("OpInstanceRemove",
341
     [ pInstanceName
342
     , pInstanceUuid
343
     , pShutdownTimeout
344
     , pIgnoreFailures
345
     ])
346
  , ("OpInstanceRename",
347
     [ pInstanceName
348
     , pInstanceUuid
349
     , pNewName
350
     , pNameCheck
351
     , pIpCheck
352
     ])
353
  , ("OpInstanceStartup",
354
     [ pInstanceName
355
     , pInstanceUuid
356
     , pForce
357
     , pIgnoreOfflineNodes
358
     , pTempHvParams
359
     , pTempBeParams
360
     , pNoRemember
361
     , pStartupPaused
362
     ])
363
  , ("OpInstanceShutdown",
364
     [ pInstanceName
365
     , pInstanceUuid
366
     , pForce
367
     , pIgnoreOfflineNodes
368
     , pShutdownTimeout'
369
     , pNoRemember
370
     ])
371
  , ("OpInstanceReboot",
372
     [ pInstanceName
373
     , pInstanceUuid
374
     , pShutdownTimeout
375
     , pIgnoreSecondaries
376
     , pRebootType
377
     ])
378
  , ("OpInstanceMove",
379
     [ pInstanceName
380
     , pInstanceUuid
381
     , pShutdownTimeout
382
     , pIgnoreIpolicy
383
     , pMoveTargetNode
384
     , pMoveTargetNodeUuid
385
     , pIgnoreConsistency
386
     ])
387
  , ("OpInstanceConsole",
388
     [ pInstanceName
389
     , pInstanceUuid
390
     ])
391
  , ("OpInstanceActivateDisks",
392
     [ pInstanceName
393
     , pInstanceUuid
394
     , pIgnoreDiskSize
395
     , pWaitForSyncFalse
396
     ])
397
  , ("OpInstanceDeactivateDisks",
398
     [ pInstanceName
399
     , pInstanceUuid
400
     , pForce
401
     ])
402
  , ("OpInstanceRecreateDisks",
403
     [ pInstanceName
404
     , pInstanceUuid
405
     , pRecreateDisksInfo
406
     , pNodes
407
     , pNodeUuids
408
     , pIallocator
409
     ])
410
  , ("OpInstanceQuery", dOldQuery)
411
  , ("OpInstanceQueryData",
412
     [ pUseLocking
413
     , pInstances
414
     , pStatic
415
     ])
416
  , ("OpInstanceSetParams",
417
     [ pInstanceName
418
     , pInstanceUuid
419
     , pForce
420
     , pForceVariant
421
     , pIgnoreIpolicy
422
     , pInstParamsNicChanges
423
     , pInstParamsDiskChanges
424
     , pInstBeParams
425
     , pRuntimeMem
426
     , pInstHvParams
427
     , pOptDiskTemplate
428
     , pPrimaryNode
429
     , pPrimaryNodeUuid
430
     , pRemoteNode
431
     , pRemoteNodeUuid
432
     , pOsNameChange
433
     , pInstOsParams
434
     , pWaitForSync
435
     , pOffline
436
     , pIpConflictsCheck
437
     , pHotplug
438
     ])
439
  , ("OpInstanceGrowDisk",
440
     [ pInstanceName
441
     , pInstanceUuid
442
     , pWaitForSync
443
     , pDiskIndex
444
     , pDiskChgAmount
445
     , pDiskChgAbsolute
446
     ])
447
  , ("OpInstanceChangeGroup",
448
     [ pInstanceName
449
     , pInstanceUuid
450
     , pEarlyRelease
451
     , pIallocator
452
     , pTargetGroups
453
     ])
454
  , ("OpGroupAdd",
455
     [ pGroupName
456
     , pNodeGroupAllocPolicy
457
     , pGroupNodeParams
458
     , pDiskParams
459
     , pHvState
460
     , pDiskState
461
     , pIpolicy
462
     ])
463
  , ("OpGroupAssignNodes",
464
     [ pGroupName
465
     , pForce
466
     , pRequiredNodes
467
     , pRequiredNodeUuids
468
     ])
469
  , ("OpGroupQuery", dOldQueryNoLocking)
470
  , ("OpGroupSetParams",
471
     [ pGroupName
472
     , pNodeGroupAllocPolicy
473
     , pGroupNodeParams
474
     , pDiskParams
475
     , pHvState
476
     , pDiskState
477
     , pIpolicy
478
     ])
479
  , ("OpGroupRemove",
480
     [ pGroupName ])
481
  , ("OpGroupRename",
482
     [ pGroupName
483
     , pNewName
484
     ])
485
  , ("OpGroupEvacuate",
486
     [ pGroupName
487
     , pEarlyRelease
488
     , pIallocator
489
     , pTargetGroups
490
     ])
491
  , ("OpOsDiagnose",
492
     [ pOutputFields
493
     , pNames ])
494
  , ("OpExtStorageDiagnose",
495
     [ pOutputFields
496
     , pNames ])
497
  , ("OpBackupQuery",
498
     [ pUseLocking
499
     , pNodes
500
     ])
501
  , ("OpBackupPrepare",
502
     [ pInstanceName
503
     , pInstanceUuid
504
     , pExportMode
505
     ])
506
  , ("OpBackupExport",
507
     [ pInstanceName
508
     , pInstanceUuid
509
     , pShutdownTimeout
510
     , pExportTargetNode
511
     , pExportTargetNodeUuid
512
     , pShutdownInstance
513
     , pRemoveInstance
514
     , pIgnoreRemoveFailures
515
     , pExportMode
516
     , pX509KeyName
517
     , pX509DestCA
518
     ])
519
  , ("OpBackupRemove",
520
     [ pInstanceName
521
     , pInstanceUuid
522
     ])
523
  , ("OpTestAllocator",
524
     [ pIAllocatorDirection
525
     , pIAllocatorMode
526
     , pIAllocatorReqName
527
     , pIAllocatorNics
528
     , pIAllocatorDisks
529
     , pHypervisor
530
     , pIallocator
531
     , pInstTags
532
     , pIAllocatorMemory
533
     , pIAllocatorVCpus
534
     , pIAllocatorOs
535
     , pDiskTemplate
536
     , pIAllocatorInstances
537
     , pIAllocatorEvacMode
538
     , pTargetGroups
539
     , pIAllocatorSpindleUse
540
     , pIAllocatorCount
541
     ])
542
  , ("OpTestJqueue",
543
     [ pJQueueNotifyWaitLock
544
     , pJQueueNotifyExec
545
     , pJQueueLogMessages
546
     , pJQueueFail
547
     ])
548
  , ("OpTestDummy",
549
     [ pTestDummyResult
550
     , pTestDummyMessages
551
     , pTestDummyFail
552
     , pTestDummySubmitJobs
553
     ])
554
  , ("OpNetworkAdd",
555
     [ pNetworkName
556
     , pNetworkAddress4
557
     , pNetworkGateway4
558
     , pNetworkAddress6
559
     , pNetworkGateway6
560
     , pNetworkMacPrefix
561
     , pNetworkAddRsvdIps
562
     , pIpConflictsCheck
563
     , pInstTags
564
     ])
565
  , ("OpNetworkRemove",
566
     [ pNetworkName
567
     , pForce
568
     ])
569
  , ("OpNetworkSetParams",
570
     [ pNetworkName
571
     , pNetworkGateway4
572
     , pNetworkAddress6
573
     , pNetworkGateway6
574
     , pNetworkMacPrefix
575
     , pNetworkAddRsvdIps
576
     , pNetworkRemoveRsvdIps
577
     ])
578
  , ("OpNetworkConnect",
579
     [ pGroupName
580
     , pNetworkName
581
     , pNetworkMode
582
     , pNetworkLink
583
     , pIpConflictsCheck
584
     ])
585
  , ("OpNetworkDisconnect",
586
     [ pGroupName
587
     , pNetworkName
588
     ])
589
  , ("OpNetworkQuery", dOldQuery)
590
  , ("OpRestrictedCommand",
591
     [ pUseLocking
592
     , pRequiredNodes
593
     , pRequiredNodeUuids
594
     , pRestrictedCommand
595
     ])
596
  ])
597

    
598
-- | Returns the OP_ID for a given opcode value.
599
$(genOpID ''OpCode "opID")
600

    
601
-- | A list of all defined/supported opcode IDs.
602
$(genAllOpIDs ''OpCode "allOpIDs")
603

    
604
instance JSON OpCode where
605
  readJSON = loadOpCode
606
  showJSON = saveOpCode
607

    
608
-- | Generates the summary value for an opcode.
609
opSummaryVal :: OpCode -> Maybe String
610
opSummaryVal OpClusterVerifyGroup { opGroupName = s } = Just (fromNonEmpty s)
611
opSummaryVal OpGroupVerifyDisks { opGroupName = s } = Just (fromNonEmpty s)
612
opSummaryVal OpClusterRename { opName = s } = Just (fromNonEmpty s)
613
opSummaryVal OpQuery { opWhat = s } = Just (queryTypeOpToRaw s)
614
opSummaryVal OpQueryFields { opWhat = s } = Just (queryTypeOpToRaw s)
615
opSummaryVal OpNodeRemove { opNodeName = s } = Just (fromNonEmpty s)
616
opSummaryVal OpNodeAdd { opNodeName = s } = Just (fromNonEmpty s)
617
opSummaryVal OpNodeModifyStorage { opNodeName = s } = Just (fromNonEmpty s)
618
opSummaryVal OpRepairNodeStorage  { opNodeName = s } = Just (fromNonEmpty s)
619
opSummaryVal OpNodeSetParams { opNodeName = s } = Just (fromNonEmpty s)
620
opSummaryVal OpNodePowercycle { opNodeName = s } = Just (fromNonEmpty s)
621
opSummaryVal OpNodeMigrate { opNodeName = s } = Just (fromNonEmpty s)
622
opSummaryVal OpNodeEvacuate { opNodeName = s } = Just (fromNonEmpty s)
623
opSummaryVal OpInstanceCreate { opInstanceName = s } = Just s
624
opSummaryVal OpInstanceReinstall { opInstanceName = s } = Just s
625
opSummaryVal OpInstanceRemove { opInstanceName = s } = Just s
626
-- FIXME: instance rename should show both names; currently it shows none
627
-- opSummaryVal OpInstanceRename { opInstanceName = s } = Just s
628
opSummaryVal OpInstanceStartup { opInstanceName = s } = Just s
629
opSummaryVal OpInstanceShutdown { opInstanceName = s } = Just s
630
opSummaryVal OpInstanceReboot { opInstanceName = s } = Just s
631
opSummaryVal OpInstanceReplaceDisks { opInstanceName = s } = Just s
632
opSummaryVal OpInstanceFailover { opInstanceName = s } = Just s
633
opSummaryVal OpInstanceMigrate { opInstanceName = s } = Just s
634
opSummaryVal OpInstanceMove { opInstanceName = s } = Just s
635
opSummaryVal OpInstanceConsole { opInstanceName = s } = Just s
636
opSummaryVal OpInstanceActivateDisks { opInstanceName = s } = Just s
637
opSummaryVal OpInstanceDeactivateDisks { opInstanceName = s } = Just s
638
opSummaryVal OpInstanceRecreateDisks { opInstanceName = s } = Just s
639
opSummaryVal OpInstanceSetParams { opInstanceName = s } = Just s
640
opSummaryVal OpInstanceGrowDisk { opInstanceName = s } = Just s
641
opSummaryVal OpInstanceChangeGroup { opInstanceName = s } = Just s
642
opSummaryVal OpGroupAdd { opGroupName = s } = Just (fromNonEmpty s)
643
opSummaryVal OpGroupAssignNodes { opGroupName = s } = Just (fromNonEmpty s)
644
opSummaryVal OpGroupSetParams { opGroupName = s } = Just (fromNonEmpty s)
645
opSummaryVal OpGroupRemove { opGroupName = s } = Just (fromNonEmpty s)
646
opSummaryVal OpGroupEvacuate { opGroupName = s } = Just (fromNonEmpty s)
647
opSummaryVal OpBackupPrepare { opInstanceName = s } = Just s
648
opSummaryVal OpBackupExport { opInstanceName = s } = Just s
649
opSummaryVal OpBackupRemove { opInstanceName = s } = Just s
650
opSummaryVal OpTagsGet { opKind = k } =
651
  Just . fromMaybe "None" $ tagNameOf k
652
opSummaryVal OpTagsSearch { opTagSearchPattern = s } = Just (fromNonEmpty s)
653
opSummaryVal OpTestDelay { opDelayDuration = d } = Just (show d)
654
opSummaryVal OpTestAllocator { opIallocator = s } =
655
  -- FIXME: Python doesn't handle None fields well, so we have behave the same
656
  Just $ maybe "None" fromNonEmpty s
657
opSummaryVal OpNetworkAdd { opNetworkName = s} = Just (fromNonEmpty s)
658
opSummaryVal OpNetworkRemove { opNetworkName = s} = Just (fromNonEmpty s)
659
opSummaryVal OpNetworkSetParams { opNetworkName = s} = Just (fromNonEmpty s)
660
opSummaryVal OpNetworkConnect { opNetworkName = s} = Just (fromNonEmpty s)
661
opSummaryVal OpNetworkDisconnect { opNetworkName = s} = Just (fromNonEmpty s)
662
opSummaryVal _ = Nothing
663

    
664
-- | Computes the summary of the opcode.
665
opSummary :: OpCode -> String
666
opSummary op =
667
  case opSummaryVal op of
668
    Nothing -> op_suffix
669
    Just s -> op_suffix ++ "(" ++ s ++ ")"
670
  where op_suffix = drop 3 $ opID op
671

    
672
-- | Generic\/common opcode parameters.
673
$(buildObject "CommonOpParams" "op"
674
  [ pDryRun
675
  , pDebugLevel
676
  , pOpPriority
677
  , pDependencies
678
  , pComment
679
  , pReason
680
  ])
681

    
682
-- | Default common parameter values.
683
defOpParams :: CommonOpParams
684
defOpParams =
685
  CommonOpParams { opDryRun     = Nothing
686
                 , opDebugLevel = Nothing
687
                 , opPriority   = OpPrioNormal
688
                 , opDepends    = Nothing
689
                 , opComment    = Nothing
690
                 , opReason     = []
691
                 }
692

    
693
-- | The top-level opcode type.
694
data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams
695
                             , metaOpCode :: OpCode
696
                             } deriving (Show, Eq)
697

    
698
-- | JSON serialisation for 'MetaOpCode'.
699
showMeta :: MetaOpCode -> JSValue
700
showMeta (MetaOpCode params op) =
701
  let objparams = toDictCommonOpParams params
702
      objop = toDictOpCode op
703
  in makeObj (objparams ++ objop)
704

    
705
-- | JSON deserialisation for 'MetaOpCode'
706
readMeta :: JSValue -> Text.JSON.Result MetaOpCode
707
readMeta v = do
708
  meta <- readJSON v
709
  op <- readJSON v
710
  return $ MetaOpCode meta op
711

    
712
instance JSON MetaOpCode where
713
  showJSON = showMeta
714
  readJSON = readMeta
715

    
716
-- | Wraps an 'OpCode' with the default parameters to build a
717
-- 'MetaOpCode'.
718
wrapOpCode :: OpCode -> MetaOpCode
719
wrapOpCode = MetaOpCode defOpParams
720

    
721
-- | Sets the comment on a meta opcode.
722
setOpComment :: String -> MetaOpCode -> MetaOpCode
723
setOpComment comment (MetaOpCode common op) =
724
  MetaOpCode (common { opComment = Just comment}) op
725

    
726
-- | Sets the priority on a meta opcode.
727
setOpPriority :: OpSubmitPriority -> MetaOpCode -> MetaOpCode
728
setOpPriority prio (MetaOpCode common op) =
729
  MetaOpCode (common { opPriority = prio }) op