1 {-# LANGUAGE TemplateHaskell #-}
3 {-| Implementation of the opcodes.
9 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
11 This program is free software; you can redistribute it and/or modify
12 it under the terms of the GNU General Public License as published by
13 the Free Software Foundation; either version 2 of the License, or
14 (at your option) any later version.
16 This program is distributed in the hope that it will be useful, but
17 WITHOUT ANY WARRANTY; without even the implied warranty of
18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 General Public License for more details.
21 You should have received a copy of the GNU General Public License
22 along with this program; if not, write to the Free Software
23 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
34 , ReplaceDisksMode(..)
49 import Data.Maybe (fromMaybe)
50 import Text.JSON (readJSON, showJSON, JSON, JSValue, makeObj)
51 import qualified Text.JSON
55 import Ganeti.OpParams
56 import Ganeti.Types (OpSubmitPriority(..), fromNonEmpty)
57 import Ganeti.Query.Language (queryTypeOpToRaw)
59 -- | OpCode representation.
61 -- We only implement a subset of Ganeti opcodes: those which are actually used
62 -- in the htools codebase.
70 , ("OpInstanceReplaceDisks",
79 , ("OpInstanceFailover",
83 , pMigrationTargetNode
87 , ("OpInstanceMigrate",
91 , pMigrationTargetNode
103 [ pTagSearchPattern ])
112 , ("OpClusterPostInit", [])
113 , ("OpClusterDestroy", [])
114 , ("OpClusterQuery", [])
115 , ("OpClusterVerify",
116 [ pDebugSimulateErrors
123 , ("OpClusterVerifyConfig",
124 [ pDebugSimulateErrors
129 , ("OpClusterVerifyGroup",
131 , pDebugSimulateErrors
137 , ("OpClusterVerifyDisks", [])
138 , ("OpGroupVerifyDisks",
141 , ("OpClusterRepairDiskSizes",
144 , ("OpClusterConfigQuery",
147 , ("OpClusterRename",
150 , ("OpClusterSetParams",
154 , pEnabledHypervisors
164 , pMaintainNodeHealth
176 , pUseExternalMipScript
178 , ("OpClusterRedistConf", [])
179 , ("OpClusterActivateMasterIp", [])
180 , ("OpClusterDeactivateMasterIp", [])
198 , ("OpNodeRemove", [ pNodeName ])
211 , ("OpNodeQuery", dOldQuery)
212 , ("OpNodeQueryvols",
216 , ("OpNodeQueryStorage",
222 , ("OpNodeModifyStorage",
228 , ("OpRepairNodeStorage",
234 , ("OpNodeSetParams",
249 , ("OpNodePowercycle",
257 , pMigrationTargetNode
269 , ("OpInstanceCreate",
295 , pSourceShutdownTimeout
300 , pOpportunisticLocking
303 , ("OpInstanceMultiAlloc",
305 , pMultiAllocInstances
306 , pOpportunisticLocking
308 , ("OpInstanceReinstall",
314 , ("OpInstanceRemove",
319 , ("OpInstanceRename",
325 , ("OpInstanceStartup",
328 , pIgnoreOfflineNodes
334 , ("OpInstanceShutdown",
337 , pIgnoreOfflineNodes
341 , ("OpInstanceReboot",
354 , ("OpInstanceConsole",
356 , ("OpInstanceActivateDisks",
361 , ("OpInstanceDeactivateDisks",
365 , ("OpInstanceRecreateDisks",
371 , ("OpInstanceQuery", dOldQuery)
372 , ("OpInstanceQueryData",
377 , ("OpInstanceSetParams",
382 , pInstParamsNicChanges
383 , pInstParamsDiskChanges
395 , ("OpInstanceGrowDisk",
402 , ("OpInstanceChangeGroup",
410 , pNodeGroupAllocPolicy
417 , ("OpGroupAssignNodes",
422 , ("OpGroupQuery", dOldQueryNoLocking)
423 , ("OpGroupSetParams",
425 , pNodeGroupAllocPolicy
438 , ("OpGroupEvacuate",
447 , ("OpExtStorageDiagnose",
454 , ("OpBackupPrepare",
464 , pIgnoreRemoveFailures
471 , ("OpTestAllocator",
472 [ pIAllocatorDirection
484 , pIAllocatorInstances
485 , pIAllocatorEvacMode
487 , pIAllocatorSpindleUse
491 [ pJQueueNotifyWaitLock
500 , pTestDummySubmitJobs
513 , ("OpNetworkRemove",
517 , ("OpNetworkSetParams",
524 , pNetworkRemoveRsvdIps
526 , ("OpNetworkConnect",
533 , ("OpNetworkDisconnect",
538 , ("OpNetworkQuery", dOldQuery)
539 , ("OpRestrictedCommand",
546 -- | Returns the OP_ID for a given opcode value.
547 $(genOpID ''OpCode "opID")
549 -- | A list of all defined/supported opcode IDs.
550 $(genAllOpIDs ''OpCode "allOpIDs")
552 instance JSON OpCode where
553 readJSON = loadOpCode
554 showJSON = saveOpCode
556 -- | Generates the summary value for an opcode.
557 opSummaryVal :: OpCode -> Maybe String
558 opSummaryVal OpClusterVerifyGroup { opGroupName = s } = Just (fromNonEmpty s)
559 opSummaryVal OpGroupVerifyDisks { opGroupName = s } = Just (fromNonEmpty s)
560 opSummaryVal OpClusterRename { opName = s } = Just (fromNonEmpty s)
561 opSummaryVal OpQuery { opWhat = s } = Just (queryTypeOpToRaw s)
562 opSummaryVal OpQueryFields { opWhat = s } = Just (queryTypeOpToRaw s)
563 opSummaryVal OpNodeRemove { opNodeName = s } = Just (fromNonEmpty s)
564 opSummaryVal OpNodeAdd { opNodeName = s } = Just (fromNonEmpty s)
565 opSummaryVal OpNodeModifyStorage { opNodeName = s } = Just (fromNonEmpty s)
566 opSummaryVal OpRepairNodeStorage { opNodeName = s } = Just (fromNonEmpty s)
567 opSummaryVal OpNodeSetParams { opNodeName = s } = Just (fromNonEmpty s)
568 opSummaryVal OpNodePowercycle { opNodeName = s } = Just (fromNonEmpty s)
569 opSummaryVal OpNodeMigrate { opNodeName = s } = Just (fromNonEmpty s)
570 opSummaryVal OpNodeEvacuate { opNodeName = s } = Just (fromNonEmpty s)
571 opSummaryVal OpInstanceCreate { opInstanceName = s } = Just s
572 opSummaryVal OpInstanceReinstall { opInstanceName = s } = Just s
573 opSummaryVal OpInstanceRemove { opInstanceName = s } = Just s
574 -- FIXME: instance rename should show both names; currently it shows none
575 -- opSummaryVal OpInstanceRename { opInstanceName = s } = Just s
576 opSummaryVal OpInstanceStartup { opInstanceName = s } = Just s
577 opSummaryVal OpInstanceShutdown { opInstanceName = s } = Just s
578 opSummaryVal OpInstanceReboot { opInstanceName = s } = Just s
579 opSummaryVal OpInstanceReplaceDisks { opInstanceName = s } = Just s
580 opSummaryVal OpInstanceFailover { opInstanceName = s } = Just s
581 opSummaryVal OpInstanceMigrate { opInstanceName = s } = Just s
582 opSummaryVal OpInstanceMove { opInstanceName = s } = Just s
583 opSummaryVal OpInstanceConsole { opInstanceName = s } = Just s
584 opSummaryVal OpInstanceActivateDisks { opInstanceName = s } = Just s
585 opSummaryVal OpInstanceDeactivateDisks { opInstanceName = s } = Just s
586 opSummaryVal OpInstanceRecreateDisks { opInstanceName = s } = Just s
587 opSummaryVal OpInstanceSetParams { opInstanceName = s } = Just s
588 opSummaryVal OpInstanceGrowDisk { opInstanceName = s } = Just s
589 opSummaryVal OpInstanceChangeGroup { opInstanceName = s } = Just s
590 opSummaryVal OpGroupAdd { opGroupName = s } = Just (fromNonEmpty s)
591 opSummaryVal OpGroupAssignNodes { opGroupName = s } = Just (fromNonEmpty s)
592 opSummaryVal OpGroupSetParams { opGroupName = s } = Just (fromNonEmpty s)
593 opSummaryVal OpGroupRemove { opGroupName = s } = Just (fromNonEmpty s)
594 opSummaryVal OpGroupEvacuate { opGroupName = s } = Just (fromNonEmpty s)
595 opSummaryVal OpBackupPrepare { opInstanceName = s } = Just s
596 opSummaryVal OpBackupExport { opInstanceName = s } = Just s
597 opSummaryVal OpBackupRemove { opInstanceName = s } = Just s
598 opSummaryVal OpTagsGet { opKind = k } =
599 Just . fromMaybe "None" $ tagNameOf k
600 opSummaryVal OpTagsSearch { opTagSearchPattern = s } = Just (fromNonEmpty s)
601 opSummaryVal OpTestDelay { opDelayDuration = d } = Just (show d)
602 opSummaryVal OpTestAllocator { opIallocator = s } =
603 -- FIXME: Python doesn't handle None fields well, so we have behave the same
604 Just $ maybe "None" fromNonEmpty s
605 opSummaryVal OpNetworkAdd { opNetworkName = s} = Just (fromNonEmpty s)
606 opSummaryVal OpNetworkRemove { opNetworkName = s} = Just (fromNonEmpty s)
607 opSummaryVal OpNetworkSetParams { opNetworkName = s} = Just (fromNonEmpty s)
608 opSummaryVal OpNetworkConnect { opNetworkName = s} = Just (fromNonEmpty s)
609 opSummaryVal OpNetworkDisconnect { opNetworkName = s} = Just (fromNonEmpty s)
610 opSummaryVal _ = Nothing
612 -- | Computes the summary of the opcode.
613 opSummary :: OpCode -> String
615 case opSummaryVal op of
617 Just s -> op_suffix ++ "(" ++ s ++ ")"
618 where op_suffix = drop 3 $ opID op
620 -- | Generic\/common opcode parameters.
621 $(buildObject "CommonOpParams" "op"
629 -- | Default common parameter values.
630 defOpParams :: CommonOpParams
632 CommonOpParams { opDryRun = Nothing
633 , opDebugLevel = Nothing
634 , opPriority = OpPrioNormal
635 , opDepends = Nothing
636 , opComment = Nothing
639 -- | The top-level opcode type.
640 data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams
641 , metaOpCode :: OpCode
642 } deriving (Show, Eq)
644 -- | JSON serialisation for 'MetaOpCode'.
645 showMeta :: MetaOpCode -> JSValue
646 showMeta (MetaOpCode params op) =
647 let objparams = toDictCommonOpParams params
648 objop = toDictOpCode op
649 in makeObj (objparams ++ objop)
651 -- | JSON deserialisation for 'MetaOpCode'
652 readMeta :: JSValue -> Text.JSON.Result MetaOpCode
656 return $ MetaOpCode meta op
658 instance JSON MetaOpCode where
662 -- | Wraps an 'OpCode' with the default parameters to build a
664 wrapOpCode :: OpCode -> MetaOpCode
665 wrapOpCode = MetaOpCode defOpParams
667 -- | Sets the comment on a meta opcode.
668 setOpComment :: String -> MetaOpCode -> MetaOpCode
669 setOpComment comment (MetaOpCode common op) =
670 MetaOpCode (common { opComment = Just comment}) op