1 {-# LANGUAGE TemplateHaskell #-}
3 {-| Implementation of opcodes parameters.
5 These are defined in a separate module only due to TemplateHaskell
6 stage restrictions - expressions defined in the current module can't
7 be passed to splices. So we have to either parameters/repeat each
8 parameter definition multiple times, or separate them into this
15 Copyright (C) 2012 Google Inc.
17 This program is free software; you can redistribute it and/or modify
18 it under the terms of the GNU General Public License as published by
19 the Free Software Foundation; either version 2 of the License, or
20 (at your option) any later version.
22 This program is distributed in the hope that it will be useful, but
23 WITHOUT ANY WARRANTY; without even the implied warranty of
24 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
25 General Public License for more details.
27 You should have received a copy of the GNU General Public License
28 along with this program; if not, write to the Free Software
29 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
34 module Ganeti.OpParams
40 , ReplaceDisksMode(..)
68 , pNodeGroupAllocPolicy
75 , pMigrationTargetNode
78 , pDebugSimulateErrors
107 , pMaintainNodeHealth
120 , pUseExternalMipScript
152 , pSourceShutdownTimeout
160 import qualified Data.Set as Set
161 import Text.JSON (readJSON, showJSON, JSON, JSValue(..), fromJSString,
162 JSObject, toJSObject)
163 import Text.JSON.Pretty (pp_value)
165 import Ganeti.BasicTypes
166 import qualified Ganeti.Constants as C
170 import qualified Ganeti.Query.Language as Qlang
172 -- * Helper functions and types
176 -- | Build a boolean field.
177 booleanField :: String -> Field
178 booleanField = flip simpleField [t| Bool |]
180 -- | Default a field to 'False'.
181 defaultFalse :: String -> Field
182 defaultFalse = defaultField [| False |] . booleanField
184 -- | Default a field to 'True'.
185 defaultTrue :: String -> Field
186 defaultTrue = defaultField [| True |] . booleanField
188 -- | An alias for a 'String' field.
189 stringField :: String -> Field
190 stringField = flip simpleField [t| String |]
192 -- | An alias for an optional string field.
193 optionalStringField :: String -> Field
194 optionalStringField = optionalField . stringField
196 -- | An alias for an optional non-empty string field.
197 optionalNEStringField :: String -> Field
198 optionalNEStringField = optionalField . flip simpleField [t| NonEmptyString |]
200 --- | Unchecked value, should be replaced by a better definition.
201 --- type UncheckedValue = JSValue
203 -- | Unchecked dict, should be replaced by a better definition.
204 type UncheckedDict = JSObject JSValue
206 -- | Unchecked list, shoild be replaced by a better definition.
207 type UncheckedList = [JSValue]
209 -- | Function to force a non-negative value, without returning via a
210 -- monad. This is needed for, and should be used /only/ in the case of
211 -- forcing constants. In case the constant is wrong (< 0), this will
212 -- become a runtime error.
213 forceNonNeg :: (Num a, Ord a, Show a) => a -> NonNegative a
214 forceNonNeg i = case mkNonNegative i of
220 -- | Data type representing what items do the tag operations apply to.
221 $(declareSADT "TagType"
222 [ ("TagTypeInstance", 'C.tagInstance)
223 , ("TagTypeNode", 'C.tagNode)
224 , ("TagTypeGroup", 'C.tagNodegroup)
225 , ("TagTypeCluster", 'C.tagCluster)
227 $(makeJSONInstance ''TagType)
229 -- | Data type holding a tag object (type and object name).
230 data TagObject = TagInstance String
234 deriving (Show, Read, Eq)
236 -- | Tag type for a given tag object.
237 tagTypeOf :: TagObject -> TagType
238 tagTypeOf (TagInstance {}) = TagTypeInstance
239 tagTypeOf (TagNode {}) = TagTypeNode
240 tagTypeOf (TagGroup {}) = TagTypeGroup
241 tagTypeOf (TagCluster {}) = TagTypeCluster
243 -- | Gets the potential tag object name.
244 tagNameOf :: TagObject -> Maybe String
245 tagNameOf (TagInstance s) = Just s
246 tagNameOf (TagNode s) = Just s
247 tagNameOf (TagGroup s) = Just s
248 tagNameOf TagCluster = Nothing
250 -- | Builds a 'TagObject' from a tag type and name.
251 tagObjectFrom :: (Monad m) => TagType -> JSValue -> m TagObject
252 tagObjectFrom TagTypeInstance (JSString s) =
253 return . TagInstance $ fromJSString s
254 tagObjectFrom TagTypeNode (JSString s) = return . TagNode $ fromJSString s
255 tagObjectFrom TagTypeGroup (JSString s) = return . TagGroup $ fromJSString s
256 tagObjectFrom TagTypeCluster JSNull = return TagCluster
258 fail $ "Invalid tag type/name combination: " ++ show t ++ "/" ++
261 -- | Name of the tag \"name\" field.
262 tagNameField :: String
263 tagNameField = "name"
265 -- | Custom encoder for 'TagObject' as represented in an opcode.
266 encodeTagObject :: TagObject -> (JSValue, [(String, JSValue)])
267 encodeTagObject t = ( showJSON (tagTypeOf t)
268 , [(tagNameField, maybe JSNull showJSON (tagNameOf t))] )
270 -- | Custom decoder for 'TagObject' as represented in an opcode.
271 decodeTagObject :: (Monad m) => [(String, JSValue)] -> JSValue -> m TagObject
272 decodeTagObject obj kind = do
273 ttype <- fromJVal kind
274 tname <- fromObj obj tagNameField
275 tagObjectFrom ttype tname
279 -- | Replace disks type.
280 $(declareSADT "ReplaceDisksMode"
281 [ ("ReplaceOnPrimary", 'C.replaceDiskPri)
282 , ("ReplaceOnSecondary", 'C.replaceDiskSec)
283 , ("ReplaceNewSecondary", 'C.replaceDiskChg)
284 , ("ReplaceAuto", 'C.replaceDiskAuto)
286 $(makeJSONInstance ''ReplaceDisksMode)
288 -- | Disk index type (embedding constraints on the index value via a
289 -- smart constructor).
290 newtype DiskIndex = DiskIndex { unDiskIndex :: Int }
291 deriving (Show, Read, Eq, Ord)
293 -- | Smart constructor for 'DiskIndex'.
294 mkDiskIndex :: (Monad m) => Int -> m DiskIndex
295 mkDiskIndex i | i >= 0 && i < C.maxDisks = return (DiskIndex i)
296 | otherwise = fail $ "Invalid value for disk index '" ++
297 show i ++ "', required between 0 and " ++
300 instance JSON DiskIndex where
301 readJSON v = readJSON v >>= mkDiskIndex
302 showJSON = showJSON . unDiskIndex
306 -- | Type holding disk access modes.
307 $(declareSADT "DiskAccess"
308 [ ("DiskReadOnly", 'C.diskRdonly)
309 , ("DiskReadWrite", 'C.diskRdwr)
311 $(makeJSONInstance ''DiskAccess)
313 -- | NIC modification definition.
314 $(buildObject "INicParams" "inic"
315 [ optionalField $ simpleField C.inicMac [t| NonEmptyString |]
316 , optionalField $ simpleField C.inicIp [t| String |]
317 , optionalField $ simpleField C.inicMode [t| NonEmptyString |]
318 , optionalField $ simpleField C.inicLink [t| NonEmptyString |]
321 -- | Disk modification definition. FIXME: disksize should be VTYPE_UNIT.
322 $(buildObject "IDiskParams" "idisk"
323 [ optionalField $ simpleField C.idiskSize [t| Int |]
324 , optionalField $ simpleField C.idiskMode [t| DiskAccess |]
325 , optionalField $ simpleField C.idiskAdopt [t| NonEmptyString |]
326 , optionalField $ simpleField C.idiskVg [t| NonEmptyString |]
327 , optionalField $ simpleField C.idiskMetavg [t| NonEmptyString |]
332 -- | A required instance name (for single-instance LUs).
333 pInstanceName :: Field
334 pInstanceName = simpleField "instance_name" [t| String |]
336 -- | A list of instances.
338 pInstances = defaultField [| [] |] $
339 simpleField "instances" [t| [NonEmptyString] |]
343 pName = simpleField "name" [t| NonEmptyString |]
347 pTagsList = simpleField "tags" [t| [String] |]
351 pTagsObject = customField 'decodeTagObject 'encodeTagObject $
352 simpleField "kind" [t| TagObject |]
354 -- | Selected output fields.
355 pOutputFields :: Field
356 pOutputFields = simpleField "output_fields" [t| [NonEmptyString] |]
358 -- | How long to wait for instance to shut down.
359 pShutdownTimeout :: Field
360 pShutdownTimeout = defaultField [| C.defaultShutdownTimeout |] $
361 simpleField "shutdown_timeout" [t| NonNegative Int |]
363 -- | Whether to force the operation.
365 pForce = defaultFalse "force"
367 -- | Whether to ignore offline nodes.
368 pIgnoreOfflineNodes :: Field
369 pIgnoreOfflineNodes = defaultFalse "ignore_offline_nodes"
371 -- | A required node name (for single-node LUs).
373 pNodeName = simpleField "node_name" [t| NonEmptyString |]
378 defaultField [| [] |] $ simpleField "node_names" [t| [NonEmptyString] |]
380 -- | A required node group name (for single-group LUs).
382 pGroupName = simpleField "group_name" [t| NonEmptyString |]
384 -- | Migration type (live\/non-live).
385 pMigrationMode :: Field
387 renameField "MigrationMode" .
389 simpleField "mode" [t| MigrationMode |]
391 -- | Obsolete \'live\' migration mode (boolean).
392 pMigrationLive :: Field
394 renameField "OldLiveMode" . optionalField $ booleanField "live"
396 -- | Whether to force an unknown OS variant.
397 pForceVariant :: Field
398 pForceVariant = defaultFalse "force_variant"
400 -- | Whether to wait for the disk to synchronize.
401 pWaitForSync :: Field
402 pWaitForSync = defaultTrue "wait_for_sync"
404 -- | Whether to wait for the disk to synchronize (defaults to false).
405 pWaitForSyncFalse :: Field
406 pWaitForSyncFalse = defaultField [| False |] pWaitForSync
408 -- | Whether to ignore disk consistency
409 pIgnoreConsistency :: Field
410 pIgnoreConsistency = defaultFalse "ignore_consistency"
413 pStorageName :: Field
415 renameField "StorageName" $ simpleField "name" [t| NonEmptyString |]
417 -- | Whether to use synchronization.
419 pUseLocking = defaultFalse "use_locking"
421 -- | Whether to check name.
423 pNameCheck = defaultTrue "name_check"
425 -- | Instance allocation policy.
426 pNodeGroupAllocPolicy :: Field
427 pNodeGroupAllocPolicy = optionalField $
428 simpleField "alloc_policy" [t| AllocPolicy |]
430 -- | Default node parameters for group.
431 pGroupNodeParams :: Field
432 pGroupNodeParams = optionalField $ simpleField "ndparams" [t| UncheckedDict |]
434 -- | Resource(s) to query for.
436 pQueryWhat = simpleField "what" [t| Qlang.QueryTypeOp |]
438 -- | Whether to release locks as soon as possible.
439 pEarlyRelease :: Field
440 pEarlyRelease = defaultFalse "early_release"
442 -- | Whether to ensure instance's IP address is inactive.
444 pIpCheck = defaultTrue "ip_check"
446 -- | Check for conflicting IPs.
447 pIpConflictsCheck :: Field
448 pIpConflictsCheck = defaultTrue "conflicts_check"
450 -- | Do not remember instance state changes.
452 pNoRemember = defaultFalse "no_remember"
454 -- | Target node for instance migration/failover.
455 pMigrationTargetNode :: Field
456 pMigrationTargetNode = optionalNEStringField "target_node"
458 -- | Pause instance at startup.
459 pStartupPaused :: Field
460 pStartupPaused = defaultFalse "startup_paused"
464 pVerbose = defaultFalse "verbose"
466 -- ** Parameters for cluster verification
468 -- | Whether to simulate errors (useful for debugging).
469 pDebugSimulateErrors :: Field
470 pDebugSimulateErrors = defaultFalse "debug_simulate_errors"
474 pErrorCodes = defaultFalse "error_codes"
476 -- | Which checks to skip.
478 pSkipChecks = defaultField [| Set.empty |] $
479 simpleField "skip_checks" [t| Set.Set VerifyOptionalChecks |]
481 -- | List of error codes that should be treated as warnings.
482 pIgnoreErrors :: Field
483 pIgnoreErrors = defaultField [| Set.empty |] $
484 simpleField "ignore_errors" [t| Set.Set CVErrorCode |]
486 -- | Optional group name.
487 pOptGroupName :: Field
488 pOptGroupName = renameField "OptGroupName" .
489 optionalField $ simpleField "group_name" [t| NonEmptyString |]
491 -- | Disk templates' parameter defaults.
493 pDiskParams = optionalField $
494 simpleField "diskparams" [t| GenericContainer DiskTemplate
497 -- * Parameters for node resource model
499 -- | Set hypervisor states.
501 pHvState = optionalField $ simpleField "hv_state" [t| UncheckedDict |]
503 -- | Set disk states.
505 pDiskState = optionalField $ simpleField "disk_state" [t| UncheckedDict |]
507 -- | Whether to ignore ipolicy violations.
508 pIgnoreIpolicy :: Field
509 pIgnoreIpolicy = defaultFalse "ignore_ipolicy"
511 -- | Allow runtime changes while migrating.
512 pAllowRuntimeChgs :: Field
513 pAllowRuntimeChgs = defaultTrue "allow_runtime_changes"
515 -- | Utility type for OpClusterSetParams.
516 type TestClusterOsListItem = (DdmSimple, NonEmptyString)
518 -- | Utility type of OsList.
519 type TestClusterOsList = [TestClusterOsListItem]
521 -- Utility type for NIC definitions.
522 --type TestNicDef = INicParams
524 -- | List of instance disks.
526 pInstDisks = renameField "instDisks" $ simpleField "disks" [t| [IDiskParams] |]
528 -- | Instance disk template.
529 pDiskTemplate :: Field
530 pDiskTemplate = simpleField "disk_template" [t| DiskTemplate |]
534 pFileDriver = optionalField $ simpleField "file_driver" [t| FileDriver |]
536 -- | Directory for storing file-backed disks.
537 pFileStorageDir :: Field
538 pFileStorageDir = optionalNEStringField "file_storage_dir"
540 -- | Volume group name.
542 pVgName = optionalStringField "vg_name"
544 -- | List of enabled hypervisors.
545 pEnabledHypervisors :: Field
546 pEnabledHypervisors =
548 simpleField "enabled_hypervisors" [t| NonEmpty Hypervisor |]
550 -- | Selected hypervisor for an instance.
554 simpleField "hypervisor" [t| Hypervisor |]
556 -- | Cluster-wide hypervisor parameters, hypervisor-dependent.
557 pClusterHvParams :: Field
559 renameField "ClusterHvParams" .
561 simpleField "hvparams" [t| Container UncheckedDict |]
563 -- | Instance hypervisor parameters.
564 pInstHvParams :: Field
566 renameField "InstHvParams" .
567 defaultField [| toJSObject [] |] $
568 simpleField "hvparams" [t| UncheckedDict |]
570 -- | Cluster-wide beparams.
571 pClusterBeParams :: Field
573 renameField "ClusterBeParams" .
574 optionalField $ simpleField "beparams" [t| UncheckedDict |]
576 -- | Instance beparams.
577 pInstBeParams :: Field
579 renameField "InstBeParams" .
580 defaultField [| toJSObject [] |] $
581 simpleField "beparams" [t| UncheckedDict |]
583 -- | Reset instance parameters to default if equal.
584 pResetDefaults :: Field
585 pResetDefaults = defaultFalse "identify_defaults"
587 -- | Cluster-wide per-OS hypervisor parameter defaults.
589 pOsHvp = optionalField $ simpleField "os_hvp" [t| Container UncheckedDict |]
591 -- | Cluster-wide OS parameter defaults.
592 pClusterOsParams :: Field
594 renameField "clusterOsParams" .
595 optionalField $ simpleField "osparams" [t| Container UncheckedDict |]
597 -- | Instance OS parameters.
598 pInstOsParams :: Field
600 renameField "instOsParams" . defaultField [| toJSObject [] |] $
601 simpleField "osparams" [t| UncheckedDict |]
603 -- | Candidate pool size.
604 pCandidatePoolSize :: Field
606 optionalField $ simpleField "candidate_pool_size" [t| Positive Int |]
608 -- | Set UID pool, must be list of lists describing UID ranges (two
609 -- items, start and end inclusive.
611 pUidPool = optionalField $ simpleField "uid_pool" [t| [[(Int, Int)]] |]
613 -- | Extend UID pool, must be list of lists describing UID ranges (two
614 -- items, start and end inclusive.
616 pAddUids = optionalField $ simpleField "add_uids" [t| [[(Int, Int)]] |]
618 -- | Shrink UID pool, must be list of lists describing UID ranges (two
619 -- items, start and end inclusive) to be removed.
621 pRemoveUids = optionalField $ simpleField "remove_uids" [t| [[(Int, Int)]] |]
623 -- | Whether to automatically maintain node health.
624 pMaintainNodeHealth :: Field
625 pMaintainNodeHealth = optionalField $ booleanField "maintain_node_health"
627 -- | Whether to wipe disks before allocating them to instances.
628 pPreallocWipeDisks :: Field
629 pPreallocWipeDisks = optionalField $ booleanField "prealloc_wipe_disks"
631 -- | Cluster-wide NIC parameter defaults.
633 pNicParams = optionalField $ simpleField "nicparams" [t| INicParams |]
635 -- | Instance NIC definitions.
637 pInstNics = simpleField "nics" [t| [INicParams] |]
639 -- | Cluster-wide node parameter defaults.
641 pNdParams = optionalField $ simpleField "ndparams" [t| UncheckedDict |]
643 -- | Cluster-wipe ipolict specs.
645 pIpolicy = optionalField $ simpleField "ipolicy" [t| UncheckedDict |]
647 -- | DRBD helper program.
649 pDrbdHelper = optionalStringField "drbd_helper"
651 -- | Default iallocator for cluster.
652 pDefaultIAllocator :: Field
653 pDefaultIAllocator = optionalStringField "default_iallocator"
655 -- | Master network device.
656 pMasterNetdev :: Field
657 pMasterNetdev = optionalStringField "master_netdev"
659 -- | Netmask of the master IP.
660 pMasterNetmask :: Field
661 pMasterNetmask = optionalField $ simpleField "master_netmask" [t| Int |]
663 -- | List of reserved LVs.
664 pReservedLvs :: Field
666 optionalField $ simpleField "reserved_lvs" [t| [NonEmptyString] |]
668 -- | Modify list of hidden operating systems: each modification must
669 -- have two items, the operation and the OS name; the operation can be
672 pHiddenOs = optionalField $ simpleField "hidden_os" [t| TestClusterOsList |]
674 -- | Modify list of blacklisted operating systems: each modification
675 -- must have two items, the operation and the OS name; the operation
676 -- can be add or remove.
677 pBlacklistedOs :: Field
679 optionalField $ simpleField "blacklisted_os" [t| TestClusterOsList |]
681 -- | Whether to use an external master IP address setup script.
682 pUseExternalMipScript :: Field
683 pUseExternalMipScript = optionalField $ booleanField "use_external_mip_script"
685 -- | Requested fields.
686 pQueryFields :: Field
687 pQueryFields = simpleField "fields" [t| [NonEmptyString] |]
690 pQueryFilter :: Field
691 pQueryFilter = simpleField "qfilter" [t| Qlang.Filter String |]
693 -- | OOB command to run.
695 pOobCommand = simpleField "command" [t| OobCommand |]
697 -- | Timeout before the OOB helper will be terminated.
700 defaultField [| C.oobTimeout |] $ simpleField "timeout" [t| Int |]
702 -- | Ignores the node offline status for power off.
703 pIgnoreStatus :: Field
704 pIgnoreStatus = defaultFalse "ignore_status"
706 -- | Time in seconds to wait between powering on nodes.
709 -- FIXME: we can't use the proper type "NonNegative Double", since
710 -- the default constant is a plain Double, not a non-negative one.
711 defaultField [| C.oobPowerDelay |] $
712 simpleField "power_delay" [t| Double |]
714 -- | Primary IP address.
716 pPrimaryIp = optionalStringField "primary_ip"
718 -- | Secondary IP address.
719 pSecondaryIp :: Field
720 pSecondaryIp = optionalNEStringField "secondary_ip"
722 -- | Whether node is re-added to cluster.
724 pReadd = defaultFalse "readd"
726 -- | Initial node group.
728 pNodeGroup = optionalNEStringField "group"
730 -- | Whether node can become master or master candidate.
731 pMasterCapable :: Field
732 pMasterCapable = optionalField $ booleanField "master_capable"
734 -- | Whether node can host instances.
736 pVmCapable = optionalField $ booleanField "vm_capable"
740 pNames = defaultField [| [] |] $ simpleField "names" [t| [NonEmptyString] |]
742 -- | List of node names.
744 pNodes = defaultField [| [] |] $ simpleField "nodes" [t| [NonEmptyString] |]
747 pStorageType :: Field
748 pStorageType = simpleField "storage_type" [t| StorageType |]
750 -- | Storage changes (unchecked).
751 pStorageChanges :: Field
752 pStorageChanges = simpleField "changes" [t| UncheckedDict |]
754 -- | Whether the node should become a master candidate.
755 pMasterCandidate :: Field
756 pMasterCandidate = optionalField $ booleanField "master_candidate"
758 -- | Whether the node should be marked as offline.
760 pOffline = optionalField $ booleanField "offline"
762 -- | Whether the node should be marked as drained.
764 pDrained = optionalField $ booleanField "drained"
766 -- | Whether node(s) should be promoted to master candidate if necessary.
767 pAutoPromote :: Field
768 pAutoPromote = defaultFalse "auto_promote"
770 -- | Whether the node should be marked as powered
772 pPowered = optionalField $ booleanField "powered"
774 -- | Iallocator for deciding the target node for shared-storage
775 -- instances during migrate and failover.
777 pIallocator = optionalNEStringField "iallocator"
779 -- | New secondary node.
781 pRemoteNode = optionalNEStringField "remote_node"
783 -- | Node evacuation mode.
785 pEvacMode = renameField "EvacMode" $ simpleField "mode" [t| NodeEvacMode |]
787 -- | Instance creation mode.
788 pInstCreateMode :: Field
790 renameField "InstCreateMode" $ simpleField "mode" [t| InstCreateMode |]
792 -- | Do not install the OS (will disable automatic start).
794 pNoInstall = optionalField $ booleanField "no_install"
796 -- | OS type for instance installation.
798 pInstOs = optionalNEStringField "os_type"
800 -- | Primary node for an instance.
801 pPrimaryNode :: Field
802 pPrimaryNode = optionalNEStringField "pnode"
804 -- | Secondary node for an instance.
805 pSecondaryNode :: Field
806 pSecondaryNode = optionalNEStringField "snode"
808 -- | Signed handshake from source (remote import only).
809 pSourceHandshake :: Field
811 optionalField $ simpleField "source_handshake" [t| UncheckedList |]
813 -- | Source instance name (remote import only).
814 pSourceInstance :: Field
815 pSourceInstance = optionalNEStringField "source_instance_name"
817 -- | How long source instance was given to shut down (remote import only).
818 -- FIXME: non-negative int, whereas the constant is a plain int.
819 pSourceShutdownTimeout :: Field
820 pSourceShutdownTimeout =
821 defaultField [| forceNonNeg C.defaultShutdownTimeout |] $
822 simpleField "source_shutdown_timeout" [t| NonNegative Int |]
824 -- | Source X509 CA in PEM format (remote import only).
825 pSourceX509Ca :: Field
826 pSourceX509Ca = optionalNEStringField "source_x509_ca"
828 -- | Source node for import.
830 pSrcNode = optionalNEStringField "src_node"
832 -- | Source directory for import.
834 pSrcPath = optionalNEStringField "src_path"
836 -- | Whether to start instance after creation.
837 pStartInstance :: Field
838 pStartInstance = defaultTrue "start"
840 -- | Instance tags. FIXME: unify/simplify with pTags, once that
841 -- migrates to NonEmpty String.
844 renameField "InstTags" .
845 defaultField [| [] |] $
846 simpleField "tags" [t| [NonEmptyString] |]