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 <jabolopes@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>

diff --git a/src/Ganeti/HTools/Program/Harep.hs b/src/Ganeti/HTools/Program/Harep.hs
index cb18085..1aa63cf 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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.