, pGroupName
, pMigrationMode
, pMigrationLive
+ , pMigrationCleanup
, pForceVariant
, pWaitForSync
, pWaitForSyncFalse
, pIgnoreRemoveFailures
, pX509KeyName
, pX509DestCA
+ , pTagSearchPattern
+ , pRestrictedCommand
+ , pReplaceDisksMode
+ , pReplaceDisksList
+ , pAllowFailover
+ , pDelayDuration
+ , pDelayOnMaster
+ , pDelayOnNodes
+ , pDelayRepeat
+ , pIAllocatorDirection
+ , pIAllocatorMode
+ , pIAllocatorReqName
+ , pIAllocatorNics
+ , pIAllocatorDisks
+ , pIAllocatorMemory
+ , pIAllocatorVCpus
+ , pIAllocatorOs
+ , pIAllocatorInstances
+ , pIAllocatorEvacMode
+ , pIAllocatorSpindleUse
+ , pIAllocatorCount
+ , pJQueueNotifyWaitLock
+ , pJQueueNotifyExec
+ , pJQueueLogMessages
+ , pJQueueFail
+ , pTestDummyResult
+ , pTestDummyMessages
+ , pTestDummyFail
+ , pTestDummySubmitJobs
+ , pNetworkName
+ , pNetworkType
+ , pNetworkAddress4
+ , pNetworkGateway4
+ , pNetworkAddress6
+ , pNetworkGateway6
+ , pNetworkMacPrefix
+ , pNetworkAddRsvdIps
+ , pNetworkRemoveRsvdIps
+ , pNetworkMode
+ , pNetworkLink
+ , dOldQuery
+ , dOldQueryNoLocking
) where
import Control.Monad (liftM)
optionalNEStringField :: String -> Field
optionalNEStringField = optionalField . flip simpleField [t| NonEmptyString |]
---- | Unchecked value, should be replaced by a better definition.
---- type UncheckedValue = JSValue
+-- | 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
| TagNode String
| TagGroup String
| TagCluster
- deriving (Show, Read, Eq)
+ deriving (Show, Eq)
-- | Tag type for a given tag object.
tagTypeOf :: TagObject -> TagType
-- | Disk index type (embedding constraints on the index value via a
-- smart constructor).
newtype DiskIndex = DiskIndex { unDiskIndex :: Int }
- deriving (Show, Read, Eq, Ord)
+ deriving (Show, Eq, Ord)
-- | Smart constructor for 'DiskIndex'.
mkDiskIndex :: (Monad m) => Int -> m DiskIndex
= RecreateDisksAll
| RecreateDisksIndices (NonEmpty DiskIndex)
| RecreateDisksParams (NonEmpty (DiskIndex, IDiskParams))
- deriving (Eq, Read, Show)
+ deriving (Eq, Show)
readRecreateDisks :: JSValue -> Text.JSON.Result RecreateDisksInfo
readRecreateDisks (JSArray []) = return RecreateDisksAll
-- | Simple type for old-style ddm changes.
data DdmOldChanges = DdmOldIndex (NonNegative Int)
| DdmOldMod DdmSimple
- deriving (Eq, Read, Show)
+ deriving (Eq, Show)
readDdmOldChanges :: JSValue -> Text.JSON.Result DdmOldChanges
readDdmOldChanges v =
= SetParamsEmpty
| SetParamsDeprecated (NonEmpty (DdmOldChanges, a))
| SetParamsNew (NonEmpty (DdmFull, Int, a))
- deriving (Eq, Read, Show)
+ deriving (Eq, Show)
-- | Custom deserialiser for 'SetParamsMods'.
readSetParams :: (JSON a) => JSValue -> Text.JSON.Result (SetParamsMods a)
-- tests). But the proper type could be parsed if we wanted.
data ExportTarget = ExportTargetLocal NonEmptyString
| ExportTargetRemote UncheckedList
- deriving (Eq, Read, Show)
+ deriving (Eq, Show)
-- | Custom reader for 'ExportTarget'.
readExportTarget :: JSValue -> Text.JSON.Result ExportTarget
pMigrationLive =
renameField "OldLiveMode" . optionalField $ booleanField "live"
+-- | Migration cleanup parameter.
+pMigrationCleanup :: Field
+pMigrationCleanup = renameField "MigrationCleanup" $ defaultFalse "cleanup"
+
-- | Whether to force an unknown OS variant.
pForceVariant :: Field
pForceVariant = defaultFalse "force_variant"
-- | Destination X509 CA (remote export only).
pX509DestCA :: Field
pX509DestCA = optionalNEStringField "destination_x509_ca"
+
+-- | Search pattern (regular expression). FIXME: this should be
+-- compiled at load time?
+pTagSearchPattern :: Field
+pTagSearchPattern =
+ renameField "TagSearchPattern" $ simpleField "pattern" [t| NonEmptyString |]
+
+-- | Restricted command name.
+pRestrictedCommand :: Field
+pRestrictedCommand =
+ renameField "RestrictedCommand" $
+ simpleField "command" [t| NonEmptyString |]
+
+-- | Replace disks mode.
+pReplaceDisksMode :: Field
+pReplaceDisksMode =
+ renameField "ReplaceDisksMode" $ simpleField "mode" [t| ReplaceDisksMode |]
+
+-- | List of disk indices.
+pReplaceDisksList :: Field
+pReplaceDisksList =
+ renameField "ReplaceDisksList" $ simpleField "disks" [t| [DiskIndex] |]
+
+-- | Whether do allow failover in migrations.
+pAllowFailover :: Field
+pAllowFailover = defaultFalse "allow_failover"
+
+-- * Test opcode parameters
+
+-- | Duration parameter for 'OpTestDelay'.
+pDelayDuration :: Field
+pDelayDuration =
+ renameField "DelayDuration "$ simpleField "duration" [t| Double |]
+
+-- | on_master field for 'OpTestDelay'.
+pDelayOnMaster :: Field
+pDelayOnMaster = renameField "DelayOnMaster" $ defaultTrue "on_master"
+
+-- | on_nodes field for 'OpTestDelay'.
+pDelayOnNodes :: Field
+pDelayOnNodes =
+ renameField "DelayOnNodes" .
+ defaultField [| [] |] $
+ simpleField "on_nodes" [t| [NonEmptyString] |]
+
+-- | Repeat parameter for OpTestDelay.
+pDelayRepeat :: Field
+pDelayRepeat =
+ renameField "DelayRepeat" .
+ defaultField [| forceNonNeg (0::Int) |] $
+ simpleField "repeat" [t| NonNegative Int |]
+
+-- | IAllocator test direction.
+pIAllocatorDirection :: Field
+pIAllocatorDirection =
+ renameField "IAllocatorDirection" $
+ simpleField "direction" [t| IAllocatorTestDir |]
+
+-- | IAllocator test mode.
+pIAllocatorMode :: Field
+pIAllocatorMode =
+ renameField "IAllocatorMode" $
+ simpleField "mode" [t| IAllocatorMode |]
+
+-- | IAllocator target name (new instance, node to evac, etc.).
+pIAllocatorReqName :: Field
+pIAllocatorReqName =
+ renameField "IAllocatorReqName" $ simpleField "name" [t| NonEmptyString |]
+
+-- | Custom OpTestIAllocator nics.
+pIAllocatorNics :: Field
+pIAllocatorNics =
+ renameField "IAllocatorNics" $ simpleField "nics" [t| [UncheckedDict] |]
+
+-- | Custom OpTestAllocator disks.
+pIAllocatorDisks :: Field
+pIAllocatorDisks =
+ renameField "IAllocatorDisks" $ simpleField "disks" [t| UncheckedList |]
+
+-- | IAllocator memory field.
+pIAllocatorMemory :: Field
+pIAllocatorMemory =
+ renameField "IAllocatorMem" .
+ optionalField $
+ simpleField "memory" [t| NonNegative Int |]
+
+-- | IAllocator vcpus field.
+pIAllocatorVCpus :: Field
+pIAllocatorVCpus =
+ renameField "IAllocatorVCpus" .
+ optionalField $
+ simpleField "vcpus" [t| NonNegative Int |]
+
+-- | IAllocator os field.
+pIAllocatorOs :: Field
+pIAllocatorOs = renameField "IAllocatorOs" $ optionalNEStringField "os"
+
+-- | IAllocator instances field.
+pIAllocatorInstances :: Field
+pIAllocatorInstances =
+ renameField "IAllocatorInstances " .
+ optionalField $
+ simpleField "instances" [t| [NonEmptyString] |]
+
+-- | IAllocator evac mode.
+pIAllocatorEvacMode :: Field
+pIAllocatorEvacMode =
+ renameField "IAllocatorEvacMode" .
+ optionalField $
+ simpleField "evac_mode" [t| NodeEvacMode |]
+
+-- | IAllocator spindle use.
+pIAllocatorSpindleUse :: Field
+pIAllocatorSpindleUse =
+ renameField "IAllocatorSpindleUse" .
+ defaultField [| forceNonNeg (1::Int) |] $
+ simpleField "spindle_use" [t| NonNegative Int |]
+
+-- | IAllocator count field.
+pIAllocatorCount :: Field
+pIAllocatorCount =
+ renameField "IAllocatorCount" .
+ defaultField [| forceNonNeg (1::Int) |] $
+ simpleField "count" [t| NonNegative Int |]
+
+-- | 'OpTestJqueue' notify_waitlock.
+pJQueueNotifyWaitLock :: Field
+pJQueueNotifyWaitLock = defaultFalse "notify_waitlock"
+
+-- | 'OpTestJQueue' notify_exec.
+pJQueueNotifyExec :: Field
+pJQueueNotifyExec = defaultFalse "notify_exec"
+
+-- | 'OpTestJQueue' log_messages.
+pJQueueLogMessages :: Field
+pJQueueLogMessages =
+ defaultField [| [] |] $ simpleField "log_messages" [t| [String] |]
+
+-- | 'OpTestJQueue' fail attribute.
+pJQueueFail :: Field
+pJQueueFail =
+ renameField "JQueueFail" $ defaultFalse "fail"
+
+-- | 'OpTestDummy' result field.
+pTestDummyResult :: Field
+pTestDummyResult =
+ renameField "TestDummyResult" $ simpleField "result" [t| UncheckedValue |]
+
+-- | 'OpTestDummy' messages field.
+pTestDummyMessages :: Field
+pTestDummyMessages =
+ renameField "TestDummyMessages" $
+ simpleField "messages" [t| UncheckedValue |]
+
+-- | 'OpTestDummy' fail field.
+pTestDummyFail :: Field
+pTestDummyFail =
+ renameField "TestDummyFail" $ simpleField "fail" [t| UncheckedValue |]
+
+-- | 'OpTestDummy' submit_jobs field.
+pTestDummySubmitJobs :: Field
+pTestDummySubmitJobs =
+ renameField "TestDummySubmitJobs" $
+ simpleField "submit_jobs" [t| UncheckedValue |]
+
+-- * Network parameters
+
+-- | Network name.
+pNetworkName :: Field
+pNetworkName = simpleField "network_name" [t| NonEmptyString |]
+
+-- | Network type field.
+pNetworkType :: Field
+pNetworkType = optionalField $ simpleField "network_type" [t| NetworkType |]
+
+-- | Network address (IPv4 subnet). FIXME: no real type for this.
+pNetworkAddress4 :: Field
+pNetworkAddress4 =
+ renameField "NetworkAddress4" $
+ simpleField "network" [t| NonEmptyString |]
+
+-- | Network gateway (IPv4 address). FIXME: no real type for this.
+pNetworkGateway4 :: Field
+pNetworkGateway4 =
+ renameField "NetworkGateway4" $
+ optionalNEStringField "gateway"
+
+-- | Network address (IPv6 subnet). FIXME: no real type for this.
+pNetworkAddress6 :: Field
+pNetworkAddress6 =
+ renameField "NetworkAddress6" $
+ optionalNEStringField "network6"
+
+-- | Network gateway (IPv6 address). FIXME: no real type for this.
+pNetworkGateway6 :: Field
+pNetworkGateway6 =
+ renameField "NetworkGateway6" $
+ optionalNEStringField "gateway6"
+
+-- | Network specific mac prefix (that overrides the cluster one).
+pNetworkMacPrefix :: Field
+pNetworkMacPrefix =
+ renameField "NetMacPrefix" $
+ optionalNEStringField "mac_prefix"
+
+-- | Network add reserved IPs.
+pNetworkAddRsvdIps :: Field
+pNetworkAddRsvdIps =
+ renameField "NetworkAddRsvdIps" .
+ optionalField $
+ simpleField "add_reserved_ips" [t| [NonEmptyString] |]
+
+-- | Network remove reserved IPs.
+pNetworkRemoveRsvdIps :: Field
+pNetworkRemoveRsvdIps =
+ renameField "NetworkRemoveRsvdIps" .
+ optionalField $
+ simpleField "remove_reserved_ips" [t| [NonEmptyString] |]
+
+-- | Network mode when connecting to a group.
+pNetworkMode :: Field
+pNetworkMode = simpleField "network_mode" [t| NICMode |]
+
+-- | Network link when connecting to a group.
+pNetworkLink :: Field
+pNetworkLink = simpleField "network_link" [t| NonEmptyString |]
+
+-- * Entire opcode parameter list
+
+-- | Old-style query opcode, with locking.
+dOldQuery :: [Field]
+dOldQuery =
+ [ pOutputFields
+ , pNames
+ , pUseLocking
+ ]
+
+-- | Old-style query opcode, without locking.
+dOldQueryNoLocking :: [Field]
+dOldQueryNoLocking =
+ [ pOutputFields
+ , pNames
+ ]
projects / ganeti-local / blobdiff