Designing somewhat-type-safe RPC

Hi, While working on the design of an RPC library (for an existing protocol), I got somewhat stuck. The system is fairly simple: for some call, a client first sends an identifier of the call, followed by a serialized form of the argument. Then the server returns some serialized result. A server exposes several procedures, all taking a certain argument type and returning a certain result type. Below is some code which sketches my current approach. The 'client' side seems straight-forward and working (hence 'runCall'), but I didn't manage to implement the server side as I imagine it to be (i.e. the parts commented out). Any pointers would be appreciated. Thanks, Nicolas {-# LANGUAGE GADTs, RankNTypes, OverloadedStrings, KindSignatures, ScopedTypeVariables #-} module RPC where import Data.Word (Word32) import Data.Binary (Binary, decode, encode) class RPC (a :: * -> * -> *) where rpcProcedureId :: a req res -> Word32 {- rpcProcedure :: Word32 -> Maybe (a req res) -} data Service req res where Ping :: Service () () Add :: Service (Word32, Word32) Word32 instance RPC Service where rpcProcedureId p = case p of Ping -> 1 Add -> 2 {- rpcProcedure i = case i of 1 -> Just Ping 2 -> Just Add _ -> Nothing -} runCall :: forall call req res. (RPC call, Binary req, Binary res) => call req res -> req -> IO res runCall call req = do let bs = encode req idx = rpcProcedureId call -- Send idx & bs to network, read stuff from network and interpret s <- return $ encode (3 :: Word32) return $ decode s runServer :: (RPC call, Binary req, Binary res) => (call req res -> req -> IO res) -> IO () {- runServer handler = do i <- return 2 -- Read from network case rpcProcedure i of Nothing -> error "No such procedure" Just (call :: call req res) -> do -- Read request from network s <- return $ encode (1 :: Word32, 2 :: Word32) let (req :: req) = decode s (res :: res) <- handler call req -- Send reply to network let res' = encode res return () -} runServer handler = undefined main :: IO () main = do runCall Ping () >>= print runCall Add (1, 2) >>= print {- runServer handler where handler :: Service req res -> req -> IO res handler c (r :: req) = case c of Ping -> return () Add -> case r of (a, b) -> return (a + b) -}

