projects / ganeti-local / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Errors.hs: improve field names for ConfigVersionMismatch
[ganeti-local] / htools / Ganeti / Luxi.hs
diff --git a/htools/Ganeti/Luxi.hs b/htools/Ganeti/Luxi.hs
index f9eacab..2086a0e 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
@@ -69,13 +67,14 @@ import System.IO.Error (isEOFError)
 import System.Timeout
 import qualified Network.Socket as S
 
-import Ganeti.HTools.JSON
-import Ganeti.HTools.Types
-import Ganeti.HTools.Utils
+import Ganeti.BasicTypes
+import Ganeti.JSON
+import Ganeti.Utils
 
 import Ganeti.Constants
 import Ganeti.Jobs (JobStatus)
 import Ganeti.OpCodes (OpCode)
+import qualified Ganeti.Query.Language as Qlang
 import Ganeti.THH
 
 -- * Utility functions
@@ -99,81 +98,85 @@ data RecvResult = RecvConnClosed    -- ^ Connection closed
 -- | The Ganeti job type.
 type JobId = Int
 
-$(declareSADT "QrViaLuxi"
-  [ ("QRLock", 'qrLock)
-  , ("QRInstance", 'qrInstance)
-  , ("QRNode", 'qrNode)
-  , ("QRGroup", 'qrGroup)
-  , ("QROs", 'qrOs)
+-- | 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 |], [| id |])
-    , ("fields",  [t| [String]  |], [| id |])
-    , ("qfilter", [t| ()        |], [| const JSNull |])
+  [ (luxiReqQuery,
+    [ ("what",    [t| Qlang.ItemType |])
+    , ("fields",  [t| [String]  |])
+    , ("qfilter", [t| Qlang.Filter Qlang.FilterField |])
+    ])
+  , (luxiReqQueryFields,
+    [ ("what",    [t| Qlang.ItemType |])
+    , ("fields",  [t| [String]  |])
     ])
   , (luxiReqQueryNodes,
-     [ ("names",  [t| [String] |], [| id |])
-     , ("fields", [t| [String] |], [| id |])
-     , ("lock",   [t| Bool     |], [| id |])
+     [ ("names",  [t| [String] |])
+     , ("fields", [t| [String] |])
+     , ("lock",   [t| Bool     |])
      ])
   , (luxiReqQueryGroups,
-     [ ("names",  [t| [String] |], [| id |])
-     , ("fields", [t| [String] |], [| id |])
-     , ("lock",   [t| Bool     |], [| id |])
+     [ ("names",  [t| [String] |])
+     , ("fields", [t| [String] |])
+     , ("lock",   [t| Bool     |])
      ])
   , (luxiReqQueryInstances,
-     [ ("names",  [t| [String] |], [| id |])
-     , ("fields", [t| [String] |], [| id |])
-     , ("lock",   [t| Bool     |], [| id |])
+     [ ("names",  [t| [String] |])
+     , ("fields", [t| [String] |])
+     , ("lock",   [t| Bool     |])
      ])
   , (luxiReqQueryJobs,
-     [ ("ids",    [t| [Int]    |], [| id |])
-     , ("fields", [t| [String] |], [| id |])
+     [ ("ids",    [t| [Int]    |])
+     , ("fields", [t| [String] |])
      ])
   , (luxiReqQueryExports,
-     [ ("nodes", [t| [String] |], [| id |])
-     , ("lock",  [t| Bool     |], [| id |])
+     [ ("nodes", [t| [String] |])
+     , ("lock",  [t| Bool     |])
      ])
   , (luxiReqQueryConfigValues,
-     [ ("fields", [t| [String] |], [| id |]) ]
+     [ ("fields", [t| [String] |]) ]
     )
   , (luxiReqQueryClusterInfo, [])
   , (luxiReqQueryTags,
-     [ ("kind", [t| String |], [| id |])
-     , ("name", [t| String |], [| id |])
+     [ ("kind", [t| TagObject |])
+     , ("name", [t| String |])
      ])
   , (luxiReqSubmitJob,
-     [ ("job", [t| [OpCode] |], [| id |]) ]
+     [ ("job", [t| [OpCode] |]) ]
     )
   , (luxiReqSubmitManyJobs,
-     [ ("ops", [t| [[OpCode]] |], [| id |]) ]
+     [ ("ops", [t| [[OpCode]] |]) ]
     )
   , (luxiReqWaitForJobChange,
-     [ ("job",      [t| Int     |], [| id |])
-     , ("fields",   [t| [String]|], [| id |])
-     , ("prev_job", [t| JSValue |], [| id |])
-     , ("prev_log", [t| JSValue |], [| id |])
-     , ("tmout",    [t| Int     |], [| id |])
+     [ ("job",      [t| Int     |])
+     , ("fields",   [t| [String]|])
+     , ("prev_job", [t| JSValue |])
+     , ("prev_log", [t| JSValue |])
+     , ("tmout",    [t| Int     |])
      ])
   , (luxiReqArchiveJob,
-     [ ("job", [t| Int |], [| id |]) ]
+     [ ("job", [t| Int |]) ]
     )
   , (luxiReqAutoArchiveJobs,
-     [ ("age",   [t| Int |], [| id |])
-     , ("tmout", [t| Int |], [| id |])
+     [ ("age",   [t| Int |])
+     , ("tmout", [t| Int |])
      ])
   , (luxiReqCancelJob,
-     [ ("job", [t| Int |], [| id |]) ]
+     [ ("job", [t| Int |]) ]
     )
   , (luxiReqSetDrainFlag,
-     [ ("flag", [t| Bool |], [| id |]) ]
+     [ ("flag", [t| Bool |]) ]
     )
   , (luxiReqSetWatcherPause,
-     [ ("duration", [t| Double |], [| id |]) ]
+     [ ("duration", [t| Double |]) ]
     )
   ])
 
@@ -182,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
@@ -229,7 +214,7 @@ data Client = Client { socket :: Handle           -- ^ The socket of the client
 getClient :: String -> IO Client
 getClient path = do
   s <- S.socket S.AF_UNIX S.Stream S.defaultProtocol
-  withTimeout connTimeout "creating luxi connection" $
+  withTimeout luxiDefCtmo "creating luxi connection" $
               S.connect s (S.SockAddrUnix path)
   rf <- newIORef B.empty
   h <- S.socketToHandle s ReadWriteMode
@@ -265,7 +250,7 @@ closeClient = hClose . socket
 
 -- | Sends a message over a luxi transport.
 sendMsg :: Client -> String -> IO ()
-sendMsg s buf = withTimeout queryTimeout "sending luxi message" $ do
+sendMsg s buf = withTimeout luxiDefRwto "sending luxi message" $ do
   let encoded = UTF8.fromString buf
       handle = socket s
   B.hPut handle encoded
@@ -277,7 +262,7 @@ sendMsg s buf = withTimeout queryTimeout "sending luxi message" $ do
 -- message and the leftover buffer contents.
 recvUpdate :: Handle -> B.ByteString -> IO (B.ByteString, B.ByteString)
 recvUpdate handle obuf = do
-  nbuf <- withTimeout queryTimeout "reading luxi response" $ do
+  nbuf <- withTimeout luxiDefRwto "reading luxi response" $ do
             _ <- hWaitForInput handle (-1)
             B.hGetNonBlocking handle 4096
   let (msg, remaining) = B.break (eOM ==) nbuf
@@ -357,12 +342,17 @@ decodeCall (LuxiCall call args) =
     ReqQueryGroups -> do
               (names, fields, locking) <- fromJVal args
               return $ QueryGroups names fields locking
-    ReqQueryClusterInfo -> do
+    ReqQueryClusterInfo ->
               return QueryClusterInfo
     ReqQuery -> do
-              (what, fields, _) <-
-                fromJVal args::Result (QrViaLuxi, [String], JSValue)
-              return $ Query what fields ()
+              (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
Unnamed repository; edit this file 'description' to name the repository.