X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/4b71f30c46e491d5d4bed740506f8111be4229b5..b04dc2425a7b743a2b1927b61169ba2526bf1403:/htools/Ganeti/Luxi.hs diff --git a/htools/Ganeti/Luxi.hs b/htools/Ganeti/Luxi.hs index 70c7785..12dc6ed 100644 --- 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,14 +67,14 @@ import System.IO.Error (isEOFError) import System.Timeout import qualified Network.Socket as S -import Ganeti.HTools.JSON +import Ganeti.JSON import Ganeti.HTools.Types -import Ganeti.HTools.Utils +import Ganeti.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 @@ -359,11 +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, 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