From 4198ce253ea9ef9184b325e4bb8d18fcc483b381 Mon Sep 17 00:00:00 2001 From: joe Date: Wed, 2 Aug 2017 01:10:08 -0400 Subject: More Tox stuff. --- src/Network/QueryResponse.hs | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs index 29a221e8..c8a6fa80 100644 --- a/src/Network/QueryResponse.hs +++ b/src/Network/QueryResponse.hs @@ -124,18 +124,27 @@ data MethodHandler err tid addr x = forall a b. MethodHandler -- address of the query is provided to the handler. , methodAction :: addr -> a -> IO b } + | forall a. NoReply + { -- | Parse the query into a more specific type for this method. + methodParse :: x -> Either err a + -- | Fully typed action to perform upon the query. The remote origin + -- address of the query is provided to the handler. + , noreplyAction :: addr -> a -> IO () + } -- | Attempt to invoke a 'MethodHandler' upon a given inbound query. If the --- parse is successful, the returned IO action will construct our reply. --- Otherwise, a parse err is returned. +-- parse is successful, the returned IO action will construct our reply if +-- there is one. Otherwise, a parse err is returned. dispatchQuery :: MethodHandler err tid addr x -- ^ Handler to invoke. -> tid -- ^ The transaction id for this query\/response session. -> addr -- ^ Our own address, to which the query was sent. -> x -- ^ The query packet. -> addr -- ^ The origin address of the query. - -> Either err (IO x) + -> Either err (IO (Maybe x)) dispatchQuery (MethodHandler unwrapQ wrapR f) tid self x addr = - fmap (\a -> wrapR tid self addr <$> f addr a) $ unwrapQ x + fmap (\a -> Just . wrapR tid self addr <$> f addr a) $ unwrapQ x +dispatchQuery (NoReply unwrapQ f) tid self x addr = + fmap (\a -> f addr a >> return Nothing) $ unwrapQ x -- | These four parameters are required to implement an ougoing query. A -- peer-to-peer algorithm will define a 'MethodSerializer' for every 'MethodHandler' that @@ -365,7 +374,7 @@ handleMessage (Client net d err pending whoami responseID) again = do self <- whoami (Just addr) tid' <- responseID tid either (reportParseError err) - (>>= sendMessage net addr) + (>>= mapM_ (sendMessage net addr)) (dispatchQuery m tid' self plain addr) IsResponse tid -> do action <- atomically $ do -- cgit v1.2.3