From: Jose A. Lopes Date: Thu, 1 Aug 2013 13:37:36 +0000 (+0200) Subject: Update Harep, Query server, and tests X-Git-Url: https://code.grnet.gr/git/ganeti-local/commitdiff_plain/6e94b75c877582ef713fa9a12a7dd6f87a414673 Update Harep, Query server, and tests Update Harep, Haskell query server, and tests concerning Luxi and opcodes to reflect the changes to Haskell to Python opcode generation. This change is necessary because TagObject is replaced by TagKind and some types in opcodes and parameters changed to be consistent with Python, for example, 'String' became 'NonEmptyString'. Signed-off-by: Jose A. Lopes Reviewed-by: Guido Trotter --- diff --git a/src/Ganeti/HTools/Program/Harep.hs b/src/Ganeti/HTools/Program/Harep.hs index cb18085..1aa63cf 100644 --- a/src/Ganeti/HTools/Program/Harep.hs +++ b/src/Ganeti/HTools/Program/Harep.hs @@ -268,12 +268,14 @@ commitChange client instData = do when (isJust arData) $ do let tag = arTag $ fromJust arData putStrLn (">>> Adding the following tag to " ++ iname ++ ":\n" ++ show tag) - execJobsWaitOk' [OpTagsSet (TagInstance iname) [tag]] + tagName <- mkNonEmpty iname + execJobsWaitOk' [OpTagsSet TagKindInstance [tag] (Just tagName)] unless (null rmTags) $ do putStr (">>> Removing the following tags from " ++ iname ++ ":\n" ++ unlines (map show rmTags)) - execJobsWaitOk' [OpTagsDel (TagInstance iname) rmTags] + tagName <- mkNonEmpty iname + execJobsWaitOk' [OpTagsDel TagKindInstance rmTags (Just tagName)] return instData { tagsToRemove = [] } diff --git a/src/Ganeti/Query/Server.hs b/src/Ganeti/Query/Server.hs index c6208be..bc2ee3e 100644 --- a/src/Ganeti/Query/Server.hs +++ b/src/Ganeti/Query/Server.hs @@ -52,11 +52,11 @@ import Ganeti.ConfigReader import Ganeti.BasicTypes import Ganeti.Logging import Ganeti.Luxi -import Ganeti.OpCodes (TagObject(..)) import qualified Ganeti.Query.Language as Qlang import qualified Ganeti.Query.Cluster as QCluster import Ganeti.Query.Query import Ganeti.Query.Filter (makeSimpleFilter) +import Ganeti.Types -- | Helper for classic queries. handleClassicQuery :: ConfigData -- ^ Cluster config @@ -149,13 +149,13 @@ handleCall cdata QueryClusterInfo = Ok _ -> return . Ok . J.makeObj $ obj Bad ex -> return $ Bad ex -handleCall cfg (QueryTags kind) = +handleCall cfg (QueryTags kind name) = do let tags = case kind of - TagCluster -> Ok . clusterTags $ configCluster cfg - TagGroup name -> groupTags <$> Config.getGroup cfg name - TagNode name -> nodeTags <$> Config.getNode cfg name - TagInstance name -> instTags <$> Config.getInstance cfg name - in return (J.showJSON <$> tags) + TagKindCluster -> Ok . clusterTags $ configCluster cfg + TagKindGroup -> groupTags <$> Config.getGroup cfg name + TagKindNode -> nodeTags <$> Config.getNode cfg name + TagKindInstance -> instTags <$> Config.getInstance cfg name + return (J.showJSON <$> tags) handleCall cfg (Query qkind qfields qfilter) = do result <- query cfg True (Qlang.Query qkind qfields qfilter) diff --git a/test/hs/Test/Ganeti/JQueue.hs b/test/hs/Test/Ganeti/JQueue.hs index e237336..9959ee5 100644 --- a/test/hs/Test/Ganeti/JQueue.hs +++ b/test/hs/Test/Ganeti/JQueue.hs @@ -161,7 +161,7 @@ case_JobStatusPri_py_equiv = do Text.JSON.Ok jobs' -> return jobs' Error msg -> assertFailure ("Unable to decode jobs: " ++ msg) - -- this already raised an expection, but we need it + -- this already raised an exception, but we need it -- for proper types >> fail "Unable to decode jobs" assertEqual "Mismatch in number of returned jobs" diff --git a/test/hs/Test/Ganeti/Luxi.hs b/test/hs/Test/Ganeti/Luxi.hs index 6eb8c12..f6ac5be 100644 --- a/test/hs/Test/Ganeti/Luxi.hs +++ b/test/hs/Test/Ganeti/Luxi.hs @@ -73,7 +73,9 @@ instance Arbitrary Luxi.LuxiOp where listOf genFQDN <*> arbitrary Luxi.ReqQueryConfigValues -> Luxi.QueryConfigValues <$> genFields Luxi.ReqQueryClusterInfo -> pure Luxi.QueryClusterInfo - Luxi.ReqQueryTags -> Luxi.QueryTags <$> arbitrary + Luxi.ReqQueryTags -> do + kind <- arbitrary + Luxi.QueryTags kind <$> genLuxiTagName kind Luxi.ReqSubmitJob -> Luxi.SubmitJob <$> resize maxOpCodes arbitrary Luxi.ReqSubmitManyJobs -> Luxi.SubmitManyJobs <$> resize maxOpCodes arbitrary diff --git a/test/hs/Test/Ganeti/OpCodes.hs b/test/hs/Test/Ganeti/OpCodes.hs index 290076e..126a1f2 100644 --- a/test/hs/Test/Ganeti/OpCodes.hs +++ b/test/hs/Test/Ganeti/OpCodes.hs @@ -45,7 +45,7 @@ import Text.Printf (printf) import Test.Ganeti.TestHelper import Test.Ganeti.TestCommon import Test.Ganeti.Types () -import Test.Ganeti.Query.Language +import Test.Ganeti.Query.Language () import Ganeti.BasicTypes import qualified Ganeti.Constants as C @@ -65,6 +65,21 @@ instance Arbitrary OpCodes.TagObject where , pure OpCodes.TagCluster ] +arbitraryOpTagsGet :: Gen OpCodes.OpCode +arbitraryOpTagsGet = do + kind <- arbitrary + OpCodes.OpTagsSet kind <$> arbitrary <*> genOpCodesTagName kind + +arbitraryOpTagsSet :: Gen OpCodes.OpCode +arbitraryOpTagsSet = do + kind <- arbitrary + OpCodes.OpTagsSet kind <$> genTags <*> genOpCodesTagName kind + +arbitraryOpTagsDel :: Gen OpCodes.OpCode +arbitraryOpTagsDel = do + kind <- arbitrary + OpCodes.OpTagsDel kind <$> genTags <*> genOpCodesTagName kind + $(genArbitrary ''OpCodes.ReplaceDisksMode) $(genArbitrary ''DiskAccess) @@ -74,8 +89,9 @@ instance Arbitrary OpCodes.DiskIndex where instance Arbitrary INicParams where arbitrary = INicParams <$> genMaybe genNameNE <*> genMaybe genName <*> - genMaybe genNameNE <*> genMaybe genNameNE <*> genMaybe genNameNE - <*> genMaybe genNameNE + genMaybe genNameNE <*> genMaybe genNameNE <*> + genMaybe genNameNE <*> genMaybe genNameNE <*> + genMaybe genNameNE instance Arbitrary IDiskParams where arbitrary = IDiskParams <$> arbitrary <*> arbitrary <*> @@ -125,13 +141,13 @@ instance Arbitrary OpCodes.OpCode where return Nothing <*> arbitrary <*> arbitrary <*> arbitrary <*> genMaybe genNameNE <*> arbitrary "OP_TAGS_GET" -> - OpCodes.OpTagsGet <$> arbitrary <*> arbitrary + arbitraryOpTagsGet "OP_TAGS_SEARCH" -> OpCodes.OpTagsSearch <$> genNameNE "OP_TAGS_SET" -> - OpCodes.OpTagsSet <$> arbitrary <*> genTags + arbitraryOpTagsSet "OP_TAGS_DEL" -> - OpCodes.OpTagsSet <$> arbitrary <*> genTags + arbitraryOpTagsDel "OP_CLUSTER_POST_INIT" -> pure OpCodes.OpClusterPostInit "OP_CLUSTER_DESTROY" -> pure OpCodes.OpClusterDestroy "OP_CLUSTER_QUERY" -> pure OpCodes.OpClusterQuery @@ -156,7 +172,7 @@ instance Arbitrary OpCodes.OpCode where OpCodes.OpClusterRename <$> genNameNE "OP_CLUSTER_SET_PARAMS" -> OpCodes.OpClusterSetParams <$> arbitrary <*> emptyMUD <*> emptyMUD <*> - arbitrary <*> genMaybe (listOf1 arbitrary >>= mkNonEmpty) <*> + arbitrary <*> genMaybe arbitrary <*> genMaybe genEmptyContainer <*> emptyMUD <*> genMaybe genEmptyContainer <*> genMaybe genEmptyContainer <*> genMaybe genEmptyContainer <*> genMaybe arbitrary <*> @@ -172,7 +188,8 @@ instance Arbitrary OpCodes.OpCode where "OP_CLUSTER_DEACTIVATE_MASTER_IP" -> pure OpCodes.OpClusterDeactivateMasterIp "OP_QUERY" -> - OpCodes.OpQuery <$> arbitrary <*> arbitrary <*> arbitrary <*> genFilter + OpCodes.OpQuery <$> arbitrary <*> arbitrary <*> arbitrary <*> + pure Nothing "OP_QUERY_FIELDS" -> OpCodes.OpQueryFields <$> arbitrary <*> arbitrary "OP_OOB_COMMAND" -> @@ -183,7 +200,7 @@ instance Arbitrary OpCodes.OpCode where OpCodes.OpNodeRemove <$> genNodeNameNE <*> return Nothing "OP_NODE_ADD" -> OpCodes.OpNodeAdd <$> genNodeNameNE <*> emptyMUD <*> emptyMUD <*> - genMaybe genName <*> genMaybe genNameNE <*> arbitrary <*> + genNameNE <*> genMaybe genNameNE <*> arbitrary <*> genMaybe genNameNE <*> arbitrary <*> arbitrary <*> emptyMUD "OP_NODE_QUERY" -> OpCodes.OpNodeQuery <$> genFieldsNE <*> genNamesNE <*> arbitrary @@ -191,13 +208,13 @@ instance Arbitrary OpCodes.OpCode where OpCodes.OpNodeQueryvols <$> arbitrary <*> genNodeNamesNE "OP_NODE_QUERY_STORAGE" -> OpCodes.OpNodeQueryStorage <$> arbitrary <*> arbitrary <*> - genNodeNamesNE <*> genNameNE + genNodeNamesNE <*> genMaybe genNameNE "OP_NODE_MODIFY_STORAGE" -> OpCodes.OpNodeModifyStorage <$> genNodeNameNE <*> return Nothing <*> - arbitrary <*> genNameNE <*> pure emptyJSObject + arbitrary <*> genMaybe genNameNE <*> pure emptyJSObject "OP_REPAIR_NODE_STORAGE" -> OpCodes.OpRepairNodeStorage <$> genNodeNameNE <*> return Nothing <*> - arbitrary <*> genNameNE <*> arbitrary + arbitrary <*> genMaybe genNameNE <*> arbitrary "OP_NODE_SET_PARAMS" -> OpCodes.OpNodeSetParams <$> genNodeNameNE <*> return Nothing <*> arbitrary <*> emptyMUD <*> emptyMUD <*> arbitrary <*> arbitrary <*> @@ -216,21 +233,19 @@ instance Arbitrary OpCodes.OpCode where genMaybe genNameNE <*> arbitrary "OP_INSTANCE_CREATE" -> OpCodes.OpInstanceCreate <$> genFQDN <*> arbitrary <*> - arbitrary <*> arbitrary <*> arbitrary <*> pure emptyJSObject <*> - arbitrary <*> arbitrary <*> arbitrary <*> genMaybe genNameNE <*> - pure emptyJSObject <*> arbitrary <*> genMaybe genNameNE <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> - arbitrary <*> arbitrary <*> pure emptyJSObject <*> - genMaybe genNameNE <*> - genMaybe genNodeNameNE <*> return Nothing <*> - genMaybe genNodeNameNE <*> return Nothing <*> - genMaybe (pure []) <*> genMaybe genNodeNameNE <*> - arbitrary <*> genMaybe genNodeNameNE <*> return Nothing <*> - genMaybe genNodeNameNE <*> genMaybe genNameNE <*> - arbitrary <*> arbitrary <*> (genTags >>= mapM mkNonEmpty) + pure emptyJSObject <*> arbitrary <*> arbitrary <*> arbitrary <*> + genMaybe genNameNE <*> pure emptyJSObject <*> arbitrary <*> + genMaybe genNameNE <*> arbitrary <*> arbitrary <*> arbitrary <*> + arbitrary <*> arbitrary <*> arbitrary <*> pure emptyJSObject <*> + genMaybe genNameNE <*> genMaybe genNodeNameNE <*> return Nothing <*> + genMaybe genNodeNameNE <*> return Nothing <*> genMaybe (pure []) <*> + genMaybe genNodeNameNE <*> arbitrary <*> genMaybe genNodeNameNE <*> + return Nothing <*> genMaybe genNodeNameNE <*> genMaybe genNameNE <*> + arbitrary <*> (genTags >>= mapM mkNonEmpty) "OP_INSTANCE_MULTI_ALLOC" -> - OpCodes.OpInstanceMultiAlloc <$> genMaybe genNameNE <*> pure [] <*> - arbitrary + OpCodes.OpInstanceMultiAlloc <$> arbitrary <*> genMaybe genNameNE <*> + pure [] "OP_INSTANCE_REINSTALL" -> OpCodes.OpInstanceReinstall <$> genFQDN <*> return Nothing <*> arbitrary <*> genMaybe genNameNE <*> genMaybe (pure emptyJSObject) @@ -267,7 +282,7 @@ instance Arbitrary OpCodes.OpCode where arbitrary <*> genNodeNamesNE <*> return Nothing <*> genMaybe genNameNE "OP_INSTANCE_QUERY" -> - OpCodes.OpInstanceQuery <$> genFieldsNE <*> genNamesNE <*> arbitrary + OpCodes.OpInstanceQuery <$> genFieldsNE <*> arbitrary <*> genNamesNE "OP_INSTANCE_QUERY_DATA" -> OpCodes.OpInstanceQueryData <$> arbitrary <*> genNodeNamesNE <*> arbitrary @@ -323,7 +338,7 @@ instance Arbitrary OpCodes.OpCode where OpCodes.OpBackupRemove <$> genFQDN <*> return Nothing "OP_TEST_ALLOCATOR" -> OpCodes.OpTestAllocator <$> arbitrary <*> arbitrary <*> - genNameNE <*> pure [] <*> pure [] <*> + genNameNE <*> genMaybe (pure []) <*> genMaybe (pure []) <*> arbitrary <*> genMaybe genNameNE <*> (genTags >>= mapM mkNonEmpty) <*> arbitrary <*> arbitrary <*> genMaybe genNameNE <*> @@ -336,24 +351,24 @@ instance Arbitrary OpCodes.OpCode where OpCodes.OpTestDummy <$> pure J.JSNull <*> pure J.JSNull <*> pure J.JSNull <*> pure J.JSNull "OP_NETWORK_ADD" -> - OpCodes.OpNetworkAdd <$> genNameNE <*> genIp4Net <*> - genMaybe genIp4Addr <*> pure Nothing <*> pure Nothing <*> - genMaybe genMacPrefix <*> genMaybe (listOf genIp4Addr) <*> + OpCodes.OpNetworkAdd <$> genNameNE <*> genIPv4Network <*> + genMaybe genIPv4Address <*> pure Nothing <*> pure Nothing <*> + genMaybe genMacPrefix <*> genMaybe (listOf genIPv4Address) <*> arbitrary <*> (genTags >>= mapM mkNonEmpty) "OP_NETWORK_REMOVE" -> OpCodes.OpNetworkRemove <$> genNameNE <*> arbitrary "OP_NETWORK_SET_PARAMS" -> OpCodes.OpNetworkSetParams <$> genNameNE <*> - genMaybe genIp4Addr <*> pure Nothing <*> pure Nothing <*> - genMaybe genMacPrefix <*> genMaybe (listOf genIp4Addr) <*> - genMaybe (listOf genIp4Addr) + genMaybe genIPv4Address <*> pure Nothing <*> pure Nothing <*> + genMaybe genMacPrefix <*> genMaybe (listOf genIPv4Address) <*> + genMaybe (listOf genIPv4Address) "OP_NETWORK_CONNECT" -> OpCodes.OpNetworkConnect <$> genNameNE <*> genNameNE <*> arbitrary <*> genNameNE <*> arbitrary "OP_NETWORK_DISCONNECT" -> OpCodes.OpNetworkDisconnect <$> genNameNE <*> genNameNE "OP_NETWORK_QUERY" -> - OpCodes.OpNetworkQuery <$> genFieldsNE <*> genNamesNE <*> arbitrary + OpCodes.OpNetworkQuery <$> genFieldsNE <*> arbitrary <*> genNamesNE "OP_RESTRICTED_COMMAND" -> OpCodes.OpRestrictedCommand <$> arbitrary <*> genNodeNamesNE <*> return Nothing <*> genNameNE @@ -445,7 +460,8 @@ case_AllDefined = do runPython "from ganeti import opcodes\n\ \from ganeti import serializer\n\ \import sys\n\ - \print serializer.Dump([opid for opid in opcodes.OP_MAPPING])\n" "" + \print serializer.Dump([opid for opid in opcodes.OP_MAPPING])\n" + "" >>= checkPythonResult py_ops <- case J.decode py_stdout::J.Result [String] of J.Ok ops -> return ops @@ -493,8 +509,8 @@ case_py_compat_types = do ) opcodes py_stdout <- runPython "from ganeti import opcodes\n\ - \import sys\n\ \from ganeti import serializer\n\ + \import sys\n\ \op_data = serializer.Load(sys.stdin.read())\n\ \decoded = [opcodes.OpCode.LoadOpCode(o) for o in op_data]\n\ \for op in decoded:\n\ diff --git a/test/hs/Test/Ganeti/TestCommon.hs b/test/hs/Test/Ganeti/TestCommon.hs index 4246ffe..ce266c9 100644 --- a/test/hs/Test/Ganeti/TestCommon.hs +++ b/test/hs/Test/Ganeti/TestCommon.hs @@ -50,12 +50,12 @@ module Test.Ganeti.TestCommon , SmallRatio(..) , genSetHelper , genSet - , genIp4AddrStr - , genIp4Addr - , genIp4NetWithNetmask - , genIp4Net + , genIPv4Address + , genIPv4Network , genIp6Addr , genIp6Net + , genOpCodesTagName + , genLuxiTagName , netmask2NumHosts , testSerialisation , resultProp @@ -283,30 +283,27 @@ genSetHelper candidates size = do genSet :: (Ord a, Bounded a, Enum a) => Maybe Int -> Gen (Set.Set a) genSet = genSetHelper [minBound..maxBound] --- | Generate an arbitrary IPv4 address in textual form (non empty). -genIp4Addr :: Gen NonEmptyString -genIp4Addr = genIp4AddrStr >>= mkNonEmpty - -- | Generate an arbitrary IPv4 address in textual form. -genIp4AddrStr :: Gen String -genIp4AddrStr = do +genIPv4 :: Gen String +genIPv4 = do a <- choose (1::Int, 255) b <- choose (0::Int, 255) c <- choose (0::Int, 255) d <- choose (0::Int, 255) - return $ intercalate "." (map show [a, b, c, d]) + return . intercalate "." $ map show [a, b, c, d] --- | Generates an arbitrary IPv4 address with a given netmask in textual form. -genIp4NetWithNetmask :: Int -> Gen NonEmptyString -genIp4NetWithNetmask netmask = do - ip <- genIp4AddrStr - mkNonEmpty $ ip ++ "/" ++ show netmask +genIPv4Address :: Gen IPv4Address +genIPv4Address = mkIPv4Address =<< genIPv4 -- | Generate an arbitrary IPv4 network in textual form. -genIp4Net :: Gen NonEmptyString -genIp4Net = do +genIPv4AddrRange :: Gen String +genIPv4AddrRange = do + ip <- genIPv4 netmask <- choose (8::Int, 30) - genIp4NetWithNetmask netmask + return $ ip ++ "/" ++ show netmask + +genIPv4Network :: Gen IPv4Network +genIPv4Network = mkIPv4Network =<< genIPv4AddrRange -- | Helper function to compute the number of hosts in a network -- given the netmask. (For IPv4 only.) @@ -329,6 +326,18 @@ genIp6Net = do ip <- genIp6Addr return $ ip ++ "/" ++ show netmask +-- | Generates a valid, arbitrary tag name with respect to the given +-- 'TagKind' for opcodes. +genOpCodesTagName :: TagKind -> Gen (Maybe NonEmptyString) +genOpCodesTagName TagKindCluster = return Nothing +genOpCodesTagName _ = Just <$> (mkNonEmpty =<< genFQDN) + +-- | Generates a valid, arbitrary tag name with respect to the given +-- 'TagKind' for Luxi. +genLuxiTagName :: TagKind -> Gen String +genLuxiTagName TagKindCluster = return "" +genLuxiTagName _ = genFQDN + -- * Helper functions -- | Checks for serialisation idempotence.