[Haskell-cafe] Designing somewhat-type-safe RPC

[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)
-}