From 9c0a27d0ae0c8127f5a8aebbb0acc92a2555ece2 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Fri, 30 Nov 2012 02:24:56 +0100
Subject: [PATCH] Simplify RPC error cases
This patch removes the node from the RPC error constructurs
CurlLayerError and OfflineNodeError. The rationale is that we anyway
return tuples (node, result), and removing this duplication allows
simplified signatures/calls in the execution of RPC calls.
Note: this was sent before as well, resending on top of current codebase.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Michele Tartara <mtartara@google.com>
---
src/Ganeti/Query/Common.hs | 4 ++--
src/Ganeti/Rpc.hs | 25 ++++++++++++-------------
test/hs/Test/Ganeti/Rpc.hs | 8 ++++----
3 files changed, 18 insertions(+), 19 deletions(-)
diff --git a/src/Ganeti/Query/Common.hs b/src/Ganeti/Query/Common.hs
index 55db65e7e..086ecad62 100644
--- a/src/Ganeti/Query/Common.hs
+++ b/src/Ganeti/Query/Common.hs
@@ -4,7 +4,7 @@
{-
-Copyright (C) 2012 Google Inc.
+Copyright (C) 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@@ -104,7 +104,7 @@ missingRuntime = FieldRuntime (\_ _ -> ResultEntry RSNoData Nothing)
-- | Convert RpcError to ResultStatus
rpcErrorToStatus :: RpcError -> ResultStatus
-rpcErrorToStatus (OfflineNodeError _) = RSOffline
+rpcErrorToStatus OfflineNodeError = RSOffline
rpcErrorToStatus _ = RSNoData
-- * Common fields
diff --git a/src/Ganeti/Rpc.hs b/src/Ganeti/Rpc.hs
index 5aa240b1b..78658bad8 100644
--- a/src/Ganeti/Rpc.hs
+++ b/src/Ganeti/Rpc.hs
@@ -98,22 +98,22 @@ curlOpts = [ CurlFollowLocation False
-- | Data type for RPC error reporting.
data RpcError
- = CurlLayerError Node String
+ = CurlLayerError String
| JsonDecodeError String
| RpcResultError String
- | OfflineNodeError Node
+ | OfflineNodeError
deriving (Show, Eq)
-- | Provide explanation to RPC errors.
explainRpcError :: RpcError -> String
-explainRpcError (CurlLayerError node code) =
- "Curl error for " ++ nodeName node ++ ", " ++ code
+explainRpcError (CurlLayerError code) =
+ "Curl error:" ++ code
explainRpcError (JsonDecodeError msg) =
"Error while decoding JSON from HTTP response: " ++ msg
explainRpcError (RpcResultError msg) =
"Error reponse received from RPC server: " ++ msg
-explainRpcError (OfflineNodeError node) =
- "Node " ++ nodeName node ++ " is marked as offline"
+explainRpcError OfflineNodeError =
+ "Node is marked offline"
type ERpcError = Either RpcError
@@ -153,17 +153,16 @@ data HttpClientRequest = HttpClientRequest
-- | Execute the request and return the result as a plain String. When
-- curl reports an error, we propagate it.
-executeHttpRequest :: Node -> ERpcError HttpClientRequest
- -> IO (ERpcError String)
-executeHttpRequest _ (Left rpc_err) = return $ Left rpc_err
-executeHttpRequest node (Right request) = do
+executeHttpRequest :: ERpcError HttpClientRequest -> IO (ERpcError String)
+executeHttpRequest (Left rpc_err) = return $ Left rpc_err
+executeHttpRequest (Right request) = do
let reqOpts = CurlPostFields [requestData request]:requestOpts request
url = requestUrl request
-- FIXME: This is very similar to getUrl in Htools/Rapi.hs
(code, !body) <- curlGetString url $ curlOpts ++ reqOpts
return $ case code of
CurlOK -> Right body
- _ -> Left $ CurlLayerError node (show code)
+ _ -> Left $ CurlLayerError (show code)
-- | Prepare url for the HTTP request.
prepareUrl :: (RpcCall a) => Node -> a -> String
@@ -183,7 +182,7 @@ prepareHttpRequest opts node call
, requestData = rpcCallData node call
, requestOpts = opts ++ curlOpts
}
- | otherwise = Left $ OfflineNodeError node
+ | otherwise = Left OfflineNodeError
-- | Parse a result based on the received HTTP response.
parseHttpResponse :: (Rpc a b) => a -> ERpcError String -> ERpcError b
@@ -201,7 +200,7 @@ executeSingleRpcCall :: (Rpc a b) =>
[CurlOption] -> Node -> a -> IO (Node, ERpcError b)
executeSingleRpcCall opts node call = do
let request = prepareHttpRequest opts node call
- response <- executeHttpRequest node request
+ response <- executeHttpRequest request
let result = parseHttpResponse call response
return (node, result)
diff --git a/test/hs/Test/Ganeti/Rpc.hs b/test/hs/Test/Ganeti/Rpc.hs
index 6e6d74f50..c6b9ddb13 100644
--- a/test/hs/Test/Ganeti/Rpc.hs
+++ b/test/hs/Test/Ganeti/Rpc.hs
@@ -7,7 +7,7 @@
{-
-Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@@ -59,19 +59,19 @@ prop_noffl_request_allinstinfo :: Rpc.RpcCallAllInstancesInfo -> Property
prop_noffl_request_allinstinfo call =
forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
res <- run $ Rpc.executeRpcCall [node] call
- stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
+ stop $ res ==? [(node, Left Rpc.OfflineNodeError)]
prop_noffl_request_instlist :: Rpc.RpcCallInstanceList -> Property
prop_noffl_request_instlist call =
forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
res <- run $ Rpc.executeRpcCall [node] call
- stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
+ stop $ res ==? [(node, Left Rpc.OfflineNodeError)]
prop_noffl_request_nodeinfo :: Rpc.RpcCallNodeInfo -> Property
prop_noffl_request_nodeinfo call =
forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do
res <- run $ Rpc.executeRpcCall [node] call
- stop $ res ==? [(node, Left (Rpc.OfflineNodeError node))]
+ stop $ res ==? [(node, Left Rpc.OfflineNodeError)]
testSuite "Rpc"
[ 'prop_noffl_request_allinstinfo
--
GitLab