diff --git a/src/Ganeti/Query/Common.hs b/src/Ganeti/Query/Common.hs index 55db65e7e4b81019e005f6de75d2c2ad9d476408..086ecad62aa19eabba5144fc6d1c01ef0785627f 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 5aa240b1bc62daa1098ce6747bf51bda4ba722fd..78658bad8d107057a52cebe28f1b3d739e9e9e5b 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 6e6d74f50d38b5b5bf8117a525ba02fd84909288..c6b9ddb132f790af0106aab389ed5d9f4dcb2fdf 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