Designing somewhat-type-safe RPC

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
4 messages Options
Reply | Threaded
Open this post in threaded view
|

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

_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: Designing somewhat-type-safe RPC

John Lato-2
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 <[hidden email]> 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.

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
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe


_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: Designing somewhat-type-safe RPC

oleg-30
In reply to this post by Nicolas Trangez

The remote procedure call is obviously a partial function: first of
all, it may fail because of various network problems. It may also fail
if a client and a server disagree on the types of the arguments and
the results of the function call. For example, the client may think
that "Add" service adds integers while the server takes "Add" to sum
floats. There is nothing in the type system that can enforce the
agreement between distributed entities. So, we are liable to get
serialization/deserialization errors. It is inevitable that the
communication part is a big "Dynamic", and getting data from that
Dynamic may fail because of `type' errors (the data were serialized at
a different type than expected, or the data were corrupted in transit).

With these assumptions, the implementation is straightforward
(enclosed). Both the server and the client operations are typed (but
the middle part, the communication, is necessarily `untyped').

Incidentally, some three years ago I wrote a quite more advanced RPC
library, in OCaml. It didn't use any GADTs and other bleeding stuff
(first, OCaml did not have GADTs at the time; second, I'm minimalist).
It did much more, including semi-automatic request batching and some
fairly complex server programs including conditionals. It already does
more than X protocol and Java RPC. If I added server-side loops, it
would do even more. Alas, I didn't have time to come back to that
project since.

        http://okmij.org/ftp/meta-future/meta-future.html



{-# LANGUAGE ExistentialQuantification  #-}

module RPC where

import System.IO
import qualified Data.Map as M

-- identifiers of functions to call
type ServiceID = String


-- ------------------------------------------------------------------------
-- Server part
-- For simplicity, we use Read for deserialization and Show for
-- serialization. Binary would've been a better choice for both

-- All functions are supposed to be uncurried.
-- ServerFn essentially packs a function together with the serializer
-- of the result and the deserializer for arguments.
data ServerFn = forall a b. (Read a, Show b) => ServerFn (a->b)
type Services = M.Map ServiceID ServerFn

-- For simplicity, we handle just one request, which we read from
-- the handle. We write the result to stdio. It is easy to generalize:
-- write the result to an output handle and loop.
runServer :: Services -> Handle -> IO ()
runServer services h = do
  service_id <- hGetLine h
  putStrLn $ service_id
  args       <- hGetLine h
  maybe (fail $ "no such service: " ++ service_id) (handle args) $
    M.lookup service_id services
 where
   handle sargs (ServerFn f) = do
     let args = read sargs
     print $ f args

-- Sample services
services :: Services
services = M.fromList [
  ("Ping", ServerFn (\ () -> ())),
  ("Add",  ServerFn (\ (x,y) -> x + y :: Int))
                      ]

-- ------------------------------------------------------------------------
-- Client part

-- Stubs of server fn
-- ClientFn a b represents a function a->b to be executed by a server
data ClientFn a b = ClientFn ServiceID

ping :: ClientFn () ()
ping = ClientFn "Ping"

add :: ClientFn (Int,Int) Int
add = ClientFn "Add"

-- the set of functions is open; more can be added at any time

-- Do the remote function application
rpc :: (Show a, Read b) => Handle -> ClientFn a b -> a -> IO b
rpc h (ClientFn fid) x = do
  hPutStrLn h fid
  hPutStrLn h (show x)
  -- read the result: currently stabbed
  result_str <- return "stubbed"
  return $ read result_str

-- ------------------------------------------------------------------------
-- Test

comm_file = "/tmp/connection"

main = do
  h <- openFile comm_file WriteMode
  -- send the request down to h. In this example, the return communication
  -- is not implemented
  res <- rpc h add (2::Int,3::Int)
     -- don't look at the result: it this example, it is undefined
  hClose h
  h <- openFile comm_file ReadMode
  runServer services h

 

_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe
Reply | Threaded
Open this post in threaded view
|

Re: Designing somewhat-type-safe RPC

Nicolas Trangez
In reply to this post by Nicolas Trangez
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

_______________________________________________
Haskell-Cafe mailing list
[hidden email]
http://www.haskell.org/mailman/listinfo/haskell-cafe