Commit d4709cce authored by Agata Murawska's avatar Agata Murawska

Datatypes for haskell RPC calls

We introduce typeclasses for RPC call and result and create a typeclass
that binds the two together. For that we need to use
MultiParamTypeClasses and FunctionalDependencies language pragmas, which
allow us to ensure that RPC result type can be deduced based on the
RPC call type.
Signed-off-by: default avatarAgata Murawska <>
Reviewed-by: default avatarIustin Pop <>
parent c4f65a0e
......@@ -412,6 +412,7 @@ HS_LIB_SRCS = \
htools/Ganeti/Luxi.hs \
htools/Ganeti/Objects.hs \
htools/Ganeti/OpCodes.hs \
htools/Ganeti/Rpc.hs \
htools/Ganeti/Runtime.hs \
htools/Ganeti/Ssconf.hs \
htools/Ganeti/THH.hs \
......@@ -78,6 +78,7 @@ import qualified Ganeti.Luxi as Luxi
import qualified Ganeti.Objects as Objects
import qualified Ganeti.OpCodes as OpCodes
import qualified Ganeti.Query2 as Query2
import qualified Ganeti.Rpc as Rpc
import qualified Ganeti.Runtime as Runtime
import qualified Ganeti.Ssconf as Ssconf
import qualified Ganeti.HTools.CLI as CLI
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-| Implementation of the RPC client.
Copyright (C) 2012 Google Inc.
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
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.
module Ganeti.Rpc
( RpcCall
, RpcResult
, Rpc
, RpcError(..)
, rpcCallName
, rpcCallTimeout
, rpcCallData
, rpcCallAcceptOffline
, rpcResultFill
) where
import qualified Text.JSON as J
import Ganeti.Objects
-- | Data type for RPC error reporting.
data RpcError
= CurlDisabledError
| CurlLayerError Node String
| JsonDecodeError String
| OfflineNodeError Node
deriving Eq
instance Show RpcError where
show CurlDisabledError =
"RPC/curl backend disabled at compile time"
show (CurlLayerError node code) =
"Curl error for " ++ nodeName node ++ ", error " ++ code
show (JsonDecodeError msg) =
"Error while decoding JSON from HTTP response " ++ msg
show (OfflineNodeError node) =
"Node " ++ nodeName node ++ " is marked as offline"
rpcErrorJsonReport :: (Monad m) => J.Result a -> m (Either RpcError a)
rpcErrorJsonReport (J.Error x) = return $ Left $ JsonDecodeError x
rpcErrorJsonReport (J.Ok x) = return $ Right x
-- | A generic class for RPC calls.
class (J.JSON a) => RpcCall a where
-- | Give the (Python) name of the procedure.
rpcCallName :: a -> String
-- | Calculate the timeout value for the call execution.
rpcCallTimeout :: a -> Int
-- | Prepare arguments of the call to be send as POST.
rpcCallData :: Node -> a -> String
-- | Whether we accept offline nodes when making a call.
rpcCallAcceptOffline :: a -> Bool
rpcCallData _ = J.encode
-- | A generic class for RPC results with default implementation.
class (J.JSON a) => RpcResult a where
-- | Create a result based on the received HTTP response.
rpcResultFill :: (Monad m) => String -> m (Either RpcError a)
rpcResultFill res = rpcErrorJsonReport $ J.decode res
-- | Generic class that ensures matching RPC call with its respective
-- result.
class (RpcCall a, RpcResult b) => Rpc a b | a -> b
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment