Synnefo » snf-ganeti » ganeti-local

{-

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

-- | Convert RpcError to ResultStatus

rpcErrorToStatus :: RpcError -> ResultStatus

rpcErrorToStatus _ = RSNoData

-- * Common fields

-- | Data type for RPC error reporting.

data RpcError

  | JsonDecodeError String

  | RpcResultError String

  deriving (Show, Eq)

-- | Provide explanation to RPC errors.

explainRpcError :: RpcError -> String

explainRpcError (JsonDecodeError msg) =

    "Error while decoding JSON from HTTP response: " ++ msg

explainRpcError (RpcResultError msg) =

    "Error reponse received from RPC server: " ++ msg

type ERpcError = Either RpcError

-- | Execute the request and return the result as a plain String. When

-- curl reports an error, we propagate it.

  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

-- | Prepare url for the HTTP request.

prepareUrl :: (RpcCall a) => Node -> a -> String

                              , requestData = rpcCallData node call

                              , requestOpts = opts ++ curlOpts

                              }

-- | Parse a result based on the received HTTP response.

parseHttpResponse :: (Rpc a b) => a -> ERpcError String -> ERpcError b

                        [CurlOption] -> Node -> a -> IO (Node, ERpcError b)

executeSingleRpcCall opts node call = do

  let request = prepareHttpRequest opts node call

  let result = parseHttpResponse call response

  return (node, result)

{-

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

prop_noffl_request_allinstinfo call =

  forAll (arbitrary `suchThat` Objects.nodeOffline) $ \node -> monadicIO $ do

      res <- run $ Rpc.executeRpcCall [node] call

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

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

testSuite "Rpc"

  [ 'prop_noffl_request_allinstinfo