Async search.

1 files changed, 4 insertions, 6 deletions

diff --git a/server/src/Network/QueryResponse.hs b/server/src/Network/QueryResponse.hs
index 4f14ea3c..94eb4796 100644
--- a/server/src/Network/QueryResponse.hs
+++ b/server/src/Network/QueryResponse.hs
@@ -332,9 +332,6 @@ data TransactionMethods d qid addr x = TransactionMethods
       -- will write the packet to the correct 'MVar' thus completing the
       -- dispatch.
     , dispatchResponse :: qid -> Result x -> d -> STM (d, IO ())
-      -- | When a timeout interval elapses, this method is called to remove the
-      -- transaction from the table.
-    , dispatchCancel :: qid -> d -> STM d
     }
 
 -- | A set of methods necessary for dispatching incoming packets.
@@ -429,7 +426,9 @@ asyncQuery c@(Client net d err pending whoami _) meth q addr0 withResponse = do
     tm_key <- registerTimeout tm expiry $ do
         atomically $ do
             tbl <- readTVar pending
-            v <- dispatchCancel (tableMethods d) qid tbl
+            -- Below, we discard the returned IO action since we will call
+            -- withResponse directly later.
+            (v,_) <- dispatchResponse (tableMethods d) qid TimedOut tbl
             writeTVar pending v
         m <- takeMVar keyvar
         forM_ m $ \_ -> withResponse qid TimedOut
@@ -505,8 +504,7 @@ transactionMethods' ::
     -> (g -> (qid,g))                    -- ^ Generate a new unique /tid/ value and update the generator state /g/.
     -> TransactionMethods (g,t a) qid addr x
 transactionMethods' store load (TableMethods insert delete lookup) generate = TransactionMethods
-    { dispatchCancel = \tid (g,t) -> return (g, delete tid t)
-    , dispatchRegister = \nowPlusExpiry v a (g,t) -> do
+    { dispatchRegister = \nowPlusExpiry v a (g,t) -> do
         let (tid,g') = generate g
         let t' = insert tid (store v) nowPlusExpiry t -- (now + microsecondsDiff expiry) t
         return ( tid, (g',t') )