From 599239addd9515bc6ca9a7cf52df3eed351b65e9 Mon Sep 17 00:00:00 2001
From: Agata Murawska <agatamurawska@google.com>
Date: Tue, 25 Sep 2012 17:18:07 +0200
Subject: [PATCH] Add alias for Either RpcError a
This was repeated a lot, so we should abstract this into a type.
Signed-off-by: Agata Murawska <agatamurawska@google.com>
Reviewed-by: Iustin Pop <iustin@google.com>
---
htools/Ganeti/Rpc.hs | 21 ++++++++++++---------
1 file changed, 12 insertions(+), 9 deletions(-)
diff --git a/htools/Ganeti/Rpc.hs b/htools/Ganeti/Rpc.hs
index 728e73a0d..377800c95 100644
--- a/htools/Ganeti/Rpc.hs
+++ b/htools/Ganeti/Rpc.hs
@@ -31,6 +31,7 @@ module Ganeti.Rpc
, RpcResult
, Rpc
, RpcError(..)
+ , ERpcError
, executeRpcCall
, rpcCallName
@@ -105,7 +106,9 @@ instance Show RpcError where
show (OfflineNodeError node) =
"Node " ++ nodeName node ++ " is marked as offline"
-rpcErrorJsonReport :: (Monad m) => J.Result a -> m (Either RpcError a)
+type ERpcError = Either RpcError
+
+rpcErrorJsonReport :: (Monad m) => J.Result a -> m (ERpcError a)
rpcErrorJsonReport (J.Error x) = return . Left $ JsonDecodeError x
rpcErrorJsonReport (J.Ok x) = return $ Right x
@@ -135,7 +138,7 @@ class (J.JSON a) => RpcCall a where
-- | 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 :: (Monad m) => String -> m (Either RpcError a)
+ rpcResultFill :: (Monad m) => String -> m (ERpcError a)
rpcResultFill res = rpcErrorJsonReport $ J.decode res
@@ -152,8 +155,8 @@ data HttpClientRequest = HttpClientRequest
-- | Execute the request and return the result as a plain String. When
-- curl reports an error, we propagate it.
-executeHttpRequest :: Node -> Either RpcError HttpClientRequest
- -> IO (Either RpcError String)
+executeHttpRequest :: Node -> ERpcError HttpClientRequest
+ -> IO (ERpcError String)
executeHttpRequest _ (Left rpc_err) = return $ Left rpc_err
#ifdef NO_CURL
@@ -182,7 +185,7 @@ prepareUrl node call =
-- | Create HTTP request for a given node provided it is online,
-- otherwise create empty response.
prepareHttpRequest :: (RpcCall a) => Node -> a
- -> Either RpcError HttpClientRequest
+ -> ERpcError HttpClientRequest
prepareHttpRequest node call
| rpcCallAcceptOffline call || not (nodeOffline node) =
Right HttpClientRequest { requestTimeout = rpcCallTimeout call
@@ -192,13 +195,13 @@ prepareHttpRequest node call
| otherwise = Left $ OfflineNodeError node
-- | Parse the response or propagate the error.
-parseHttpResponse :: (Monad m, RpcResult a) => Either RpcError String
- -> m (Either RpcError a)
+parseHttpResponse :: (Monad m, RpcResult a) => ERpcError String
+ -> m (ERpcError a)
parseHttpResponse (Left err) = return $ Left err
parseHttpResponse (Right response) = rpcResultFill response
-- | Execute RPC call for a sigle node.
-executeSingleRpcCall :: (Rpc a b) => Node -> a -> IO (Node, Either RpcError b)
+executeSingleRpcCall :: (Rpc a b) => Node -> a -> IO (Node, ERpcError b)
executeSingleRpcCall node call = do
let request = prepareHttpRequest node call
response <- executeHttpRequest node request
@@ -206,7 +209,7 @@ executeSingleRpcCall node call = do
return (node, result)
-- | Execute RPC call for many nodes in parallel.
-executeRpcCall :: (Rpc a b) => [Node] -> a -> IO [(Node, Either RpcError b)]
+executeRpcCall :: (Rpc a b) => [Node] -> a -> IO [(Node, ERpcError b)]
executeRpcCall nodes call =
sequence $ parMap rwhnf (uncurry executeSingleRpcCall)
(zip nodes $ repeat call)
--
GitLab