Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / OpCodes.hs @ 7b6996a8

History | View | Annotate | Download (27.6 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.Types
56
import Ganeti.Query.Language (queryTypeOpToRaw)
57

    
58
import Data.List (intercalate)
59
import Data.Map (Map)
60
import qualified Data.Map as Map
61
import Data.Set (Set)
62
import qualified Data.Set as Set
63

    
64
import qualified Ganeti.Constants as C
65

    
66
instance PyValue Bool
67
instance PyValue Int
68
instance PyValue Double
69
instance PyValue Char
70

    
71
instance (PyValue a, PyValue b) => PyValue (a, b) where
72
  showValue (x, y) = show (showValue x, showValue y)
73

    
74
instance PyValue a => PyValue [a] where
75
  showValue xs = show (map showValue xs)
76

    
77
instance PyValue a => PyValue (Set a) where
78
  showValue s = showValue (Set.toList s)
79

    
80
instance (PyValue k, PyValue a) => PyValue (Map k a) where
81
  showValue mp =
82
    "{" ++ intercalate ", " (map showPair (Map.assocs mp)) ++ "}"
83
    where showPair (k, x) = show k ++ ":" ++ show x
84

    
85
instance PyValue DiskIndex where
86
  showValue = showValue . unDiskIndex
87

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

    
91
instance PyValue RecreateDisksInfo where
92
  showValue RecreateDisksAll = "[]"
93
  showValue (RecreateDisksIndices is) = showValue is
94
  showValue (RecreateDisksParams is) = showValue is
95

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

    
100
instance PyValue a => PyValue (NonNegative a) where
101
  showValue = showValue . fromNonNegative
102
  
103
instance PyValue a => PyValue (NonEmpty a) where
104
  showValue = showValue . fromNonEmpty
105
  
106
-- FIXME: should use the 'toRaw' function instead of being harcoded or
107
-- perhaps use something similar to the NonNegative type instead of
108
-- using the declareSADT
109
instance PyValue ExportMode where
110
  showValue ExportModeLocal = show C.exportModeLocal
111
  showValue ExportModeRemove = show C.exportModeLocal
112

    
113
instance PyValue CVErrorCode where
114
  showValue = cVErrorCodeToRaw
115
  
116
instance PyValue VerifyOptionalChecks where
117
  showValue = verifyOptionalChecksToRaw
118

    
119
instance PyValue INicParams where
120
  showValue = error "instance PyValue INicParams: not implemented"
121

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

    
127
instance PyValue JSValue where
128
  showValue (JSObject obj) = showValue obj
129
  showValue x = show x
130

    
131
type JobIdListOnly = [(Bool, Either String JobId)]
132

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

    
136
type QueryFieldDef =
137
  (NonEmptyString, NonEmptyString, TagKind, NonEmptyString)
138

    
139
type QueryResponse =
140
  ([QueryFieldDef], [[(QueryResultCode, JSValue)]])
141

    
142
type QueryFieldsResponse = [QueryFieldDef]
143

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

    
958
-- | Returns the OP_ID for a given opcode value.
959
$(genOpID ''OpCode "opID")
960

    
961
-- | A list of all defined/supported opcode IDs.
962
$(genAllOpIDs ''OpCode "allOpIDs")
963

    
964
instance JSON OpCode where
965
  readJSON = loadOpCode
966
  showJSON = saveOpCode
967

    
968
-- | Generates the summary value for an opcode.
969
opSummaryVal :: OpCode -> Maybe String
970
opSummaryVal OpClusterVerifyGroup { opGroupName = s } = Just (fromNonEmpty s)
971
opSummaryVal OpGroupVerifyDisks { opGroupName = s } = Just (fromNonEmpty s)
972
opSummaryVal OpClusterRename { opName = s } = Just (fromNonEmpty s)
973
opSummaryVal OpQuery { opWhat = s } = Just (queryTypeOpToRaw s)
974
opSummaryVal OpQueryFields { opWhat = s } = Just (queryTypeOpToRaw s)
975
opSummaryVal OpNodeRemove { opNodeName = s } = Just (fromNonEmpty s)
976
opSummaryVal OpNodeAdd { opNodeName = s } = Just (fromNonEmpty s)
977
opSummaryVal OpNodeModifyStorage { opNodeName = s } = Just (fromNonEmpty s)
978
opSummaryVal OpRepairNodeStorage  { opNodeName = s } = Just (fromNonEmpty s)
979
opSummaryVal OpNodeSetParams { opNodeName = s } = Just (fromNonEmpty s)
980
opSummaryVal OpNodePowercycle { opNodeName = s } = Just (fromNonEmpty s)
981
opSummaryVal OpNodeMigrate { opNodeName = s } = Just (fromNonEmpty s)
982
opSummaryVal OpNodeEvacuate { opNodeName = s } = Just (fromNonEmpty s)
983
opSummaryVal OpInstanceCreate { opInstanceName = s } = Just s
984
opSummaryVal OpInstanceReinstall { opInstanceName = s } = Just s
985
opSummaryVal OpInstanceRemove { opInstanceName = s } = Just s
986
-- FIXME: instance rename should show both names; currently it shows none
987
-- opSummaryVal OpInstanceRename { opInstanceName = s } = Just s
988
opSummaryVal OpInstanceStartup { opInstanceName = s } = Just s
989
opSummaryVal OpInstanceShutdown { opInstanceName = s } = Just s
990
opSummaryVal OpInstanceReboot { opInstanceName = s } = Just s
991
opSummaryVal OpInstanceReplaceDisks { opInstanceName = s } = Just s
992
opSummaryVal OpInstanceFailover { opInstanceName = s } = Just s
993
opSummaryVal OpInstanceMigrate { opInstanceName = s } = Just s
994
opSummaryVal OpInstanceMove { opInstanceName = s } = Just s
995
opSummaryVal OpInstanceConsole { opInstanceName = s } = Just s
996
opSummaryVal OpInstanceActivateDisks { opInstanceName = s } = Just s
997
opSummaryVal OpInstanceDeactivateDisks { opInstanceName = s } = Just s
998
opSummaryVal OpInstanceRecreateDisks { opInstanceName = s } = Just s
999
opSummaryVal OpInstanceSetParams { opInstanceName = s } = Just s
1000
opSummaryVal OpInstanceGrowDisk { opInstanceName = s } = Just s
1001
opSummaryVal OpInstanceChangeGroup { opInstanceName = s } = Just s
1002
opSummaryVal OpGroupAdd { opGroupName = s } = Just (fromNonEmpty s)
1003
opSummaryVal OpGroupAssignNodes { opGroupName = s } = Just (fromNonEmpty s)
1004
opSummaryVal OpGroupSetParams { opGroupName = s } = Just (fromNonEmpty s)
1005
opSummaryVal OpGroupRemove { opGroupName = s } = Just (fromNonEmpty s)
1006
opSummaryVal OpGroupEvacuate { opGroupName = s } = Just (fromNonEmpty s)
1007
opSummaryVal OpBackupPrepare { opInstanceName = s } = Just s
1008
opSummaryVal OpBackupExport { opInstanceName = s } = Just s
1009
opSummaryVal OpBackupRemove { opInstanceName = s } = Just s
1010
opSummaryVal OpTagsGet { opKind = s } = Just (show s)
1011
opSummaryVal OpTagsSearch { opTagSearchPattern = s } = Just (fromNonEmpty s)
1012
opSummaryVal OpTestDelay { opDelayDuration = d } = Just (show d)
1013
opSummaryVal OpTestAllocator { opIallocator = s } =
1014
  -- FIXME: Python doesn't handle None fields well, so we have behave the same
1015
  Just $ maybe "None" fromNonEmpty s
1016
opSummaryVal OpNetworkAdd { opNetworkName = s} = Just (fromNonEmpty s)
1017
opSummaryVal OpNetworkRemove { opNetworkName = s} = Just (fromNonEmpty s)
1018
opSummaryVal OpNetworkSetParams { opNetworkName = s} = Just (fromNonEmpty s)
1019
opSummaryVal OpNetworkConnect { opNetworkName = s} = Just (fromNonEmpty s)
1020
opSummaryVal OpNetworkDisconnect { opNetworkName = s} = Just (fromNonEmpty s)
1021
opSummaryVal _ = Nothing
1022

    
1023
-- | Computes the summary of the opcode.
1024
opSummary :: OpCode -> String
1025
opSummary op =
1026
  case opSummaryVal op of
1027
    Nothing -> op_suffix
1028
    Just s -> op_suffix ++ "(" ++ s ++ ")"
1029
  where op_suffix = drop 3 $ opID op
1030

    
1031
-- | Generic\/common opcode parameters.
1032
$(buildObject "CommonOpParams" "op"
1033
  [ pDryRun
1034
  , pDebugLevel
1035
  , pOpPriority
1036
  , pDependencies
1037
  , pComment
1038
  , pReason
1039
  ])
1040

    
1041
-- | Default common parameter values.
1042
defOpParams :: CommonOpParams
1043
defOpParams =
1044
  CommonOpParams { opDryRun     = Nothing
1045
                 , opDebugLevel = Nothing
1046
                 , opPriority   = OpPrioNormal
1047
                 , opDepends    = Nothing
1048
                 , opComment    = Nothing
1049
                 , opReason     = []
1050
                 }
1051

    
1052
-- | The top-level opcode type.
1053
data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams
1054
                             , metaOpCode :: OpCode
1055
                             } deriving (Show, Eq)
1056

    
1057
-- | JSON serialisation for 'MetaOpCode'.
1058
showMeta :: MetaOpCode -> JSValue
1059
showMeta (MetaOpCode params op) =
1060
  let objparams = toDictCommonOpParams params
1061
      objop = toDictOpCode op
1062
  in makeObj (objparams ++ objop)
1063

    
1064
-- | JSON deserialisation for 'MetaOpCode'
1065
readMeta :: JSValue -> Text.JSON.Result MetaOpCode
1066
readMeta v = do
1067
  meta <- readJSON v
1068
  op <- readJSON v
1069
  return $ MetaOpCode meta op
1070

    
1071
instance JSON MetaOpCode where
1072
  showJSON = showMeta
1073
  readJSON = readMeta
1074

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

    
1080
-- | Sets the comment on a meta opcode.
1081
setOpComment :: String -> MetaOpCode -> MetaOpCode
1082
setOpComment comment (MetaOpCode common op) =
1083
  MetaOpCode (common { opComment = Just comment}) op
1084

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