From bd70e2dff02ea98b7d892d3a97d92f6df84fd4fe Mon Sep 17 00:00:00 2001
From: Trolli Schmittlauch <t.schmittlauch@orlives.de>
Date: Wed, 29 Jul 2020 00:06:16 +0200
Subject: [PATCH] implement multiple post fetch (with placeholder content)

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

diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs
index ef22e29..169d2b7 100644
--- a/src/Hash2Pub/PostService.hs
+++ b/src/Hash2Pub/PostService.hs
@@ -14,7 +14,7 @@ import           Control.Concurrent.STM
 import           Control.Concurrent.STM.TChan
 import           Control.Concurrent.STM.TQueue
 import           Control.Concurrent.STM.TVar
-import           Control.Monad                 (forM_, forever)
+import           Control.Monad                 (foldM, forM_, forever)
 import           Control.Monad.IO.Class        (liftIO)
 import qualified Data.ByteString.Lazy.UTF8     as BSU
 import qualified Data.HashMap.Strict           as HMap
@@ -150,7 +150,7 @@ relayInbox serv post = do
     let
         containedTags = fmap (normaliseTag . Txt.tail) . filter ((==) '#' . Txt.head) . Txt.words $ post
     -- generate post ID
-    postId <- liftIO $ Txt.pack . show <$> (randomRIO (0, 2^128-1) :: IO Integer)
+    postId <- liftIO $ Txt.pack . show <$> (randomRIO (0, 2^(128::Integer)-1) :: IO Integer)
     -- add ID to own posts
     liftIO . atomically $ modifyTVar' (ownPosts serv) (HSet.insert postId)
     -- enqueue a relay job for each tag
@@ -186,9 +186,17 @@ postFetch serv postID = do
        then pure placeholderPost
        else throwError $ err404 { errBody = "No post found with this ID" }
 
+
 postMultiFetch :: PostService d -> Txt.Text -> Handler Txt.Text
-postMultiFetch serv postIDs = pure $ "Here be multiple post dragons: "
-                      <> (Txt.unwords . Txt.lines $ postIDs)
+postMultiFetch serv postIDs = do
+    let idList = Txt.lines postIDs
+    postSet <- liftIO . readTVarIO . ownPosts $ serv
+    -- look up existence of all given post IDs, fail if even one is missing
+    foldM (\response postID ->
+        if HSet.member postID postSet
+           then pure $ placeholderPost <> "\n" <> response
+           else throwError $ err404 { errBody = "No post found with this ID" }
+          ) "" idList
 
 tagDelivery :: PostService d -> Txt.Text -> Txt.Text -> Handler Txt.Text
 tagDelivery serv hashtag posts = pure $ "Here be #" <> hashtag <> " dragons with " <> posts