OpCodes.hs 27.6 KB
Newer Older
Jose A. Lopes's avatar
Jose A. Lopes committed
1
2
{-# LANGUAGE ExistentialQuantification, TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
3

4
5
6
7
8
9
{-| Implementation of the opcodes.

-}

{-

10
Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Google Inc.
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

module Ganeti.OpCodes
Jose A. Lopes's avatar
Jose A. Lopes committed
30
31
  ( pyClasses
  , OpCode(..)
32
  , ReplaceDisksMode(..)
33
34
35
  , DiskIndex
  , mkDiskIndex
  , unDiskIndex
36
  , opID
37
  , opReasonSrcID
38
  , allOpIDs
39
  , allOpFields
Iustin Pop's avatar
Iustin Pop committed
40
  , opSummary
41
42
43
  , CommonOpParams(..)
  , defOpParams
  , MetaOpCode(..)
44
  , resolveDependencies
45
46
  , wrapOpCode
  , setOpComment
47
  , setOpPriority
48
  ) where
49

50
51
import Data.List (intercalate)
import Data.Map (Map)
52
import qualified Text.JSON
53
import Text.JSON (readJSON, JSObject, JSON, JSValue(..), makeObj, fromJSObject)
54

55
import qualified Ganeti.Constants as C
Jose A. Lopes's avatar
Jose A. Lopes committed
56
import qualified Ganeti.Hs2Py.OpDoc as OpDoc
57
import Ganeti.JSON (DictObject(..))
58
import Ganeti.OpParams
59
import Ganeti.PyValue ()
Iustin Pop's avatar
Iustin Pop committed
60
import Ganeti.Query.Language (queryTypeOpToRaw)
61
62
import Ganeti.THH
import Ganeti.Types
Jose A. Lopes's avatar
Jose A. Lopes committed
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

instance PyValue DiskIndex where
  showValue = showValue . unDiskIndex

instance PyValue IDiskParams where
  showValue _ = error "OpCodes.showValue(IDiskParams): unhandled case"

instance PyValue RecreateDisksInfo where
  showValue RecreateDisksAll = "[]"
  showValue (RecreateDisksIndices is) = showValue is
  showValue (RecreateDisksParams is) = showValue is

instance PyValue a => PyValue (SetParamsMods a) where
  showValue SetParamsEmpty = "[]"
  showValue _ = error "OpCodes.showValue(SetParamsMods): unhandled case"

instance PyValue a => PyValue (NonNegative a) where
  showValue = showValue . fromNonNegative
Thomas Thrainer's avatar
Thomas Thrainer committed
81

Jose A. Lopes's avatar
Jose A. Lopes committed
82
83
instance PyValue a => PyValue (NonEmpty a) where
  showValue = showValue . fromNonEmpty
Thomas Thrainer's avatar
Thomas Thrainer committed
84

Jose A. Lopes's avatar
Jose A. Lopes committed
85
86
87
88
89
-- FIXME: should use the 'toRaw' function instead of being harcoded or
-- perhaps use something similar to the NonNegative type instead of
-- using the declareSADT
instance PyValue ExportMode where
  showValue ExportModeLocal = show C.exportModeLocal
90
  showValue ExportModeRemote = show C.exportModeLocal
Jose A. Lopes's avatar
Jose A. Lopes committed
91
92
93

instance PyValue CVErrorCode where
  showValue = cVErrorCodeToRaw
Jose A. Lopes's avatar
Jose A. Lopes committed
94

Jose A. Lopes's avatar
Jose A. Lopes committed
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
instance PyValue VerifyOptionalChecks where
  showValue = verifyOptionalChecksToRaw

instance PyValue INicParams where
  showValue = error "instance PyValue INicParams: not implemented"

instance PyValue a => PyValue (JSObject a) where
  showValue obj =
    "{" ++ intercalate ", " (map showPair (fromJSObject obj)) ++ "}"
    where showPair (k, v) = show k ++ ":" ++ showValue v

instance PyValue JSValue where
  showValue (JSObject obj) = showValue obj
  showValue x = show x

110
type JobIdListOnly = Map String [(Bool, Either String JobId)]
Jose A. Lopes's avatar
Jose A. Lopes committed
111
112
113
114
115
116
117
118
119
120
121
122

type InstanceMultiAllocResponse =
  ([(Bool, Either String JobId)], NonEmptyString)

type QueryFieldDef =
  (NonEmptyString, NonEmptyString, TagKind, NonEmptyString)

type QueryResponse =
  ([QueryFieldDef], [[(QueryResultCode, JSValue)]])

type QueryFieldsResponse = [QueryFieldDef]

123
124
-- | OpCode representation.
--
125
126
-- We only implement a subset of Ganeti opcodes: those which are actually used
-- in the htools codebase.
127
$(genOpCode "OpCode"
Jose A. Lopes's avatar
Jose A. Lopes committed
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
  [ ("OpClusterPostInit",
     [t| Bool |],
     OpDoc.opClusterPostInit,
     [],
     [])
  , ("OpClusterDestroy",
     [t| NonEmptyString |],
     OpDoc.opClusterDestroy,
     [],
     [])
  , ("OpClusterQuery",
     [t| JSObject JSValue |],
     OpDoc.opClusterQuery,
     [],
     [])
143
  , ("OpClusterVerify",
Jose A. Lopes's avatar
Jose A. Lopes committed
144
145
     [t| JobIdListOnly |],
     OpDoc.opClusterVerify,
146
147
148
149
150
151
     [ pDebugSimulateErrors
     , pErrorCodes
     , pSkipChecks
     , pIgnoreErrors
     , pVerbose
     , pOptGroupName
Jose A. Lopes's avatar
Jose A. Lopes committed
152
153
     ],
     [])
154
  , ("OpClusterVerifyConfig",
Jose A. Lopes's avatar
Jose A. Lopes committed
155
156
     [t| Bool |],
     OpDoc.opClusterVerifyConfig,
157
158
159
160
     [ pDebugSimulateErrors
     , pErrorCodes
     , pIgnoreErrors
     , pVerbose
Jose A. Lopes's avatar
Jose A. Lopes committed
161
162
     ],
     [])
163
  , ("OpClusterVerifyGroup",
Jose A. Lopes's avatar
Jose A. Lopes committed
164
165
     [t| Bool |],
     OpDoc.opClusterVerifyGroup,
166
167
168
169
170
171
     [ pGroupName
     , pDebugSimulateErrors
     , pErrorCodes
     , pSkipChecks
     , pIgnoreErrors
     , pVerbose
Jose A. Lopes's avatar
Jose A. Lopes committed
172
173
174
175
176
177
178
     ],
     "group_name")
  , ("OpClusterVerifyDisks",
     [t| JobIdListOnly |],
     OpDoc.opClusterVerifyDisks,
     [],
     [])
179
  , ("OpGroupVerifyDisks",
Jose A. Lopes's avatar
Jose A. Lopes committed
180
181
     [t| (Map String String, [String], Map String [[String]]) |],
     OpDoc.opGroupVerifyDisks,
182
     [ pGroupName
Jose A. Lopes's avatar
Jose A. Lopes committed
183
184
     ],
     "group_name")
185
  , ("OpClusterRepairDiskSizes",
Jose A. Lopes's avatar
Jose A. Lopes committed
186
187
     [t| [(NonEmptyString, NonNegative Int, NonEmptyString, NonNegative Int)]|],
     OpDoc.opClusterRepairDiskSizes,
188
     [ pInstances
Jose A. Lopes's avatar
Jose A. Lopes committed
189
190
     ],
     [])
191
  , ("OpClusterConfigQuery",
Jose A. Lopes's avatar
Jose A. Lopes committed
192
193
     [t| [JSValue] |],
     OpDoc.opClusterConfigQuery,
194
     [ pOutputFields
Jose A. Lopes's avatar
Jose A. Lopes committed
195
196
     ],
     [])
197
  , ("OpClusterRename",
Jose A. Lopes's avatar
Jose A. Lopes committed
198
199
      [t| NonEmptyString |],
      OpDoc.opClusterRename,
200
     [ pName
Jose A. Lopes's avatar
Jose A. Lopes committed
201
202
     ],
     "name")
203
  , ("OpClusterSetParams",
204
     [t| Either () JobIdListOnly |],
Jose A. Lopes's avatar
Jose A. Lopes committed
205
     OpDoc.opClusterSetParams,
206
207
     [ pForce
     , pHvState
208
209
210
211
212
213
     , pDiskState
     , pVgName
     , pEnabledHypervisors
     , pClusterHvParams
     , pClusterBeParams
     , pOsHvp
214
     , pClusterOsParams
215
     , pClusterOsParamsPrivate
216
     , pGroupDiskParams
217
     , pCandidatePoolSize
218
     , pMaxRunningJobs
219
220
221
222
223
224
     , pUidPool
     , pAddUids
     , pRemoveUids
     , pMaintainNodeHealth
     , pPreallocWipeDisks
     , pNicParams
Jose A. Lopes's avatar
Jose A. Lopes committed
225
226
     , withDoc "Cluster-wide node parameter defaults" pNdParams
     , withDoc "Cluster-wide ipolicy specs" pIpolicy
227
228
     , pDrbdHelper
     , pDefaultIAllocator
229
     , pDefaultIAllocatorParams
230
     , pNetworkMacPrefix
231
     , pMasterNetdev
232
     , pMasterNetmask
233
234
235
236
     , pReservedLvs
     , pHiddenOs
     , pBlacklistedOs
     , pUseExternalMipScript
237
     , pEnabledDiskTemplates
238
     , pModifyEtcHosts
239
240
     , pClusterFileStorageDir
     , pClusterSharedFileStorageDir
241
     , pClusterGlusterStorageDir
242
     , pInstanceCommunicationNetwork
Hrvoje Ribicic's avatar
Hrvoje Ribicic committed
243
     , pZeroingImage
244
     , pCompressionTools
Jose A. Lopes's avatar
Jose A. Lopes committed
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
     ],
     [])
  , ("OpClusterRedistConf",
     [t| () |],
     OpDoc.opClusterRedistConf,
     [],
     [])
  , ("OpClusterActivateMasterIp",
     [t| () |],
     OpDoc.opClusterActivateMasterIp,
     [],
     [])
  , ("OpClusterDeactivateMasterIp",
     [t| () |],
     OpDoc.opClusterDeactivateMasterIp,
     [],
     [])
262
263
264
265
266
  , ("OpClusterRenewCrypto",
     [t| () |],
     OpDoc.opClusterRenewCrypto,
     [],
     [])
267
  , ("OpQuery",
Jose A. Lopes's avatar
Jose A. Lopes committed
268
269
     [t| QueryResponse |],
     OpDoc.opQuery,
270
271
272
273
     [ pQueryWhat
     , pUseLocking
     , pQueryFields
     , pQueryFilter
Jose A. Lopes's avatar
Jose A. Lopes committed
274
275
     ],
     "what")
276
  , ("OpQueryFields",
Jose A. Lopes's avatar
Jose A. Lopes committed
277
278
     [t| QueryFieldsResponse |],
     OpDoc.opQueryFields,
279
     [ pQueryWhat
Jose A. Lopes's avatar
Jose A. Lopes committed
280
281
282
     , pQueryFieldsFields
     ],
     "what")
283
  , ("OpOobCommand",
Jose A. Lopes's avatar
Jose A. Lopes committed
284
285
     [t| [[(QueryResultCode, JSValue)]] |],
     OpDoc.opOobCommand,
286
     [ pNodeNames
Jose A. Lopes's avatar
Jose A. Lopes committed
287
     , withDoc "List of node UUIDs to run the OOB command against" pNodeUuids
288
289
290
291
     , pOobCommand
     , pOobTimeout
     , pIgnoreStatus
     , pPowerDelay
Jose A. Lopes's avatar
Jose A. Lopes committed
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
     ],
     [])
  , ("OpRestrictedCommand",
     [t| [(Bool, String)] |],
     OpDoc.opRestrictedCommand,
     [ pUseLocking
     , withDoc
       "Nodes on which the command should be run (at least one)"
       pRequiredNodes
     , withDoc
       "Node UUIDs on which the command should be run (at least one)"
       pRequiredNodeUuids
     , pRestrictedCommand
     ],
     [])
Thomas Thrainer's avatar
Thomas Thrainer committed
307
  , ("OpNodeRemove",
Jose A. Lopes's avatar
Jose A. Lopes committed
308
309
     [t| () |],
      OpDoc.opNodeRemove,
Thomas Thrainer's avatar
Thomas Thrainer committed
310
311
     [ pNodeName
     , pNodeUuid
Jose A. Lopes's avatar
Jose A. Lopes committed
312
313
     ],
     "node_name")
314
  , ("OpNodeAdd",
Jose A. Lopes's avatar
Jose A. Lopes committed
315
316
     [t| () |],
      OpDoc.opNodeAdd,
317
318
319
320
321
322
323
324
325
326
     [ pNodeName
     , pHvState
     , pDiskState
     , pPrimaryIp
     , pSecondaryIp
     , pReadd
     , pNodeGroup
     , pMasterCapable
     , pVmCapable
     , pNdParams
Jose A. Lopes's avatar
Jose A. Lopes committed
327
328
     ],
     "node_name")
329
  , ("OpNodeQueryvols",
Jose A. Lopes's avatar
Jose A. Lopes committed
330
331
     [t| [JSValue] |],
     OpDoc.opNodeQueryvols,
332
     [ pOutputFields
Jose A. Lopes's avatar
Jose A. Lopes committed
333
334
335
     , withDoc "Empty list to query all nodes, node names otherwise" pNodes
     ],
     [])
336
  , ("OpNodeQueryStorage",
Jose A. Lopes's avatar
Jose A. Lopes committed
337
338
     [t| [[JSValue]] |],
     OpDoc.opNodeQueryStorage,
339
     [ pOutputFields
340
     , pOptStorageType
Jose A. Lopes's avatar
Jose A. Lopes committed
341
342
343
     , withDoc
       "Empty list to query all, list of names to query otherwise"
       pNodes
344
     , pStorageName
Jose A. Lopes's avatar
Jose A. Lopes committed
345
346
     ],
     [])
347
  , ("OpNodeModifyStorage",
Jose A. Lopes's avatar
Jose A. Lopes committed
348
349
     [t| () |],
     OpDoc.opNodeModifyStorage,
350
     [ pNodeName
Thomas Thrainer's avatar
Thomas Thrainer committed
351
     , pNodeUuid
352
353
354
     , pStorageType
     , pStorageName
     , pStorageChanges
Jose A. Lopes's avatar
Jose A. Lopes committed
355
356
     ],
     "node_name")
357
  , ("OpRepairNodeStorage",
Jose A. Lopes's avatar
Jose A. Lopes committed
358
359
      [t| () |],
      OpDoc.opRepairNodeStorage,
360
     [ pNodeName
Thomas Thrainer's avatar
Thomas Thrainer committed
361
     , pNodeUuid
362
363
364
     , pStorageType
     , pStorageName
     , pIgnoreConsistency
Jose A. Lopes's avatar
Jose A. Lopes committed
365
366
     ],
     "node_name")
367
  , ("OpNodeSetParams",
Jose A. Lopes's avatar
Jose A. Lopes committed
368
369
     [t| [(NonEmptyString, JSValue)] |],
     OpDoc.opNodeSetParams,
370
     [ pNodeName
Thomas Thrainer's avatar
Thomas Thrainer committed
371
     , pNodeUuid
372
373
374
375
     , pForce
     , pHvState
     , pDiskState
     , pMasterCandidate
Jose A. Lopes's avatar
Jose A. Lopes committed
376
     , withDoc "Whether to mark the node offline" pOffline
377
378
379
380
381
382
     , pDrained
     , pAutoPromote
     , pMasterCapable
     , pVmCapable
     , pSecondaryIp
     , pNdParams
383
     , pPowered
Jose A. Lopes's avatar
Jose A. Lopes committed
384
385
     ],
     "node_name")
386
  , ("OpNodePowercycle",
Jose A. Lopes's avatar
Jose A. Lopes committed
387
388
     [t| Maybe NonEmptyString |],
     OpDoc.opNodePowercycle,
389
     [ pNodeName
Thomas Thrainer's avatar
Thomas Thrainer committed
390
     , pNodeUuid
391
     , pForce
Jose A. Lopes's avatar
Jose A. Lopes committed
392
393
     ],
     "node_name")
394
  , ("OpNodeMigrate",
Jose A. Lopes's avatar
Jose A. Lopes committed
395
396
     [t| JobIdListOnly |],
     OpDoc.opNodeMigrate,
397
     [ pNodeName
Thomas Thrainer's avatar
Thomas Thrainer committed
398
     , pNodeUuid
399
400
401
     , pMigrationMode
     , pMigrationLive
     , pMigrationTargetNode
Thomas Thrainer's avatar
Thomas Thrainer committed
402
     , pMigrationTargetNodeUuid
403
404
405
     , pAllowRuntimeChgs
     , pIgnoreIpolicy
     , pIallocator
Jose A. Lopes's avatar
Jose A. Lopes committed
406
407
     ],
     "node_name")
408
  , ("OpNodeEvacuate",
Jose A. Lopes's avatar
Jose A. Lopes committed
409
410
     [t| JobIdListOnly |],
     OpDoc.opNodeEvacuate,
411
412
     [ pEarlyRelease
     , pNodeName
Thomas Thrainer's avatar
Thomas Thrainer committed
413
     , pNodeUuid
414
     , pRemoteNode
Thomas Thrainer's avatar
Thomas Thrainer committed
415
     , pRemoteNodeUuid
416
417
     , pIallocator
     , pEvacMode
Jose A. Lopes's avatar
Jose A. Lopes committed
418
419
     ],
     "node_name")
420
  , ("OpInstanceCreate",
Jose A. Lopes's avatar
Jose A. Lopes committed
421
422
     [t| [NonEmptyString] |],
     OpDoc.opInstanceCreate,
423
424
425
426
427
     [ pInstanceName
     , pForceVariant
     , pWaitForSync
     , pNameCheck
     , pIgnoreIpolicy
Jose A. Lopes's avatar
Jose A. Lopes committed
428
     , pOpportunisticLocking
429
430
     , pInstBeParams
     , pInstDisks
431
     , pOptDiskTemplate
432
433
434
435
436
437
438
439
440
441
442
443
     , pFileDriver
     , pFileStorageDir
     , pInstHvParams
     , pHypervisor
     , pIallocator
     , pResetDefaults
     , pIpCheck
     , pIpConflictsCheck
     , pInstCreateMode
     , pInstNics
     , pNoInstall
     , pInstOsParams
444
445
     , pInstOsParamsPrivate
     , pInstOsParamsSecret
446
447
     , pInstOs
     , pPrimaryNode
Thomas Thrainer's avatar
Thomas Thrainer committed
448
     , pPrimaryNodeUuid
449
     , pSecondaryNode
Thomas Thrainer's avatar
Thomas Thrainer committed
450
     , pSecondaryNodeUuid
451
452
453
454
455
     , pSourceHandshake
     , pSourceInstance
     , pSourceShutdownTimeout
     , pSourceX509Ca
     , pSrcNode
Thomas Thrainer's avatar
Thomas Thrainer committed
456
     , pSrcNodeUuid
457
     , pSrcPath
458
     , pBackupCompress
459
460
     , pStartInstance
     , pInstTags
461
     , pInstanceCommunication
Jose A. Lopes's avatar
Jose A. Lopes committed
462
463
     ],
     "instance_name")
464
  , ("OpInstanceMultiAlloc",
Jose A. Lopes's avatar
Jose A. Lopes committed
465
466
467
468
     [t| InstanceMultiAllocResponse |],
     OpDoc.opInstanceMultiAlloc,
     [ pOpportunisticLocking
     , pIallocator
469
     , pMultiAllocInstances
Jose A. Lopes's avatar
Jose A. Lopes committed
470
471
     ],
     [])
472
  , ("OpInstanceReinstall",
Jose A. Lopes's avatar
Jose A. Lopes committed
473
474
     [t| () |],
     OpDoc.opInstanceReinstall,
475
     [ pInstanceName
476
     , pInstanceUuid
477
478
479
     , pForceVariant
     , pInstOs
     , pTempOsParams
480
481
     , pTempOsParamsPrivate
     , pTempOsParamsSecret
Jose A. Lopes's avatar
Jose A. Lopes committed
482
483
     ],
     "instance_name")
484
  , ("OpInstanceRemove",
Jose A. Lopes's avatar
Jose A. Lopes committed
485
486
     [t| () |],
     OpDoc.opInstanceRemove,
487
     [ pInstanceName
488
     , pInstanceUuid
489
490
     , pShutdownTimeout
     , pIgnoreFailures
Jose A. Lopes's avatar
Jose A. Lopes committed
491
492
     ],
     "instance_name")
493
  , ("OpInstanceRename",
Jose A. Lopes's avatar
Jose A. Lopes committed
494
495
     [t| NonEmptyString |],
     OpDoc.opInstanceRename,
496
     [ pInstanceName
497
     , pInstanceUuid
Jose A. Lopes's avatar
Jose A. Lopes committed
498
     , withDoc "New instance name" pNewName
499
500
     , pNameCheck
     , pIpCheck
Jose A. Lopes's avatar
Jose A. Lopes committed
501
502
     ],
     [])
503
  , ("OpInstanceStartup",
Jose A. Lopes's avatar
Jose A. Lopes committed
504
505
     [t| () |],
     OpDoc.opInstanceStartup,
506
     [ pInstanceName
507
     , pInstanceUuid
508
509
510
511
512
513
     , pForce
     , pIgnoreOfflineNodes
     , pTempHvParams
     , pTempBeParams
     , pNoRemember
     , pStartupPaused
Jose A. Lopes's avatar
Jose A. Lopes committed
514
515
     ],
     "instance_name")
516
  , ("OpInstanceShutdown",
Jose A. Lopes's avatar
Jose A. Lopes committed
517
518
     [t| () |],
     OpDoc.opInstanceShutdown,
519
     [ pInstanceName
520
     , pInstanceUuid
521
     , pForce
522
     , pIgnoreOfflineNodes
Jose A. Lopes's avatar
Jose A. Lopes committed
523
     , pShutdownTimeout'
524
     , pNoRemember
Jose A. Lopes's avatar
Jose A. Lopes committed
525
526
     ],
     "instance_name")
527
  , ("OpInstanceReboot",
Jose A. Lopes's avatar
Jose A. Lopes committed
528
529
     [t| () |],
     OpDoc.opInstanceReboot,
530
     [ pInstanceName
531
     , pInstanceUuid
532
533
534
     , pShutdownTimeout
     , pIgnoreSecondaries
     , pRebootType
Jose A. Lopes's avatar
Jose A. Lopes committed
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
     ],
     "instance_name")
  , ("OpInstanceReplaceDisks",
     [t| () |],
     OpDoc.opInstanceReplaceDisks,
     [ pInstanceName
     , pInstanceUuid
     , pEarlyRelease
     , pIgnoreIpolicy
     , pReplaceDisksMode
     , pReplaceDisksList
     , pRemoteNode
     , pRemoteNodeUuid
     , pIallocator
     ],
     "instance_name")
  , ("OpInstanceFailover",
     [t| () |],
     OpDoc.opInstanceFailover,
     [ pInstanceName
     , pInstanceUuid
     , pShutdownTimeout
     , pIgnoreConsistency
     , pMigrationTargetNode
     , pMigrationTargetNodeUuid
     , pIgnoreIpolicy
Thomas Thrainer's avatar
Thomas Thrainer committed
561
     , pMigrationCleanup
Jose A. Lopes's avatar
Jose A. Lopes committed
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
     , pIallocator
     ],
     "instance_name")
  , ("OpInstanceMigrate",
     [t| () |],
     OpDoc.opInstanceMigrate,
     [ pInstanceName
     , pInstanceUuid
     , pMigrationMode
     , pMigrationLive
     , pMigrationTargetNode
     , pMigrationTargetNodeUuid
     , pAllowRuntimeChgs
     , pIgnoreIpolicy
     , pMigrationCleanup
     , pIallocator
     , pAllowFailover
     ],
     "instance_name")
581
  , ("OpInstanceMove",
Jose A. Lopes's avatar
Jose A. Lopes committed
582
583
     [t| () |],
     OpDoc.opInstanceMove,
584
     [ pInstanceName
585
     , pInstanceUuid
586
587
588
     , pShutdownTimeout
     , pIgnoreIpolicy
     , pMoveTargetNode
Thomas Thrainer's avatar
Thomas Thrainer committed
589
     , pMoveTargetNodeUuid
590
     , pMoveCompress
591
     , pIgnoreConsistency
Jose A. Lopes's avatar
Jose A. Lopes committed
592
593
     ],
     "instance_name")
594
  , ("OpInstanceConsole",
Jose A. Lopes's avatar
Jose A. Lopes committed
595
596
     [t| JSObject JSValue |],
     OpDoc.opInstanceConsole,
597
598
     [ pInstanceName
     , pInstanceUuid
Jose A. Lopes's avatar
Jose A. Lopes committed
599
600
     ],
     "instance_name")
601
  , ("OpInstanceActivateDisks",
Jose A. Lopes's avatar
Jose A. Lopes committed
602
603
     [t| [(NonEmptyString, NonEmptyString, NonEmptyString)] |],
     OpDoc.opInstanceActivateDisks,
604
     [ pInstanceName
605
     , pInstanceUuid
606
607
     , pIgnoreDiskSize
     , pWaitForSyncFalse
Jose A. Lopes's avatar
Jose A. Lopes committed
608
609
     ],
     "instance_name")
610
  , ("OpInstanceDeactivateDisks",
Jose A. Lopes's avatar
Jose A. Lopes committed
611
612
     [t| () |],
     OpDoc.opInstanceDeactivateDisks,
613
     [ pInstanceName
614
     , pInstanceUuid
615
     , pForce
Jose A. Lopes's avatar
Jose A. Lopes committed
616
617
     ],
     "instance_name")
618
  , ("OpInstanceRecreateDisks",
Jose A. Lopes's avatar
Jose A. Lopes committed
619
620
     [t| () |],
     OpDoc.opInstanceRecreateDisks,
621
     [ pInstanceName
622
     , pInstanceUuid
623
     , pRecreateDisksInfo
Jose A. Lopes's avatar
Jose A. Lopes committed
624
625
     , withDoc "New instance nodes, if relocation is desired" pNodes
     , withDoc "New instance node UUIDs, if relocation is desired" pNodeUuids
626
     , pIallocator
Jose A. Lopes's avatar
Jose A. Lopes committed
627
628
     ],
     "instance_name")
629
  , ("OpInstanceQueryData",
Jose A. Lopes's avatar
Jose A. Lopes committed
630
631
     [t| JSObject (JSObject JSValue) |],
     OpDoc.opInstanceQueryData,
632
633
634
     [ pUseLocking
     , pInstances
     , pStatic
Jose A. Lopes's avatar
Jose A. Lopes committed
635
636
     ],
     [])
637
  , ("OpInstanceSetParams",
Jose A. Lopes's avatar
Jose A. Lopes committed
638
639
      [t| [(NonEmptyString, JSValue)] |],
      OpDoc.opInstanceSetParams,
640
     [ pInstanceName
641
     , pInstanceUuid
642
643
644
645
646
647
648
649
     , pForce
     , pForceVariant
     , pIgnoreIpolicy
     , pInstParamsNicChanges
     , pInstParamsDiskChanges
     , pInstBeParams
     , pRuntimeMem
     , pInstHvParams
650
     , pOptDiskTemplate
651
     , pPrimaryNode
Thomas Thrainer's avatar
Thomas Thrainer committed
652
     , pPrimaryNodeUuid
Jose A. Lopes's avatar
Jose A. Lopes committed
653
654
655
656
     , withDoc "Secondary node (used when changing disk template)" pRemoteNode
     , withDoc
       "Secondary node UUID (used when changing disk template)"
       pRemoteNodeUuid
657
658
     , pOsNameChange
     , pInstOsParams
659
     , pInstOsParamsPrivate
660
     , pWaitForSync
Jose A. Lopes's avatar
Jose A. Lopes committed
661
     , withDoc "Whether to mark the instance as offline" pOffline
662
     , pIpConflictsCheck
Dimitris Aragiorgis's avatar
Dimitris Aragiorgis committed
663
     , pHotplug
664
     , pHotplugIfPossible
665
     , pOptInstanceCommunication
Jose A. Lopes's avatar
Jose A. Lopes committed
666
667
     ],
     "instance_name")
668
  , ("OpInstanceGrowDisk",
Jose A. Lopes's avatar
Jose A. Lopes committed
669
670
     [t| () |],
     OpDoc.opInstanceGrowDisk,
671
     [ pInstanceName
672
     , pInstanceUuid
673
674
675
676
     , pWaitForSync
     , pDiskIndex
     , pDiskChgAmount
     , pDiskChgAbsolute
Jose A. Lopes's avatar
Jose A. Lopes committed
677
678
     ],
     "instance_name")
679
  , ("OpInstanceChangeGroup",
Jose A. Lopes's avatar
Jose A. Lopes committed
680
681
     [t| JobIdListOnly |],
     OpDoc.opInstanceChangeGroup,
682
     [ pInstanceName
683
     , pInstanceUuid
684
685
686
     , pEarlyRelease
     , pIallocator
     , pTargetGroups
Jose A. Lopes's avatar
Jose A. Lopes committed
687
688
     ],
     "instance_name")
Iustin Pop's avatar
Iustin Pop committed
689
  , ("OpGroupAdd",
690
     [t| Either () JobIdListOnly |],
Jose A. Lopes's avatar
Jose A. Lopes committed
691
     OpDoc.opGroupAdd,
Iustin Pop's avatar
Iustin Pop committed
692
693
694
     [ pGroupName
     , pNodeGroupAllocPolicy
     , pGroupNodeParams
695
     , pGroupDiskParams
Iustin Pop's avatar
Iustin Pop committed
696
697
     , pHvState
     , pDiskState
Jose A. Lopes's avatar
Jose A. Lopes committed
698
699
700
     , withDoc "Group-wide ipolicy specs" pIpolicy
     ],
     "group_name")
Iustin Pop's avatar
Iustin Pop committed
701
  , ("OpGroupAssignNodes",
Jose A. Lopes's avatar
Jose A. Lopes committed
702
703
     [t| () |],
     OpDoc.opGroupAssignNodes,
Iustin Pop's avatar
Iustin Pop committed
704
705
     [ pGroupName
     , pForce
Jose A. Lopes's avatar
Jose A. Lopes committed
706
707
708
709
     , withDoc "List of nodes to assign" pRequiredNodes
     , withDoc "List of node UUIDs to assign" pRequiredNodeUuids
     ],
     "group_name")
Iustin Pop's avatar
Iustin Pop committed
710
  , ("OpGroupSetParams",
Jose A. Lopes's avatar
Jose A. Lopes committed
711
712
     [t| [(NonEmptyString, JSValue)] |],
     OpDoc.opGroupSetParams,
Iustin Pop's avatar
Iustin Pop committed
713
714
715
     [ pGroupName
     , pNodeGroupAllocPolicy
     , pGroupNodeParams
716
     , pGroupDiskParams
Iustin Pop's avatar
Iustin Pop committed
717
718
     , pHvState
     , pDiskState
Jose A. Lopes's avatar
Jose A. Lopes committed
719
720
721
     , withDoc "Group-wide ipolicy specs" pIpolicy
     ],
     "group_name")
Iustin Pop's avatar
Iustin Pop committed
722
  , ("OpGroupRemove",
Jose A. Lopes's avatar
Jose A. Lopes committed
723
724
725
726
727
     [t| () |],
     OpDoc.opGroupRemove,
     [ pGroupName
     ],
     "group_name")
Iustin Pop's avatar
Iustin Pop committed
728
  , ("OpGroupRename",
Jose A. Lopes's avatar
Jose A. Lopes committed
729
730
     [t| NonEmptyString |],
     OpDoc.opGroupRename,
Iustin Pop's avatar
Iustin Pop committed
731
     [ pGroupName
Jose A. Lopes's avatar
Jose A. Lopes committed
732
733
734
     , withDoc "New group name" pNewName
     ],
     [])
Iustin Pop's avatar
Iustin Pop committed
735
  , ("OpGroupEvacuate",
Jose A. Lopes's avatar
Jose A. Lopes committed
736
737
     [t| JobIdListOnly |],
     OpDoc.opGroupEvacuate,
Iustin Pop's avatar
Iustin Pop committed
738
739
740
741
     [ pGroupName
     , pEarlyRelease
     , pIallocator
     , pTargetGroups
Jose A. Lopes's avatar
Jose A. Lopes committed
742
743
     ],
     "group_name")
Iustin Pop's avatar
Iustin Pop committed
744
  , ("OpOsDiagnose",
Jose A. Lopes's avatar
Jose A. Lopes committed
745
746
     [t| [[JSValue]] |],
     OpDoc.opOsDiagnose,
Iustin Pop's avatar
Iustin Pop committed
747
     [ pOutputFields
Jose A. Lopes's avatar
Jose A. Lopes committed
748
749
750
     , withDoc "Which operating systems to diagnose" pNames
     ],
     [])
751
  , ("OpExtStorageDiagnose",
Jose A. Lopes's avatar
Jose A. Lopes committed
752
753
     [t| [[JSValue]] |],
     OpDoc.opExtStorageDiagnose,
754
     [ pOutputFields
Jose A. Lopes's avatar
Jose A. Lopes committed
755
756
757
     , withDoc "Which ExtStorage Provider to diagnose" pNames
     ],
     [])
Iustin Pop's avatar
Iustin Pop committed
758
  , ("OpBackupPrepare",
Jose A. Lopes's avatar
Jose A. Lopes committed
759
760
     [t| Maybe (JSObject JSValue) |],
     OpDoc.opBackupPrepare,
Iustin Pop's avatar
Iustin Pop committed
761
     [ pInstanceName
762
     , pInstanceUuid
Iustin Pop's avatar
Iustin Pop committed
763
     , pExportMode
Jose A. Lopes's avatar
Jose A. Lopes committed
764
765
     ],
     "instance_name")
Iustin Pop's avatar
Iustin Pop committed
766
  , ("OpBackupExport",
Jose A. Lopes's avatar
Jose A. Lopes committed
767
768
     [t| (Bool, [Bool]) |],
     OpDoc.opBackupExport,
Iustin Pop's avatar
Iustin Pop committed
769
     [ pInstanceName
770
     , pInstanceUuid
771
     , pBackupCompress
Iustin Pop's avatar
Iustin Pop committed
772
773
     , pShutdownTimeout
     , pExportTargetNode
Thomas Thrainer's avatar
Thomas Thrainer committed
774
     , pExportTargetNodeUuid
775
     , pShutdownInstance
Iustin Pop's avatar
Iustin Pop committed
776
777
     , pRemoveInstance
     , pIgnoreRemoveFailures
Jose A. Lopes's avatar
Jose A. Lopes committed
778
     , defaultField [| ExportModeLocal |] pExportMode
Iustin Pop's avatar
Iustin Pop committed
779
780
     , pX509KeyName
     , pX509DestCA
781
     , pZeroFreeSpace
782
783
     , pZeroingTimeoutFixed
     , pZeroingTimeoutPerMiB
Jose A. Lopes's avatar
Jose A. Lopes committed
784
785
     ],
     "instance_name")
Iustin Pop's avatar
Iustin Pop committed
786
  , ("OpBackupRemove",
Jose A. Lopes's avatar
Jose A. Lopes committed
787
788
     [t| () |],
     OpDoc.opBackupRemove,
789
790
     [ pInstanceName
     , pInstanceUuid
Jose A. Lopes's avatar
Jose A. Lopes committed
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
     ],
     "instance_name")
  , ("OpTagsGet",
     [t| [NonEmptyString] |],
     OpDoc.opTagsGet,
     [ pTagsObject
     , pUseLocking
     , withDoc "Name of object to retrieve tags from" pTagsName
     ],
     "name")
  , ("OpTagsSearch",
     [t| [(NonEmptyString, NonEmptyString)] |],
     OpDoc.opTagsSearch,
     [ pTagSearchPattern
     ],
     "pattern")
  , ("OpTagsSet",
     [t| () |],
     OpDoc.opTagsSet,
     [ pTagsObject
     , pTagsList
     , withDoc "Name of object where tag(s) should be added" pTagsName
     ],
     [])
  , ("OpTagsDel",
     [t| () |],
     OpDoc.opTagsDel,
     [ pTagsObject
     , pTagsList
     , withDoc "Name of object where tag(s) should be deleted" pTagsName
     ],
     [])
  , ("OpTestDelay",
     [t| () |],
     OpDoc.opTestDelay,
     [ pDelayDuration
     , pDelayOnMaster
     , pDelayOnNodes
     , pDelayOnNodeUuids
     , pDelayRepeat
831
     , pDelayInterruptible
Jose A. Lopes's avatar
Jose A. Lopes committed
832
833
     ],
     "duration")
Iustin Pop's avatar
Iustin Pop committed
834
  , ("OpTestAllocator",
Jose A. Lopes's avatar
Jose A. Lopes committed
835
     [t| String |],
Jose A. Lopes's avatar
Jose A. Lopes committed
836
     OpDoc.opTestAllocator,
Iustin Pop's avatar
Iustin Pop committed
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
     [ pIAllocatorDirection
     , pIAllocatorMode
     , pIAllocatorReqName
     , pIAllocatorNics
     , pIAllocatorDisks
     , pHypervisor
     , pIallocator
     , pInstTags
     , pIAllocatorMemory
     , pIAllocatorVCpus
     , pIAllocatorOs
     , pDiskTemplate
     , pIAllocatorInstances
     , pIAllocatorEvacMode
     , pTargetGroups
     , pIAllocatorSpindleUse
     , pIAllocatorCount
Jose A. Lopes's avatar
Jose A. Lopes committed
854
855
     ],
     "iallocator")
Iustin Pop's avatar
Iustin Pop committed
856
  , ("OpTestJqueue",
Jose A. Lopes's avatar
Jose A. Lopes committed
857
     [t| Bool |],
Jose A. Lopes's avatar
Jose A. Lopes committed
858
     OpDoc.opTestJqueue,
Iustin Pop's avatar
Iustin Pop committed
859
860
861
862
     [ pJQueueNotifyWaitLock
     , pJQueueNotifyExec
     , pJQueueLogMessages
     , pJQueueFail
Jose A. Lopes's avatar
Jose A. Lopes committed
863
864
     ],
     [])
Iustin Pop's avatar
Iustin Pop committed
865
  , ("OpTestDummy",
Jose A. Lopes's avatar
Jose A. Lopes committed
866
867
     [t| () |],
     OpDoc.opTestDummy,
Iustin Pop's avatar
Iustin Pop committed
868
869
870
871
     [ pTestDummyResult
     , pTestDummyMessages
     , pTestDummyFail
     , pTestDummySubmitJobs
Jose A. Lopes's avatar
Jose A. Lopes committed
872
873
     ],
     [])
874
  , ("OpNetworkAdd",
Jose A. Lopes's avatar
Jose A. Lopes committed
875
876
     [t| () |],
     OpDoc.opNetworkAdd,
877
878
879
880
881
882
883
     [ pNetworkName
     , pNetworkAddress4
     , pNetworkGateway4
     , pNetworkAddress6
     , pNetworkGateway6
     , pNetworkMacPrefix
     , pNetworkAddRsvdIps
Iustin Pop's avatar
Iustin Pop committed
884
     , pIpConflictsCheck
Jose A. Lopes's avatar
Jose A. Lopes committed
885
886
887
     , withDoc "Network tags" pInstTags
     ],
     "network_name")
888
  , ("OpNetworkRemove",
Jose A. Lopes's avatar
Jose A. Lopes committed
889
890
     [t| () |],
     OpDoc.opNetworkRemove,
891
892
     [ pNetworkName
     , pForce
Jose A. Lopes's avatar
Jose A. Lopes committed
893
894
     ],
     "network_name")
895
  , ("OpNetworkSetParams",
Jose A. Lopes's avatar
Jose A. Lopes committed
896
897
     [t| () |],
     OpDoc.opNetworkSetParams,
898
899
900
901
902
     [ pNetworkName
     , pNetworkGateway4
     , pNetworkAddress6
     , pNetworkGateway6
     , pNetworkMacPrefix
Jose A. Lopes's avatar
Jose A. Lopes committed
903
     , withDoc "Which external IP addresses to reserve" pNetworkAddRsvdIps
904
     , pNetworkRemoveRsvdIps
Jose A. Lopes's avatar
Jose A. Lopes committed
905
906
     ],
     "network_name")
907
  , ("OpNetworkConnect",
Jose A. Lopes's avatar
Jose A. Lopes committed
908
909
     [t| () |],
     OpDoc.opNetworkConnect,
910
911
912
913
914
     [ pGroupName
     , pNetworkName
     , pNetworkMode
     , pNetworkLink
     , pIpConflictsCheck
Jose A. Lopes's avatar
Jose A. Lopes committed
915
916
     ],
     "network_name")
917
  , ("OpNetworkDisconnect",
Jose A. Lopes's avatar
Jose A. Lopes committed
918
919
     [t| () |],
     OpDoc.opNetworkDisconnect,
920
921
     [ pGroupName
     , pNetworkName
Jose A. Lopes's avatar
Jose A. Lopes committed
922
923
     ],
     "network_name")
924
  ])
925

926
-- | Returns the OP_ID for a given opcode value.
927
$(genOpID ''OpCode "opID")
928

929
930
931
-- | A list of all defined/supported opcode IDs.
$(genAllOpIDs ''OpCode "allOpIDs")

932
933
934
935
-- | Convert the opcode name to lowercase with underscores and strip
-- the @Op@ prefix.
$(genOpLowerStrip (C.opcodeReasonSrcOpcode ++ ":") ''OpCode "opReasonSrcID")

936
instance JSON OpCode where
937
938
  readJSON = loadOpCode
  showJSON = saveOpCode
939

Iustin Pop's avatar
Iustin Pop committed
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
-- | Generates the summary value for an opcode.
opSummaryVal :: OpCode -> Maybe String
opSummaryVal OpClusterVerifyGroup { opGroupName = s } = Just (fromNonEmpty s)
opSummaryVal OpGroupVerifyDisks { opGroupName = s } = Just (fromNonEmpty s)
opSummaryVal OpClusterRename { opName = s } = Just (fromNonEmpty s)
opSummaryVal OpQuery { opWhat = s } = Just (queryTypeOpToRaw s)
opSummaryVal OpQueryFields { opWhat = s } = Just (queryTypeOpToRaw s)
opSummaryVal OpNodeRemove { opNodeName = s } = Just (fromNonEmpty s)
opSummaryVal OpNodeAdd { opNodeName = s } = Just (fromNonEmpty s)
opSummaryVal OpNodeModifyStorage { opNodeName = s } = Just (fromNonEmpty s)
opSummaryVal OpRepairNodeStorage  { opNodeName = s } = Just (fromNonEmpty s)
opSummaryVal OpNodeSetParams { opNodeName = s } = Just (fromNonEmpty s)
opSummaryVal OpNodePowercycle { opNodeName = s } = Just (fromNonEmpty s)
opSummaryVal OpNodeMigrate { opNodeName = s } = Just (fromNonEmpty s)
opSummaryVal OpNodeEvacuate { opNodeName = s } = Just (fromNonEmpty s)
opSummaryVal OpInstanceCreate { opInstanceName = s } = Just s
opSummaryVal OpInstanceReinstall { opInstanceName = s } = Just s
opSummaryVal OpInstanceRemove { opInstanceName = s } = Just s
-- FIXME: instance rename should show both names; currently it shows none
-- opSummaryVal OpInstanceRename { opInstanceName = s } = Just s
opSummaryVal OpInstanceStartup { opInstanceName = s } = Just s
opSummaryVal OpInstanceShutdown { opInstanceName = s } = Just s
opSummaryVal OpInstanceReboot { opInstanceName = s } = Just s
opSummaryVal OpInstanceReplaceDisks { opInstanceName = s } = Just s
opSummaryVal OpInstanceFailover { opInstanceName = s } = Just s
opSummaryVal OpInstanceMigrate { opInstanceName = s } = Just s
opSummaryVal OpInstanceMove { opInstanceName = s } = Just s
opSummaryVal OpInstanceConsole { opInstanceName = s } = Just s
opSummaryVal OpInstanceActivateDisks { opInstanceName = s } = Just s
opSummaryVal OpInstanceDeactivateDisks { opInstanceName = s } = Just s
opSummaryVal OpInstanceRecreateDisks { opInstanceName = s } = Just s
opSummaryVal OpInstanceSetParams { opInstanceName = s } = Just s
opSummaryVal OpInstanceGrowDisk { opInstanceName = s } = Just s
opSummaryVal OpInstanceChangeGroup { opInstanceName = s } = Just s
opSummaryVal OpGroupAdd { opGroupName = s } = Just (fromNonEmpty s)
opSummaryVal OpGroupAssignNodes { opGroupName = s } = Just (fromNonEmpty s)
opSummaryVal OpGroupSetParams { opGroupName = s } = Just (fromNonEmpty s)
opSummaryVal OpGroupRemove { opGroupName = s } = Just (fromNonEmpty s)
opSummaryVal OpGroupEvacuate { opGroupName = s } = Just (fromNonEmpty s)
opSummaryVal OpBackupPrepare { opInstanceName = s } = Just s
opSummaryVal OpBackupExport { opInstanceName = s } = Just s
opSummaryVal OpBackupRemove { opInstanceName = s } = Just s
Jose A. Lopes's avatar
Jose A. Lopes committed
982
opSummaryVal OpTagsGet { opKind = s } = Just (show s)
Iustin Pop's avatar
Iustin Pop committed
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
opSummaryVal OpTagsSearch { opTagSearchPattern = s } = Just (fromNonEmpty s)
opSummaryVal OpTestDelay { opDelayDuration = d } = Just (show d)
opSummaryVal OpTestAllocator { opIallocator = s } =
  -- FIXME: Python doesn't handle None fields well, so we have behave the same
  Just $ maybe "None" fromNonEmpty s
opSummaryVal OpNetworkAdd { opNetworkName = s} = Just (fromNonEmpty s)
opSummaryVal OpNetworkRemove { opNetworkName = s} = Just (fromNonEmpty s)
opSummaryVal OpNetworkSetParams { opNetworkName = s} = Just (fromNonEmpty s)
opSummaryVal OpNetworkConnect { opNetworkName = s} = Just (fromNonEmpty s)
opSummaryVal OpNetworkDisconnect { opNetworkName = s} = Just (fromNonEmpty s)
opSummaryVal _ = Nothing

-- | Computes the summary of the opcode.
opSummary :: OpCode -> String
opSummary op =
  case opSummaryVal op of
    Nothing -> op_suffix
    Just s -> op_suffix ++ "(" ++ s ++ ")"
  where op_suffix = drop 3 $ opID op

1003
1004
1005
1006
1007
1008
1009
-- | Generic\/common opcode parameters.
$(buildObject "CommonOpParams" "op"
  [ pDryRun
  , pDebugLevel
  , pOpPriority
  , pDependencies
  , pComment
1010
  , pReason
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
  ])

-- | Default common parameter values.
defOpParams :: CommonOpParams
defOpParams =
  CommonOpParams { opDryRun     = Nothing
                 , opDebugLevel = Nothing
                 , opPriority   = OpPrioNormal
                 , opDepends    = Nothing
                 , opComment    = Nothing
1021
                 , opReason     = []
1022
1023
                 }

1024
1025
1026
1027
1028
1029
1030
-- | Resolve relative dependencies to absolute ones, given the job ID.
resolveDependsCommon :: (Monad m) => CommonOpParams -> JobId -> m CommonOpParams
resolveDependsCommon p@(CommonOpParams { opDepends = Just deps}) jid = do
  deps' <- mapM (`absoluteJobDependency` jid) deps
  return p { opDepends = Just deps' }
resolveDependsCommon p _ = return p

1031
-- | The top-level opcode type.
Iustin Pop's avatar
Iustin Pop committed
1032
1033
1034
data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams
                             , metaOpCode :: OpCode
                             } deriving (Show, Eq)
1035

1036
1037
1038
1039
1040
1041
-- | Resolve relative dependencies to absolute ones, given the job Id.
resolveDependencies :: (Monad m) => MetaOpCode -> JobId -> m MetaOpCode
resolveDependencies mopc jid = do
  mpar <- resolveDependsCommon (metaParams mopc) jid
  return (mopc { metaParams = mpar })

1042
1043
1044
-- | JSON serialisation for 'MetaOpCode'.
showMeta :: MetaOpCode -> JSValue
showMeta (MetaOpCode params op) =
1045
  let objparams = toDict params
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
      objop = toDictOpCode op
  in makeObj (objparams ++ objop)

-- | JSON deserialisation for 'MetaOpCode'
readMeta :: JSValue -> Text.JSON.Result MetaOpCode
readMeta v = do
  meta <- readJSON v
  op <- readJSON v
  return $ MetaOpCode meta op

instance JSON MetaOpCode where
  showJSON = showMeta
  readJSON = readMeta

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

-- | Sets the comment on a meta opcode.
setOpComment :: String -> MetaOpCode -> MetaOpCode
setOpComment comment (MetaOpCode common op) =
  MetaOpCode (common { opComment = Just comment}) op
1069
1070
1071
1072
1073

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