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

Add a 'real' type for JobIds



Currently, the job ID is a simple type alias. This is suboptimal, as
it means we can't use a custom JSON (or Arbitrary) instance for it.

The patch changes it into a newtype, and then a) simplifies some
deserialisation code and b) changes some more fields to this new type
(rather than plain 'Int').

We also move the JobId to types, since it will be needed in opcodes as
well.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent 6903fea0
......@@ -33,11 +33,13 @@ module Test.Ganeti.Types
, InstanceStatus(..)
, NonEmpty(..)
, Hypervisor(..)
, JobId(..)
) where
import Data.List (sort)
import Test.QuickCheck as QuickCheck hiding (Result)
import Test.HUnit
import qualified Text.JSON as J
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
......@@ -45,6 +47,7 @@ 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" #-}
......@@ -109,6 +112,11 @@ $(genArbitrary ''NICMode)
$(genArbitrary ''FinalizedJobStatus)
instance Arbitrary Luxi.JobId where
arbitrary = do
(Positive i) <- arbitrary
Luxi.makeJobId i
-- * Properties
prop_AllocPolicy_serialisation :: AllocPolicy -> Property
......@@ -271,6 +279,12 @@ case_FinalizedJobStatus_pyequiv = do
[minBound..maxBound]
assertEqual "for FinalizedJobStatus equivalence" all_py_codes all_hs_codes
-- | Tests JobId serialisation (both from string and ints).
prop_JobId_serialisation :: JobId -> Property
prop_JobId_serialisation jid =
testSerialisation jid .&&.
(J.readJSON . J.showJSON . show $ fromJobId jid) ==? J.Ok jid
testSuite "Types"
[ 'prop_AllocPolicy_serialisation
, 'prop_DiskTemplate_serialisation
......@@ -304,4 +318,5 @@ testSuite "Types"
, 'case_NICMode_pyequiv
, 'prop_FinalizedJobStatus_serialisation
, 'case_FinalizedJobStatus_pyequiv
, 'prop_JobId_serialisation
]
......@@ -30,6 +30,8 @@ module Ganeti.Luxi
, LuxiReq(..)
, Client
, JobId
, fromJobId
, makeJobId
, RecvResult(..)
, strOfOp
, getClient
......@@ -52,7 +54,6 @@ module Ganeti.Luxi
import Control.Exception (catch)
import Data.IORef
import Data.Ratio (numerator, denominator)
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as UTF8
import Data.Word (Word8)
......@@ -74,9 +75,9 @@ import Ganeti.JSON
import Ganeti.Jobs (JobStatus)
import Ganeti.OpParams (pTagsObject)
import Ganeti.OpCodes
import Ganeti.Utils
import qualified Ganeti.Query.Language as Qlang
import Ganeti.THH
import Ganeti.Types
-- * Utility functions
......@@ -96,9 +97,6 @@ data RecvResult = RecvConnClosed -- ^ Connection closed
| RecvOk String -- ^ Successfull receive
deriving (Show, Eq)
-- | The Ganeti job type.
type JobId = Int
-- | Currently supported Luxi operations and JSON serialization.
$(genLuxiOp "LuxiOp"
[ (luxiReqQuery,
......@@ -126,7 +124,7 @@ $(genLuxiOp "LuxiOp"
, simpleField "lock" [t| Bool |]
])
, (luxiReqQueryJobs,
[ simpleField "ids" [t| [Int] |]
[ simpleField "ids" [t| [JobId] |]
, simpleField "fields" [t| [String] |]
])
, (luxiReqQueryExports,
......@@ -146,24 +144,24 @@ $(genLuxiOp "LuxiOp"
[ simpleField "ops" [t| [[OpCode]] |] ]
)
, (luxiReqWaitForJobChange,
[ simpleField "job" [t| Int |]
[ simpleField "job" [t| JobId |]
, simpleField "fields" [t| [String]|]
, simpleField "prev_job" [t| JSValue |]
, simpleField "prev_log" [t| JSValue |]
, simpleField "tmout" [t| Int |]
])
, (luxiReqArchiveJob,
[ simpleField "job" [t| Int |] ]
[ simpleField "job" [t| JobId |] ]
)
, (luxiReqAutoArchiveJobs,
[ simpleField "age" [t| Int |]
, simpleField "tmout" [t| Int |]
])
, (luxiReqCancelJob,
[ simpleField "job" [t| Int |] ]
[ simpleField "job" [t| JobId |] ]
)
, (luxiReqChangeJobPriority,
[ simpleField "job" [t| Int |]
[ simpleField "job" [t| JobId |]
, simpleField "priority" [t| Int |] ]
)
, (luxiReqSetDrainFlag,
......@@ -326,10 +324,9 @@ decodeCall :: LuxiCall -> Result LuxiOp
decodeCall (LuxiCall call args) =
case call of
ReqQueryJobs -> do
(jid, jargs) <- fromJVal args
rid <- mapM parseJobId jid
(jids, jargs) <- fromJVal args
let rargs = map fromJSString jargs
return $ QueryJobs rid rargs
return $ QueryJobs jids rargs
ReqQueryInstances -> do
(names, fields, locking) <- fromJVal args
return $ QueryInstances names fields locking
......@@ -372,12 +369,10 @@ decodeCall (LuxiCall call args) =
J.readJSON d `ap`
J.readJSON e
_ -> J.Error "Not enough values"
rid <- parseJobId jid
return $ WaitForJobChange rid fields pinfo pidx wtmout
return $ WaitForJobChange jid fields pinfo pidx wtmout
ReqArchiveJob -> do
[jid] <- fromJVal args
rid <- parseJobId jid
return $ ArchiveJob rid
return $ ArchiveJob jid
ReqAutoArchiveJobs -> do
(age, tmout) <- fromJVal args
return $ AutoArchiveJobs age tmout
......@@ -392,13 +387,11 @@ decodeCall (LuxiCall call args) =
item <- tagObjectFrom kind name
return $ QueryTags item
ReqCancelJob -> do
[job] <- fromJVal args
rid <- parseJobId job
return $ CancelJob rid
[jid] <- fromJVal args
return $ CancelJob jid
ReqChangeJobPriority -> do
(job, priority) <- fromJVal args
rid <- parseJobId job
return $ ChangeJobPriority rid priority
(jid, priority) <- fromJVal args
return $ ChangeJobPriority jid priority
ReqSetDrainFlag -> do
[flag] <- fromJVal args
return $ SetDrainFlag flag
......@@ -437,22 +430,12 @@ callMethod method s = do
let rval = validateResult result
return rval
-- | Parses a job ID.
parseJobId :: JSValue -> Result JobId
parseJobId (JSString x) = tryRead "parsing job id" . fromJSString $ x
parseJobId (JSRational _ x) =
if denominator x /= 1
then Bad $ "Got fractional job ID from master daemon?! Value:" ++ show x
-- FIXME: potential integer overflow here on 32-bit platforms
else Ok . fromIntegral . numerator $ x
parseJobId x = Bad $ "Wrong type/value for job id: " ++ show x
-- | Parse job submission result.
parseSubmitJobResult :: JSValue -> ErrorResult JobId
parseSubmitJobResult (JSArray [JSBool True, v]) =
case parseJobId v of
Bad msg -> Bad $ LuxiError msg
Ok v' -> Ok v'
case J.readJSON v of
J.Error msg -> Bad $ LuxiError msg
J.Ok v' -> Ok v'
parseSubmitJobResult (JSArray [JSBool False, JSString x]) =
Bad . LuxiError $ fromJSString x
parseSubmitJobResult v =
......
......@@ -73,13 +73,18 @@ module Ganeti.Types
, nICModeToRaw
, FinalizedJobStatus(..)
, finalizedJobStatusToRaw
, JobId
, fromJobId
, makeJobId
) where
import qualified Text.JSON as JSON
import Data.Ratio (numerator, denominator)
import qualified Ganeti.Constants as C
import qualified Ganeti.THH as THH
import Ganeti.JSON
import Ganeti.Utils
-- * Generic types
......@@ -342,3 +347,27 @@ $(THH.declareSADT "FinalizedJobStatus"
, ("JobStatusFailed", 'C.jobStatusError)
])
$(THH.makeJSONInstance ''FinalizedJobStatus)
-- | The Ganeti job type.
newtype JobId = JobId { fromJobId :: Int }
deriving (Show, Eq)
-- | Builds a job ID.
makeJobId :: (Monad m) => Int -> m JobId
makeJobId i | i >= 0 = return $ JobId i
| otherwise = fail $ "Invalid value for job ID ' " ++ show i ++ "'"
-- | Parses a job ID.
parseJobId :: (Monad m) => JSON.JSValue -> m JobId
parseJobId (JSON.JSString x) =
tryRead "parsing job id" (JSON.fromJSString x) >>= makeJobId
parseJobId (JSON.JSRational _ x) =
if denominator x /= 1
then fail $ "Got fractional job ID from master daemon?! Value:" ++ show x
-- FIXME: potential integer overflow here on 32-bit platforms
else makeJobId . fromIntegral . numerator $ x
parseJobId x = fail $ "Wrong type/value for job id: " ++ show x
instance JSON.JSON JobId where
showJSON = JSON.showJSON . fromJobId
readJSON = parseJobId
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