c4da480a8a21161aefe29c422eb436d310c54f3a
[ganeti-github.git] / src / Ganeti / OpCodes.hs
1 {-# LANGUAGE ExistentialQuantification, TemplateHaskell, StandaloneDeriving #-}
2 {-# OPTIONS_GHC -fno-warn-orphans -O0 #-}
3 -- We have to disable optimisation here, as some versions of ghc otherwise
4 -- fail to compile this code, at least within reasonable memory limits (40g).
5
6 {-| Implementation of the opcodes.
7
8 -}
9
10 {-
11
12 Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Google Inc.
13 All rights reserved.
14
15 Redistribution and use in source and binary forms, with or without
16 modification, are permitted provided that the following conditions are
17 met:
18
19 1. Redistributions of source code must retain the above copyright notice,
20 this list of conditions and the following disclaimer.
21
22 2. Redistributions in binary form must reproduce the above copyright
23 notice, this list of conditions and the following disclaimer in the
24 documentation and/or other materials provided with the distribution.
25
26 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
27 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
28 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
29 PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
30 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
31 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
32 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
33 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
34 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
35 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
36 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
37
38 -}
39
40 module Ganeti.OpCodes
41 ( pyClasses
42 , OpCode(..)
43 , ReplaceDisksMode(..)
44 , DiskIndex
45 , mkDiskIndex
46 , unDiskIndex
47 , opID
48 , opReasonSrcID
49 , allOpIDs
50 , allOpFields
51 , opSummary
52 , CommonOpParams(..)
53 , defOpParams
54 , MetaOpCode(..)
55 , resolveDependencies
56 , wrapOpCode
57 , setOpComment
58 , setOpPriority
59 ) where
60
61 import Prelude ()
62 import Ganeti.Prelude
63
64 import Data.List (intercalate)
65 import Data.Map (Map)
66 import qualified Text.JSON
67 import Text.JSON (readJSON, JSObject, JSON, JSValue(..), fromJSObject)
68
69 import qualified Ganeti.Constants as C
70 import qualified Ganeti.Hs2Py.OpDoc as OpDoc
71 import Ganeti.JSON (DictObject(..), readJSONfromDict, showJSONtoDict)
72 import Ganeti.OpParams
73 import Ganeti.PyValue ()
74 import Ganeti.Query.Language (queryTypeOpToRaw)
75 import Ganeti.THH
76 import Ganeti.Types
77
78 instance PyValue DiskIndex where
79 showValue = showValue . unDiskIndex
80
81 instance PyValue IDiskParams where
82 showValue _ = error "OpCodes.showValue(IDiskParams): unhandled case"
83
84 instance PyValue RecreateDisksInfo where
85 showValue RecreateDisksAll = "[]"
86 showValue (RecreateDisksIndices is) = showValue is
87 showValue (RecreateDisksParams is) = showValue is
88
89 instance PyValue a => PyValue (SetParamsMods a) where
90 showValue SetParamsEmpty = "[]"
91 showValue _ = error "OpCodes.showValue(SetParamsMods): unhandled case"
92
93 instance PyValue a => PyValue (NonNegative a) where
94 showValue = showValue . fromNonNegative
95
96 instance PyValue a => PyValue (NonEmpty a) where
97 showValue = showValue . fromNonEmpty
98
99 -- FIXME: should use the 'toRaw' function instead of being harcoded or
100 -- perhaps use something similar to the NonNegative type instead of
101 -- using the declareSADT
102 instance PyValue ExportMode where
103 showValue ExportModeLocal = show C.exportModeLocal
104 showValue ExportModeRemote = show C.exportModeLocal
105
106 instance PyValue CVErrorCode where
107 showValue = cVErrorCodeToRaw
108
109 instance PyValue VerifyOptionalChecks where
110 showValue = verifyOptionalChecksToRaw
111
112 instance PyValue INicParams where
113 showValue = error "instance PyValue INicParams: not implemented"
114
115 instance PyValue a => PyValue (JSObject a) where
116 showValue obj =
117 "{" ++ intercalate ", " (map showPair (fromJSObject obj)) ++ "}"
118 where showPair (k, v) = show k ++ ":" ++ showValue v
119
120 instance PyValue JSValue where
121 showValue (JSObject obj) = showValue obj
122 showValue x = show x
123
124 type JobIdListOnly = Map String [(Bool, Either String JobId)]
125
126 type InstanceMultiAllocResponse =
127 ([(Bool, Either String JobId)], NonEmptyString)
128
129 type QueryFieldDef =
130 (NonEmptyString, NonEmptyString, TagKind, NonEmptyString)
131
132 type QueryResponse =
133 ([QueryFieldDef], [[(QueryResultCode, JSValue)]])
134
135 type QueryFieldsResponse = [QueryFieldDef]
136
137 -- | OpCode representation.
138 --
139 -- We only implement a subset of Ganeti opcodes: those which are actually used
140 -- in the htools codebase.
141 $(genOpCode "OpCode"
142 [ ("OpClusterPostInit",
143 [t| Bool |],
144 OpDoc.opClusterPostInit,
145 [],
146 [])
147 , ("OpClusterDestroy",
148 [t| NonEmptyString |],
149 OpDoc.opClusterDestroy,
150 [],
151 [])
152 , ("OpClusterQuery",
153 [t| JSObject JSValue |],
154 OpDoc.opClusterQuery,
155 [],
156 [])
157 , ("OpClusterVerify",
158 [t| JobIdListOnly |],
159 OpDoc.opClusterVerify,
160 [ pDebugSimulateErrors
161 , pErrorCodes
162 , pSkipChecks
163 , pIgnoreErrors
164 , pVerbose
165 , pOptGroupName
166 , pVerifyClutter
167 ],
168 [])
169 , ("OpClusterVerifyConfig",
170 [t| Bool |],
171 OpDoc.opClusterVerifyConfig,
172 [ pDebugSimulateErrors
173 , pErrorCodes
174 , pIgnoreErrors
175 , pVerbose
176 ],
177 [])
178 , ("OpClusterVerifyGroup",
179 [t| Bool |],
180 OpDoc.opClusterVerifyGroup,
181 [ pGroupName
182 , pDebugSimulateErrors
183 , pErrorCodes
184 , pSkipChecks
185 , pIgnoreErrors
186 , pVerbose
187 , pVerifyClutter
188 ],
189 "group_name")
190 , ("OpClusterVerifyDisks",
191 [t| JobIdListOnly |],
192 OpDoc.opClusterVerifyDisks,
193 [ pOptGroupName
194 , pIsStrict
195 ],
196 [])
197 , ("OpGroupVerifyDisks",
198 [t| (Map String String, [String], Map String [[String]]) |],
199 OpDoc.opGroupVerifyDisks,
200 [ pGroupName
201 , pIsStrict
202 ],
203 "group_name")
204 , ("OpClusterRepairDiskSizes",
205 [t| [(NonEmptyString, NonNegative Int, NonEmptyString, NonNegative Int)]|],
206 OpDoc.opClusterRepairDiskSizes,
207 [ pInstances
208 ],
209 [])
210 , ("OpClusterConfigQuery",
211 [t| [JSValue] |],
212 OpDoc.opClusterConfigQuery,
213 [ pOutputFields
214 ],
215 [])
216 , ("OpClusterRename",
217 [t| NonEmptyString |],
218 OpDoc.opClusterRename,
219 [ pName
220 ],
221 "name")
222 , ("OpClusterSetParams",
223 [t| Either () JobIdListOnly |],
224 OpDoc.opClusterSetParams,
225 [ pForce
226 , pHvState
227 , pDiskState
228 , pVgName
229 , pEnabledHypervisors
230 , pClusterHvParams
231 , pClusterBeParams
232 , pOsHvp
233 , pClusterOsParams
234 , pClusterOsParamsPrivate
235 , pGroupDiskParams
236 , pCandidatePoolSize
237 , pMaxRunningJobs
238 , pMaxTrackedJobs
239 , pUidPool
240 , pAddUids
241 , pRemoveUids
242 , pMaintainNodeHealth
243 , pPreallocWipeDisks
244 , pNicParams
245 , withDoc "Cluster-wide node parameter defaults" pNdParams
246 , withDoc "Cluster-wide ipolicy specs" pIpolicy
247 , pDrbdHelper
248 , pDefaultIAllocator
249 , pDefaultIAllocatorParams
250 , pNetworkMacPrefix
251 , pMasterNetdev
252 , pMasterNetmask
253 , pReservedLvs
254 , pHiddenOs
255 , pBlacklistedOs
256 , pUseExternalMipScript
257 , pEnabledDiskTemplates
258 , pModifyEtcHosts
259 , pModifySshSetup
260 , pClusterFileStorageDir
261 , pClusterSharedFileStorageDir
262 , pClusterGlusterStorageDir
263 , pInstallImage
264 , pInstanceCommunicationNetwork
265 , pZeroingImage
266 , pCompressionTools
267 , pEnabledUserShutdown
268 , pEnabledDataCollectors
269 , pDataCollectorInterval
270 , pDiagnoseDataCollectorFilename
271 , pMaintdRoundDelay
272 , pMaintdEnableBalancing
273 , pMaintdBalancingThreshold
274 ],
275 [])
276 , ("OpClusterRedistConf",
277 [t| () |],
278 OpDoc.opClusterRedistConf,
279 [],
280 [])
281 , ("OpClusterActivateMasterIp",
282 [t| () |],
283 OpDoc.opClusterActivateMasterIp,
284 [],
285 [])
286 , ("OpClusterDeactivateMasterIp",
287 [t| () |],
288 OpDoc.opClusterDeactivateMasterIp,
289 [],
290 [])
291 , ("OpClusterRenewCrypto",
292 [t| () |],
293 OpDoc.opClusterRenewCrypto,
294 [ pNodeSslCerts
295 , pRenewSshKeys
296 , pSshKeyType
297 , pSshKeyBits
298 , pVerbose
299 , pDebug
300 ],
301 [])
302 , ("OpQuery",
303 [t| QueryResponse |],
304 OpDoc.opQuery,
305 [ pQueryWhat
306 , pUseLocking
307 , pQueryFields
308 , pQueryFilter
309 ],
310 "what")
311 , ("OpQueryFields",
312 [t| QueryFieldsResponse |],
313 OpDoc.opQueryFields,
314 [ pQueryWhat
315 , pQueryFieldsFields
316 ],
317 "what")
318 , ("OpOobCommand",
319 [t| [[(QueryResultCode, JSValue)]] |],
320 OpDoc.opOobCommand,
321 [ pNodeNames
322 , withDoc "List of node UUIDs to run the OOB command against" pNodeUuids
323 , pOobCommand
324 , pOobTimeout
325 , pIgnoreStatus
326 , pPowerDelay
327 ],
328 [])
329 , ("OpRestrictedCommand",
330 [t| [(Bool, String)] |],
331 OpDoc.opRestrictedCommand,
332 [ pUseLocking
333 , withDoc
334 "Nodes on which the command should be run (at least one)"
335 pRequiredNodes
336 , withDoc
337 "Node UUIDs on which the command should be run (at least one)"
338 pRequiredNodeUuids
339 , pRestrictedCommand
340 ],
341 [])
342 , ("OpRepairCommand",
343 [t| String |],
344 OpDoc.opRepairCommand,
345 [ pNodeName
346 , pRepairCommand
347 , pInput
348 ],
349 [])
350 , ("OpNodeRemove",
351 [t| () |],
352 OpDoc.opNodeRemove,
353 [ pNodeName
354 , pNodeUuid
355 , pVerbose
356 , pDebug
357 ],
358 "node_name")
359 , ("OpNodeAdd",
360 [t| () |],
361 OpDoc.opNodeAdd,
362 [ pNodeName
363 , pHvState
364 , pDiskState
365 , pPrimaryIp
366 , pSecondaryIp
367 , pReadd
368 , pNodeGroup
369 , pMasterCapable
370 , pVmCapable
371 , pNdParams
372 , pNodeSetup
373 , pVerbose
374 , pDebug
375 ],
376 "node_name")
377 , ("OpNodeQueryvols",
378 [t| [JSValue] |],
379 OpDoc.opNodeQueryvols,
380 [ pOutputFields
381 , withDoc "Empty list to query all nodes, node names otherwise" pNodes
382 ],
383 [])
384 , ("OpNodeQueryStorage",
385 [t| [[JSValue]] |],
386 OpDoc.opNodeQueryStorage,
387 [ pOutputFields
388 , pOptStorageType
389 , withDoc
390 "Empty list to query all, list of names to query otherwise"
391 pNodes
392 , pStorageName
393 ],
394 [])
395 , ("OpNodeModifyStorage",
396 [t| () |],
397 OpDoc.opNodeModifyStorage,
398 [ pNodeName
399 , pNodeUuid
400 , pStorageType
401 , pStorageName
402 , pStorageChanges
403 ],
404 "node_name")
405 , ("OpRepairNodeStorage",
406 [t| () |],
407 OpDoc.opRepairNodeStorage,
408 [ pNodeName
409 , pNodeUuid
410 , pStorageType
411 , pStorageName
412 , pIgnoreConsistency
413 ],
414 "node_name")
415 , ("OpNodeSetParams",
416 [t| [(NonEmptyString, JSValue)] |],
417 OpDoc.opNodeSetParams,
418 [ pNodeName
419 , pNodeUuid
420 , pForce
421 , pHvState
422 , pDiskState
423 , pMasterCandidate
424 , withDoc "Whether to mark the node offline" pOffline
425 , pDrained
426 , pAutoPromote
427 , pMasterCapable
428 , pVmCapable
429 , pSecondaryIp
430 , pNdParams
431 , pPowered
432 , pVerbose
433 , pDebug
434 ],
435 "node_name")
436 , ("OpNodePowercycle",
437 [t| Maybe NonEmptyString |],
438 OpDoc.opNodePowercycle,
439 [ pNodeName
440 , pNodeUuid
441 , pForce
442 ],
443 "node_name")
444 , ("OpNodeMigrate",
445 [t| JobIdListOnly |],
446 OpDoc.opNodeMigrate,
447 [ pNodeName
448 , pNodeUuid
449 , pMigrationMode
450 , pMigrationLive
451 , pMigrationTargetNode
452 , pMigrationTargetNodeUuid
453 , pAllowRuntimeChgs
454 , pIgnoreIpolicy
455 , pIallocator
456 ],
457 "node_name")
458 , ("OpNodeEvacuate",
459 [t| JobIdListOnly |],
460 OpDoc.opNodeEvacuate,
461 [ pEarlyRelease
462 , pNodeName
463 , pNodeUuid
464 , pRemoteNode
465 , pRemoteNodeUuid
466 , pIallocator
467 , pEvacMode
468 , pIgnoreSoftErrors
469 ],
470 "node_name")
471 , ("OpInstanceCreate",
472 [t| [NonEmptyString] |],
473 OpDoc.opInstanceCreate,
474 [ pInstanceName
475 , pForceVariant
476 , pWaitForSync
477 , pNameCheck
478 , pIgnoreIpolicy
479 , pOpportunisticLocking
480 , pInstBeParams
481 , pInstDisks
482 , pOptDiskTemplate
483 , pOptGroupName
484 , pFileDriver
485 , pFileStorageDir
486 , pInstHvParams
487 , pHypervisor
488 , pIallocator
489 , pResetDefaults
490 , pIpCheck
491 , pIpConflictsCheck
492 , pInstCreateMode
493 , pInstNics
494 , pNoInstall
495 , pInstOsParams
496 , pInstOsParamsPrivate
497 , pInstOsParamsSecret
498 , pInstOs
499 , pPrimaryNode
500 , pPrimaryNodeUuid
501 , pSecondaryNode
502 , pSecondaryNodeUuid
503 , pSourceHandshake
504 , pSourceInstance
505 , pSourceShutdownTimeout
506 , pSourceX509Ca
507 , pSrcNode
508 , pSrcNodeUuid
509 , pSrcPath
510 , pBackupCompress
511 , pStartInstance
512 , pForthcoming
513 , pCommit
514 , pInstTags
515 , pInstanceCommunication
516 , pHelperStartupTimeout
517 , pHelperShutdownTimeout
518 ],
519 "instance_name")
520 , ("OpInstanceMultiAlloc",
521 [t| InstanceMultiAllocResponse |],
522 OpDoc.opInstanceMultiAlloc,
523 [ pOpportunisticLocking
524 , pIallocator
525 , pMultiAllocInstances
526 ],
527 [])
528 , ("OpInstanceReinstall",
529 [t| () |],
530 OpDoc.opInstanceReinstall,
531 [ pInstanceName
532 , pInstanceUuid
533 , pForceVariant
534 , pInstOs
535 , pTempOsParams
536 , pTempOsParamsPrivate
537 , pTempOsParamsSecret
538 , pTempOsParamsClear
539 , pTempOsParamsPrivateClear
540 , pTempOsParamsRemove
541 , pTempOsParamsPrivateRemove
542 ],
543 "instance_name")
544 , ("OpInstanceRemove",
545 [t| () |],
546 OpDoc.opInstanceRemove,
547 [ pInstanceName
548 , pInstanceUuid
549 , pShutdownTimeout
550 , pIgnoreFailures
551 ],
552 "instance_name")
553 , ("OpInstanceRename",
554 [t| NonEmptyString |],
555 OpDoc.opInstanceRename,
556 [ pInstanceName
557 , pInstanceUuid
558 , withDoc "New instance name" pNewName
559 , pNameCheck
560 , pIpCheck
561 ],
562 [])
563 , ("OpInstanceStartup",
564 [t| () |],
565 OpDoc.opInstanceStartup,
566 [ pInstanceName
567 , pInstanceUuid
568 , pForce
569 , pIgnoreOfflineNodes
570 , pTempHvParams
571 , pTempBeParams
572 , pNoRemember
573 , pStartupPaused
574 -- timeout to cleanup a user down instance
575 , pShutdownTimeout
576 ],
577 "instance_name")
578 , ("OpInstanceShutdown",
579 [t| () |],
580 OpDoc.opInstanceShutdown,
581 [ pInstanceName
582 , pInstanceUuid
583 , pForce
584 , pIgnoreOfflineNodes
585 , pShutdownTimeout'
586 , pNoRemember
587 , pAdminStateSource
588 ],
589 "instance_name")
590 , ("OpInstanceReboot",
591 [t| () |],
592 OpDoc.opInstanceReboot,
593 [ pInstanceName
594 , pInstanceUuid
595 , pShutdownTimeout
596 , pIgnoreSecondaries
597 , pRebootType
598 ],
599 "instance_name")
600 , ("OpInstanceReplaceDisks",
601 [t| () |],
602 OpDoc.opInstanceReplaceDisks,
603 [ pInstanceName
604 , pInstanceUuid
605 , pEarlyRelease
606 , pIgnoreIpolicy
607 , pReplaceDisksMode
608 , pReplaceDisksList
609 , pRemoteNode
610 , pRemoteNodeUuid
611 , pIallocator
612 ],
613 "instance_name")
614 , ("OpInstanceFailover",
615 [t| () |],
616 OpDoc.opInstanceFailover,
617 [ pInstanceName
618 , pInstanceUuid
619 , pShutdownTimeout
620 , pIgnoreConsistency
621 , pMigrationTargetNode
622 , pMigrationTargetNodeUuid
623 , pIgnoreIpolicy
624 , pMigrationCleanup
625 , pIallocator
626 ],
627 "instance_name")
628 , ("OpInstanceMigrate",
629 [t| () |],
630 OpDoc.opInstanceMigrate,
631 [ pInstanceName
632 , pInstanceUuid
633 , pMigrationMode
634 , pMigrationLive
635 , pMigrationTargetNode
636 , pMigrationTargetNodeUuid
637 , pAllowRuntimeChgs
638 , pIgnoreIpolicy
639 , pMigrationCleanup
640 , pIallocator
641 , pAllowFailover
642 , pIgnoreHVVersions
643 ],
644 "instance_name")
645 , ("OpInstanceMove",
646 [t| () |],
647 OpDoc.opInstanceMove,
648 [ pInstanceName
649 , pInstanceUuid
650 , pShutdownTimeout
651 , pIgnoreIpolicy
652 , pMoveTargetNode
653 , pMoveTargetNodeUuid
654 , pMoveCompress
655 , pIgnoreConsistency
656 ],
657 "instance_name")
658 , ("OpInstanceConsole",
659 [t| JSObject JSValue |],
660 OpDoc.opInstanceConsole,
661 [ pInstanceName
662 , pInstanceUuid
663 ],
664 "instance_name")
665 , ("OpInstanceActivateDisks",
666 [t| [(NonEmptyString, NonEmptyString, Maybe NonEmptyString)] |],
667 OpDoc.opInstanceActivateDisks,
668 [ pInstanceName
669 , pInstanceUuid
670 , pIgnoreDiskSize
671 , pWaitForSyncFalse
672 ],
673 "instance_name")
674 , ("OpInstanceDeactivateDisks",
675 [t| () |],
676 OpDoc.opInstanceDeactivateDisks,
677 [ pInstanceName
678 , pInstanceUuid
679 , pForce
680 ],
681 "instance_name")
682 , ("OpInstanceRecreateDisks",
683 [t| () |],
684 OpDoc.opInstanceRecreateDisks,
685 [ pInstanceName
686 , pInstanceUuid
687 , pRecreateDisksInfo
688 , withDoc "New instance nodes, if relocation is desired" pNodes
689 , withDoc "New instance node UUIDs, if relocation is desired" pNodeUuids
690 , pIallocator
691 ],
692 "instance_name")
693 , ("OpInstanceQueryData",
694 [t| JSObject (JSObject JSValue) |],
695 OpDoc.opInstanceQueryData,
696 [ pUseLocking
697 , pInstances
698 , pStatic
699 ],
700 [])
701 , ("OpInstanceSetParams",
702 [t| [(NonEmptyString, JSValue)] |],
703 OpDoc.opInstanceSetParams,
704 [ pInstanceName
705 , pInstanceUuid
706 , pForce
707 , pForceVariant
708 , pIgnoreIpolicy
709 , pInstParamsNicChanges
710 , pInstParamsDiskChanges
711 , pInstBeParams
712 , pRuntimeMem
713 , pInstHvParams
714 , pOptDiskTemplate
715 , pExtParams
716 , pFileDriver
717 , pFileStorageDir
718 , pPrimaryNode
719 , pPrimaryNodeUuid
720 , withDoc "Secondary node (used when changing disk template)" pRemoteNode
721 , withDoc
722 "Secondary node UUID (used when changing disk template)"
723 pRemoteNodeUuid
724 , pIallocator
725 , pOsNameChange
726 , pInstOsParams
727 , pInstOsParamsPrivate
728 , pInstOsParamsClear
729 , pInstOsParamsPrivateClear
730 , pInstOsParamsRemove
731 , pInstOsParamsPrivateRemove
732 , pWaitForSync
733 , withDoc "Whether to mark the instance as offline" pOffline
734 , pIpConflictsCheck
735 , pHotplug
736 , pHotplugIfPossible
737 , pOptInstanceCommunication
738 ],
739 "instance_name")
740 , ("OpInstanceGrowDisk",
741 [t| () |],
742 OpDoc.opInstanceGrowDisk,
743 [ pInstanceName
744 , pInstanceUuid
745 , pWaitForSync
746 , pDiskIndex
747 , pDiskChgAmount
748 , pDiskChgAbsolute
749 , pIgnoreIpolicy
750 ],
751 "instance_name")
752 , ("OpInstanceChangeGroup",
753 [t| JobIdListOnly |],
754 OpDoc.opInstanceChangeGroup,
755 [ pInstanceName
756 , pInstanceUuid
757 , pEarlyRelease
758 , pIallocator
759 , pTargetGroups
760 ],
761 "instance_name")
762 , ("OpGroupAdd",
763 [t| Either () JobIdListOnly |],
764 OpDoc.opGroupAdd,
765 [ pGroupName
766 , pNodeGroupAllocPolicy
767 , pGroupNodeParams
768 , pGroupDiskParams
769 , pHvState
770 , pDiskState
771 , withDoc "Group-wide ipolicy specs" pIpolicy
772 ],
773 "group_name")
774 , ("OpGroupAssignNodes",
775 [t| () |],
776 OpDoc.opGroupAssignNodes,
777 [ pGroupName
778 , pForce
779 , withDoc "List of nodes to assign" pRequiredNodes
780 , withDoc "List of node UUIDs to assign" pRequiredNodeUuids
781 ],
782 "group_name")
783 , ("OpGroupSetParams",
784 [t| [(NonEmptyString, JSValue)] |],
785 OpDoc.opGroupSetParams,
786 [ pGroupName
787 , pNodeGroupAllocPolicy
788 , pGroupNodeParams
789 , pGroupDiskParams
790 , pHvState
791 , pDiskState
792 , withDoc "Group-wide ipolicy specs" pIpolicy
793 ],
794 "group_name")
795 , ("OpGroupRemove",
796 [t| () |],
797 OpDoc.opGroupRemove,
798 [ pGroupName
799 ],
800 "group_name")
801 , ("OpGroupRename",
802 [t| NonEmptyString |],
803 OpDoc.opGroupRename,
804 [ pGroupName
805 , withDoc "New group name" pNewName
806 ],
807 [])
808 , ("OpGroupEvacuate",
809 [t| JobIdListOnly |],
810 OpDoc.opGroupEvacuate,
811 [ pGroupName
812 , pEarlyRelease
813 , pIallocator
814 , pTargetGroups
815 , pSequential
816 , pForceFailover
817 ],
818 "group_name")
819 , ("OpOsDiagnose",
820 [t| [[JSValue]] |],
821 OpDoc.opOsDiagnose,
822 [ pOutputFields
823 , withDoc "Which operating systems to diagnose" pNames
824 ],
825 [])
826 , ("OpExtStorageDiagnose",
827 [t| [[JSValue]] |],
828 OpDoc.opExtStorageDiagnose,
829 [ pOutputFields
830 , withDoc "Which ExtStorage Provider to diagnose" pNames
831 ],
832 [])
833 , ("OpBackupPrepare",
834 [t| Maybe (JSObject JSValue) |],
835 OpDoc.opBackupPrepare,
836 [ pInstanceName
837 , pInstanceUuid
838 , pExportMode
839 ],
840 "instance_name")
841 , ("OpBackupExport",
842 [t| (Bool, [Bool]) |],
843 OpDoc.opBackupExport,
844 [ pInstanceName
845 , pInstanceUuid
846 , pBackupCompress
847 , pShutdownTimeout
848 , pExportTargetNode
849 , pExportTargetNodeUuid
850 , pShutdownInstance
851 , pRemoveInstance
852 , pIgnoreRemoveFailures
853 , defaultField [| ExportModeLocal |] pExportMode
854 , pX509KeyName
855 , pX509DestCA
856 , pZeroFreeSpace
857 , pZeroingTimeoutFixed
858 , pZeroingTimeoutPerMiB
859 , pLongSleep
860 ],
861 "instance_name")
862 , ("OpBackupRemove",
863 [t| () |],
864 OpDoc.opBackupRemove,
865 [ pInstanceName
866 , pInstanceUuid
867 ],
868 "instance_name")
869 , ("OpTagsGet",
870 [t| [NonEmptyString] |],
871 OpDoc.opTagsGet,
872 [ pTagsObject
873 , pUseLocking
874 , withDoc "Name of object to retrieve tags from" pTagsName
875 ],
876 "name")
877 , ("OpTagsSearch",
878 [t| [(NonEmptyString, NonEmptyString)] |],
879 OpDoc.opTagsSearch,
880 [ pTagSearchPattern
881 ],
882 "pattern")
883 , ("OpTagsSet",
884 [t| () |],
885 OpDoc.opTagsSet,
886 [ pTagsObject
887 , pTagsList
888 , withDoc "Name of object where tag(s) should be added" pTagsName
889 ],
890 [])
891 , ("OpTagsDel",
892 [t| () |],
893 OpDoc.opTagsDel,
894 [ pTagsObject
895 , pTagsList
896 , withDoc "Name of object where tag(s) should be deleted" pTagsName
897 ],
898 [])
899 , ("OpTestDelay",
900 [t| () |],
901 OpDoc.opTestDelay,
902 [ pDelayDuration
903 , pDelayOnMaster
904 , pDelayOnNodes
905 , pDelayOnNodeUuids
906 , pDelayRepeat
907 , pDelayInterruptible
908 , pDelayNoLocks
909 ],
910 "duration")
911 , ("OpTestAllocator",
912 [t| String |],
913 OpDoc.opTestAllocator,
914 [ pIAllocatorDirection
915 , pIAllocatorMode
916 , pIAllocatorReqName
917 , pIAllocatorNics
918 , pIAllocatorDisks
919 , pHypervisor
920 , pIallocator
921 , pInstTags
922 , pIAllocatorMemory
923 , pIAllocatorVCpus
924 , pIAllocatorOs
925 , pOptDiskTemplate
926 , pIAllocatorInstances
927 , pIAllocatorEvacMode
928 , pTargetGroups
929 , pIAllocatorSpindleUse
930 , pIAllocatorCount
931 , pOptGroupName
932 ],
933 "iallocator")
934 , ("OpTestJqueue",
935 [t| Bool |],
936 OpDoc.opTestJqueue,
937 [ pJQueueNotifyWaitLock
938 , pJQueueNotifyExec
939 , pJQueueLogMessages
940 , pJQueueFail
941 ],
942 [])
943 , ("OpTestOsParams",
944 [t| () |],
945 OpDoc.opTestOsParams,
946 [ pInstOsParamsSecret
947 ],
948 [])
949 , ("OpTestDummy",
950 [t| () |],
951 OpDoc.opTestDummy,
952 [ pTestDummyResult
953 , pTestDummyMessages
954 , pTestDummyFail
955 , pTestDummySubmitJobs
956 ],
957 [])
958 , ("OpNetworkAdd",
959 [t| () |],
960 OpDoc.opNetworkAdd,
961 [ pNetworkName
962 , pNetworkAddress4
963 , pNetworkGateway4
964 , pNetworkAddress6
965 , pNetworkGateway6
966 , pNetworkMacPrefix
967 , pNetworkAddRsvdIps
968 , pIpConflictsCheck
969 , withDoc "Network tags" pInstTags
970 ],
971 "network_name")
972 , ("OpNetworkRemove",
973 [t| () |],
974 OpDoc.opNetworkRemove,
975 [ pNetworkName
976 , pForce
977 ],
978 "network_name")
979 , ("OpNetworkSetParams",
980 [t| () |],
981 OpDoc.opNetworkSetParams,
982 [ pNetworkName
983 , pNetworkGateway4
984 , pNetworkAddress6
985 , pNetworkGateway6
986 , pNetworkMacPrefix
987 , withDoc "Which external IP addresses to reserve" pNetworkAddRsvdIps
988 , pNetworkRemoveRsvdIps
989 ],
990 "network_name")
991 , ("OpNetworkConnect",
992 [t| () |],
993 OpDoc.opNetworkConnect,
994 [ pGroupName
995 , pNetworkName
996 , pNetworkMode
997 , pNetworkLink
998 , pNetworkVlan
999 , pIpConflictsCheck
1000 ],
1001 "network_name")
1002 , ("OpNetworkDisconnect",
1003 [t| () |],
1004 OpDoc.opNetworkDisconnect,
1005 [ pGroupName
1006 , pNetworkName
1007 ],
1008 "network_name")
1009 ])
1010
1011 deriving instance Ord OpCode
1012
1013 -- | Returns the OP_ID for a given opcode value.
1014 $(genOpID ''OpCode "opID")
1015
1016 -- | A list of all defined/supported opcode IDs.
1017 $(genAllOpIDs ''OpCode "allOpIDs")
1018
1019 -- | Convert the opcode name to lowercase with underscores and strip
1020 -- the @Op@ prefix.
1021 $(genOpLowerStrip (C.opcodeReasonSrcOpcode ++ ":") ''OpCode "opReasonSrcID")
1022
1023 instance JSON OpCode where
1024 readJSON = readJSONfromDict
1025 showJSON = showJSONtoDict
1026
1027 -- | Generates the summary value for an opcode.
1028 opSummaryVal :: OpCode -> Maybe String
1029 opSummaryVal OpClusterVerifyGroup { opGroupName = s } = Just (fromNonEmpty s)
1030 opSummaryVal OpGroupVerifyDisks { opGroupName = s } = Just (fromNonEmpty s)
1031 opSummaryVal OpClusterRename { opName = s } = Just (fromNonEmpty s)
1032 opSummaryVal OpQuery { opWhat = s } = Just (queryTypeOpToRaw s)
1033 opSummaryVal OpQueryFields { opWhat = s } = Just (queryTypeOpToRaw s)
1034 opSummaryVal OpNodeRemove { opNodeName = s } = Just (fromNonEmpty s)
1035 opSummaryVal OpNodeAdd { opNodeName = s } = Just (fromNonEmpty s)
1036 opSummaryVal OpNodeModifyStorage { opNodeName = s } = Just (fromNonEmpty s)
1037 opSummaryVal OpRepairNodeStorage { opNodeName = s } = Just (fromNonEmpty s)
1038 opSummaryVal OpNodeSetParams { opNodeName = s } = Just (fromNonEmpty s)
1039 opSummaryVal OpNodePowercycle { opNodeName = s } = Just (fromNonEmpty s)
1040 opSummaryVal OpNodeMigrate { opNodeName = s } = Just (fromNonEmpty s)
1041 opSummaryVal OpNodeEvacuate { opNodeName = s } = Just (fromNonEmpty s)
1042 opSummaryVal OpInstanceCreate { opInstanceName = s } = Just s
1043 opSummaryVal OpInstanceReinstall { opInstanceName = s } = Just s
1044 opSummaryVal OpInstanceRemove { opInstanceName = s } = Just s
1045 -- FIXME: instance rename should show both names; currently it shows none
1046 -- opSummaryVal OpInstanceRename { opInstanceName = s } = Just s
1047 opSummaryVal OpInstanceStartup { opInstanceName = s } = Just s
1048 opSummaryVal OpInstanceShutdown { opInstanceName = s } = Just s
1049 opSummaryVal OpInstanceReboot { opInstanceName = s } = Just s
1050 opSummaryVal OpInstanceReplaceDisks { opInstanceName = s } = Just s
1051 opSummaryVal OpInstanceFailover { opInstanceName = s } = Just s
1052 opSummaryVal OpInstanceMigrate { opInstanceName = s } = Just s
1053 opSummaryVal OpInstanceMove { opInstanceName = s } = Just s
1054 opSummaryVal OpInstanceConsole { opInstanceName = s } = Just s
1055 opSummaryVal OpInstanceActivateDisks { opInstanceName = s } = Just s
1056 opSummaryVal OpInstanceDeactivateDisks { opInstanceName = s } = Just s
1057 opSummaryVal OpInstanceRecreateDisks { opInstanceName = s } = Just s
1058 opSummaryVal OpInstanceSetParams { opInstanceName = s } = Just s
1059 opSummaryVal OpInstanceGrowDisk { opInstanceName = s } = Just s
1060 opSummaryVal OpInstanceChangeGroup { opInstanceName = s } = Just s
1061 opSummaryVal OpGroupAdd { opGroupName = s } = Just (fromNonEmpty s)
1062 opSummaryVal OpGroupAssignNodes { opGroupName = s } = Just (fromNonEmpty s)
1063 opSummaryVal OpGroupSetParams { opGroupName = s } = Just (fromNonEmpty s)
1064 opSummaryVal OpGroupRemove { opGroupName = s } = Just (fromNonEmpty s)
1065 opSummaryVal OpGroupEvacuate { opGroupName = s } = Just (fromNonEmpty s)
1066 opSummaryVal OpBackupPrepare { opInstanceName = s } = Just s
1067 opSummaryVal OpBackupExport { opInstanceName = s } = Just s
1068 opSummaryVal OpBackupRemove { opInstanceName = s } = Just s
1069 opSummaryVal OpTagsGet { opKind = s } = Just (show s)
1070 opSummaryVal OpTagsSearch { opTagSearchPattern = s } = Just (fromNonEmpty s)
1071 opSummaryVal OpTestDelay { opDelayDuration = d } = Just (show d)
1072 opSummaryVal OpTestAllocator { opIallocator = s } =
1073 -- FIXME: Python doesn't handle None fields well, so we have behave the same
1074 Just $ maybe "None" fromNonEmpty s
1075 opSummaryVal OpNetworkAdd { opNetworkName = s} = Just (fromNonEmpty s)
1076 opSummaryVal OpNetworkRemove { opNetworkName = s} = Just (fromNonEmpty s)
1077 opSummaryVal OpNetworkSetParams { opNetworkName = s} = Just (fromNonEmpty s)
1078 opSummaryVal OpNetworkConnect { opNetworkName = s} = Just (fromNonEmpty s)
1079 opSummaryVal OpNetworkDisconnect { opNetworkName = s} = Just (fromNonEmpty s)
1080 opSummaryVal _ = Nothing
1081
1082 -- | Computes the summary of the opcode.
1083 opSummary :: OpCode -> String
1084 opSummary op =
1085 case opSummaryVal op of
1086 Nothing -> op_suffix
1087 Just s -> op_suffix ++ "(" ++ s ++ ")"
1088 where op_suffix = drop 3 $ opID op
1089
1090 -- | Generic\/common opcode parameters.
1091 $(buildObject "CommonOpParams" "op"
1092 [ pDryRun
1093 , pDebugLevel
1094 , pOpPriority
1095 , pDependencies
1096 , pComment
1097 , pReason
1098 ])
1099
1100 deriving instance Ord CommonOpParams
1101
1102 -- | Default common parameter values.
1103 defOpParams :: CommonOpParams
1104 defOpParams =
1105 CommonOpParams { opDryRun = Nothing
1106 , opDebugLevel = Nothing
1107 , opPriority = OpPrioNormal
1108 , opDepends = Nothing
1109 , opComment = Nothing
1110 , opReason = []
1111 }
1112
1113 -- | Resolve relative dependencies to absolute ones, given the job ID.
1114 resolveDependsCommon :: (Monad m) => CommonOpParams -> JobId -> m CommonOpParams
1115 resolveDependsCommon p@(CommonOpParams { opDepends = Just deps}) jid = do
1116 deps' <- mapM (`absoluteJobDependency` jid) deps
1117 return p { opDepends = Just deps' }
1118 resolveDependsCommon p _ = return p
1119
1120 -- | The top-level opcode type.
1121 data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams
1122 , metaOpCode :: OpCode
1123 } deriving (Show, Eq, Ord)
1124
1125 -- | Resolve relative dependencies to absolute ones, given the job Id.
1126 resolveDependencies :: (Monad m) => MetaOpCode -> JobId -> m MetaOpCode
1127 resolveDependencies mopc jid = do
1128 mpar <- resolveDependsCommon (metaParams mopc) jid
1129 return (mopc { metaParams = mpar })
1130
1131 instance DictObject MetaOpCode where
1132 toDict (MetaOpCode meta op) = toDict meta ++ toDict op
1133 fromDictWKeys dict = MetaOpCode <$> fromDictWKeys dict
1134 <*> fromDictWKeys dict
1135
1136 instance JSON MetaOpCode where
1137 readJSON = readJSONfromDict
1138 showJSON = showJSONtoDict
1139
1140 -- | Wraps an 'OpCode' with the default parameters to build a
1141 -- 'MetaOpCode'.
1142 wrapOpCode :: OpCode -> MetaOpCode
1143 wrapOpCode = MetaOpCode defOpParams
1144
1145 -- | Sets the comment on a meta opcode.
1146 setOpComment :: String -> MetaOpCode -> MetaOpCode
1147 setOpComment comment (MetaOpCode common op) =
1148 MetaOpCode (common { opComment = Just comment}) op
1149
1150 -- | Sets the priority on a meta opcode.
1151 setOpPriority :: OpSubmitPriority -> MetaOpCode -> MetaOpCode
1152 setOpPriority prio (MetaOpCode common op) =
1153 MetaOpCode (common { opPriority = prio }) op