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

do not store published posts for reducing memory consumption

Browse source
This commit is contained in:
Trolli Schmittlauch 2020-09-16 13:49:26 +02:00
parent a2f268d374
commit f5de7601bb
1 changed files with 15 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
src/Hash2Pub/PostService.hs
View file

@ -57,7 +57,7 @@ data PostService d = PostService
-- ^ for each tag store the subscribers + their queue -- ^ for each tag store the subscribers + their queue
, ownSubscriptions :: TVar (HMap.HashMap NodeID POSIXTime) , ownSubscriptions :: TVar (HMap.HashMap NodeID POSIXTime)
-- ^ tags subscribed by the own node have an assigned lease time -- ^ 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, -- ^ just store the existence of posts for saving memory,
, relayInQueue :: TQueue (Hashtag, PostID, PostContent) , relayInQueue :: TQueue (Hashtag, PostID, PostContent)
-- ^ Queue for processing incoming posts of own instance asynchronously -- ^ 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 threadVar <- newTVarIO =<< myThreadId -- own thread ID as placeholder
subscriberVar <- newTVarIO emptyRMap subscriberVar <- newTVarIO emptyRMap
ownSubsVar <- newTVarIO HMap.empty ownSubsVar <- newTVarIO HMap.empty
ownPostVar <- newTVarIO HSet.empty --ownPostVar <- newTVarIO HSet.empty
relayInQueue' <- newTQueueIO relayInQueue' <- newTQueueIO
postFetchQueue' <- newTQueueIO postFetchQueue' <- newTQueueIO
migrationsInProgress' <- newTVarIO HMap.empty migrationsInProgress' <- newTVarIO HMap.empty
@ -108,7 +108,7 @@ instance DHT d => Service PostService d where
, serviceThread = threadVar , serviceThread = threadVar
, subscribers = subscriberVar , subscribers = subscriberVar
, ownSubscriptions = ownSubsVar , ownSubscriptions = ownSubsVar
, ownPosts = ownPostVar --, ownPosts = ownPostVar
, relayInQueue = relayInQueue' , relayInQueue = relayInQueue'
, postFetchQueue = postFetchQueue' , postFetchQueue = postFetchQueue'
, migrationsInProgress = migrationsInProgress' , migrationsInProgress = migrationsInProgress'
@ -258,28 +258,23 @@ subscriptionDelivery serv senderID subList = do
-- | endpoint for fetching a post by its ID -- | endpoint for fetching a post by its ID
postFetch :: PostService d -> Text -> Handler Text postFetch :: PostService d -> Text -> Handler Text
postFetch serv postID = do postFetch serv _ = do
postSet <- liftIO . readTVarIO . ownPosts $ serv -- decision: for saving memory do not store published posts, just
if HSet.member postID postSet -- pretend there is a post for each requested ID
-- decision: always return the same placeholder post
then do
liftIO . atomically . writeTQueue (statsQueue serv) $ StatsEvent IncomingPostFetchEvent 1 0 -- tag fetched for is irrelevant liftIO . atomically . writeTQueue (statsQueue serv) $ StatsEvent IncomingPostFetchEvent 1 0 -- tag fetched for is irrelevant
pure placeholderPost pure placeholderPost
else throwError $ err404 { errBody = "No post found with this ID" }
-- | endpoint for fetching multiple posts of this instance by their IDs -- | endpoint for fetching multiple posts of this instance by their IDs
postMultiFetch :: PostService d -> Text -> Handler Text postMultiFetch :: PostService d -> Text -> Handler Text
postMultiFetch serv postIDs = do postMultiFetch serv postIDs = do
let idList = Txt.lines postIDs let
postSet <- liftIO . readTVarIO . ownPosts $ serv idList = Txt.lines postIDs
-- look up existence of all given post IDs, fail if even one is missing -- decision: for saving memory do not store published posts, just
response <- foldM (\response postID -> -- pretend there is a post for each requested ID
if HSet.member postID postSet response = foldl (\response' _ ->
then pure $ placeholderPost <> "\n" <> response placeholderPost <> "\n" <> response'
else throwError $ err404 { errBody = "No post found with this ID" }
) "" idList ) "" 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 liftIO . atomically . writeTQueue (statsQueue serv) $ StatsEvent IncomingPostFetchEvent (length idList) 0 -- tag fetched for is irrelevant
pure response pure response
@ -292,8 +287,7 @@ postInbox serv post = do
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::Integer)-1) :: IO Integer) postId <- liftIO $ Txt.pack . show <$> (randomRIO (0, 2^(128::Integer)-1) :: IO Integer)
-- add ID to own posts -- decision: for saving memory do not store published post IDs, just deliver a post for any requested ID
liftIO . atomically $ modifyTVar' (ownPosts serv) (HSet.insert postId)
-- enqueue a relay job for each tag -- enqueue a relay job for each tag
liftIO $ forM_ (containedTags :: [Text]) (\tag -> liftIO $ forM_ (containedTags :: [Text]) (\tag ->
atomically $ writeTQueue (relayInQueue serv) (tag, postId, post) atomically $ writeTQueue (relayInQueue serv) (tag, postId, post)