Revision 1ca709c1 src/Ganeti/Rpc.hs
b/src/Ganeti/Rpc.hs | ||
---|---|---|
1 |
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, CPP,
|
|
1 |
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, |
|
2 | 2 |
BangPatterns, TemplateHaskell #-} |
3 | 3 |
|
4 | 4 |
{-| Implementation of the RPC client. |
... | ... | |
7 | 7 |
|
8 | 8 |
{- |
9 | 9 |
|
10 |
Copyright (C) 2012 Google Inc. |
|
10 |
Copyright (C) 2012, 2013 Google Inc.
|
|
11 | 11 |
|
12 | 12 |
This program is free software; you can redistribute it and/or modify |
13 | 13 |
it under the terms of the GNU General Public License as published by |
... | ... | |
75 | 75 |
import qualified Text.JSON as J |
76 | 76 |
import Text.JSON.Pretty (pp_value) |
77 | 77 |
|
78 |
#ifndef NO_CURL |
|
79 | 78 |
import Network.Curl |
80 | 79 |
import qualified Ganeti.Path as P |
81 |
#endif |
|
82 | 80 |
|
83 | 81 |
import qualified Ganeti.Constants as C |
84 | 82 |
import Ganeti.Objects |
... | ... | |
88 | 86 |
|
89 | 87 |
-- * Base RPC functionality and types |
90 | 88 |
|
91 |
#ifndef NO_CURL |
|
92 | 89 |
-- | The curl options used for RPC. |
93 | 90 |
curlOpts :: [CurlOption] |
94 | 91 |
curlOpts = [ CurlFollowLocation False |
... | ... | |
98 | 95 |
, CurlSSLKeyType "PEM" |
99 | 96 |
, CurlConnectTimeout (fromIntegral C.rpcConnectTimeout) |
100 | 97 |
] |
101 |
#endif |
|
102 | 98 |
|
103 | 99 |
-- | Data type for RPC error reporting. |
104 | 100 |
data RpcError |
105 |
= CurlDisabledError |
|
106 |
| CurlLayerError Node String |
|
101 |
= CurlLayerError Node String |
|
107 | 102 |
| JsonDecodeError String |
108 | 103 |
| RpcResultError String |
109 | 104 |
| OfflineNodeError Node |
... | ... | |
111 | 106 |
|
112 | 107 |
-- | Provide explanation to RPC errors. |
113 | 108 |
explainRpcError :: RpcError -> String |
114 |
explainRpcError CurlDisabledError = |
|
115 |
"RPC/curl backend disabled at compile time" |
|
116 | 109 |
explainRpcError (CurlLayerError node code) = |
117 | 110 |
"Curl error for " ++ nodeName node ++ ", " ++ code |
118 | 111 |
explainRpcError (JsonDecodeError msg) = |
... | ... | |
164 | 157 |
-> IO (ERpcError String) |
165 | 158 |
|
166 | 159 |
executeHttpRequest _ (Left rpc_err) = return $ Left rpc_err |
167 |
#ifdef NO_CURL |
|
168 |
executeHttpRequest _ _ = return $ Left CurlDisabledError |
|
169 |
#else |
|
170 | 160 |
executeHttpRequest node (Right request) = do |
171 | 161 |
cert_file <- P.nodedCertFile |
172 | 162 |
let reqOpts = [ CurlTimeout (fromIntegral $ requestTimeout request) |
... | ... | |
181 | 171 |
return $ case code of |
182 | 172 |
CurlOK -> Right body |
183 | 173 |
_ -> Left $ CurlLayerError node (show code) |
184 |
#endif |
|
185 | 174 |
|
186 | 175 |
-- | Prepare url for the HTTP request. |
187 | 176 |
prepareUrl :: (RpcCall a) => Node -> a -> String |
Also available in: Unified diff