Synnefo » snf-ganeti

  BangPatterns, TemplateHaskell #-}

{-| Implementation of the RPC client.

{-

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

import qualified Text.JSON as J

import Text.JSON.Pretty (pp_value)

import Network.Curl

import qualified Ganeti.Path as P

import qualified Ganeti.Constants as C

import Ganeti.Objects

-- * Base RPC functionality and types

-- | The curl options used for RPC.

curlOpts :: [CurlOption]

curlOpts = [ CurlFollowLocation False

           , CurlSSLKeyType "PEM"

           , CurlConnectTimeout (fromIntegral C.rpcConnectTimeout)

           ]

-- | Data type for RPC error reporting.

data RpcError

  | JsonDecodeError String

  | RpcResultError String

  | OfflineNodeError Node

-- | Provide explanation to RPC errors.

explainRpcError :: RpcError -> String

explainRpcError (CurlLayerError node code) =

    "Curl error for " ++ nodeName node ++ ", " ++ code

explainRpcError (JsonDecodeError msg) =

                   -> IO (ERpcError String)

executeHttpRequest _ (Left rpc_err) = return $ Left rpc_err

executeHttpRequest node (Right request) = do

  cert_file <- P.nodedCertFile

  let reqOpts = [ CurlTimeout (fromIntegral $ requestTimeout request)

  return $ case code of

             CurlOK -> Right body

             _ -> Left $ CurlLayerError node (show code)

-- | Prepare url for the HTTP request.

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