Move the unittest helper to a new Test/Ganeti dir

[ganeti-local] / htools / Ganeti / Luxi.hs

diff --git a/htools/Ganeti/Luxi.hs b/htools/Ganeti/Luxi.hs
index 70c7785..3f6a54c 100644 (file)
--- a/htools/Ganeti/Luxi.hs
+++ b/htools/Ganeti/Luxi.hs
@@ -27,14 +27,12 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 module Ganeti.Luxi
   ( LuxiOp(..)
-  , QrViaLuxi(..)
-  , ResultStatus(..)
   , LuxiReq(..)
   , Client
   , JobId
   , RecvResult(..)
+  , TagObject(..)
   , strOfOp
-  , checkRS
   , getClient
   , getServer
   , acceptClient
@@ -76,7 +74,7 @@ import Ganeti.HTools.Utils
 import Ganeti.Constants
 import Ganeti.Jobs (JobStatus)
 import Ganeti.OpCodes (OpCode)
-import qualified Ganeti.Qlang as Qlang
+import qualified Ganeti.Query.Language as Qlang
 import Ganeti.THH
 
 -- * Utility functions
@@ -100,22 +98,25 @@ data RecvResult = RecvConnClosed    -- ^ Connection closed
 -- | The Ganeti job type.
 type JobId = Int
 
-$(declareSADT "QrViaLuxi"
-  [ ("QRLock",     'qrLock)
-  , ("QRInstance", 'qrInstance)
-  , ("QRNode",     'qrNode)
-  , ("QRGroup",    'qrGroup)
-  , ("QROs",       'qrOs)
-  , ("QRJob",      'qrJob)
+-- | Data type representing what items do the tag operations apply to.
+$(declareSADT "TagObject"
+  [ ("TagInstance", 'tagInstance)
+  , ("TagNode",     'tagNode)
+  , ("TagGroup",    'tagNodegroup)
+  , ("TagCluster",  'tagCluster)
   ])
-$(makeJSONInstance ''QrViaLuxi)
+$(makeJSONInstance ''TagObject)
 
 -- | Currently supported Luxi operations and JSON serialization.
 $(genLuxiOp "LuxiOp"
-  [(luxiReqQuery,
-    [ ("what",    [t| QrViaLuxi |])
+  [ (luxiReqQuery,
+    [ ("what",    [t| Qlang.ItemType |])
+    , ("fields",  [t| [String]  |])
+    , ("qfilter", [t| Qlang.Filter Qlang.FilterField |])
+    ])
+  , (luxiReqQueryFields,
+    [ ("what",    [t| Qlang.ItemType |])
     , ("fields",  [t| [String]  |])
-    , ("qfilter", [t| Qlang.Filter |])
     ])
   , (luxiReqQueryNodes,
      [ ("names",  [t| [String] |])
@@ -145,7 +146,7 @@ $(genLuxiOp "LuxiOp"
     )
   , (luxiReqQueryClusterInfo, [])
   , (luxiReqQueryTags,
-     [ ("kind", [t| String |])
+     [ ("kind", [t| TagObject |])
      , ("name", [t| String |])
      ])
   , (luxiReqSubmitJob,
@@ -184,27 +185,9 @@ $(makeJSONInstance ''LuxiReq)
 -- | The serialisation of LuxiOps into strings in messages.
 $(genStrOfOp ''LuxiOp "strOfOp")
 
-$(declareIADT "ResultStatus"
-  [ ("RSNormal", 'rsNormal)
-  , ("RSUnknown", 'rsUnknown)
-  , ("RSNoData", 'rsNodata)
-  , ("RSUnavailable", 'rsUnavail)
-  , ("RSOffline", 'rsOffline)
-  ])
-
-$(makeJSONInstance ''ResultStatus)
-
 -- | Type holding the initial (unparsed) Luxi call.
 data LuxiCall = LuxiCall LuxiReq JSValue
 
--- | Check that ResultStatus is success or fail with descriptive message.
-checkRS :: (Monad m) => ResultStatus -> a -> m a
-checkRS RSNormal val    = return val
-checkRS RSUnknown _     = fail "Unknown field"
-checkRS RSNoData _      = fail "No data for a field"
-checkRS RSUnavailable _ = fail "Ganeti reports unavailable data"
-checkRS RSOffline _     = fail "Ganeti reports resource as offline"
-
 -- | The end-of-message separator.
 eOM :: Word8
 eOM = 3
@@ -364,6 +347,12 @@ decodeCall (LuxiCall call args) =
     ReqQuery -> do
               (what, fields, qfilter) <- fromJVal args
               return $ Query what fields qfilter
+    ReqQueryFields -> do
+              (what, fields) <- fromJVal args
+              fields' <- case fields of
+                           JSNull -> return []
+                           _ -> fromJVal fields
+              return $ QueryFields what fields'
     ReqSubmitJob -> do
               [ops1] <- fromJVal args
               ops2 <- mapM (fromJResult (luxiReqToRaw call) . J.readJSON) ops1