+{-# LANGUAGE TemplateHaskell #-}
+
{-| Implementation of the Ganeti LUXI interface.
-}
module Ganeti.Luxi
( LuxiOp(..)
+ , QrViaLuxi(..)
+ , ResultStatus(..)
, Client
+ , checkRS
, getClient
, closeClient
, callMethod
import Ganeti.HTools.Utils
import Ganeti.HTools.Types
+import Ganeti.Constants
import Ganeti.Jobs (JobStatus)
import Ganeti.OpCodes (OpCode)
+import Ganeti.THH
-- * Utility functions
-- * Generic protocol functionality
--- | Currently supported Luxi operations.
-data LuxiOp = QueryInstances [String] [String] Bool
- | QueryNodes [String] [String] Bool
- | QueryGroups [String] [String] Bool
- | QueryJobs [Int] [String]
- | QueryExports [String] Bool
- | QueryConfigValues [String]
- | QueryClusterInfo
- | QueryTags String String
- | SubmitJob [OpCode]
- | SubmitManyJobs [[OpCode]]
- | WaitForJobChange Int [String] JSValue JSValue Int
- | ArchiveJob Int
- | AutoArchiveJobs Int Int
- | CancelJob Int
- | SetDrainFlag Bool
- | SetWatcherPause Double
- deriving (Show, Read)
+$(declareSADT "QrViaLuxi"
+ [ ("QRLock", 'qrLock)
+ , ("QRInstance", 'qrInstance)
+ , ("QRNode", 'qrNode)
+ , ("QRGroup", 'qrGroup)
+ , ("QROs", 'qrOs)
+ ])
+$(makeJSONInstance ''QrViaLuxi)
+
+-- | Currently supported Luxi operations and JSON serialization.
+$(genLuxiOp "LuxiOp"
+ [("Query" ,
+ [ ("what", [t| QrViaLuxi |], [| id |])
+ , ("fields", [t| [String] |], [| id |])
+ , ("qfilter", [t| () |], [| const JSNull |])
+ ])
+ , ("QueryNodes",
+ [ ("names", [t| [String] |], [| id |])
+ , ("fields", [t| [String] |], [| id |])
+ , ("lock", [t| Bool |], [| id |])
+ ])
+ , ("QueryGroups",
+ [ ("names", [t| [String] |], [| id |])
+ , ("fields", [t| [String] |], [| id |])
+ , ("lock", [t| Bool |], [| id |])
+ ])
+ , ("QueryInstances",
+ [ ("names", [t| [String] |], [| id |])
+ , ("fields", [t| [String] |], [| id |])
+ , ("lock", [t| Bool |], [| id |])
+ ])
+ , ("QueryJobs",
+ [ ("ids", [t| [Int] |], [| map show |])
+ , ("fields", [t| [String] |], [| id |])
+ ])
+ , ("QueryExports",
+ [ ("nodes", [t| [String] |], [| id |])
+ , ("lock", [t| Bool |], [| id |])
+ ])
+ , ("QueryConfigValues",
+ [ ("fields", [t| [String] |], [| id |]) ]
+ )
+ , ("QueryClusterInfo", [])
+ , ("QueryTags",
+ [ ("kind", [t| String |], [| id |])
+ , ("name", [t| String |], [| id |])
+ ])
+ , ("SubmitJob",
+ [ ("job", [t| [OpCode] |], [| id |]) ]
+ )
+ , ("SubmitManyJobs",
+ [ ("ops", [t| [[OpCode]] |], [| id |]) ]
+ )
+ , ("WaitForJobChange",
+ [ ("job", [t| Int |], [| id |])
+ , ("fields", [t| [String]|], [| id |])
+ , ("prev_job", [t| JSValue |], [| id |])
+ , ("prev_log", [t| JSValue |], [| id |])
+ , ("tmout", [t| Int |], [| id |])
+ ])
+ , ("ArchiveJob",
+ [ ("job", [t| Int |], [| show |]) ]
+ )
+ , ("AutoArchiveJobs",
+ [ ("age", [t| Int |], [| id |])
+ , ("tmout", [t| Int |], [| id |])
+ ])
+ , ("CancelJob",
+ [ ("job", [t| Int |], [| show |]) ]
+ )
+ , ("SetDrainFlag",
+ [ ("flag", [t| Bool |], [| id |]) ]
+ )
+ , ("SetWatcherPause",
+ [ ("duration", [t| Double |], [| id |]) ]
+ )
+ ])
-- | The serialisation of LuxiOps into strings in messages.
-strOfOp :: LuxiOp -> String
-strOfOp QueryNodes {} = "QueryNodes"
-strOfOp QueryGroups {} = "QueryGroups"
-strOfOp QueryInstances {} = "QueryInstances"
-strOfOp QueryJobs {} = "QueryJobs"
-strOfOp QueryExports {} = "QueryExports"
-strOfOp QueryConfigValues {} = "QueryConfigValues"
-strOfOp QueryClusterInfo {} = "QueryClusterInfo"
-strOfOp QueryTags {} = "QueryTags"
-strOfOp SubmitManyJobs {} = "SubmitManyJobs"
-strOfOp WaitForJobChange {} = "WaitForJobChange"
-strOfOp SubmitJob {} = "SubmitJob"
-strOfOp ArchiveJob {} = "ArchiveJob"
-strOfOp AutoArchiveJobs {} = "AutoArchiveJobs"
-strOfOp CancelJob {} = "CancelJob"
-strOfOp SetDrainFlag {} = "SetDrainFlag"
-strOfOp SetWatcherPause {} = "SetWatcherPause"
+$(genStrOfOp ''LuxiOp "strOfOp")
+
+$(declareIADT "ResultStatus"
+ [ ("RSNormal", 'rsNormal)
+ , ("RSUnknown", 'rsUnknown)
+ , ("RSNoData", 'rsNodata)
+ , ("RSUnavailable", 'rsUnavail)
+ , ("RSOffline", 'rsOffline)
+ ])
+
+$(makeJSONInstance ''ResultStatus)
+
+-- | 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 :: Char
| Result
-- | The serialisation of MsgKeys into strings in messages.
-strOfKey :: MsgKeys -> String
-strOfKey Method = "method"
-strOfKey Args = "args"
-strOfKey Success = "success"
-strOfKey Result = "result"
+$(genStrOfKey ''MsgKeys "strOfKey")
-- | Luxi client encapsulation.
data Client = Client { socket :: S.Socket -- ^ The socket of the client
writeIORef (rbuf s) nbuf
return msg
--- | Compute the serialized form of a Luxi operation
-opToArgs :: LuxiOp -> JSValue
-opToArgs (QueryNodes names fields lock) = J.showJSON (names, fields, lock)
-opToArgs (QueryGroups names fields lock) = J.showJSON (names, fields, lock)
-opToArgs (QueryInstances names fields lock) = J.showJSON (names, fields, lock)
-opToArgs (QueryJobs ids fields) = J.showJSON (map show ids, fields)
-opToArgs (QueryExports nodes lock) = J.showJSON (nodes, lock)
-opToArgs (QueryConfigValues fields) = J.showJSON fields
-opToArgs (QueryClusterInfo) = J.showJSON ()
-opToArgs (QueryTags kind name) = J.showJSON (kind, name)
-opToArgs (SubmitJob j) = J.showJSON j
-opToArgs (SubmitManyJobs ops) = J.showJSON ops
--- This is special, since the JSON library doesn't export an instance
--- of a 5-tuple
-opToArgs (WaitForJobChange a b c d e) =
- JSArray [ J.showJSON a, J.showJSON b, J.showJSON c
- , J.showJSON d, J.showJSON e]
-opToArgs (ArchiveJob a) = J.showJSON (show a)
-opToArgs (AutoArchiveJobs a b) = J.showJSON (a, b)
-opToArgs (CancelJob a) = J.showJSON (show a)
-opToArgs (SetDrainFlag flag) = J.showJSON flag
-opToArgs (SetWatcherPause duration) = J.showJSON [duration]
-
-- | Serialize a request to String.
buildCall :: LuxiOp -- ^ The method
-> String -- ^ The serialized form
projects / ganeti-local / blobdiff