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 ...@@ -33,11 +33,13 @@ module Test.Ganeti.Types
, InstanceStatus(..) , InstanceStatus(..)
, NonEmpty(..) , NonEmpty(..)
, Hypervisor(..) , Hypervisor(..)
, JobId(..)
) where ) where
import Data.List (sort) import Data.List (sort)
import Test.QuickCheck as QuickCheck hiding (Result) import Test.QuickCheck as QuickCheck hiding (Result)
import Test.HUnit import Test.HUnit
import qualified Text.JSON as J
import Test.Ganeti.TestHelper import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon import Test.Ganeti.TestCommon
...@@ -45,6 +47,7 @@ import Test.Ganeti.TestCommon ...@@ -45,6 +47,7 @@ import Test.Ganeti.TestCommon
import Ganeti.BasicTypes import Ganeti.BasicTypes
import qualified Ganeti.Constants as C import qualified Ganeti.Constants as C
import Ganeti.Types as Types import Ganeti.Types as Types
import Ganeti.Luxi as Luxi
{-# ANN module "HLint: ignore Use camelCase" #-} {-# ANN module "HLint: ignore Use camelCase" #-}
...@@ -109,6 +112,11 @@ $(genArbitrary ''NICMode) ...@@ -109,6 +112,11 @@ $(genArbitrary ''NICMode)
$(genArbitrary ''FinalizedJobStatus) $(genArbitrary ''FinalizedJobStatus)
instance Arbitrary Luxi.JobId where
arbitrary = do
(Positive i) <- arbitrary
Luxi.makeJobId i
-- * Properties -- * Properties
prop_AllocPolicy_serialisation :: AllocPolicy -> Property prop_AllocPolicy_serialisation :: AllocPolicy -> Property
...@@ -271,6 +279,12 @@ case_FinalizedJobStatus_pyequiv = do ...@@ -271,6 +279,12 @@ case_FinalizedJobStatus_pyequiv = do
[minBound..maxBound] [minBound..maxBound]
assertEqual "for FinalizedJobStatus equivalence" all_py_codes all_hs_codes 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" testSuite "Types"
[ 'prop_AllocPolicy_serialisation [ 'prop_AllocPolicy_serialisation
, 'prop_DiskTemplate_serialisation , 'prop_DiskTemplate_serialisation
...@@ -304,4 +318,5 @@ testSuite "Types" ...@@ -304,4 +318,5 @@ testSuite "Types"
, 'case_NICMode_pyequiv , 'case_NICMode_pyequiv
, 'prop_FinalizedJobStatus_serialisation , 'prop_FinalizedJobStatus_serialisation
, 'case_FinalizedJobStatus_pyequiv , 'case_FinalizedJobStatus_pyequiv
, 'prop_JobId_serialisation
] ]
...@@ -30,6 +30,8 @@ module Ganeti.Luxi ...@@ -30,6 +30,8 @@ module Ganeti.Luxi
, LuxiReq(..) , LuxiReq(..)
, Client , Client
, JobId , JobId
, fromJobId
, makeJobId
, RecvResult(..) , RecvResult(..)
, strOfOp , strOfOp
, getClient , getClient
...@@ -52,7 +54,6 @@ module Ganeti.Luxi ...@@ -52,7 +54,6 @@ module Ganeti.Luxi
import Control.Exception (catch) import Control.Exception (catch)
import Data.IORef import Data.IORef
import Data.Ratio (numerator, denominator)
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.UTF8 as UTF8
import Data.Word (Word8) import Data.Word (Word8)
...@@ -74,9 +75,9 @@ import Ganeti.JSON ...@@ -74,9 +75,9 @@ import Ganeti.JSON
import Ganeti.Jobs (JobStatus) import Ganeti.Jobs (JobStatus)
import Ganeti.OpParams (pTagsObject) import Ganeti.OpParams (pTagsObject)
import Ganeti.OpCodes import Ganeti.OpCodes
import Ganeti.Utils
import qualified Ganeti.Query.Language as Qlang import qualified Ganeti.Query.Language as Qlang
import Ganeti.THH import Ganeti.THH
import Ganeti.Types
-- * Utility functions -- * Utility functions
...@@ -96,9 +97,6 @@ data RecvResult = RecvConnClosed -- ^ Connection closed ...@@ -96,9 +97,6 @@ data RecvResult = RecvConnClosed -- ^ Connection closed
| RecvOk String -- ^ Successfull receive | RecvOk String -- ^ Successfull receive
deriving (Show, Eq) deriving (Show, Eq)
-- | The Ganeti job type.
type JobId = Int
-- | Currently supported Luxi operations and JSON serialization. -- | Currently supported Luxi operations and JSON serialization.
$(genLuxiOp "LuxiOp" $(genLuxiOp "LuxiOp"
[ (luxiReqQuery, [ (luxiReqQuery,
...@@ -126,7 +124,7 @@ $(genLuxiOp "LuxiOp" ...@@ -126,7 +124,7 @@ $(genLuxiOp "LuxiOp"
, simpleField "lock" [t| Bool |] , simpleField "lock" [t| Bool |]
]) ])
, (luxiReqQueryJobs, , (luxiReqQueryJobs,
[ simpleField "ids" [t| [Int] |] [ simpleField "ids" [t| [JobId] |]
, simpleField "fields" [t| [String] |] , simpleField "fields" [t| [String] |]
]) ])
, (luxiReqQueryExports, , (luxiReqQueryExports,
...@@ -146,24 +144,24 @@ $(genLuxiOp "LuxiOp" ...@@ -146,24 +144,24 @@ $(genLuxiOp "LuxiOp"
[ simpleField "ops" [t| [[OpCode]] |] ] [ simpleField "ops" [t| [[OpCode]] |] ]
) )
, (luxiReqWaitForJobChange, , (luxiReqWaitForJobChange,
[ simpleField "job" [t| Int |] [ simpleField "job" [t| JobId |]
, simpleField "fields" [t| [String]|] , simpleField "fields" [t| [String]|]
, simpleField "prev_job" [t| JSValue |] , simpleField "prev_job" [t| JSValue |]
, simpleField "prev_log" [t| JSValue |] , simpleField "prev_log" [t| JSValue |]
, simpleField "tmout" [t| Int |] , simpleField "tmout" [t| Int |]
]) ])
, (luxiReqArchiveJob, , (luxiReqArchiveJob,
[ simpleField "job" [t| Int |] ] [ simpleField "job" [t| JobId |] ]
) )
, (luxiReqAutoArchiveJobs, , (luxiReqAutoArchiveJobs,
[ simpleField "age" [t| Int |] [ simpleField "age" [t| Int |]
, simpleField "tmout" [t| Int |] , simpleField "tmout" [t| Int |]
]) ])
, (luxiReqCancelJob, , (luxiReqCancelJob,
[ simpleField "job" [t| Int |] ] [ simpleField "job" [t| JobId |] ]
) )
, (luxiReqChangeJobPriority, , (luxiReqChangeJobPriority,
[ simpleField "job" [t| Int |] [ simpleField "job" [t| JobId |]
, simpleField "priority" [t| Int |] ] , simpleField "priority" [t| Int |] ]
) )
, (luxiReqSetDrainFlag, , (luxiReqSetDrainFlag,
...@@ -326,10 +324,9 @@ decodeCall :: LuxiCall -> Result LuxiOp ...@@ -326,10 +324,9 @@ decodeCall :: LuxiCall -> Result LuxiOp
decodeCall (LuxiCall call args) = decodeCall (LuxiCall call args) =
case call of case call of
ReqQueryJobs -> do ReqQueryJobs -> do
(jid, jargs) <- fromJVal args (jids, jargs) <- fromJVal args
rid <- mapM parseJobId jid
let rargs = map fromJSString jargs let rargs = map fromJSString jargs
return $ QueryJobs rid rargs return $ QueryJobs jids rargs
ReqQueryInstances -> do ReqQueryInstances -> do
(names, fields, locking) <- fromJVal args (names, fields, locking) <- fromJVal args
return $ QueryInstances names fields locking return $ QueryInstances names fields locking
...@@ -372,12 +369,10 @@ decodeCall (LuxiCall call args) = ...@@ -372,12 +369,10 @@ decodeCall (LuxiCall call args) =
J.readJSON d `ap` J.readJSON d `ap`
J.readJSON e J.readJSON e
_ -> J.Error "Not enough values" _ -> J.Error "Not enough values"
rid <- parseJobId jid return $ WaitForJobChange jid fields pinfo pidx wtmout
return $ WaitForJobChange rid fields pinfo pidx wtmout
ReqArchiveJob -> do ReqArchiveJob -> do
[jid] <- fromJVal args [jid] <- fromJVal args
rid <- parseJobId jid return $ ArchiveJob jid
return $ ArchiveJob rid
ReqAutoArchiveJobs -> do ReqAutoArchiveJobs -> do
(age, tmout) <- fromJVal args (age, tmout) <- fromJVal args
return $ AutoArchiveJobs age tmout return $ AutoArchiveJobs age tmout
...@@ -392,13 +387,11 @@ decodeCall (LuxiCall call args) = ...@@ -392,13 +387,11 @@ decodeCall (LuxiCall call args) =
item <- tagObjectFrom kind name item <- tagObjectFrom kind name
return $ QueryTags item return $ QueryTags item
ReqCancelJob -> do ReqCancelJob -> do
[job] <- fromJVal args [jid] <- fromJVal args
rid <- parseJobId job return $ CancelJob jid
return $ CancelJob rid
ReqChangeJobPriority -> do ReqChangeJobPriority -> do
(job, priority) <- fromJVal args (jid, priority) <- fromJVal args
rid <- parseJobId job return $ ChangeJobPriority jid priority
return $ ChangeJobPriority rid priority
ReqSetDrainFlag -> do ReqSetDrainFlag -> do
[flag] <- fromJVal args [flag] <- fromJVal args
return $ SetDrainFlag flag return $ SetDrainFlag flag
...@@ -437,22 +430,12 @@ callMethod method s = do ...@@ -437,22 +430,12 @@ callMethod method s = do
let rval = validateResult result let rval = validateResult result
return rval 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. -- | Parse job submission result.
parseSubmitJobResult :: JSValue -> ErrorResult JobId parseSubmitJobResult :: JSValue -> ErrorResult JobId
parseSubmitJobResult (JSArray [JSBool True, v]) = parseSubmitJobResult (JSArray [JSBool True, v]) =
case parseJobId v of case J.readJSON v of
Bad msg -> Bad $ LuxiError msg J.Error msg -> Bad $ LuxiError msg
Ok v' -> Ok v' J.Ok v' -> Ok v'
parseSubmitJobResult (JSArray [JSBool False, JSString x]) = parseSubmitJobResult (JSArray [JSBool False, JSString x]) =
Bad . LuxiError $ fromJSString x Bad . LuxiError $ fromJSString x
parseSubmitJobResult v = parseSubmitJobResult v =
......
...@@ -73,13 +73,18 @@ module Ganeti.Types ...@@ -73,13 +73,18 @@ module Ganeti.Types
, nICModeToRaw , nICModeToRaw
, FinalizedJobStatus(..) , FinalizedJobStatus(..)
, finalizedJobStatusToRaw , finalizedJobStatusToRaw
, JobId
, fromJobId
, makeJobId
) where ) where
import qualified Text.JSON as JSON import qualified Text.JSON as JSON
import Data.Ratio (numerator, denominator)
import qualified Ganeti.Constants as C import qualified Ganeti.Constants as C
import qualified Ganeti.THH as THH import qualified Ganeti.THH as THH
import Ganeti.JSON import Ganeti.JSON
import Ganeti.Utils
-- * Generic types -- * Generic types
...@@ -342,3 +347,27 @@ $(THH.declareSADT "FinalizedJobStatus" ...@@ -342,3 +347,27 @@ $(THH.declareSADT "FinalizedJobStatus"
, ("JobStatusFailed", 'C.jobStatusError) , ("JobStatusFailed", 'C.jobStatusError)
]) ])
$(THH.makeJSONInstance ''FinalizedJobStatus) $(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