krpc-0.2.2.0: KRPC remote procedure call protocol implementation.

Portabilityportable
Stabilityexperimental
Maintainerpxqr.sta@gmail.com
Safe HaskellNone

Remote.KRPC

Contents

Description

This module provides safe remote procedure call. One important point is exceptions and errors, so be able handle them properly we need to investigate a bit about how this all works. Internally, in order to make method invokation KRPC makes the following steps:

  • Caller serialize arguments to bencoded bytestrings;
  • Caller send bytestring data over UDP to the callee;
  • Callee receive and decode arguments to the method and method name. If it can't decode then it send ProtocolError back to the caller;
  • Callee search for the method name in the method table. If it not present in the table then callee send MethodUnknown back to the caller;
  • Callee check if argument names match. If not it send ProtocolError back;
  • Callee make the actuall call to the plain old haskell function. If the function throw exception then callee send ServerError back.
  • Callee serialize result of the function to bencoded bytestring.
  • Callee encode result to bencoded bytestring and send it back to the caller.
  • Caller check if return values names match with the signature it called in the first step.
  • Caller extracts results and finally return results of the procedure call as ordinary haskell values.

If every other error occurred caller get the GenericError. All errors returned by callee are throwed as ordinary haskell exceptions at caller side. Make sure that both callee and caller uses the same method signatures and everything should be ok: this KRPC implementation provides some level of safety through types. Also note that both caller and callee use plain UDP, so KRPC is unreliable.

Consider one tiny example. From now caller = client and callee = server or remote.

Somewhere we have to define all procedure signatures. Imagine that this is a library shared between client and server:

  factorialMethod :: Method Int Int
  factorialMethod = method "factorial" ["x"] ["y"]

Otherwise you can define this code in both client and server of course. But in this case you might get into troubles: you can get MethodUnknown or ProtocolError if name or type of method will mismatch after not synced changes in client or server code.

Now let's define our client-side:

 main = withRemote  $ \remote -> do
    result <- call remote (0, 6000) factorialMethod 4
    assert (result == 24) $ print "Success!"

It basically open socket with withRemote and make all the other steps in call as describe above. And finally our server-side:

 factorialImpl :: Int -> Int
 factorialImpl n = product [1..n]

 main = runServer [factorialMethod $ return . factorialImpl]

Here we implement method signature from that shared lib and run server with runServer by passing method table in.

For async API use async package, old API have been removed.

For more examples see exsamples or tests directories.

For protocol details see Protocol module.

Synopsis

Method

data Method param result Source

Method datatype used to describe name, parameters and return values of procedure. Client use a method to invoke, server implements the method to make the actual work.

We use the following fantom types to ensure type-safiety:

  • param: Type of method parameters. Ordinary Tuple type used to specify more than one parameter, so for example Method (Int, Int) result will take two arguments.
  • result: Type of return value of the method. Similarly, tuple used to specify more than one return value, so for exsample Method (Foo, Bar) (Bar, Foo) will take two arguments and return two values.

To pass raw dictionaries you should specify empty param list:

 method "my_method" [] [] :: Method BEncode BEncode

In this case you should handle dictionary extraction by hand, both in client and server.

Constructors

Method 

Fields

methodName :: MethodName

Name used in query.

methodParams :: [ParamName]

Name of each parameter in right to left order.

methodVals :: [ValName]

Name of each return value in right to left order.

Instances

Eq (Method param result) 
Ord (Method param result) 
(Typeable a, Typeable b) => Show (Method a b) 
Generic (Method param result) 
BEncodable (Method a b) 

method :: MethodName -> [ParamName] -> [ValName] -> Method param resultSource

Makes method signature. Note that order of parameters and return values are not important as long as corresponding names and types are match. For exsample this is the equal definitions:

 methodA : Method (Foo, Bar) (Baz, Quux)
 methodA = method "mymethod" ["a", "b"] ["c", "d"]
 methodA : Method (Bar, Foo) (Quux, Baz)
 methodB = method "mymethod" ["b", "a"] ["d", "c"]

idM :: Method a aSource

Identity procedure signature. Could be used for echo servers. Implemented as:

 idM = method "id" ["x"] ["y"]

Client

type RemoteAddr = KRemoteAddrSource

Address of remote can be called by client.

data RPCException Source

Represent any error mentioned by protocol specification that call, await might throw. For more details see Protocol.

Constructors

RPCException KError 

callSource

Arguments

:: (MonadBaseControl IO host, MonadIO host) 
=> (BEncodable param, BEncodable result) 
=> RemoteAddr

Address of callee.

-> Method param result

Procedure to call.

-> param

Arguments passed by callee to procedure.

-> host result

Values returned by callee from the procedure.

Makes remote procedure call. Throws RPCException on any error occurred.

Server

type MethodHandler remote = (MethodName, HandlerBody remote)Source

Procedure signature and implementation binded up.

(==>)Source

Arguments

:: forall remote param result . (BEncodable param, BEncodable result) 
=> Monad remote 
=> Method param result

Signature.

-> (param -> remote result)

Implementation.

-> MethodHandler remote

Handler used by server.

Assign method implementation to the method signature.

(==>@)Source

Arguments

:: forall remote param result . (BEncodable param, BEncodable result) 
=> Monad remote 
=> Method param result

Signature.

-> (KRemoteAddr -> param -> remote result)

Implementation.

-> MethodHandler remote

Handler used by server.

Similar to ==>@ but additionally pass caller address.

serverSource

Arguments

:: (MonadBaseControl IO remote, MonadIO remote) 
=> PortNumber

Port used to accept incoming connections.

-> [MethodHandler remote]

Method table.

-> remote () 

Run RPC server on specified port by using list of handlers. Server will dispatch procedure specified by callee, but note that it will not create new thread for each connection.

Internal

call_Source

Arguments

:: (MonadBaseControl IO host, MonadIO host) 
=> (BEncodable param, BEncodable result) 
=> Remote

Socket to use

-> RemoteAddr

Address of callee.

-> Method param result

Procedure to call.

-> param

Arguments passed by callee to procedure.

-> host result

Values returned by callee from the procedure.

The same as call but use already opened socket.

withRemote :: (MonadBaseControl IO m, MonadIO m) => (KRemote -> m a) -> m aSource