This looks very similar to some code that I was working on a few months ago, https://github.com/JohnLato/lifted-lens. I never really started to use it, but everything that's there works (sadly I don't have any examples right now, but the module Language.Lens.Lifted is the top-level, and I could add an example if you're interested). First, consider how something might work without using GADTs. You'd want your server to read the identifiers, figure out the types to use for everything, and instantiate its argument at the correct types. This means you'd have a function like:
runServer :: (forall call req res. (RPC call, Binary req, Binary res) => call req res -> req -> IO res) -> IO ()
Now, I'm not entirely sure how this will interact with GADTs as you're
using them. The problem I had with lifted-lens was convincing GHC that
various constraints (that are required by certain GADT constructors) were
satisfiable at the point the constructor would be applied. I ended up
needing to do a lot of CPS-like transforms in more places than I expected.
On Thu, Jan 2, 2014 at 12:30 PM, Nicolas Trangez
Hi,
While working on the design of an RPC library (for an existing protocol), I got somewhat stuck. The system is fairly simple: for some call, a client first sends an identifier of the call, followed by a serialized form of the argument. Then the server returns some serialized result. A server exposes several procedures, all taking a certain argument type and returning a certain result type.
Below is some code which sketches my current approach. The 'client' side seems straight-forward and working (hence 'runCall'), but I didn't manage to implement the server side as I imagine it to be (i.e. the parts commented out).
Any pointers would be appreciated.
Thanks,
Nicolas
{-# LANGUAGE GADTs, RankNTypes, OverloadedStrings, KindSignatures, ScopedTypeVariables #-}
module RPC where
import Data.Word (Word32) import Data.Binary (Binary, decode, encode)
class RPC (a :: * -> * -> *) where rpcProcedureId :: a req res -> Word32 {- rpcProcedure :: Word32 -> Maybe (a req res) -}
data Service req res where Ping :: Service () () Add :: Service (Word32, Word32) Word32
instance RPC Service where rpcProcedureId p = case p of Ping -> 1 Add -> 2 {- rpcProcedure i = case i of 1 -> Just Ping 2 -> Just Add _ -> Nothing -}
runCall :: forall call req res. (RPC call, Binary req, Binary res) => call req res -> req -> IO res runCall call req = do let bs = encode req idx = rpcProcedureId call -- Send idx & bs to network, read stuff from network and interpret s <- return $ encode (3 :: Word32)
return $ decode s
runServer :: (RPC call, Binary req, Binary res) => (call req res -> req -> IO res) -> IO () {- runServer handler = do i <- return 2 -- Read from network case rpcProcedure i of Nothing -> error "No such procedure" Just (call :: call req res) -> do -- Read request from network s <- return $ encode (1 :: Word32, 2 :: Word32) let (req :: req) = decode s (res :: res) <- handler call req -- Send reply to network let res' = encode res return () -} runServer handler = undefined
main :: IO () main = do runCall Ping () >>= print runCall Add (1, 2) >>= print {- runServer handler where handler :: Service req res -> req -> IO res handler c (r :: req) = case c of Ping -> return () Add -> case r of (a, b) -> return (a + b) -}
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Thu, 2014-01-02 at 21:30 +0100, Nicolas Trangez wrote:
Hi,
While working on the design of an RPC library (for an existing protocol), I got somewhat stuck. The system is fairly simple: for some call, a client first sends an identifier of the call, followed by a serialized form of the argument. Then the server returns some serialized result. A server exposes several procedures, all taking a certain argument type and returning a certain result type.
I figured out how to get my intentions into working code thanks to the input of John Lato (which got me to the correct type signature... I always have troubles with those RankN types) and Oleg (for using an existential type in his solution. I tried that before, but must have done something wrong). Thanks! The end result only uses GADTs and Rank2Types, so I think that's fairly reasonable. Code below. Regards, Nicolas {-# LANGUAGE Rank2Types, GADTs #-} {-# OPTIONS_GHC -Wall #-} module RPC2 where import Data.Word (Word32) import Data.Binary (Binary, decode, encode) import Control.Monad (forever) import Control.Monad.IO.Class (MonadIO(liftIO)) import System.IO (hFlush, stdout) -- Library code -- Not exported, use `procedure` instead data SomeProcedure a = forall req res. (Binary req, Binary res) => SomeProcedure (a req res) class RPC a where rpcProcedureId :: a req res -> Word32 rpcProcedure :: Word32 -> Maybe (SomeProcedure a) procedure :: (Binary req, Binary res) => a req res -> Maybe (SomeProcedure a) procedure = Just . SomeProcedure runServer :: (MonadIO m, RPC call) => (forall req res. call req res -> req -> m res) -> m () runServer handler = forever $ do -- Read tag from network tag <- liftIO $ do putStr "Procedure tag: " >> hFlush stdout read `fmap` getLine case rpcProcedure tag of Nothing -> liftIO $ putStrLn "Unknown procedure!" -- TODO Handle correctly Just (SomeProcedure c) -> do -- Read request data from network input <- recvData let req = decode input res <- handler c req let res' = encode res -- Write result to network liftIO $ putStrLn $ "Result data: " ++ show res' where -- Fake data coming from network -- (Note: when the request is 'Ping', `()` can be read from this as -- well) recvData = return $ encode (1 :: Word32, 2 :: Word32) -- API user code data Service req res where Ping :: Service () () Add :: Service (Word32, Word32) Word32 instance RPC Service where rpcProcedureId p = case p of Ping -> 0 Add -> 1 rpcProcedure i = case i of 0 -> procedure Ping 1 -> procedure Add _ -> Nothing serviceHandler :: Service req res -> req -> IO res serviceHandler call req = case call of Ping -> putStrLn $ "Ping " ++ show req Add -> do putStrLn $ "Add " ++ show req return (fst req + snd req) main :: IO () main = runServer serviceHandler
participants (2)
-
John Lato
-
Nicolas Trangez