diff --git a/htools/Ganeti/Rpc.hs b/htools/Ganeti/Rpc.hs index e0007c8466fbf17a3bffb0645a8f02ee39f93fb6..7654a1550925d2bdf462d449539323208817b4c4 100644 --- a/htools/Ganeti/Rpc.hs +++ b/htools/Ganeti/Rpc.hs @@ -64,6 +64,9 @@ module Ganeti.Rpc , RpcCallStorageList(..) , RpcResultStorageList(..) + , RpcCallTestDelay(..) + , RpcResultTestDelay(..) + , rpcTimeoutFromRaw -- FIXME: Not used anywhere ) where @@ -83,6 +86,8 @@ import Ganeti.THH import Ganeti.Compat import Ganeti.JSON +-- * Base RPC functionality and types + #ifndef NO_CURL -- | The curl options used for RPC. curlOpts :: [CurlOption] @@ -243,6 +248,8 @@ fromJSValueToRes val = fromJResultToRes (J.readJSON val) -- * RPC calls and results +-- ** Instance info + -- | InstanceInfo -- Returns information about a single instance. @@ -282,6 +289,8 @@ instance Rpc RpcCallInstanceInfo RpcResultInstanceInfo where _ -> Left $ JsonDecodeError ("Expected JSObject, got " ++ show (pp_value res)) +-- ** AllInstancesInfo + -- | AllInstancesInfo -- Returns information about all running instances on the given nodes $(buildObject "RpcCallAllInstancesInfo" "rpcCallAllInstInfo" @@ -309,6 +318,8 @@ instance Rpc RpcCallAllInstancesInfo RpcResultAllInstancesInfo where _ -> Left $ JsonDecodeError ("Expected JSObject, got " ++ show (pp_value res)) +-- ** InstanceList + -- | InstanceList -- Returns the list of running instances on the given nodes. $(buildObject "RpcCallInstanceList" "rpcCallInstList" @@ -326,6 +337,8 @@ instance RpcCall RpcCallInstanceList where instance Rpc RpcCallInstanceList RpcResultInstanceList where rpcResultFill _ res = fromJSValueToRes res RpcResultInstanceList +-- ** NodeInfo + -- | NodeInfo -- Return node information. $(buildObject "RpcCallNodeInfo" "rpcCallNodeInfo" @@ -368,6 +381,8 @@ instance Rpc RpcCallNodeInfo RpcResultNodeInfo where rpcResultFill _ res = fromJSValueToRes res (\(b, vg, hv) -> RpcResultNodeInfo b vg hv) +-- ** Version + -- | Version -- Query node version. -- Note: We can't use THH as it does not know what to do with empty dict @@ -392,6 +407,8 @@ instance RpcCall RpcCallVersion where instance Rpc RpcCallVersion RpcResultVersion where rpcResultFill _ res = fromJSValueToRes res RpcResultVersion +-- ** StorageList + -- | StorageList -- Get list of storage units. -- FIXME: This may be moved to Objects @@ -439,3 +456,30 @@ instance Rpc RpcCallStorageList RpcResultStorageList where rpcResultFill call res = let sfields = rpcCallStorageListFields call in fromJSValueToRes res (RpcResultStorageList . map (zip sfields)) + +-- ** TestDelay + + +-- | Call definition for test delay. +$(buildObject "RpcCallTestDelay" "rpcCallTestDelay" + [ simpleField "duration" [t| Double |] + ]) + +-- | Result definition for test delay. +data RpcResultTestDelay = RpcResultTestDelay + deriving Show + +-- | Custom JSON instance for null result. +instance J.JSON RpcResultTestDelay where + showJSON _ = J.JSNull + readJSON J.JSNull = return RpcResultTestDelay + readJSON _ = fail "Unable to read RpcResultTestDelay" + +instance RpcCall RpcCallTestDelay where + rpcCallName _ = "test_delay" + rpcCallTimeout = ceiling . (+ 5) . rpcCallTestDelayDuration + rpcCallAcceptOffline _ = False + rpcCallData _ call = J.encode [rpcCallTestDelayDuration call] + +instance Rpc RpcCallTestDelay RpcResultTestDelay where + rpcResultFill _ res = fromJSValueToRes res id