Implement predictive queue cluster parameter
[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 , pEnabledPredictiveQueue
275 ],
276 [])
277 , ("OpClusterRedistConf",
278 [t| () |],
279 OpDoc.opClusterRedistConf,
280 [],
281 [])
282 , ("OpClusterActivateMasterIp",
283 [t| () |],
284 OpDoc.opClusterActivateMasterIp,
285 [],
286 [])
287 , ("OpClusterDeactivateMasterIp",
288 [t| () |],
289 OpDoc.opClusterDeactivateMasterIp,
290 [],
291 [])
292 , ("OpClusterRenewCrypto",
293 [t| () |],
294 OpDoc.opClusterRenewCrypto,
295 [ pNodeSslCerts
296 , pRenewSshKeys
297 , pSshKeyType
298 , pSshKeyBits
299 , pVerbose
300 , pDebug
301 ],
302 [])
303 , ("OpQuery",
304 [t| QueryResponse |],
305 OpDoc.opQuery,
306 [ pQueryWhat
307 , pUseLocking
308 , pQueryFields
309 , pQueryFilter
310 ],
311 "what")
312 , ("OpQueryFields",
313 [t| QueryFieldsResponse |],
314 OpDoc.opQueryFields,
315 [ pQueryWhat
316 , pQueryFieldsFields
317 ],
318 "what")
319 , ("OpOobCommand",
320 [t| [[(QueryResultCode, JSValue)]] |],
321 OpDoc.opOobCommand,
322 [ pNodeNames
323 , withDoc "List of node UUIDs to run the OOB command against" pNodeUuids
324 , pOobCommand
325 , pOobTimeout
326 , pIgnoreStatus
327 , pPowerDelay
328 ],
329 [])
330 , ("OpRestrictedCommand",
331 [t| [(Bool, String)] |],
332 OpDoc.opRestrictedCommand,
333 [ pUseLocking
334 , withDoc
335 "Nodes on which the command should be run (at least one)"
336 pRequiredNodes
337 , withDoc
338 "Node UUIDs on which the command should be run (at least one)"
339 pRequiredNodeUuids
340 , pRestrictedCommand
341 ],
342 [])
343 , ("OpRepairCommand",
344 [t| String |],
345 OpDoc.opRepairCommand,
346 [ pNodeName
347 , pRepairCommand
348 , pInput
349 ],
350 [])
351 , ("OpNodeRemove",
352 [t| () |],
353 OpDoc.opNodeRemove,
354 [ pNodeName
355 , pNodeUuid
356 , pVerbose
357 , pDebug
358 ],
359 "node_name")
360 , ("OpNodeAdd",
361 [t| () |],
362 OpDoc.opNodeAdd,
363 [ pNodeName
364 , pHvState
365 , pDiskState
366 , pPrimaryIp
367 , pSecondaryIp
368 , pReadd
369 , pNodeGroup
370 , pMasterCapable
371 , pVmCapable
372 , pNdParams
373 , pNodeSetup
374 , pVerbose
375 , pDebug
376 ],
377 "node_name")
378 , ("OpNodeQueryvols",
379 [t| [JSValue] |],
380 OpDoc.opNodeQueryvols,
381 [ pOutputFields
382 , withDoc "Empty list to query all nodes, node names otherwise" pNodes
383 ],
384 [])
385 , ("OpNodeQueryStorage",
386 [t| [[JSValue]] |],
387 OpDoc.opNodeQueryStorage,
388 [ pOutputFields
389 , pOptStorageType
390 , withDoc
391 "Empty list to query all, list of names to query otherwise"
392 pNodes
393 , pStorageName
394 ],
395 [])
396 , ("OpNodeModifyStorage",
397 [t| () |],
398 OpDoc.opNodeModifyStorage,
399 [ pNodeName
400 , pNodeUuid
401 , pStorageType
402 , pStorageName
403 , pStorageChanges
404 ],
405 "node_name")
406 , ("OpRepairNodeStorage",
407 [t| () |],
408 OpDoc.opRepairNodeStorage,
409 [ pNodeName
410 , pNodeUuid
411 , pStorageType
412 , pStorageName
413 , pIgnoreConsistency
414 ],
415 "node_name")
416 , ("OpNodeSetParams",
417 [t| [(NonEmptyString, JSValue)] |],
418 OpDoc.opNodeSetParams,
419 [ pNodeName
420 , pNodeUuid
421 , pForce
422 , pHvState
423 , pDiskState
424 , pMasterCandidate
425 , withDoc "Whether to mark the node offline" pOffline
426 , pDrained
427 , pAutoPromote
428 , pMasterCapable
429 , pVmCapable
430 , pSecondaryIp
431 , pNdParams
432 , pPowered
433 , pVerbose
434 , pDebug
435 ],
436 "node_name")
437 , ("OpNodePowercycle",
438 [t| Maybe NonEmptyString |],
439 OpDoc.opNodePowercycle,
440 [ pNodeName
441 , pNodeUuid
442 , pForce
443 ],
444 "node_name")
445 , ("OpNodeMigrate",
446 [t| JobIdListOnly |],
447 OpDoc.opNodeMigrate,
448 [ pNodeName
449 , pNodeUuid
450 , pMigrationMode
451 , pMigrationLive
452 , pMigrationTargetNode
453 , pMigrationTargetNodeUuid
454 , pAllowRuntimeChgs
455 , pIgnoreIpolicy
456 , pIallocator
457 ],
458 "node_name")
459 , ("OpNodeEvacuate",
460 [t| JobIdListOnly |],
461 OpDoc.opNodeEvacuate,
462 [ pEarlyRelease
463 , pNodeName
464 , pNodeUuid
465 , pRemoteNode
466 , pRemoteNodeUuid
467 , pIallocator
468 , pEvacMode
469 , pIgnoreSoftErrors
470 ],
471 "node_name")
472 , ("OpInstanceCreate",
473 [t| [NonEmptyString] |],
474 OpDoc.opInstanceCreate,
475 [ pInstanceName
476 , pForceVariant
477 , pWaitForSync
478 , pNameCheck
479 , pIgnoreIpolicy
480 , pOpportunisticLocking
481 , pInstBeParams
482 , pInstDisks
483 , pOptDiskTemplate
484 , pOptGroupName
485 , pFileDriver
486 , pFileStorageDir
487 , pInstHvParams
488 , pHypervisor
489 , pIallocator
490 , pResetDefaults
491 , pIpCheck
492 , pIpConflictsCheck
493 , pInstCreateMode
494 , pInstNics
495 , pNoInstall
496 , pInstOsParams
497 , pInstOsParamsPrivate
498 , pInstOsParamsSecret
499 , pInstOs
500 , pPrimaryNode
501 , pPrimaryNodeUuid
502 , pSecondaryNode
503 , pSecondaryNodeUuid
504 , pSourceHandshake
505 , pSourceInstance
506 , pSourceShutdownTimeout
507 , pSourceX509Ca
508 , pSrcNode
509 , pSrcNodeUuid
510 , pSrcPath
511 , pBackupCompress
512 , pStartInstance
513 , pForthcoming
514 , pCommit
515 , pInstTags
516 , pInstanceCommunication
517 , pHelperStartupTimeout
518 , pHelperShutdownTimeout
519 ],
520 "instance_name")
521 , ("OpInstanceMultiAlloc",
522 [t| InstanceMultiAllocResponse |],
523 OpDoc.opInstanceMultiAlloc,
524 [ pOpportunisticLocking
525 , pIallocator
526 , pMultiAllocInstances
527 ],
528 [])
529 , ("OpInstanceReinstall",
530 [t| () |],
531 OpDoc.opInstanceReinstall,
532 [ pInstanceName
533 , pInstanceUuid
534 , pForceVariant
535 , pInstOs
536 , pTempOsParams
537 , pTempOsParamsPrivate
538 , pTempOsParamsSecret
539 , pTempOsParamsClear
540 , pTempOsParamsPrivateClear
541 , pTempOsParamsRemove
542 , pTempOsParamsPrivateRemove
543 ],
544 "instance_name")
545 , ("OpInstanceRemove",
546 [t| () |],
547 OpDoc.opInstanceRemove,
548 [ pInstanceName
549 , pInstanceUuid
550 , pShutdownTimeout
551 , pIgnoreFailures
552 ],
553 "instance_name")
554 , ("OpInstanceRename",
555 [t| NonEmptyString |],
556 OpDoc.opInstanceRename,
557 [ pInstanceName
558 , pInstanceUuid
559 , withDoc "New instance name" pNewName
560 , pNameCheck
561 , pIpCheck
562 ],
563 [])
564 , ("OpInstanceStartup",
565 [t| () |],
566 OpDoc.opInstanceStartup,
567 [ pInstanceName
568 , pInstanceUuid
569 , pForce
570 , pIgnoreOfflineNodes
571 , pTempHvParams
572 , pTempBeParams
573 , pNoRemember
574 , pStartupPaused
575 -- timeout to cleanup a user down instance
576 , pShutdownTimeout
577 ],
578 "instance_name")
579 , ("OpInstanceShutdown",
580 [t| () |],
581 OpDoc.opInstanceShutdown,
582 [ pInstanceName
583 , pInstanceUuid
584 , pForce
585 , pIgnoreOfflineNodes
586 , pShutdownTimeout'
587 , pNoRemember
588 , pAdminStateSource
589 ],
590 "instance_name")
591 , ("OpInstanceReboot",
592 [t| () |],
593 OpDoc.opInstanceReboot,
594 [ pInstanceName
595 , pInstanceUuid
596 , pShutdownTimeout
597 , pIgnoreSecondaries
598 , pRebootType
599 ],
600 "instance_name")
601 , ("OpInstanceReplaceDisks",
602 [t| () |],
603 OpDoc.opInstanceReplaceDisks,
604 [ pInstanceName
605 , pInstanceUuid
606 , pEarlyRelease
607 , pIgnoreIpolicy
608 , pReplaceDisksMode
609 , pReplaceDisksList
610 , pRemoteNode
611 , pRemoteNodeUuid
612 , pIallocator
613 ],
614 "instance_name")
615 , ("OpInstanceFailover",
616 [t| () |],
617 OpDoc.opInstanceFailover,
618 [ pInstanceName
619 , pInstanceUuid
620 , pShutdownTimeout
621 , pIgnoreConsistency
622 , pMigrationTargetNode
623 , pMigrationTargetNodeUuid
624 , pIgnoreIpolicy
625 , pMigrationCleanup
626 , pIallocator
627 ],
628 "instance_name")
629 , ("OpInstanceMigrate",
630 [t| () |],
631 OpDoc.opInstanceMigrate,
632 [ pInstanceName
633 , pInstanceUuid
634 , pMigrationMode
635 , pMigrationLive
636 , pMigrationTargetNode
637 , pMigrationTargetNodeUuid
638 , pAllowRuntimeChgs
639 , pIgnoreIpolicy
640 , pMigrationCleanup
641 , pIallocator
642 , pAllowFailover
643 , pIgnoreHVVersions
644 ],
645 "instance_name")
646 , ("OpInstanceMove",
647 [t| () |],
648 OpDoc.opInstanceMove,
649 [ pInstanceName
650 , pInstanceUuid
651 , pShutdownTimeout
652 , pIgnoreIpolicy
653 , pMoveTargetNode
654 , pMoveTargetNodeUuid
655 , pMoveCompress
656 , pIgnoreConsistency
657 ],
658 "instance_name")
659 , ("OpInstanceConsole",
660 [t| JSObject JSValue |],
661 OpDoc.opInstanceConsole,
662 [ pInstanceName
663 , pInstanceUuid
664 ],
665 "instance_name")
666 , ("OpInstanceActivateDisks",
667 [t| [(NonEmptyString, NonEmptyString, Maybe NonEmptyString)] |],
668 OpDoc.opInstanceActivateDisks,
669 [ pInstanceName
670 , pInstanceUuid
671 , pIgnoreDiskSize
672 , pWaitForSyncFalse
673 ],
674 "instance_name")
675 , ("OpInstanceDeactivateDisks",
676 [t| () |],
677 OpDoc.opInstanceDeactivateDisks,
678 [ pInstanceName
679 , pInstanceUuid
680 , pForce
681 ],
682 "instance_name")
683 , ("OpInstanceRecreateDisks",
684 [t| () |],
685 OpDoc.opInstanceRecreateDisks,
686 [ pInstanceName
687 , pInstanceUuid
688 , pRecreateDisksInfo
689 , withDoc "New instance nodes, if relocation is desired" pNodes
690 , withDoc "New instance node UUIDs, if relocation is desired" pNodeUuids
691 , pIallocator
692 ],
693 "instance_name")
694 , ("OpInstanceQueryData",
695 [t| JSObject (JSObject JSValue) |],
696 OpDoc.opInstanceQueryData,
697 [ pUseLocking
698 , pInstances
699 , pStatic
700 ],
701 [])
702 , ("OpInstanceSetParams",
703 [t| [(NonEmptyString, JSValue)] |],
704 OpDoc.opInstanceSetParams,
705 [ pInstanceName
706 , pInstanceUuid
707 , pForce
708 , pForceVariant
709 , pIgnoreIpolicy
710 , pInstParamsNicChanges
711 , pInstParamsDiskChanges
712 , pInstBeParams
713 , pRuntimeMem
714 , pInstHvParams
715 , pOptDiskTemplate
716 , pExtParams
717 , pFileDriver
718 , pFileStorageDir
719 , pPrimaryNode
720 , pPrimaryNodeUuid
721 , withDoc "Secondary node (used when changing disk template)" pRemoteNode
722 , withDoc
723 "Secondary node UUID (used when changing disk template)"
724 pRemoteNodeUuid
725 , pIallocator
726 , pOsNameChange
727 , pInstOsParams
728 , pInstOsParamsPrivate
729 , pInstOsParamsClear
730 , pInstOsParamsPrivateClear
731 , pInstOsParamsRemove
732 , pInstOsParamsPrivateRemove
733 , pWaitForSync
734 , withDoc "Whether to mark the instance as offline" pOffline
735 , pIpConflictsCheck
736 , pHotplug
737 , pHotplugIfPossible
738 , pOptInstanceCommunication
739 ],
740 "instance_name")
741 , ("OpInstanceGrowDisk",
742 [t| () |],
743 OpDoc.opInstanceGrowDisk,
744 [ pInstanceName
745 , pInstanceUuid
746 , pWaitForSync
747 , pDiskIndex
748 , pDiskChgAmount
749 , pDiskChgAbsolute
750 , pIgnoreIpolicy
751 ],
752 "instance_name")
753 , ("OpInstanceChangeGroup",
754 [t| JobIdListOnly |],
755 OpDoc.opInstanceChangeGroup,
756 [ pInstanceName
757 , pInstanceUuid
758 , pEarlyRelease
759 , pIallocator
760 , pTargetGroups
761 ],
762 "instance_name")
763 , ("OpGroupAdd",
764 [t| Either () JobIdListOnly |],
765 OpDoc.opGroupAdd,
766 [ pGroupName
767 , pNodeGroupAllocPolicy
768 , pGroupNodeParams
769 , pGroupDiskParams
770 , pHvState
771 , pDiskState
772 , withDoc "Group-wide ipolicy specs" pIpolicy
773 ],
774 "group_name")
775 , ("OpGroupAssignNodes",
776 [t| () |],
777 OpDoc.opGroupAssignNodes,
778 [ pGroupName
779 , pForce
780 , withDoc "List of nodes to assign" pRequiredNodes
781 , withDoc "List of node UUIDs to assign" pRequiredNodeUuids
782 ],
783 "group_name")
784 , ("OpGroupSetParams",
785 [t| [(NonEmptyString, JSValue)] |],
786 OpDoc.opGroupSetParams,
787 [ pGroupName
788 , pNodeGroupAllocPolicy
789 , pGroupNodeParams
790 , pGroupDiskParams
791 , pHvState
792 , pDiskState
793 , withDoc "Group-wide ipolicy specs" pIpolicy
794 ],
795 "group_name")
796 , ("OpGroupRemove",
797 [t| () |],
798 OpDoc.opGroupRemove,
799 [ pGroupName
800 ],
801 "group_name")
802 , ("OpGroupRename",
803 [t| NonEmptyString |],
804 OpDoc.opGroupRename,
805 [ pGroupName
806 , withDoc "New group name" pNewName
807 ],
808 [])
809 , ("OpGroupEvacuate",
810 [t| JobIdListOnly |],
811 OpDoc.opGroupEvacuate,
812 [ pGroupName
813 , pEarlyRelease
814 , pIallocator
815 , pTargetGroups
816 , pSequential
817 , pForceFailover
818 ],
819 "group_name")
820 , ("OpOsDiagnose",
821 [t| [[JSValue]] |],
822 OpDoc.opOsDiagnose,
823 [ pOutputFields
824 , withDoc "Which operating systems to diagnose" pNames
825 ],
826 [])
827 , ("OpExtStorageDiagnose",
828 [t| [[JSValue]] |],
829 OpDoc.opExtStorageDiagnose,
830 [ pOutputFields
831 , withDoc "Which ExtStorage Provider to diagnose" pNames
832 ],
833 [])
834 , ("OpBackupPrepare",
835 [t| Maybe (JSObject JSValue) |],
836 OpDoc.opBackupPrepare,
837 [ pInstanceName
838 , pInstanceUuid
839 , pExportMode
840 ],
841 "instance_name")
842 , ("OpBackupExport",
843 [t| (Bool, [Bool]) |],
844 OpDoc.opBackupExport,
845 [ pInstanceName
846 , pInstanceUuid
847 , pBackupCompress
848 , pShutdownTimeout
849 , pExportTargetNode
850 , pExportTargetNodeUuid
851 , pShutdownInstance
852 , pRemoveInstance
853 , pIgnoreRemoveFailures
854 , defaultField [| ExportModeLocal |] pExportMode
855 , pX509KeyName
856 , pX509DestCA
857 , pZeroFreeSpace
858 , pZeroingTimeoutFixed
859 , pZeroingTimeoutPerMiB
860 , pLongSleep
861 ],
862 "instance_name")
863 , ("OpBackupRemove",
864 [t| () |],
865 OpDoc.opBackupRemove,
866 [ pInstanceName
867 , pInstanceUuid
868 ],
869 "instance_name")
870 , ("OpTagsGet",
871 [t| [NonEmptyString] |],
872 OpDoc.opTagsGet,
873 [ pTagsObject
874 , pUseLocking
875 , withDoc "Name of object to retrieve tags from" pTagsName
876 ],
877 "name")
878 , ("OpTagsSearch",
879 [t| [(NonEmptyString, NonEmptyString)] |],
880 OpDoc.opTagsSearch,
881 [ pTagSearchPattern
882 ],
883 "pattern")
884 , ("OpTagsSet",
885 [t| () |],
886 OpDoc.opTagsSet,
887 [ pTagsObject
888 , pTagsList
889 , withDoc "Name of object where tag(s) should be added" pTagsName
890 ],
891 [])
892 , ("OpTagsDel",
893 [t| () |],
894 OpDoc.opTagsDel,
895 [ pTagsObject
896 , pTagsList
897 , withDoc "Name of object where tag(s) should be deleted" pTagsName
898 ],
899 [])
900 , ("OpTestDelay",
901 [t| () |],
902 OpDoc.opTestDelay,
903 [ pDelayDuration
904 , pDelayOnMaster
905 , pDelayOnNodes
906 , pDelayOnNodeUuids
907 , pDelayRepeat
908 , pDelayInterruptible
909 , pDelayNoLocks
910 ],
911 "duration")
912 , ("OpTestAllocator",
913 [t| String |],
914 OpDoc.opTestAllocator,
915 [ pIAllocatorDirection
916 , pIAllocatorMode
917 , pIAllocatorReqName
918 , pIAllocatorNics
919 , pIAllocatorDisks
920 , pHypervisor
921 , pIallocator
922 , pInstTags
923 , pIAllocatorMemory
924 , pIAllocatorVCpus
925 , pIAllocatorOs
926 , pOptDiskTemplate
927 , pIAllocatorInstances
928 , pIAllocatorEvacMode
929 , pTargetGroups
930 , pIAllocatorSpindleUse
931 , pIAllocatorCount
932 , pOptGroupName
933 ],
934 "iallocator")
935 , ("OpTestJqueue",
936 [t| Bool |],
937 OpDoc.opTestJqueue,
938 [ pJQueueNotifyWaitLock
939 , pJQueueNotifyExec
940 , pJQueueLogMessages
941 , pJQueueFail
942 ],
943 [])
944 , ("OpTestOsParams",
945 [t| () |],
946 OpDoc.opTestOsParams,
947 [ pInstOsParamsSecret
948 ],
949 [])
950 , ("OpTestDummy",
951 [t| () |],
952 OpDoc.opTestDummy,
953 [ pTestDummyResult
954 , pTestDummyMessages
955 , pTestDummyFail
956 , pTestDummySubmitJobs
957 ],
958 [])
959 , ("OpNetworkAdd",
960 [t| () |],
961 OpDoc.opNetworkAdd,
962 [ pNetworkName
963 , pNetworkAddress4
964 , pNetworkGateway4
965 , pNetworkAddress6
966 , pNetworkGateway6
967 , pNetworkMacPrefix
968 , pNetworkAddRsvdIps
969 , pIpConflictsCheck
970 , withDoc "Network tags" pInstTags
971 ],
972 "network_name")
973 , ("OpNetworkRemove",
974 [t| () |],
975 OpDoc.opNetworkRemove,
976 [ pNetworkName
977 , pForce
978 ],
979 "network_name")
980 , ("OpNetworkSetParams",
981 [t| () |],
982 OpDoc.opNetworkSetParams,
983 [ pNetworkName
984 , pNetworkGateway4
985 , pNetworkAddress6
986 , pNetworkGateway6
987 , pNetworkMacPrefix
988 , withDoc "Which external IP addresses to reserve" pNetworkAddRsvdIps
989 , pNetworkRemoveRsvdIps
990 ],
991 "network_name")
992 , ("OpNetworkConnect",
993 [t| () |],
994 OpDoc.opNetworkConnect,
995 [ pGroupName
996 , pNetworkName
997 , pNetworkMode
998 , pNetworkLink
999 , pNetworkVlan
1000 , pIpConflictsCheck
1001 ],
1002 "network_name")
1003 , ("OpNetworkDisconnect",
1004 [t| () |],
1005 OpDoc.opNetworkDisconnect,
1006 [ pGroupName
1007 , pNetworkName
1008 ],
1009 "network_name")
1010 ])
1011
1012 deriving instance Ord OpCode
1013
1014 -- | Returns the OP_ID for a given opcode value.
1015 $(genOpID ''OpCode "opID")
1016
1017 -- | A list of all defined/supported opcode IDs.
1018 $(genAllOpIDs ''OpCode "allOpIDs")
1019
1020 -- | Convert the opcode name to lowercase with underscores and strip
1021 -- the @Op@ prefix.
1022 $(genOpLowerStrip (C.opcodeReasonSrcOpcode ++ ":") ''OpCode "opReasonSrcID")
1023
1024 instance JSON OpCode where
1025 readJSON = readJSONfromDict
1026 showJSON = showJSONtoDict
1027
1028 -- | Generates the summary value for an opcode.
1029 opSummaryVal :: OpCode -> Maybe String
1030 opSummaryVal OpClusterVerifyGroup { opGroupName = s } = Just (fromNonEmpty s)
1031 opSummaryVal OpGroupVerifyDisks { opGroupName = s } = Just (fromNonEmpty s)
1032 opSummaryVal OpClusterRename { opName = s } = Just (fromNonEmpty s)
1033 opSummaryVal OpQuery { opWhat = s } = Just (queryTypeOpToRaw s)
1034 opSummaryVal OpQueryFields { opWhat = s } = Just (queryTypeOpToRaw s)
1035 opSummaryVal OpNodeRemove { opNodeName = s } = Just (fromNonEmpty s)
1036 opSummaryVal OpNodeAdd { opNodeName = s } = Just (fromNonEmpty s)
1037 opSummaryVal OpNodeModifyStorage { opNodeName = s } = Just (fromNonEmpty s)
1038 opSummaryVal OpRepairNodeStorage { opNodeName = s } = Just (fromNonEmpty s)
1039 opSummaryVal OpNodeSetParams { opNodeName = s } = Just (fromNonEmpty s)
1040 opSummaryVal OpNodePowercycle { opNodeName = s } = Just (fromNonEmpty s)
1041 opSummaryVal OpNodeMigrate { opNodeName = s } = Just (fromNonEmpty s)
1042 opSummaryVal OpNodeEvacuate { opNodeName = s } = Just (fromNonEmpty s)
1043 opSummaryVal OpInstanceCreate { opInstanceName = s } = Just s
1044 opSummaryVal OpInstanceReinstall { opInstanceName = s } = Just s
1045 opSummaryVal OpInstanceRemove { opInstanceName = s } = Just s
1046 -- FIXME: instance rename should show both names; currently it shows none
1047 -- opSummaryVal OpInstanceRename { opInstanceName = s } = Just s
1048 opSummaryVal OpInstanceStartup { opInstanceName = s } = Just s
1049 opSummaryVal OpInstanceShutdown { opInstanceName = s } = Just s
1050 opSummaryVal OpInstanceReboot { opInstanceName = s } = Just s
1051 opSummaryVal OpInstanceReplaceDisks { opInstanceName = s } = Just s
1052 opSummaryVal OpInstanceFailover { opInstanceName = s } = Just s
1053 opSummaryVal OpInstanceMigrate { opInstanceName = s } = Just s
1054 opSummaryVal OpInstanceMove { opInstanceName = s } = Just s
1055 opSummaryVal OpInstanceConsole { opInstanceName = s } = Just s
1056 opSummaryVal OpInstanceActivateDisks { opInstanceName = s } = Just s
1057 opSummaryVal OpInstanceDeactivateDisks { opInstanceName = s } = Just s
1058 opSummaryVal OpInstanceRecreateDisks { opInstanceName = s } = Just s
1059 opSummaryVal OpInstanceSetParams { opInstanceName = s } = Just s
1060 opSummaryVal OpInstanceGrowDisk { opInstanceName = s } = Just s
1061 opSummaryVal OpInstanceChangeGroup { opInstanceName = s } = Just s
1062 opSummaryVal OpGroupAdd { opGroupName = s } = Just (fromNonEmpty s)
1063 opSummaryVal OpGroupAssignNodes { opGroupName = s } = Just (fromNonEmpty s)
1064 opSummaryVal OpGroupSetParams { opGroupName = s } = Just (fromNonEmpty s)
1065 opSummaryVal OpGroupRemove { opGroupName = s } = Just (fromNonEmpty s)
1066 opSummaryVal OpGroupEvacuate { opGroupName = s } = Just (fromNonEmpty s)
1067 opSummaryVal OpBackupPrepare { opInstanceName = s } = Just s
1068 opSummaryVal OpBackupExport { opInstanceName = s } = Just s
1069 opSummaryVal OpBackupRemove { opInstanceName = s } = Just s
1070 opSummaryVal OpTagsGet { opKind = s } = Just (show s)
1071 opSummaryVal OpTagsSearch { opTagSearchPattern = s } = Just (fromNonEmpty s)
1072 opSummaryVal OpTestDelay { opDelayDuration = d } = Just (show d)
1073 opSummaryVal OpTestAllocator { opIallocator = s } =
1074 -- FIXME: Python doesn't handle None fields well, so we have behave the same
1075 Just $ maybe "None" fromNonEmpty s
1076 opSummaryVal OpNetworkAdd { opNetworkName = s} = Just (fromNonEmpty s)
1077 opSummaryVal OpNetworkRemove { opNetworkName = s} = Just (fromNonEmpty s)
1078 opSummaryVal OpNetworkSetParams { opNetworkName = s} = Just (fromNonEmpty s)
1079 opSummaryVal OpNetworkConnect { opNetworkName = s} = Just (fromNonEmpty s)
1080 opSummaryVal OpNetworkDisconnect { opNetworkName = s} = Just (fromNonEmpty s)
1081 opSummaryVal _ = Nothing
1082
1083 -- | Computes the summary of the opcode.
1084 opSummary :: OpCode -> String
1085 opSummary op =
1086 case opSummaryVal op of
1087 Nothing -> op_suffix
1088 Just s -> op_suffix ++ "(" ++ s ++ ")"
1089 where op_suffix = drop 3 $ opID op
1090
1091 -- | Generic\/common opcode parameters.
1092 $(buildObject "CommonOpParams" "op"
1093 [ pDryRun
1094 , pDebugLevel
1095 , pOpPriority
1096 , pDependencies
1097 , pComment
1098 , pReason
1099 ])
1100
1101 deriving instance Ord CommonOpParams
1102
1103 -- | Default common parameter values.
1104 defOpParams :: CommonOpParams
1105 defOpParams =
1106 CommonOpParams { opDryRun = Nothing
1107 , opDebugLevel = Nothing
1108 , opPriority = OpPrioNormal
1109 , opDepends = Nothing
1110 , opComment = Nothing
1111 , opReason = []
1112 }
1113
1114 -- | Resolve relative dependencies to absolute ones, given the job ID.
1115 resolveDependsCommon :: (Monad m) => CommonOpParams -> JobId -> m CommonOpParams
1116 resolveDependsCommon p@(CommonOpParams { opDepends = Just deps}) jid = do
1117 deps' <- mapM (`absoluteJobDependency` jid) deps
1118 return p { opDepends = Just deps' }
1119 resolveDependsCommon p _ = return p
1120
1121 -- | The top-level opcode type.
1122 data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams
1123 , metaOpCode :: OpCode
1124 } deriving (Show, Eq, Ord)
1125
1126 -- | Resolve relative dependencies to absolute ones, given the job Id.
1127 resolveDependencies :: (Monad m) => MetaOpCode -> JobId -> m MetaOpCode
1128 resolveDependencies mopc jid = do
1129 mpar <- resolveDependsCommon (metaParams mopc) jid
1130 return (mopc { metaParams = mpar })
1131
1132 instance DictObject MetaOpCode where
1133 toDict (MetaOpCode meta op) = toDict meta ++ toDict op
1134 fromDictWKeys dict = MetaOpCode <$> fromDictWKeys dict
1135 <*> fromDictWKeys dict
1136
1137 instance JSON MetaOpCode where
1138 readJSON = readJSONfromDict
1139 showJSON = showJSONtoDict
1140
1141 -- | Wraps an 'OpCode' with the default parameters to build a
1142 -- 'MetaOpCode'.
1143 wrapOpCode :: OpCode -> MetaOpCode
1144 wrapOpCode = MetaOpCode defOpParams
1145
1146 -- | Sets the comment on a meta opcode.
1147 setOpComment :: String -> MetaOpCode -> MetaOpCode
1148 setOpComment comment (MetaOpCode common op) =
1149 MetaOpCode (common { opComment = Just comment}) op
1150
1151 -- | Sets the priority on a meta opcode.
1152 setOpPriority :: OpSubmitPriority -> MetaOpCode -> MetaOpCode
1153 setOpPriority prio (MetaOpCode common op) =
1154 MetaOpCode (common { opPriority = prio }) op