X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/398e90665de59e0386f4d703fc59c0f7c63c3b4a..228ef0f2bcdacea52cf512779b99947d1b8cb173:/htools/Ganeti/OpParams.hs

diff --git a/htools/Ganeti/OpParams.hs b/htools/Ganeti/OpParams.hs
index 955599c..4eefc6d 100644
--- a/htools/Ganeti/OpParams.hs
+++ b/htools/Ganeti/OpParams.hs
@@ -63,6 +63,7 @@ module Ganeti.OpParams
   , pGroupName
   , pMigrationMode
   , pMigrationLive
+  , pMigrationCleanup
   , pForceVariant
   , pWaitForSync
   , pWaitForSyncFalse
@@ -187,6 +188,48 @@ module Ganeti.OpParams
   , 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)
@@ -231,8 +274,8 @@ optionalStringField = optionalField . stringField
 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
@@ -265,7 +308,7 @@ data TagObject = TagInstance String
                | TagNode     String
                | TagGroup    String
                | TagCluster
-               deriving (Show, Read, Eq)
+               deriving (Show, Eq)
 
 -- | Tag type for a given tag object.
 tagTypeOf :: TagObject -> TagType
@@ -322,7 +365,7 @@ $(makeJSONInstance ''ReplaceDisksMode)
 -- | 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
@@ -370,7 +413,7 @@ data RecreateDisksInfo
   = 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
@@ -392,7 +435,7 @@ instance JSON RecreateDisksInfo where
 -- | 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 =
@@ -413,7 +456,7 @@ data SetParamsMods a
   = 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)
@@ -435,7 +478,7 @@ instance (JSON a) => JSON (SetParamsMods a) where
 -- 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
@@ -524,6 +567,10 @@ pMigrationLive :: Field
 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"
@@ -1112,3 +1159,246 @@ pX509KeyName = optionalField $ simpleField "x509_key_name" [t| UncheckedList |]
 -- | 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
+  ]