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