More Tox stuff.

1 files changed, 14 insertions, 5 deletions

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