Synnefo » snf-ganeti

  , RpcResult

  , Rpc

  , RpcError(..)

  , executeRpcCall

  , rpcCallName

  show (OfflineNodeError node) =

    "Node " ++ nodeName node ++ " is marked as offline"

rpcErrorJsonReport (J.Error x) = return . Left $ JsonDecodeError x

rpcErrorJsonReport (J.Ok x) = return $ Right x

-- | A generic class for RPC results with default implementation.

class (J.JSON a) => RpcResult a where

  -- | Create a result based on the received HTTP response.

  rpcResultFill res = rpcErrorJsonReport $  J.decode res

-- | Execute the request and return the result as a plain String. When

-- curl reports an error, we propagate it.

executeHttpRequest _ (Left rpc_err) = return $ Left rpc_err

#ifdef NO_CURL

-- | Create HTTP request for a given node provided it is online,

-- otherwise create empty response.

prepareHttpRequest ::  (RpcCall a) => Node -> a

prepareHttpRequest node call

  | rpcCallAcceptOffline call || not (nodeOffline node) =

      Right HttpClientRequest { requestTimeout = rpcCallTimeout call

  | otherwise = Left $ OfflineNodeError node

-- | Parse the response or propagate the error.

parseHttpResponse (Left err) = return $ Left err

parseHttpResponse (Right response) = rpcResultFill response

-- | Execute RPC call for a sigle node.

executeSingleRpcCall node call = do

  let request = prepareHttpRequest node call

  response <- executeHttpRequest node request

  return (node, result)

-- | Execute RPC call for many nodes in parallel.

executeRpcCall nodes call =

  sequence $ parMap rwhnf (uncurry executeSingleRpcCall)

               (zip nodes $ repeat call)