Revision 8e527d04 src/Ganeti/Rpc.hs
| b/src/Ganeti/Rpc.hs | ||
|---|---|---|
| 34 | 34 |
, explainRpcError |
| 35 | 35 |
, executeRpcCall |
| 36 | 36 |
, executeRpcCalls |
| 37 |
, rpcErrors |
|
| 37 | 38 |
, logRpcErrors |
| 38 | 39 |
|
| 39 | 40 |
, rpcCallName |
| ... | ... | |
| 86 | 87 |
import qualified Codec.Compression.Zlib as Zlib |
| 87 | 88 |
import qualified Data.ByteString.Lazy.Char8 as BL |
| 88 | 89 |
import qualified Data.Map as Map |
| 89 |
import Data.Maybe (fromMaybe) |
|
| 90 |
import Data.Maybe (fromMaybe, mapMaybe)
|
|
| 90 | 91 |
import qualified Text.JSON as J |
| 91 | 92 |
import Text.JSON.Pretty (pp_value) |
| 92 | 93 |
import qualified Data.ByteString.Base64.Lazy as Base64 |
| ... | ... | |
| 209 | 210 |
J.JSString msg -> Left $ RpcResultError (J.fromJSString msg) |
| 210 | 211 |
_ -> Left . JsonDecodeError $ show (pp_value jerr) |
| 211 | 212 |
|
| 213 |
-- | Scan the list of results produced by executeRpcCall and extract |
|
| 214 |
-- all the RPC errors. |
|
| 215 |
rpcErrors :: [(a, ERpcError b)] -> [(a, RpcError)] |
|
| 216 |
rpcErrors = |
|
| 217 |
let rpcErr (node, Left err) = Just (node, err) |
|
| 218 |
rpcErr _ = Nothing |
|
| 219 |
in mapMaybe rpcErr |
|
| 220 |
|
|
| 212 | 221 |
-- | Scan the list of results produced by executeRpcCall and log all the RPC |
| 213 |
-- errors. |
|
| 214 |
logRpcErrors :: [(a, ERpcError b)] -> IO () |
|
| 215 |
logRpcErrors allElems = |
|
| 216 |
let logOneRpcErr (_, Right _) = return () |
|
| 217 |
logOneRpcErr (_, Left err) = |
|
| 218 |
logError $ "Error in the RPC HTTP reply: " ++ show err |
|
| 219 |
in mapM_ logOneRpcErr allElems |
|
| 222 |
-- errors. Returns the list of errors for further processing. |
|
| 223 |
logRpcErrors :: (MonadLog m, Show a) => [(a, ERpcError b)] |
|
| 224 |
-> m [(a, RpcError)] |
|
| 225 |
logRpcErrors rs = |
|
| 226 |
let logOneRpcErr (node, err) = |
|
| 227 |
logError $ "Error in the RPC HTTP reply from '" ++ |
|
| 228 |
show node ++ "': " ++ show err |
|
| 229 |
errs = rpcErrors rs |
|
| 230 |
in mapM_ logOneRpcErr errs >> return errs |
|
| 220 | 231 |
|
| 221 | 232 |
-- | Get options for RPC call |
| 222 | 233 |
getOptionsForCall :: (Rpc a b) => FilePath -> FilePath -> a -> [CurlOption] |
| ... | ... | |
| 258 | 269 |
-- now parse the replies |
| 259 | 270 |
let results'' = zipWith parseHttpReply calls results' |
| 260 | 271 |
pairedList = zip nodes results'' |
| 261 |
logRpcErrors pairedList |
|
| 272 |
_ <- logRpcErrors pairedList
|
|
| 262 | 273 |
return pairedList |
| 263 | 274 |
|
| 264 | 275 |
-- | Execute an RPC call for many nodes in parallel. |
Also available in: Unified diff