Commit b46ba79c authored by Iustin Pop's avatar Iustin Pop
Browse files

Add types and parameters for common opcode implementation



This will go into a separate type; this patch adds the needed
underlying types and parameters.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent c67b908a
......@@ -47,7 +47,6 @@ import Test.Ganeti.TestCommon
import Ganeti.BasicTypes
import qualified Ganeti.Constants as C
import Ganeti.Types as Types
import Ganeti.Luxi as Luxi
{-# ANN module "HLint: ignore Use camelCase" #-}
......@@ -118,10 +117,16 @@ $(genArbitrary ''NICMode)
$(genArbitrary ''FinalizedJobStatus)
instance Arbitrary Luxi.JobId where
instance Arbitrary JobId where
arbitrary = do
(Positive i) <- arbitrary
Luxi.makeJobId i
makeJobId i
$(genArbitrary ''JobIdDep)
$(genArbitrary ''JobDependency)
$(genArbitrary ''OpSubmitPriority)
-- * Properties
......@@ -307,6 +312,14 @@ prop_JobId_serialisation jid =
testSerialisation jid .&&.
(J.readJSON . J.showJSON . show $ fromJobId jid) ==? J.Ok jid
-- | Test 'JobDependency' serialisation.
prop_JobDependency_serialisation :: JobDependency -> Property
prop_JobDependency_serialisation = testSerialisation
-- | Test 'OpSubmitPriority' serialisation.
prop_OpSubmitPriority_serialisation :: OpSubmitPriority -> Property
prop_OpSubmitPriority_serialisation = testSerialisation
testSuite "Types"
[ 'prop_AllocPolicy_serialisation
, 'prop_DiskTemplate_serialisation
......@@ -343,4 +356,6 @@ testSuite "Types"
, 'prop_FinalizedJobStatus_serialisation
, 'case_FinalizedJobStatus_pyequiv
, 'prop_JobId_serialisation
, 'prop_JobDependency_serialisation
, 'prop_OpSubmitPriority_serialisation
]
......@@ -229,6 +229,11 @@ module Ganeti.OpParams
, pNetworkRemoveRsvdIps
, pNetworkMode
, pNetworkLink
, pDryRun
, pDebugLevel
, pOpPriority
, pDependencies
, pComment
, dOldQuery
, dOldQueryNoLocking
) where
......@@ -1393,6 +1398,31 @@ pNetworkMode = simpleField "network_mode" [t| NICMode |]
pNetworkLink :: Field
pNetworkLink = simpleField "network_link" [t| NonEmptyString |]
-- * Common opcode parameters
-- | Run checks only, don't execute.
pDryRun :: Field
pDryRun = optionalField $ booleanField "dry_run"
-- | Debug level.
pDebugLevel :: Field
pDebugLevel = optionalField $ simpleField "debug_level" [t| NonNegative Int |]
-- | Opcode priority. Note: python uses a separate constant, we're
-- using the actual value we know it's the default.
pOpPriority :: Field
pOpPriority =
defaultField [| OpPrioNormal |] $
simpleField "priority" [t| OpSubmitPriority |]
-- | Job dependencies.
pDependencies :: Field
pDependencies = optionalField $ simpleField "depends" [t| [JobDependency] |]
-- | Comment field.
pComment :: Field
pComment = optionalField $ stringField "comment"
-- * Entire opcode parameter list
-- | Old-style query opcode, with locking.
......
......@@ -79,9 +79,15 @@ module Ganeti.Types
, JobId
, fromJobId
, makeJobId
, RelativeJobId
, JobIdDep(..)
, JobDependency(..)
, OpSubmitPriority(..)
) where
import Control.Monad (liftM)
import qualified Text.JSON as JSON
import Text.JSON (JSON, readJSON, showJSON)
import Data.Ratio (numerator, denominator)
import qualified Ganeti.Constants as C
......@@ -388,3 +394,38 @@ parseJobId x = fail $ "Wrong type/value for job id: " ++ show x
instance JSON.JSON JobId where
showJSON = JSON.showJSON . fromJobId
readJSON = parseJobId
-- | Relative job ID type alias.
type RelativeJobId = Negative Int
-- | Job ID dependency.
data JobIdDep = JobDepRelative RelativeJobId
| JobDepAbsolute JobId
deriving (Show, Eq)
instance JSON.JSON JobIdDep where
showJSON (JobDepRelative i) = showJSON i
showJSON (JobDepAbsolute i) = showJSON i
readJSON v =
case JSON.readJSON v::JSON.Result (Negative Int) of
-- first try relative dependency, usually most common
JSON.Ok r -> return $ JobDepRelative r
JSON.Error _ -> liftM JobDepAbsolute
(fromJResult "parsing absolute job id" (readJSON v) >>=
makeJobId)
-- | Job Dependency type.
data JobDependency = JobDependency JobIdDep [FinalizedJobStatus]
deriving (Show, Eq)
instance JSON JobDependency where
showJSON (JobDependency dep status) = showJSON (dep, status)
readJSON = liftM (uncurry JobDependency) . readJSON
-- | Valid opcode priorities for submit.
$(THH.declareIADT "OpSubmitPriority"
[ ("OpPrioLow", 'C.opPrioLow)
, ("OpPrioNormal", 'C.opPrioNormal)
, ("OpPrioHigh", 'C.opPrioHigh)
])
$(THH.makeJSONInstance ''OpSubmitPriority)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment