Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / OpCodes.hs @ 0cffcdb1

History | View | Annotate | Download (27.2 kB)

1
{-# LANGUAGE ExistentialQuantification, TemplateHaskell #-}
2
{-# OPTIONS_GHC -fno-warn-orphans #-}
3

    
4
{-| Implementation of the opcodes.
5

    
6
-}
7

    
8
{-
9

    
10
Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Google Inc.
11

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

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

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

    
27
-}
28

    
29
module Ganeti.OpCodes
30
  ( pyClasses
31
  , OpCode(..)
32
  , ReplaceDisksMode(..)
33
  , DiskIndex
34
  , mkDiskIndex
35
  , unDiskIndex
36
  , opID
37
  , allOpIDs
38
  , allOpFields
39
  , opSummary
40
  , CommonOpParams(..)
41
  , defOpParams
42
  , MetaOpCode(..)
43
  , resolveDependencies
44
  , wrapOpCode
45
  , setOpComment
46
  , setOpPriority
47
  ) where
48

    
49
import Text.JSON (readJSON, JSObject, JSON, JSValue(..), makeObj, fromJSObject)
50
import qualified Text.JSON
51

    
52
import Ganeti.THH
53

    
54
import qualified Ganeti.Hs2Py.OpDoc as OpDoc
55
import Ganeti.OpParams
56
import Ganeti.PyValue ()
57
import Ganeti.Types
58
import Ganeti.Query.Language (queryTypeOpToRaw)
59

    
60
import Data.List (intercalate)
61
import Data.Map (Map)
62

    
63
import qualified Ganeti.Constants as C
64

    
65
instance PyValue DiskIndex where
66
  showValue = showValue . unDiskIndex
67

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

    
71
instance PyValue RecreateDisksInfo where
72
  showValue RecreateDisksAll = "[]"
73
  showValue (RecreateDisksIndices is) = showValue is
74
  showValue (RecreateDisksParams is) = showValue is
75

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

    
80
instance PyValue a => PyValue (NonNegative a) where
81
  showValue = showValue . fromNonNegative
82

    
83
instance PyValue a => PyValue (NonEmpty a) where
84
  showValue = showValue . fromNonEmpty
85

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

    
93
instance PyValue CVErrorCode where
94
  showValue = cVErrorCodeToRaw
95

    
96
instance PyValue VerifyOptionalChecks where
97
  showValue = verifyOptionalChecksToRaw
98

    
99
instance PyValue INicParams where
100
  showValue = error "instance PyValue INicParams: not implemented"
101

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

    
107
instance PyValue JSValue where
108
  showValue (JSObject obj) = showValue obj
109
  showValue x = show x
110

    
111
type JobIdListOnly = Map String [(Bool, Either String JobId)]
112

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

    
116
type QueryFieldDef =
117
  (NonEmptyString, NonEmptyString, TagKind, NonEmptyString)
118

    
119
type QueryResponse =
120
  ([QueryFieldDef], [[(QueryResultCode, JSValue)]])
121

    
122
type QueryFieldsResponse = [QueryFieldDef]
123

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

    
921
-- | Returns the OP_ID for a given opcode value.
922
$(genOpID ''OpCode "opID")
923

    
924
-- | A list of all defined/supported opcode IDs.
925
$(genAllOpIDs ''OpCode "allOpIDs")
926

    
927
instance JSON OpCode where
928
  readJSON = loadOpCode
929
  showJSON = saveOpCode
930

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

    
986
-- | Computes the summary of the opcode.
987
opSummary :: OpCode -> String
988
opSummary op =
989
  case opSummaryVal op of
990
    Nothing -> op_suffix
991
    Just s -> op_suffix ++ "(" ++ s ++ ")"
992
  where op_suffix = drop 3 $ opID op
993

    
994
-- | Generic\/common opcode parameters.
995
$(buildObject "CommonOpParams" "op"
996
  [ pDryRun
997
  , pDebugLevel
998
  , pOpPriority
999
  , pDependencies
1000
  , pComment
1001
  , pReason
1002
  ])
1003

    
1004
-- | Default common parameter values.
1005
defOpParams :: CommonOpParams
1006
defOpParams =
1007
  CommonOpParams { opDryRun     = Nothing
1008
                 , opDebugLevel = Nothing
1009
                 , opPriority   = OpPrioNormal
1010
                 , opDepends    = Nothing
1011
                 , opComment    = Nothing
1012
                 , opReason     = []
1013
                 }
1014

    
1015
-- | Resolve relative dependencies to absolute ones, given the job ID.
1016
resolveDependsCommon :: (Monad m) => CommonOpParams -> JobId -> m CommonOpParams
1017
resolveDependsCommon p@(CommonOpParams { opDepends = Just deps}) jid = do
1018
  deps' <- mapM (`absoluteJobDependency` jid) deps
1019
  return p { opDepends = Just deps' }
1020
resolveDependsCommon p _ = return p
1021

    
1022
-- | The top-level opcode type.
1023
data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams
1024
                             , metaOpCode :: OpCode
1025
                             } deriving (Show, Eq)
1026

    
1027
-- | Resolve relative dependencies to absolute ones, given the job Id.
1028
resolveDependencies :: (Monad m) => MetaOpCode -> JobId -> m MetaOpCode
1029
resolveDependencies mopc jid = do
1030
  mpar <- resolveDependsCommon (metaParams mopc) jid
1031
  return (mopc { metaParams = mpar })
1032

    
1033
-- | JSON serialisation for 'MetaOpCode'.
1034
showMeta :: MetaOpCode -> JSValue
1035
showMeta (MetaOpCode params op) =
1036
  let objparams = toDictCommonOpParams params
1037
      objop = toDictOpCode op
1038
  in makeObj (objparams ++ objop)
1039

    
1040
-- | JSON deserialisation for 'MetaOpCode'
1041
readMeta :: JSValue -> Text.JSON.Result MetaOpCode
1042
readMeta v = do
1043
  meta <- readJSON v
1044
  op <- readJSON v
1045
  return $ MetaOpCode meta op
1046

    
1047
instance JSON MetaOpCode where
1048
  showJSON = showMeta
1049
  readJSON = readMeta
1050

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

    
1056
-- | Sets the comment on a meta opcode.
1057
setOpComment :: String -> MetaOpCode -> MetaOpCode
1058
setOpComment comment (MetaOpCode common op) =
1059
  MetaOpCode (common { opComment = Just comment}) op
1060

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