Revision 85f6a869
| b/src/Ganeti/Rpc.hs | ||
|---|---|---|
| 146 | 146 |
|
| 147 | 147 |
-- | Http Request definition. |
| 148 | 148 |
data HttpClientRequest = HttpClientRequest |
| 149 |
{ requestTimeout :: Int
|
|
| 150 |
, requestUrl :: String
|
|
| 151 |
, requestPostData :: String
|
|
| 149 |
{ requestUrl :: String -- ^ The actual URL for the node endpoint
|
|
| 150 |
, requestData :: String -- ^ The arguments for the call
|
|
| 151 |
, requestOpts :: [CurlOption] -- ^ The various curl options
|
|
| 152 | 152 |
} |
| 153 | 153 |
|
| 154 | 154 |
-- | Execute the request and return the result as a plain String. When |
| 155 | 155 |
-- curl reports an error, we propagate it. |
| 156 | 156 |
executeHttpRequest :: Node -> ERpcError HttpClientRequest |
| 157 | 157 |
-> IO (ERpcError String) |
| 158 |
|
|
| 159 | 158 |
executeHttpRequest _ (Left rpc_err) = return $ Left rpc_err |
| 160 | 159 |
executeHttpRequest node (Right request) = do |
| 161 |
cert_file <- P.nodedCertFile |
|
| 162 |
let reqOpts = [ CurlTimeout (fromIntegral $ requestTimeout request) |
|
| 163 |
, CurlPostFields [requestPostData request] |
|
| 164 |
, CurlSSLCert cert_file |
|
| 165 |
, CurlSSLKey cert_file |
|
| 166 |
, CurlCAInfo cert_file |
|
| 167 |
] |
|
| 160 |
let reqOpts = CurlPostFields [requestData request]:requestOpts request |
|
| 168 | 161 |
url = requestUrl request |
| 169 | 162 |
-- FIXME: This is very similar to getUrl in Htools/Rapi.hs |
| 170 | 163 |
(code, !body) <- curlGetString url $ curlOpts ++ reqOpts |
| ... | ... | |
| 182 | 175 |
|
| 183 | 176 |
-- | Create HTTP request for a given node provided it is online, |
| 184 | 177 |
-- otherwise create empty response. |
| 185 |
prepareHttpRequest :: (RpcCall a) => Node -> a
|
|
| 178 |
prepareHttpRequest :: (RpcCall a) => [CurlOption] -> Node -> a
|
|
| 186 | 179 |
-> ERpcError HttpClientRequest |
| 187 |
prepareHttpRequest node call |
|
| 180 |
prepareHttpRequest opts node call
|
|
| 188 | 181 |
| rpcCallAcceptOffline call || not (nodeOffline node) = |
| 189 |
Right HttpClientRequest { requestTimeout = rpcCallTimeout call
|
|
| 190 |
, requestUrl = prepareUrl node call
|
|
| 191 |
, requestPostData = rpcCallData node call
|
|
| 182 |
Right HttpClientRequest { requestUrl = prepareUrl node call
|
|
| 183 |
, requestData = rpcCallData node call
|
|
| 184 |
, requestOpts = opts ++ curlOpts
|
|
| 192 | 185 |
} |
| 193 | 186 |
| otherwise = Left $ OfflineNodeError node |
| 194 | 187 |
|
| ... | ... | |
| 204 | 197 |
_ -> Left . JsonDecodeError $ show (pp_value jerr) |
| 205 | 198 |
|
| 206 | 199 |
-- | Execute RPC call for a sigle node. |
| 207 |
executeSingleRpcCall :: (Rpc a b) => Node -> a -> IO (Node, ERpcError b) |
|
| 208 |
executeSingleRpcCall node call = do |
|
| 209 |
let request = prepareHttpRequest node call |
|
| 200 |
executeSingleRpcCall :: (Rpc a b) => |
|
| 201 |
[CurlOption] -> Node -> a -> IO (Node, ERpcError b) |
|
| 202 |
executeSingleRpcCall opts node call = do |
|
| 203 |
let request = prepareHttpRequest opts node call |
|
| 210 | 204 |
response <- executeHttpRequest node request |
| 211 | 205 |
let result = parseHttpResponse call response |
| 212 | 206 |
return (node, result) |
| 213 | 207 |
|
| 214 | 208 |
-- | Execute RPC call for many nodes in parallel. |
| 215 | 209 |
executeRpcCall :: (Rpc a b) => [Node] -> a -> IO [(Node, ERpcError b)] |
| 216 |
executeRpcCall nodes call = |
|
| 217 |
sequence $ parMap rwhnf (uncurry executeSingleRpcCall) |
|
| 218 |
(zip nodes $ repeat call) |
|
| 210 |
executeRpcCall nodes call = do |
|
| 211 |
cert_file <- P.nodedCertFile |
|
| 212 |
let opts = [ CurlTimeout (fromIntegral $ rpcCallTimeout call) |
|
| 213 |
, CurlSSLCert cert_file |
|
| 214 |
, CurlSSLKey cert_file |
|
| 215 |
, CurlCAInfo cert_file |
|
| 216 |
] |
|
| 217 |
sequence $ parMap rwhnf (\n -> executeSingleRpcCall opts n call) nodes |
|
| 219 | 218 |
|
| 220 | 219 |
-- | Helper function that is used to read dictionaries of values. |
| 221 | 220 |
sanitizeDictResults :: [(String, J.Result a)] -> ERpcError [(String, a)] |
Also available in: Unified diff