From f5de7601bbef988d82e756d42e3f2197f2646325 Mon Sep 17 00:00:00 2001
From: Trolli Schmittlauch <t.schmittlauch@orlives.de>
Date: Wed, 16 Sep 2020 13:49:26 +0200
Subject: [PATCH] do not store published posts for reducing memory consumption

---
 src/Hash2Pub/PostService.hs | 36 +++++++++++++++---------------------
 1 file changed, 15 insertions(+), 21 deletions(-)

diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs
index bd83506..75bdd33 100644
--- a/src/Hash2Pub/PostService.hs
+++ b/src/Hash2Pub/PostService.hs
@@ -57,7 +57,7 @@ data PostService d = PostService
     -- ^ for each tag store the subscribers + their queue
     , ownSubscriptions     :: TVar (HMap.HashMap NodeID POSIXTime)
     -- ^ tags subscribed by the own node have an assigned lease time
-    , ownPosts             :: TVar (HSet.HashSet Text)
+    --, ownPosts             :: TVar (HSet.HashSet Text)
     -- ^ just store the existence of posts for saving memory,
     , relayInQueue         :: TQueue (Hashtag, PostID, PostContent)
     -- ^ Queue for processing incoming posts of own instance asynchronously
@@ -92,7 +92,7 @@ instance DHT d => Service PostService d where
         threadVar <- newTVarIO =<< myThreadId -- own thread ID as placeholder
         subscriberVar <- newTVarIO emptyRMap
         ownSubsVar <- newTVarIO HMap.empty
-        ownPostVar <- newTVarIO HSet.empty
+        --ownPostVar <- newTVarIO HSet.empty
         relayInQueue' <- newTQueueIO
         postFetchQueue' <- newTQueueIO
         migrationsInProgress' <- newTVarIO HMap.empty
@@ -108,7 +108,7 @@ instance DHT d => Service PostService d where
               , serviceThread = threadVar
               , subscribers = subscriberVar
               , ownSubscriptions = ownSubsVar
-              , ownPosts = ownPostVar
+              --, ownPosts = ownPostVar
               , relayInQueue = relayInQueue'
               , postFetchQueue = postFetchQueue'
               , migrationsInProgress = migrationsInProgress'
@@ -258,28 +258,23 @@ subscriptionDelivery serv senderID subList = do
 
 -- | endpoint for fetching a post by its ID
 postFetch :: PostService d -> Text -> Handler Text
-postFetch serv postID = do
-    postSet <- liftIO . readTVarIO . ownPosts $ serv
-    if HSet.member postID postSet
-       -- decision: always return the same placeholder post
-       then do
-           liftIO . atomically . writeTQueue (statsQueue serv) $ StatsEvent IncomingPostFetchEvent 1 0  -- tag fetched for is irrelevant
-           pure placeholderPost
-       else throwError $ err404 { errBody = "No post found with this ID" }
+postFetch serv _ = do
+    -- decision: for saving memory do not store published posts, just
+    -- pretend there is a post for each requested ID
+    liftIO . atomically . writeTQueue (statsQueue serv) $ StatsEvent IncomingPostFetchEvent 1 0  -- tag fetched for is irrelevant
+    pure placeholderPost
 
 
 -- | endpoint for fetching multiple posts of this instance by their IDs
 postMultiFetch :: PostService d -> Text -> Handler Text
 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
-    response <- foldM (\response postID ->
-        if HSet.member postID postSet
-           then pure $ placeholderPost <> "\n" <> response
-           else throwError $ err404 { errBody = "No post found with this ID" }
+    let
+        idList = Txt.lines postIDs
+        -- decision: for saving memory do not store published posts, just
+        -- pretend there is a post for each requested ID
+        response = foldl (\response' _ ->
+           placeholderPost <> "\n" <> response'
           ) "" idList
-    -- this shouldn't be reached in case of error
     liftIO . atomically . writeTQueue (statsQueue serv) $ StatsEvent IncomingPostFetchEvent (length idList) 0  -- tag fetched for is irrelevant
     pure response
 
@@ -292,8 +287,7 @@ postInbox serv post = do
         containedTags = fmap (normaliseTag . Txt.tail) . filter ((==) '#' . Txt.head) . Txt.words $ post
     -- generate post ID
     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)
+    -- decision: for saving memory do not store published post IDs, just deliver a post for any requested ID
     -- enqueue a relay job for each tag
     liftIO $ forM_ (containedTags :: [Text]) (\tag ->
         atomically $ writeTQueue (relayInQueue serv) (tag, postId,  post)