Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / OpCodes.hs @ 015f1517

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

    
912
-- | Returns the OP_ID for a given opcode value.
913
$(genOpID ''OpCode "opID")
914

    
915
-- | A list of all defined/supported opcode IDs.
916
$(genAllOpIDs ''OpCode "allOpIDs")
917

    
918
instance JSON OpCode where
919
  readJSON = loadOpCode
920
  showJSON = saveOpCode
921

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

    
977
-- | Computes the summary of the opcode.
978
opSummary :: OpCode -> String
979
opSummary op =
980
  case opSummaryVal op of
981
    Nothing -> op_suffix
982
    Just s -> op_suffix ++ "(" ++ s ++ ")"
983
  where op_suffix = drop 3 $ opID op
984

    
985
-- | Generic\/common opcode parameters.
986
$(buildObject "CommonOpParams" "op"
987
  [ pDryRun
988
  , pDebugLevel
989
  , pOpPriority
990
  , pDependencies
991
  , pComment
992
  , pReason
993
  ])
994

    
995
-- | Default common parameter values.
996
defOpParams :: CommonOpParams
997
defOpParams =
998
  CommonOpParams { opDryRun     = Nothing
999
                 , opDebugLevel = Nothing
1000
                 , opPriority   = OpPrioNormal
1001
                 , opDepends    = Nothing
1002
                 , opComment    = Nothing
1003
                 , opReason     = []
1004
                 }
1005

    
1006
-- | Resolve relative dependencies to absolute ones, given the job ID.
1007
resolveDependsCommon :: (Monad m) => CommonOpParams -> JobId -> m CommonOpParams
1008
resolveDependsCommon p@(CommonOpParams { opDepends = Just deps}) jid = do
1009
  deps' <- mapM (`absoluteJobDependency` jid) deps
1010
  return p { opDepends = Just deps' }
1011
resolveDependsCommon p _ = return p
1012

    
1013
-- | The top-level opcode type.
1014
data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams
1015
                             , metaOpCode :: OpCode
1016
                             } deriving (Show, Eq)
1017

    
1018
-- | Resolve relative dependencies to absolute ones, given the job Id.
1019
resolveDependencies :: (Monad m) => MetaOpCode -> JobId -> m MetaOpCode
1020
resolveDependencies mopc jid = do
1021
  mpar <- resolveDependsCommon (metaParams mopc) jid
1022
  return (mopc { metaParams = mpar })
1023

    
1024
-- | JSON serialisation for 'MetaOpCode'.
1025
showMeta :: MetaOpCode -> JSValue
1026
showMeta (MetaOpCode params op) =
1027
  let objparams = toDictCommonOpParams params
1028
      objop = toDictOpCode op
1029
  in makeObj (objparams ++ objop)
1030

    
1031
-- | JSON deserialisation for 'MetaOpCode'
1032
readMeta :: JSValue -> Text.JSON.Result MetaOpCode
1033
readMeta v = do
1034
  meta <- readJSON v
1035
  op <- readJSON v
1036
  return $ MetaOpCode meta op
1037

    
1038
instance JSON MetaOpCode where
1039
  showJSON = showMeta
1040
  readJSON = readMeta
1041

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

    
1047
-- | Sets the comment on a meta opcode.
1048
setOpComment :: String -> MetaOpCode -> MetaOpCode
1049
setOpComment comment (MetaOpCode common op) =
1050
  MetaOpCode (common { opComment = Just comment}) op
1051

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