From b8cedada4892a6abbea5b31e2599e80d26220118 Mon Sep 17 00:00:00 2001
From: Trolli Schmittlauch <t.schmittlauch@orlives.de>
Date: Mon, 17 Aug 2020 11:37:04 +0200
Subject: [PATCH] prevent threads not awaiting migration from blocking their
 response

---
 src/Hash2Pub/PostService.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs
index c277327..a871343 100644
--- a/src/Hash2Pub/PostService.hs
+++ b/src/Hash2Pub/PostService.hs
@@ -232,10 +232,12 @@ subscriptionDelivery serv senderID subList = do
                           :: STM (Either String ()))
     -- TODO: should this always signal migration finished to avoid deadlocksP
     liftIO $ putMVar syncMVar ()    -- wakes up waiting thread
-    liftIO $ putMVar syncMVar ()    -- blocks until waiting thread has resumed
-    -- delete this migration from ongoing ones
-    liftIO . atomically $ modifyTVar' (migrationsInProgress serv) $
-        HMap.delete (fromInteger senderID)
+    -- allow response to be completed independently from waiting thread
+    _ <- liftIO . forkIO $ do
+        putMVar syncMVar ()    -- blocks until waiting thread has resumed
+        -- delete this migration from ongoing ones
+        liftIO . atomically $ modifyTVar' (migrationsInProgress serv) $
+            HMap.delete (fromInteger senderID)
     case res of
       Left err -> throwError err410 {errBody = BSUL.fromString err}
       Right _  -> pure ""