Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / OpCodes.hs @ da4a52a3

History | View | Annotate | Download (17.6 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
     ])
438
  , ("OpInstanceGrowDisk",
439
     [ pInstanceName
440
     , pInstanceUuid
441
     , pWaitForSync
442
     , pDiskIndex
443
     , pDiskChgAmount
444
     , pDiskChgAbsolute
445
     ])
446
  , ("OpInstanceChangeGroup",
447
     [ pInstanceName
448
     , pInstanceUuid
449
     , pEarlyRelease
450
     , pIallocator
451
     , pTargetGroups
452
     ])
453
  , ("OpGroupAdd",
454
     [ pGroupName
455
     , pNodeGroupAllocPolicy
456
     , pGroupNodeParams
457
     , pDiskParams
458
     , pHvState
459
     , pDiskState
460
     , pIpolicy
461
     ])
462
  , ("OpGroupAssignNodes",
463
     [ pGroupName
464
     , pForce
465
     , pRequiredNodes
466
     , pRequiredNodeUuids
467
     ])
468
  , ("OpGroupQuery", dOldQueryNoLocking)
469
  , ("OpGroupSetParams",
470
     [ pGroupName
471
     , pNodeGroupAllocPolicy
472
     , pGroupNodeParams
473
     , pDiskParams
474
     , pHvState
475
     , pDiskState
476
     , pIpolicy
477
     ])
478
  , ("OpGroupRemove",
479
     [ pGroupName ])
480
  , ("OpGroupRename",
481
     [ pGroupName
482
     , pNewName
483
     ])
484
  , ("OpGroupEvacuate",
485
     [ pGroupName
486
     , pEarlyRelease
487
     , pIallocator
488
     , pTargetGroups
489
     ])
490
  , ("OpOsDiagnose",
491
     [ pOutputFields
492
     , pNames ])
493
  , ("OpExtStorageDiagnose",
494
     [ pOutputFields
495
     , pNames ])
496
  , ("OpBackupQuery",
497
     [ pUseLocking
498
     , pNodes
499
     ])
500
  , ("OpBackupPrepare",
501
     [ pInstanceName
502
     , pInstanceUuid
503
     , pExportMode
504
     ])
505
  , ("OpBackupExport",
506
     [ pInstanceName
507
     , pInstanceUuid
508
     , pShutdownTimeout
509
     , pExportTargetNode
510
     , pExportTargetNodeUuid
511
     , pShutdownInstance
512
     , pRemoveInstance
513
     , pIgnoreRemoveFailures
514
     , pExportMode
515
     , pX509KeyName
516
     , pX509DestCA
517
     ])
518
  , ("OpBackupRemove",
519
     [ pInstanceName
520
     , pInstanceUuid
521
     ])
522
  , ("OpTestAllocator",
523
     [ pIAllocatorDirection
524
     , pIAllocatorMode
525
     , pIAllocatorReqName
526
     , pIAllocatorNics
527
     , pIAllocatorDisks
528
     , pHypervisor
529
     , pIallocator
530
     , pInstTags
531
     , pIAllocatorMemory
532
     , pIAllocatorVCpus
533
     , pIAllocatorOs
534
     , pDiskTemplate
535
     , pIAllocatorInstances
536
     , pIAllocatorEvacMode
537
     , pTargetGroups
538
     , pIAllocatorSpindleUse
539
     , pIAllocatorCount
540
     ])
541
  , ("OpTestJqueue",
542
     [ pJQueueNotifyWaitLock
543
     , pJQueueNotifyExec
544
     , pJQueueLogMessages
545
     , pJQueueFail
546
     ])
547
  , ("OpTestDummy",
548
     [ pTestDummyResult
549
     , pTestDummyMessages
550
     , pTestDummyFail
551
     , pTestDummySubmitJobs
552
     ])
553
  , ("OpNetworkAdd",
554
     [ pNetworkName
555
     , pNetworkAddress4
556
     , pNetworkGateway4
557
     , pNetworkAddress6
558
     , pNetworkGateway6
559
     , pNetworkMacPrefix
560
     , pNetworkAddRsvdIps
561
     , pIpConflictsCheck
562
     , pInstTags
563
     ])
564
  , ("OpNetworkRemove",
565
     [ pNetworkName
566
     , pForce
567
     ])
568
  , ("OpNetworkSetParams",
569
     [ pNetworkName
570
     , pNetworkGateway4
571
     , pNetworkAddress6
572
     , pNetworkGateway6
573
     , pNetworkMacPrefix
574
     , pNetworkAddRsvdIps
575
     , pNetworkRemoveRsvdIps
576
     ])
577
  , ("OpNetworkConnect",
578
     [ pGroupName
579
     , pNetworkName
580
     , pNetworkMode
581
     , pNetworkLink
582
     , pIpConflictsCheck
583
     ])
584
  , ("OpNetworkDisconnect",
585
     [ pGroupName
586
     , pNetworkName
587
     ])
588
  , ("OpNetworkQuery", dOldQuery)
589
  , ("OpRestrictedCommand",
590
     [ pUseLocking
591
     , pRequiredNodes
592
     , pRequiredNodeUuids
593
     , pRestrictedCommand
594
     ])
595
  ])
596

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

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

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

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

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

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

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

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

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

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

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

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

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

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