Revision 96dad12d
| b/htools/Ganeti/Rpc.hs | ||
|---|---|---|
| 1 | 1 |
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, CPP,
|
| 2 |
BangPatterns #-} |
|
| 2 |
BangPatterns, TemplateHaskell #-}
|
|
| 3 | 3 |
|
| 4 | 4 |
{-| Implementation of the RPC client.
|
| 5 | 5 |
|
| ... | ... | |
| 39 | 39 |
, rpcCallAcceptOffline |
| 40 | 40 |
|
| 41 | 41 |
, rpcResultFill |
| 42 |
|
|
| 43 |
, InstanceInfo(..) |
|
| 44 |
, RpcCallAllInstancesInfo(..) |
|
| 45 |
, RpcResultAllInstancesInfo(..) |
|
| 46 |
|
|
| 47 |
, rpcTimeoutFromRaw -- FIXME: Not used anywhere |
|
| 42 | 48 |
) where |
| 43 | 49 |
|
| 44 | 50 |
import qualified Text.JSON as J |
| 51 |
import Text.JSON (makeObj) |
|
| 45 | 52 |
|
| 46 | 53 |
#ifndef NO_CURL |
| 47 | 54 |
import Network.Curl |
| ... | ... | |
| 49 | 56 |
|
| 50 | 57 |
import qualified Ganeti.Constants as C |
| 51 | 58 |
import Ganeti.Objects |
| 59 |
import Ganeti.THH |
|
| 52 | 60 |
import Ganeti.HTools.Compat |
| 61 |
import Ganeti.HTools.JSON |
|
| 53 | 62 |
|
| 54 | 63 |
#ifndef NO_CURL |
| 55 | 64 |
-- | The curl options used for RPC. |
| ... | ... | |
| 88 | 97 |
rpcErrorJsonReport (J.Error x) = return $ Left $ JsonDecodeError x |
| 89 | 98 |
rpcErrorJsonReport (J.Ok x) = return $ Right x |
| 90 | 99 |
|
| 100 |
-- | Basic timeouts for RPC calls. |
|
| 101 |
$(declareIADT "RpcTimeout" |
|
| 102 |
[ ( "Urgent", 'C.rpcTmoUrgent ) |
|
| 103 |
, ( "Fast", 'C.rpcTmoFast ) |
|
| 104 |
, ( "Normal", 'C.rpcTmoNormal ) |
|
| 105 |
, ( "Slow", 'C.rpcTmoSlow ) |
|
| 106 |
, ( "FourHours", 'C.rpcTmo4hrs ) |
|
| 107 |
, ( "OneDay", 'C.rpcTmo1day ) |
|
| 108 |
]) |
|
| 109 |
|
|
| 91 | 110 |
-- | A generic class for RPC calls. |
| 92 | 111 |
class (J.JSON a) => RpcCall a where |
| 93 | 112 |
-- | Give the (Python) name of the procedure. |
| ... | ... | |
| 180 | 199 |
executeRpcCall nodes call = |
| 181 | 200 |
sequence $ parMap rwhnf (uncurry executeSingleRpcCall) |
| 182 | 201 |
(zip nodes $ repeat call) |
| 202 |
|
|
| 203 |
-- * RPC calls and results |
|
| 204 |
|
|
| 205 |
-- | AllInstancesInfo |
|
| 206 |
-- Returns information about all instances on the given nodes |
|
| 207 |
$(buildObject "RpcCallAllInstancesInfo" "rpcCallAllInstInfo" $ |
|
| 208 |
[ simpleField "hypervisors" [t| [Hypervisor] |] ]) |
|
| 209 |
|
|
| 210 |
$(buildObject "InstanceInfo" "instInfo" $ |
|
| 211 |
[ simpleField "name" [t| String |] |
|
| 212 |
, simpleField "memory" [t| Int|] |
|
| 213 |
, simpleField "state" [t| AdminState |] |
|
| 214 |
, simpleField "vcpus" [t| Int |] |
|
| 215 |
, simpleField "time" [t| Int |] |
|
| 216 |
]) |
|
| 217 |
|
|
| 218 |
$(buildObject "RpcResultAllInstancesInfo" "rpcResAllInstInfo" $ |
|
| 219 |
[ simpleField "instances" [t| [InstanceInfo] |] ]) |
|
| 220 |
|
|
| 221 |
instance RpcCall RpcCallAllInstancesInfo where |
|
| 222 |
rpcCallName _ = "all_instances_info" |
|
| 223 |
rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
|
| 224 |
rpcCallAcceptOffline _ = False |
|
| 225 |
|
|
| 226 |
instance RpcResult RpcResultAllInstancesInfo |
|
| 227 |
|
|
| 228 |
instance Rpc RpcCallAllInstancesInfo RpcResultAllInstancesInfo |
|
Also available in: Unified diff