courier 0.1.0.9 → 0.1.0.10
raw patch · 3 files changed
+97/−17 lines, 3 filesdep +uuid
Dependencies added: uuid
Files
- changes.md +23/−2
- courier.cabal +3/−2
- src/Network/RPC.hs +71/−13
changes.md view
@@ -1,8 +1,29 @@+0.1.0.10++ * Added hear primitive as one-shot counterpart to call. While handle+ may be generally useful for many applications as it fully encapsulates repeated+ handling of incoming requests, hear adds the ability to wait for a single+ incoming request. Hear also returns a function of type Reply suitable for sending+ a single response to the caller. Being more low-level in nature, some applications+ find direct use of hear more flexible than the higher-level handle construct.++ * Fixed a mistake in 0.1.0.9 where RPCs where supposed to have unique identifiers+ for matching up a call with a response. The value was never computed, when it+ should have been a random value for every call, so that responses could be matched+ with their originating request. Now using Data.UUID.V4 to generate unique identifiers+ for each request; dependency added in cabal.++ * Unit tests on OS X 10.9 unreliable again, with both ghc 7.6.3 and ghc 7.8.1 (rc1)++ * Unit tests passing on Ubuntu 12.04 LTS AMD64 ghc 7.6.3++ * Unit tests passing on FP Complete with 7.8 preview compiler+ 0.1.0.9 * Added HelloWorld example, and updated code sample in documentation to reflect working with the current API- + * Early implementation of synchronous RPCs on top of endpoints, with basic unit tests. Both single and group RPCs are implemented, as are calls with definite and indefinite waits for responses.@@ -10,7 +31,7 @@ * Removed dependency on network-simple * Improved documentation throughout.- + 0.1.0.8 * Enabled selective out of order mesage reception, by using a Mailbox, an extension of STM's
courier.cabal view
@@ -1,5 +1,5 @@ name: courier-version: 0.1.0.9+version: 0.1.0.10 synopsis: A message-passing library for simplifying network applications description: Inspired by Erlang's simple message-passing facilities, courier provides roughly similar capabilities. Applications simply create one or more endpoints, @@ -64,7 +64,8 @@ hslogger, network, stm,- text+ text,+ uuid Test-Suite test-courier type: exitcode-stdio-1.0
src/Network/RPC.hs view
@@ -42,6 +42,10 @@ gcall, gcallWithTimeout, + hear,+ hearTimeout,+ Reply,+ HandleSite, handle, hangup@@ -62,14 +66,19 @@ import qualified Data.Map as M import qualified Data.Set as S import Data.Serialize+import Data.UUID+import Data.UUID.V4+import Data.Word -------------------------------------------------------------------------------- -------------------------------------------------------------------------------- type Method = String +type RequestId = (Word32, Word32, Word32, Word32)+ data Request a = (Serialize a) => Request {- requestId :: String,+ requestId :: RequestId, requestCaller :: Name, requestMethod :: Method, requestArgs :: a@@ -89,7 +98,7 @@ return $ Request rid caller method args data Response b = (Serialize b) => Response {- responseId :: String,+ responseId :: RequestId, responseFrom :: Name, responseValue :: b }@@ -126,7 +135,8 @@ -} call :: (Serialize a, Serialize b) => CallSite -> Name -> Method -> a -> IO b call (CallSite endpoint from) name method args = do- let req = Request {requestId = "",requestCaller = from,requestMethod = method, requestArgs = args}+ ruuid <- nextRandom+ let req = Request {requestId = toWords ruuid,requestCaller = from,requestMethod = method, requestArgs = args} sendMessage_ endpoint name $ encode req selectMessage endpoint $ \msg -> do case decode msg of@@ -160,7 +170,8 @@ -} gcall :: (Serialize a, Serialize b) => CallSite -> [Name] -> Method -> a -> IO (M.Map Name b) gcall (CallSite endpoint from) names method args = do- let req = Request {requestId = "",requestCaller = from,requestMethod = method, requestArgs = args}+ ruuid <- nextRandom+ let req = Request {requestId = toWords ruuid,requestCaller = from,requestMethod = method, requestArgs = args} sendAll req recvAll req M.empty where@@ -194,7 +205,8 @@ -} gcallWithTimeout :: (Serialize a, Serialize b) => CallSite -> [Name] -> Method -> Int -> a -> IO (M.Map Name (Maybe b)) gcallWithTimeout (CallSite endpoint from) names method delay args = do- let req = Request {requestId = "",requestCaller = from,requestMethod = method, requestArgs = args}+ ruuid <- nextRandom+ let req = Request {requestId = toWords ruuid,requestCaller = from,requestMethod = method, requestArgs = args} sendAll req allResults <- atomically $ newTVar M.empty responses <- race (recvAll req allResults) (threadDelay delay)@@ -232,6 +244,58 @@ complete partial = foldl (\final name -> M.insert name (M.lookup name partial) final) M.empty names {-|+A 'Reply' is a one-shot function for sending a response to an incoming request.+-}+type Reply b = b -> IO ()++{-|+Wait for a single incoming request to invoke the indicated 'Method' on the specified+'Endpoint'. Return both the method arguments and a 'Reply' function useful for sending+the reply. A good pattern for using 'hear' will pattern match the result to a tuple of+the form @(args,reply)@, then use the args as needed to compute a result, and then+finally send the result back to the client by simply passing the result to reply: @reply result@.++The invoker of 'hear' must supply the 'Name' they have bound to the 'Endpoint', as this+helps the original requestor of the RPC differentiate responses when the RPC was a group+call.+-}+hear :: (Serialize a,Serialize b) => Endpoint -> Name -> Method -> IO (a,Reply b)+hear endpoint name method = do+ (caller,rid,args) <- selectMessage endpoint $ \msg -> do+ case decode msg of+ Left _ -> Nothing+ Right (Request rid caller rmethod args) -> do+ if rmethod == method+ then Just (caller,rid,args)+ else Nothing+ return (args, reply caller rid)+ where+ reply caller rid result = do+ sendMessage_ endpoint caller $ encode $ Response rid name result+++{-|+Same as 'hear', except return 'Nothing' if no request received within the specified+timeout (measured in microseconds), or return a 'Just' instance containing both the+method arguments and a 'Reply' function useful for sending the reply.+-}+hearTimeout :: (Serialize a,Serialize b) => Endpoint -> Name -> Method -> Int -> IO (Maybe (a,Reply b))+hearTimeout endpoint name method timeout = do+ req <- selectMessageTimeout endpoint timeout $ \msg -> do+ case decode msg of+ Left _ -> Nothing+ Right (Request rid caller rmethod args) -> do+ if rmethod == method+ then Just (caller,rid,args)+ else Nothing+ case req of+ Just (caller,rid,args) -> return $ Just (args, reply caller rid)+ Nothing -> return Nothing+ where+ reply caller rid result = do+ sendMessage_ endpoint caller $ encode $ Response rid name result++{-| A 'HandleSite' is a just reference to the actual handler of a specific method. Mostly for invoking 'hangup' on the handler, once it is no longer needed. -}@@ -247,15 +311,9 @@ return $ HandleSite name task where handleCall = do- (caller,rid,args) <- selectMessage endpoint $ \msg -> do- case decode msg of- Left _ -> Nothing- Right (Request rid caller rmethod args) -> do- if rmethod == method- then Just (caller,rid,args)- else Nothing+ (args,reply) <- hear endpoint name method result <- fn args- sendMessage_ endpoint caller $ encode $ Response rid name result+ reply result handleCall {-|