Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / OpCodes.hs @ df58ca1c

History | View | Annotate | Download (27 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 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
  , wrapOpCode
44
  , setOpComment
45
  , setOpPriority
46
  ) where
47

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

    
51
import Ganeti.THH
52

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

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

    
62
import qualified Ganeti.Constants as C
63

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

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

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

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

    
79
instance PyValue a => PyValue (NonNegative a) where
80
  showValue = showValue . fromNonNegative
81
  
82
instance PyValue a => PyValue (NonEmpty a) where
83
  showValue = showValue . fromNonEmpty
84
  
85
-- FIXME: should use the 'toRaw' function instead of being harcoded or
86
-- perhaps use something similar to the NonNegative type instead of
87
-- using the declareSADT
88
instance PyValue ExportMode where
89
  showValue ExportModeLocal = show C.exportModeLocal
90
  showValue ExportModeRemote = show C.exportModeLocal
91

    
92
instance PyValue CVErrorCode where
93
  showValue = cVErrorCodeToRaw
94

    
95
instance PyValue VerifyOptionalChecks where
96
  showValue = verifyOptionalChecksToRaw
97

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

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

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

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

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

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

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

    
121
type QueryFieldsResponse = [QueryFieldDef]
122

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

    
938
-- | Returns the OP_ID for a given opcode value.
939
$(genOpID ''OpCode "opID")
940

    
941
-- | A list of all defined/supported opcode IDs.
942
$(genAllOpIDs ''OpCode "allOpIDs")
943

    
944
instance JSON OpCode where
945
  readJSON = loadOpCode
946
  showJSON = saveOpCode
947

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

    
1003
-- | Computes the summary of the opcode.
1004
opSummary :: OpCode -> String
1005
opSummary op =
1006
  case opSummaryVal op of
1007
    Nothing -> op_suffix
1008
    Just s -> op_suffix ++ "(" ++ s ++ ")"
1009
  where op_suffix = drop 3 $ opID op
1010

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

    
1021
-- | Default common parameter values.
1022
defOpParams :: CommonOpParams
1023
defOpParams =
1024
  CommonOpParams { opDryRun     = Nothing
1025
                 , opDebugLevel = Nothing
1026
                 , opPriority   = OpPrioNormal
1027
                 , opDepends    = Nothing
1028
                 , opComment    = Nothing
1029
                 , opReason     = []
1030
                 }
1031

    
1032
-- | The top-level opcode type.
1033
data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams
1034
                             , metaOpCode :: OpCode
1035
                             } deriving (Show, Eq)
1036

    
1037
-- | JSON serialisation for 'MetaOpCode'.
1038
showMeta :: MetaOpCode -> JSValue
1039
showMeta (MetaOpCode params op) =
1040
  let objparams = toDictCommonOpParams params
1041
      objop = toDictOpCode op
1042
  in makeObj (objparams ++ objop)
1043

    
1044
-- | JSON deserialisation for 'MetaOpCode'
1045
readMeta :: JSValue -> Text.JSON.Result MetaOpCode
1046
readMeta v = do
1047
  meta <- readJSON v
1048
  op <- readJSON v
1049
  return $ MetaOpCode meta op
1050

    
1051
instance JSON MetaOpCode where
1052
  showJSON = showMeta
1053
  readJSON = readMeta
1054

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

    
1060
-- | Sets the comment on a meta opcode.
1061
setOpComment :: String -> MetaOpCode -> MetaOpCode
1062
setOpComment comment (MetaOpCode common op) =
1063
  MetaOpCode (common { opComment = Just comment}) op
1064

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