TOX rewrite: Response nonces are now distinct from query nonces.

1 files changed, 40 insertions, 36 deletions

diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs
index 221c2284..9262132f 100644
--- a/src/Network/QueryResponse.hs
+++ b/src/Network/QueryResponse.hs
@@ -45,7 +45,7 @@ import System.Timeout
 --  > r <- sendQuery client method q
 --  > -- Quit client.
 --  > quitServer
-forkListener :: Client err meth tid addr x ctx -> IO (IO ())
+forkListener :: Client err meth tid addr x -> IO (IO ())
 forkListener client = do
     thread_id <- forkIO $ do
         myThreadId >>= flip labelThread "listener"
@@ -58,21 +58,21 @@ forkListener client = do
 -- out if 'forkListener' was never invoked to spawn a thread receive and
 -- dispatch the response.
 sendQuery ::
-    forall err a b tbl x ctx meth tid addr.
-        Client err meth tid addr x ctx          -- ^ A query/response implementation.
-        -> MethodSerializer addr x ctx meth a b -- ^ Information for marshalling the query.
-        -> a                                    -- ^ The outbound query.
-        -> addr                                 -- ^ Destination address of query.
-        -> IO (Maybe b)                         -- ^ The response, or 'Nothing' if it timed out.
-sendQuery (Client net d err pending whoami) meth q addr = do
+    forall err a b tbl x meth tid addr.
+        Client err meth tid addr x          -- ^ A query/response implementation.
+        -> MethodSerializer addr x meth a b -- ^ Information for marshalling the query.
+        -> a                                -- ^ The outbound query.
+        -> addr                             -- ^ Destination address of query.
+        -> IO (Maybe b)                     -- ^ The response, or 'Nothing' if it timed out.
+sendQuery (Client net d err pending whoami _) meth q addr = do
     mvar <- newEmptyMVar
     tid <- atomically $ do
         tbl <- readTVar pending
         let (tid, tbl') = dispatchRegister (tableMethods d) mvar tbl
         writeTVar pending tbl'
         return tid
-    (self,ctx) <- whoami
-    sendMessage net addr (wrapQuery meth ctx self addr q)
+    self <- whoami
+    sendMessage net addr (wrapQuery meth self addr q)
     mres <- timeout (methodTimeout meth) $ takeMVar mvar
     case mres of
         Just x -> return $ Just $ unwrapResponse meth x
@@ -84,21 +84,25 @@ sendQuery (Client net d err pending whoami) meth q addr = do
 -- * Implementing a query\/response 'Client'.
 
 -- | All inputs required to implement a query\/response client.
-data Client err meth tid addr x ctx = forall tbl. Client
+data Client err meth tid addr x = forall tbl. Client
     { -- | The 'Transport' used to dispatch and receive packets.
       clientNet :: Transport err addr x
       -- | Methods for handling inbound packets.
-    , clientDispatcher :: DispatchMethods tbl err meth tid addr x ctx
+    , clientDispatcher :: DispatchMethods tbl err meth tid addr x
       -- | Methods for reporting various conditions.
     , clientErrorReporter :: ErrorReporter addr x meth tid err
       -- | State necessary for routing inbound responses and assigning unique
       -- /tid/ values for outgoing queries.
     , clientPending :: TVar tbl
-      -- | An action yielding this client\'s own address along with some
-      -- context neccessary for serializing outgoing packets.  It is invoked
-      -- once on each outbound and inbound packet.  It is valid for this to
-      -- always return the same value.
-    , clientContext :: IO (addr,ctx)
+      -- | An action yielding this client\'s own address.  It is invoked once
+      -- on each outbound and inbound packet.  It is valid for this to always
+      -- return the same value.
+    , clientAddress :: IO addr
+      -- | Transform a query /tid/ value to an appropriate response /tid/
+      -- value.  Normally, this would be the identity transformation, but if
+      -- /tid/ includes a unique cryptographic nonce, then it should be
+      -- generated here.
+    , clientResponseId :: tid -> IO tid
     }
 
 -- | An incomming message can be classified into three cases.
@@ -108,13 +112,13 @@ data MessageClass err meth tid
     | IsResponse tid   -- ^ A response to a outgoing query we associated with a /tid/ value.
     | IsUnknown err    -- ^ None of the above.
 
--- | Handler for an inbound query of type _x_ from an address of type _addr_.
-data MethodHandler err tid addr x ctx = forall a b. MethodHandler
+-- | Handler for an inbound query of type /x/ from an address of type _addr_.
+data MethodHandler err tid addr x = forall a b. MethodHandler
     { -- | Parse the query into a more specific type for this method.
       methodParse :: x -> Either err a
       -- | Serialize the response for transmission, given a context /ctx/ and the origin
       -- and destination addresses.
-    , methodSerialize :: ctx -> tid -> addr -> addr -> b -> x
+    , methodSerialize :: tid -> addr -> addr -> b -> x
       -- | Fully typed action to perform upon the query.  The remote origin
       -- address of the query is provided to the handler.
     , methodAction :: addr -> a -> IO b
@@ -123,20 +127,19 @@ data MethodHandler err tid addr x ctx = forall a b. MethodHandler
 -- | 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.
-dispatchQuery :: MethodHandler err tid addr x ctx -- ^ Handler to invoke.
-                 -> ctx                           -- ^ Arbitrary context used during serialization.
-                 -> 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.
+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)
-dispatchQuery (MethodHandler unwrapQ wrapR f) ctx tid self x addr =
-    fmap (\a -> wrapR ctx tid self addr <$> f addr a) $ unwrapQ x
+dispatchQuery (MethodHandler unwrapQ wrapR f) tid self x addr =
+    fmap (\a -> wrapR tid self addr <$> f addr a) $ 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
 -- might be returned by 'lookupHandler'.
-data MethodSerializer addr x ctx meth a b = MethodSerializer
+data MethodSerializer addr x meth a b = MethodSerializer
     { -- | Seconds to wait for a response.
       methodTimeout :: Int
       -- | A method identifier used for error reporting.  This needn't be the
@@ -146,7 +149,7 @@ data MethodSerializer addr x ctx meth a b = MethodSerializer
       -- The /addr/ arguments are, respectively, our own origin address and the
       -- destination of the request.  The /ctx/ argument is useful for attaching
       -- auxillary notations on all outgoing packets.
-    , wrapQuery :: ctx -> addr -> addr -> a -> x
+    , wrapQuery :: addr -> addr -> a -> x
       -- | Parse an inbound packet /x/ into a response /b/ for this query.
     , unwrapResponse :: x -> b
     }
@@ -274,11 +277,11 @@ transactionMethods (TableMethods insert delete lookup) generate = TransactionMet
     }
 
 -- | A set of methods neccessary for dispatching incomming packets.
