schmittlauch/Hash2Pub
1
0
Fork 1
Code Issues 47 Pull requests Releases Wiki Activity

implement multiple post fetch (with placeholder content)

Browse source
This commit is contained in:
Trolli Schmittlauch 2020-07-29 00:06:16 +02:00
parent 63bc06a88e
commit bd70e2dff0
1 changed files with 12 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
src/Hash2Pub/PostService.hs
View file

@ -14,7 +14,7 @@ import Control.Concurrent.STM
import Control.Concurrent.STM.TChan import Control.Concurrent.STM.TChan
import Control.Concurrent.STM.TQueue import Control.Concurrent.STM.TQueue
import Control.Concurrent.STM.TVar import Control.Concurrent.STM.TVar
import Control.Monad (forM_, forever) import Control.Monad (foldM, forM_, forever)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString.Lazy.UTF8 as BSU import qualified Data.ByteString.Lazy.UTF8 as BSU
import qualified Data.HashMap.Strict as HMap import qualified Data.HashMap.Strict as HMap
@ -150,7 +150,7 @@ relayInbox serv post = do
let let
containedTags = fmap (normaliseTag . Txt.tail) . filter ((==) '#' . Txt.head) . Txt.words $ post containedTags = fmap (normaliseTag . Txt.tail) . filter ((==) '#' . Txt.head) . Txt.words $ post
-- generate post ID -- 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 -- add ID to own posts
liftIO . atomically $ modifyTVar' (ownPosts serv) (HSet.insert postId) liftIO . atomically $ modifyTVar' (ownPosts serv) (HSet.insert postId)
-- enqueue a relay job for each tag -- enqueue a relay job for each tag
@ -186,9 +186,17 @@ postFetch serv postID = do
then pure placeholderPost then pure placeholderPost
else throwError $ err404 { errBody = "No post found with this ID" } else throwError $ err404 { errBody = "No post found with this ID" }
postMultiFetch :: PostService d -> Txt.Text -> Handler Txt.Text postMultiFetch :: PostService d -> Txt.Text -> Handler Txt.Text
postMultiFetch serv postIDs = pure $ "Here be multiple post dragons: " postMultiFetch serv postIDs = do
<> (Txt.unwords . Txt.lines $ postIDs) 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 :: PostService d -> Txt.Text -> Txt.Text -> Handler Txt.Text
tagDelivery serv hashtag posts = pure $ "Here be #" <> hashtag <> " dragons with " <> posts tagDelivery serv hashtag posts = pure $ "Here be #" <> hashtag <> " dragons with " <> posts