Commit 4a826364 authored by Iustin Pop's avatar Iustin Pop
Browse files

Add CommonOpParams and MetaOpCode types



This patch adds the "meta" opcode type and the common op
params. Compatibility tests with Python are changed to pass Meta
opcodes.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent d5af1f95
...@@ -337,6 +337,10 @@ instance Arbitrary OpCodes.OpCode where ...@@ -337,6 +337,10 @@ instance Arbitrary OpCodes.OpCode where
genNameNE genNameNE
_ -> fail $ "Undefined arbitrary for opcode " ++ op_id _ -> fail $ "Undefined arbitrary for opcode " ++ op_id
instance Arbitrary OpCodes.CommonOpParams where
arbitrary = OpCodes.CommonOpParams <$> arbitrary <*> arbitrary <*>
arbitrary <*> resize 5 arbitrary <*> genMaybe genName
-- * Helper functions -- * Helper functions
-- | Empty JSObject. -- | Empty JSObject.
...@@ -403,6 +407,9 @@ genMacPrefix = do ...@@ -403,6 +407,9 @@ genMacPrefix = do
octets <- vectorOf 3 $ choose (0::Int, 255) octets <- vectorOf 3 $ choose (0::Int, 255)
mkNonEmpty . intercalate ":" $ map (printf "%02x") octets mkNonEmpty . intercalate ":" $ map (printf "%02x") octets
-- | Arbitrary instance for MetaOpCode, defined here due to TH ordering.
$(genArbitrary ''OpCodes.MetaOpCode)
-- * Test cases -- * Test cases
-- | Check that opcode serialization is idempotent. -- | Check that opcode serialization is idempotent.
...@@ -441,7 +448,7 @@ case_py_compat_types :: HUnit.Assertion ...@@ -441,7 +448,7 @@ case_py_compat_types :: HUnit.Assertion
case_py_compat_types = do case_py_compat_types = do
let num_opcodes = length OpCodes.allOpIDs * 100 let num_opcodes = length OpCodes.allOpIDs * 100
sample_opcodes <- sample' (vectorOf num_opcodes sample_opcodes <- sample' (vectorOf num_opcodes
(arbitrary::Gen OpCodes.OpCode)) (arbitrary::Gen OpCodes.MetaOpCode))
let opcodes = head sample_opcodes let opcodes = head sample_opcodes
serialized = J.encode opcodes serialized = J.encode opcodes
-- check for non-ASCII fields, usually due to 'arbitrary :: String' -- check for non-ASCII fields, usually due to 'arbitrary :: String'
...@@ -460,7 +467,7 @@ case_py_compat_types = do ...@@ -460,7 +467,7 @@ case_py_compat_types = do
\encoded = [op.__getstate__() for op in decoded]\n\ \encoded = [op.__getstate__() for op in decoded]\n\
\print serializer.Dump(encoded)" serialized \print serializer.Dump(encoded)" serialized
>>= checkPythonResult >>= checkPythonResult
let deserialised = J.decode py_stdout::J.Result [OpCodes.OpCode] let deserialised = J.decode py_stdout::J.Result [OpCodes.MetaOpCode]
decoded <- case deserialised of decoded <- case deserialised of
J.Ok ops -> return ops J.Ok ops -> return ops
J.Error msg -> J.Error msg ->
...@@ -506,9 +513,16 @@ case_py_compat_fields = do ...@@ -506,9 +513,16 @@ case_py_compat_fields = do
py_flds hs_flds py_flds hs_flds
) $ zip py_fields hs_fields ) $ zip py_fields hs_fields
-- | Checks that setOpComment works correctly.
prop_setOpComment :: OpCodes.MetaOpCode -> String -> Property
prop_setOpComment op comment =
let (OpCodes.MetaOpCode common _) = OpCodes.setOpComment comment op
in OpCodes.opComment common ==? Just comment
testSuite "OpCodes" testSuite "OpCodes"
[ 'prop_serialization [ 'prop_serialization
, 'case_AllDefined , 'case_AllDefined
, 'case_py_compat_types , 'case_py_compat_types
, 'case_py_compat_fields , 'case_py_compat_fields
, 'prop_setOpComment
] ]
...@@ -38,13 +38,20 @@ module Ganeti.OpCodes ...@@ -38,13 +38,20 @@ module Ganeti.OpCodes
, opID , opID
, allOpIDs , allOpIDs
, allOpFields , allOpFields
, CommonOpParams(..)
, defOpParams
, MetaOpCode(..)
, wrapOpCode
, setOpComment
) where ) where
import Text.JSON (readJSON, showJSON, JSON()) import Text.JSON (readJSON, showJSON, JSON, JSValue, makeObj)
import qualified Text.JSON
import Ganeti.THH import Ganeti.THH
import Ganeti.OpParams import Ganeti.OpParams
import Ganeti.Types (OpSubmitPriority(..))
-- | OpCode representation. -- | OpCode representation.
-- --
...@@ -538,3 +545,54 @@ $(genAllOpIDs ''OpCode "allOpIDs") ...@@ -538,3 +545,54 @@ $(genAllOpIDs ''OpCode "allOpIDs")
instance JSON OpCode where instance JSON OpCode where
readJSON = loadOpCode readJSON = loadOpCode
showJSON = saveOpCode showJSON = saveOpCode
-- | Generic\/common opcode parameters.
$(buildObject "CommonOpParams" "op"
[ pDryRun
, pDebugLevel
, pOpPriority
, pDependencies
, pComment
])
-- | Default common parameter values.
defOpParams :: CommonOpParams
defOpParams =
CommonOpParams { opDryRun = Nothing
, opDebugLevel = Nothing
, opPriority = OpPrioNormal
, opDepends = Nothing
, opComment = Nothing
}
-- | The top-level opcode type.
data MetaOpCode = MetaOpCode CommonOpParams OpCode
deriving (Show, Eq)
-- | JSON serialisation for 'MetaOpCode'.
showMeta :: MetaOpCode -> JSValue
showMeta (MetaOpCode params op) =
let objparams = toDictCommonOpParams params
objop = toDictOpCode op
in makeObj (objparams ++ objop)
-- | JSON deserialisation for 'MetaOpCode'
readMeta :: JSValue -> Text.JSON.Result MetaOpCode
readMeta v = do
meta <- readJSON v
op <- readJSON v
return $ MetaOpCode meta op
instance JSON MetaOpCode where
showJSON = showMeta
readJSON = readMeta
-- | Wraps an 'OpCode' with the default parameters to build a
-- 'MetaOpCode'.
wrapOpCode :: OpCode -> MetaOpCode
wrapOpCode = MetaOpCode defOpParams
-- | Sets the comment on a meta opcode.
setOpComment :: String -> MetaOpCode -> MetaOpCode
setOpComment comment (MetaOpCode common op) =
MetaOpCode (common { opComment = Just comment}) op
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