-data DispatchMethods tbl err meth tid addr x ctx = DispatchMethods
+data DispatchMethods tbl err meth tid addr x = DispatchMethods
     { -- | Clasify an inbound packet as a query or response.
       classifyInbound :: x -> MessageClass err meth tid
       -- | Lookup the handler for a inbound query.
-    , lookupHandler :: meth -> Maybe (MethodHandler err tid addr x ctx)
+    , lookupHandler :: meth -> Maybe (MethodHandler err tid addr x)
       -- | Methods for handling incomming responses.
     , tableMethods :: TransactionMethods tbl tid x
     }
@@ -326,10 +329,10 @@ contramapE f (ErrorReporter pe mh unk tim)
 -- 'fix' in a forked thread that loops until 'awaitMessage' returns 'Nothing'
 -- or throws an exception.
 handleMessage ::
-    Client err meth tid addr x ctx
+    Client err meth tid addr x
     -> IO ()
     -> IO ()
-handleMessage (Client net d err pending whoami) again = do
+handleMessage (Client net d err pending whoami responseID) again = do
   awaitMessage net >>= \case
     Just (Left e)              -> do reportParseError err e
                                      again
@@ -338,10 +341,11 @@ handleMessage (Client net d err pending whoami) again = do
             IsQuery meth tid -> case lookupHandler d meth of
                                 Nothing -> reportMissingHandler err meth addr plain
                                 Just m  -> do
-                                  (self,ctx) <- whoami
+                                  self <- whoami
+                                  tid' <- responseID tid
                                   either (reportParseError err)
                                          (>>= sendMessage net addr)
-                                         (dispatchQuery m ctx tid self plain addr)
+                                         (dispatchQuery m tid' self plain addr)
             IsResponse tid -> do
                 action <- atomically $ do
                     ts0 <- readTVar pending