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.
|