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