Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / OpCodes.hs @ f6d4b52d

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
     , 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