, DiskIndex
, mkDiskIndex
, unDiskIndex
+ , INicParams(..)
+ , IDiskParams(..)
, pInstanceName
+ , pInstances
+ , pName
, pTagsList
, pTagsObject
+ , pOutputFields
+ , pShutdownTimeout
+ , pForce
+ , pIgnoreOfflineNodes
+ , pNodeName
+ , pNodeNames
+ , pGroupName
+ , pMigrationMode
+ , pMigrationLive
+ , pForceVariant
+ , pWaitForSync
+ , pWaitForSyncFalse
+ , pIgnoreConsistency
+ , pStorageName
+ , pUseLocking
+ , pNameCheck
+ , pNodeGroupAllocPolicy
+ , pGroupNodeParams
+ , pQueryWhat
+ , pEarlyRelease
+ , pNoRemember
+ , pMigrationTargetNode
+ , pStartupPaused
+ , pVerbose
+ , pDebugSimulateErrors
+ , pErrorCodes
+ , pSkipChecks
+ , pIgnoreErrors
+ , pOptGroupName
+ , pDiskParams
+ , pHvState
+ , pDiskState
+ , pIgnoreIpolicy
+ , pAllowRuntimeChgs
+ , pVgName
+ , pEnabledHypervisors
+ , pClusterHvParams
+ , pClusterBeParams
+ , pOsHvp
+ , pOsParams
+ , pCandidatePoolSize
+ , pUidPool
+ , pAddUids
+ , pRemoveUids
+ , pMaintainNodeHealth
+ , pPreallocWipeDisks
+ , pNicParams
+ , pNdParams
+ , pIpolicy
+ , pDrbdHelper
+ , pDefaultIAllocator
+ , pMasterNetdev
+ , pMasterNetmask
+ , pReservedLvs
+ , pHiddenOs
+ , pBlacklistedOs
+ , pUseExternalMipScript
+ , pQueryFields
+ , pQueryFilter
+ , pOobCommand
+ , pOobTimeout
+ , pIgnoreStatus
+ , pPowerDelay
+ , pPrimaryIp
+ , pSecondaryIp
+ , pReadd
+ , pNodeGroup
+ , pMasterCapable
+ , pVmCapable
+ , pNames
+ , pNodes
+ , pStorageType
+ , pStorageChanges
+ , pMasterCandidate
+ , pOffline
+ , pDrained
+ , pAutoPromote
+ , pPowered
+ , pIallocator
+ , pRemoteNode
+ , pEvacMode
) where
-import Text.JSON (readJSON, showJSON, JSON, JSValue(..), fromJSString)
+import qualified Data.Set as Set
+import Text.JSON (readJSON, showJSON, JSON, JSValue(..), fromJSString,
+ JSObject)
import Text.JSON.Pretty (pp_value)
import qualified Ganeti.Constants as C
import Ganeti.THH
import Ganeti.JSON
+import Ganeti.Types
+import qualified Ganeti.Query.Language as Qlang
-- * Helper functions and types
+-- * Type aliases
+
+-- | Build a boolean field.
+booleanField :: String -> Field
+booleanField = flip simpleField [t| Bool |]
+
+-- | Default a field to 'False'.
+defaultFalse :: String -> Field
+defaultFalse = defaultField [| False |] . booleanField
+
+-- | Default a field to 'True'.
+defaultTrue :: String -> Field
+defaultTrue = defaultField [| True |] . booleanField
+
+-- | An alias for a 'String' field.
+stringField :: String -> Field
+stringField = flip simpleField [t| String |]
+
+-- | An alias for an optional string field.
+optionalStringField :: String -> Field
+optionalStringField = optionalField . stringField
+
+-- | An alias for an optional non-empty string field.
+optionalNEStringField :: String -> Field
+optionalNEStringField = optionalField . flip simpleField [t| NonEmptyString |]
+
+--- | Unchecked value, should be replaced by a better definition.
+--- type UncheckedValue = JSValue
+
+-- | Unchecked dict, should be replaced by a better definition.
+type UncheckedDict = JSObject JSValue
+
-- ** Tags
-- | Data type representing what items do the tag operations apply to.
readJSON v = readJSON v >>= mkDiskIndex
showJSON = showJSON . unDiskIndex
+-- ** I* param types
+
+-- | Type holding disk access modes.
+$(declareSADT "DiskAccess"
+ [ ("DiskReadOnly", 'C.diskRdonly)
+ , ("DiskReadWrite", 'C.diskRdwr)
+ ])
+$(makeJSONInstance ''DiskAccess)
+
+-- | NIC modification definition.
+$(buildObject "INicParams" "inic"
+ [ optionalField $ simpleField C.inicMac [t| NonEmptyString |]
+ , optionalField $ simpleField C.inicIp [t| String |]
+ , optionalField $ simpleField C.inicMode [t| NonEmptyString |]
+ , optionalField $ simpleField C.inicLink [t| NonEmptyString |]
+ ])
+
+-- | Disk modification definition.
+$(buildObject "IDiskParams" "idisk"
+ [ simpleField C.idiskSize [t| Int |] -- FIXME: VTYPE_UNIT
+ , simpleField C.idiskMode [t| DiskAccess |]
+ , simpleField C.idiskAdopt [t| NonEmptyString |]
+ , simpleField C.idiskVg [t| NonEmptyString |]
+ , simpleField C.idiskMetavg [t| NonEmptyString |]
+ ])
+
-- * Parameters
--- | Instance name.
+-- | A required instance name (for single-instance LUs).
pInstanceName :: Field
pInstanceName = simpleField "instance_name" [t| String |]
+-- | A list of instances.
+pInstances :: Field
+pInstances = defaultField [| [] |] $
+ simpleField "instances" [t| [NonEmptyString] |]
+
+-- | A generic name.
+pName :: Field
+pName = simpleField "name" [t| NonEmptyString |]
+
-- | Tags list.
pTagsList :: Field
pTagsList = simpleField "tags" [t| [String] |]
pTagsObject :: Field
pTagsObject = customField 'decodeTagObject 'encodeTagObject $
simpleField "kind" [t| TagObject |]
+
+-- | Selected output fields.
+pOutputFields :: Field
+pOutputFields = simpleField "output_fields" [t| [NonEmptyString] |]
+
+-- | How long to wait for instance to shut down.
+pShutdownTimeout :: Field
+pShutdownTimeout = defaultField [| C.defaultShutdownTimeout |] $
+ simpleField "shutdown_timeout" [t| NonNegative Int |]
+
+-- | Whether to force the operation.
+pForce :: Field
+pForce = defaultFalse "force"
+
+-- | Whether to ignore offline nodes.
+pIgnoreOfflineNodes :: Field
+pIgnoreOfflineNodes = defaultFalse "ignore_offline_nodes"
+
+-- | A required node name (for single-node LUs).
+pNodeName :: Field
+pNodeName = simpleField "node_name" [t| NonEmptyString |]
+
+-- | List of nodes.
+pNodeNames :: Field
+pNodeNames =
+ defaultField [| [] |] $ simpleField "node_names" [t| [NonEmptyString] |]
+
+-- | A required node group name (for single-group LUs).
+pGroupName :: Field
+pGroupName = simpleField "group_name" [t| NonEmptyString |]
+
+-- | Migration type (live\/non-live).
+pMigrationMode :: Field
+pMigrationMode =
+ renameField "MigrationMode" $
+ optionalField $
+ simpleField "mode" [t| MigrationMode |]
+
+-- | Obsolete \'live\' migration mode (boolean).
+pMigrationLive :: Field
+pMigrationLive =
+ renameField "OldLiveMode" $ optionalField $ booleanField "live"
+
+-- | Whether to force an unknown OS variant.
+pForceVariant :: Field
+pForceVariant = defaultFalse "force_variant"
+
+-- | Whether to wait for the disk to synchronize.
+pWaitForSync :: Field
+pWaitForSync = defaultTrue "wait_for_sync"
+
+-- | Whether to wait for the disk to synchronize (defaults to false).
+pWaitForSyncFalse :: Field
+pWaitForSyncFalse = defaultField [| False |] pWaitForSync
+
+-- | Whether to ignore disk consistency
+pIgnoreConsistency :: Field
+pIgnoreConsistency = defaultFalse "ignore_consistency"
+
+-- | Storage name.
+pStorageName :: Field
+pStorageName =
+ renameField "StorageName" $ simpleField "name" [t| NonEmptyString |]
+
+-- | Whether to use synchronization.
+pUseLocking :: Field
+pUseLocking = defaultFalse "use_locking"
+
+-- | Whether to check name.
+pNameCheck :: Field
+pNameCheck = defaultTrue "name_check"
+
+-- | Instance allocation policy.
+pNodeGroupAllocPolicy :: Field
+pNodeGroupAllocPolicy = optionalField $
+ simpleField "alloc_policy" [t| AllocPolicy |]
+
+-- | Default node parameters for group.
+pGroupNodeParams :: Field
+pGroupNodeParams = optionalField $ simpleField "ndparams" [t| UncheckedDict |]
+
+-- | Resource(s) to query for.
+pQueryWhat :: Field
+pQueryWhat = simpleField "what" [t| Qlang.QueryTypeOp |]
+
+-- | Whether to release locks as soon as possible.
+pEarlyRelease :: Field
+pEarlyRelease = defaultFalse "early_release"
+
+-- _PIpCheckDoc = "Whether to ensure instance's IP address is inactive"
+
+-- | Do not remember instance state changes.
+pNoRemember :: Field
+pNoRemember = defaultFalse "no_remember"
+
+-- | Target node for instance migration/failover.
+pMigrationTargetNode :: Field
+pMigrationTargetNode = optionalNEStringField "target_node"
+
+-- | Pause instance at startup.
+pStartupPaused :: Field
+pStartupPaused = defaultFalse "startup_paused"
+
+-- | Verbose mode.
+pVerbose :: Field
+pVerbose = defaultFalse "verbose"
+
+-- ** Parameters for cluster verification
+
+-- | Whether to simulate errors (useful for debugging).
+pDebugSimulateErrors :: Field
+pDebugSimulateErrors = defaultFalse "debug_simulate_errors"
+
+-- | Error codes.
+pErrorCodes :: Field
+pErrorCodes = defaultFalse "error_codes"
+
+-- | Which checks to skip.
+pSkipChecks :: Field
+pSkipChecks = defaultField [| Set.empty |] $
+ simpleField "skip_checks" [t| Set.Set VerifyOptionalChecks |]
+
+-- | List of error codes that should be treated as warnings.
+pIgnoreErrors :: Field
+pIgnoreErrors = defaultField [| Set.empty |] $
+ simpleField "ignore_errors" [t| Set.Set CVErrorCode |]
+
+-- | Optional group name.
+pOptGroupName :: Field
+pOptGroupName = renameField "OptGroupName" $
+ optionalField $ simpleField "group_name" [t| NonEmptyString |]
+
+-- | Disk templates' parameter defaults.
+pDiskParams :: Field
+pDiskParams = optionalField $
+ simpleField "diskparams" [t| GenericContainer DiskTemplate
+ UncheckedDict |]
+
+-- * Parameters for node resource model
+
+-- | Set hypervisor states.
+pHvState :: Field
+pHvState = optionalField $ simpleField "hv_state" [t| UncheckedDict |]
+
+-- | Set disk states.
+pDiskState :: Field
+pDiskState = optionalField $ simpleField "disk_state" [t| UncheckedDict |]
+
+-- | Whether to ignore ipolicy violations.
+pIgnoreIpolicy :: Field
+pIgnoreIpolicy = defaultFalse "ignore_ipolicy"
+
+-- | Allow runtime changes while migrating.
+pAllowRuntimeChgs :: Field
+pAllowRuntimeChgs = defaultTrue "allow_runtime_changes"
+
+-- | Utility type for OpClusterSetParams.
+type TestClusterOsListItem = (DdmSimple, NonEmptyString)
+
+-- | Utility type of OsList.
+type TestClusterOsList = [TestClusterOsListItem]
+
+-- Utility type for NIC definitions.
+--type TestNicDef = INicParams
+--type TDiskParams = IDiskParams
+
+-- | Volume group name.
+pVgName :: Field
+pVgName = optionalStringField "vg_name"
+
+-- | List of enabled hypervisors.
+pEnabledHypervisors :: Field
+pEnabledHypervisors =
+ optionalField $
+ simpleField "enabled_hypervisors" [t| NonEmpty Hypervisor |]
+
+-- | Cluster-wide hypervisor parameters, hypervisor-dependent.
+pClusterHvParams :: Field
+pClusterHvParams =
+ optionalField $
+ simpleField "hvparams" [t| Container UncheckedDict |]
+
+-- | Cluster-wide beparams.
+pClusterBeParams :: Field
+pClusterBeParams = optionalField $ simpleField "beparams" [t| UncheckedDict |]
+
+-- | Cluster-wide per-OS hypervisor parameter defaults.
+pOsHvp :: Field
+pOsHvp = optionalField $ simpleField "os_hvp" [t| Container UncheckedDict |]
+
+-- | Cluster-wide OS parameter defaults.
+pOsParams :: Field
+pOsParams =
+ optionalField $ simpleField "osparams" [t| Container UncheckedDict |]
+
+-- | Candidate pool size.
+pCandidatePoolSize :: Field
+pCandidatePoolSize =
+ optionalField $ simpleField "candidate_pool_size" [t| Positive Int |]
+
+-- | Set UID pool, must be list of lists describing UID ranges (two
+-- items, start and end inclusive.
+pUidPool :: Field
+pUidPool = optionalField $ simpleField "uid_pool" [t| [[(Int, Int)]] |]
+
+-- | Extend UID pool, must be list of lists describing UID ranges (two
+-- items, start and end inclusive.
+pAddUids :: Field
+pAddUids = optionalField $ simpleField "add_uids" [t| [[(Int, Int)]] |]
+
+-- | Shrink UID pool, must be list of lists describing UID ranges (two
+-- items, start and end inclusive) to be removed.
+pRemoveUids :: Field
+pRemoveUids = optionalField $ simpleField "remove_uids" [t| [[(Int, Int)]] |]
+
+-- | Whether to automatically maintain node health.
+pMaintainNodeHealth :: Field
+pMaintainNodeHealth = optionalField $ booleanField "maintain_node_health"
+
+-- | Whether to wipe disks before allocating them to instances.
+pPreallocWipeDisks :: Field
+pPreallocWipeDisks = optionalField $ booleanField "prealloc_wipe_disks"
+
+-- | Cluster-wide NIC parameter defaults.
+pNicParams :: Field
+pNicParams = optionalField $ simpleField "nicparams" [t| INicParams |]
+
+-- | Cluster-wide node parameter defaults.
+pNdParams :: Field
+pNdParams = optionalField $ simpleField "ndparams" [t| UncheckedDict |]
+
+-- | Cluster-wipe ipolict specs.
+pIpolicy :: Field
+pIpolicy = optionalField $ simpleField "ipolicy" [t| UncheckedDict |]
+
+-- | DRBD helper program.
+pDrbdHelper :: Field
+pDrbdHelper = optionalStringField "drbd_helper"
+
+-- | Default iallocator for cluster.
+pDefaultIAllocator :: Field
+pDefaultIAllocator = optionalStringField "default_iallocator"
+
+-- | Master network device.
+pMasterNetdev :: Field
+pMasterNetdev = optionalStringField "master_netdev"
+
+-- | Netmask of the master IP.
+pMasterNetmask :: Field
+pMasterNetmask = optionalField $ simpleField "master_netmask" [t| Int |]
+
+-- | List of reserved LVs.
+pReservedLvs :: Field
+pReservedLvs =
+ optionalField $ simpleField "reserved_lvs" [t| [NonEmptyString] |]
+
+-- | Modify list of hidden operating systems: each modification must
+-- have two items, the operation and the OS name; the operation can be
+-- add or remove.
+pHiddenOs :: Field
+pHiddenOs = optionalField $ simpleField "hidden_os" [t| TestClusterOsList |]
+
+-- | Modify list of blacklisted operating systems: each modification
+-- must have two items, the operation and the OS name; the operation
+-- can be add or remove.
+pBlacklistedOs :: Field
+pBlacklistedOs =
+ optionalField $ simpleField "blacklisted_os" [t| TestClusterOsList |]
+
+-- | Whether to use an external master IP address setup script.
+pUseExternalMipScript :: Field
+pUseExternalMipScript = optionalField $ booleanField "use_external_mip_script"
+
+-- | Requested fields.
+pQueryFields :: Field
+pQueryFields = simpleField "fields" [t| [NonEmptyString] |]
+
+-- | Query filter.
+pQueryFilter :: Field
+pQueryFilter = simpleField "qfilter" [t| Qlang.Filter String |]
+
+-- | OOB command to run.
+pOobCommand :: Field
+pOobCommand = simpleField "command" [t| OobCommand |]
+
+-- | Timeout before the OOB helper will be terminated.
+pOobTimeout :: Field
+pOobTimeout =
+ defaultField [| C.oobTimeout |] $ simpleField "timeout" [t| Int |]
+
+-- | Ignores the node offline status for power off.
+pIgnoreStatus :: Field
+pIgnoreStatus = defaultFalse "ignore_status"
+
+-- | Time in seconds to wait between powering on nodes.
+pPowerDelay :: Field
+pPowerDelay =
+ -- FIXME: we can't use the proper type "NonNegative Double", since
+ -- the default constant is a plain Double, not a non-negative one.
+ defaultField [| C.oobPowerDelay |] $
+ simpleField "power_delay" [t| Double |]
+
+-- | Primary IP address.
+pPrimaryIp :: Field
+pPrimaryIp = optionalStringField "primary_ip"
+
+-- | Secondary IP address.
+pSecondaryIp :: Field
+pSecondaryIp = optionalNEStringField "secondary_ip"
+
+-- | Whether node is re-added to cluster.
+pReadd :: Field
+pReadd = defaultFalse "readd"
+
+-- | Initial node group.
+pNodeGroup :: Field
+pNodeGroup = optionalNEStringField "group"
+
+-- | Whether node can become master or master candidate.
+pMasterCapable :: Field
+pMasterCapable = optionalField $ booleanField "master_capable"
+
+-- | Whether node can host instances.
+pVmCapable :: Field
+pVmCapable = optionalField $ booleanField "vm_capable"
+
+-- | List of names.
+pNames :: Field
+pNames = defaultField [| [] |] $ simpleField "names" [t| [NonEmptyString] |]
+
+-- | List of node names.
+pNodes :: Field
+pNodes = defaultField [| [] |] $ simpleField "nodes" [t| [NonEmptyString] |]
+
+-- | Storage type.
+pStorageType :: Field
+pStorageType = simpleField "storage_type" [t| StorageType |]
+
+-- | Storage changes (unchecked).
+pStorageChanges :: Field
+pStorageChanges = simpleField "changes" [t| UncheckedDict |]
+
+-- | Whether the node should become a master candidate.
+pMasterCandidate :: Field
+pMasterCandidate = optionalField $ booleanField "master_candidate"
+
+-- | Whether the node should be marked as offline.
+pOffline :: Field
+pOffline = optionalField $ booleanField "offline"
+
+-- | Whether the node should be marked as drained.
+pDrained ::Field
+pDrained = optionalField $ booleanField "drained"
+
+-- | Whether node(s) should be promoted to master candidate if necessary.
+pAutoPromote :: Field
+pAutoPromote = defaultFalse "auto_promote"
+
+-- | Whether the node should be marked as powered
+pPowered :: Field
+pPowered = optionalField $ booleanField "powered"
+
+-- | Iallocator for deciding the target node for shared-storage
+-- instances during migrate and failover.
+pIallocator :: Field
+pIallocator = optionalNEStringField "iallocator"
+
+-- | New secondary node.
+pRemoteNode :: Field
+pRemoteNode = optionalNEStringField "remote_node"
+
+-- | Node evacuation mode.
+pEvacMode :: Field
+pEvacMode = renameField "EvacMode" $ simpleField "mode" [t| NodeEvacMode |]
projects / ganeti-local / commitdiff