Make Query operators enforce strictness

[ganeti-local] / htools / Ganeti / OpParams.hs

diff --git a/htools/Ganeti/OpParams.hs b/htools/Ganeti/OpParams.hs
index a83ec3d..4eefc6d 100644 (file)
--- a/htools/Ganeti/OpParams.hs
+++ b/htools/Ganeti/OpParams.hs
@@ -63,6 +63,7 @@ module Ganeti.OpParams
   , pGroupName
   , pMigrationMode
   , pMigrationLive
+  , pMigrationCleanup
   , pForceVariant
   , pWaitForSync
   , pWaitForSyncFalse
@@ -189,6 +190,12 @@ module Ganeti.OpParams
   , pX509DestCA
   , pTagSearchPattern
   , pRestrictedCommand
+  , pReplaceDisksMode
+  , pReplaceDisksList
+  , pAllowFailover
+  , pDelayDuration
+  , pDelayOnMaster
+  , pDelayOnNodes
   , pDelayRepeat
   , pIAllocatorDirection
   , pIAllocatorMode
@@ -221,6 +228,8 @@ module Ganeti.OpParams
   , pNetworkRemoveRsvdIps
   , pNetworkMode
   , pNetworkLink
+  , dOldQuery
+  , dOldQueryNoLocking
   ) where
 
 import Control.Monad (liftM)
@@ -299,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
@@ -356,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
@@ -404,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
@@ -426,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 =
@@ -447,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)
@@ -469,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
@@ -558,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"
@@ -1159,8 +1172,38 @@ 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 =
@@ -1342,3 +1385,20 @@ 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
+  ]