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

annotate the PostService server/ request-handler functions

Browse source
This commit is contained in:
Trolli Schmittlauch 2020-09-09 18:01:51 +02:00
parent 72eca0f4fe
commit 12fcd13754
1 changed files with 9 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
src/Hash2Pub/PostService.hs
View file

@ -167,6 +167,7 @@ postServer service = relayInbox service
:<|> tagUnsubscribe service :<|> tagUnsubscribe service
-- | delivery endpoint: receive posts of a handled tag and enqueue them for relaying
relayInbox :: DHT d => PostService d -> Hashtag -> Text -> Handler NoContent relayInbox :: DHT d => PostService d -> Hashtag -> Text -> Handler NoContent
relayInbox serv tag posts = do relayInbox serv tag posts = do
let let
@ -195,6 +196,7 @@ newtype UnhandledTagException = UnhandledTagException String
instance Exception UnhandledTagException instance Exception UnhandledTagException
-- | delivery endpoint: receives a list of subscribers of tags and their outstanding queues for migration
subscriptionDelivery :: DHT d => PostService d -> Integer -> Text -> Handler Text subscriptionDelivery :: DHT d => PostService d -> Integer -> Text -> Handler Text
subscriptionDelivery serv senderID subList = do subscriptionDelivery serv senderID subList = do
let let
@ -240,6 +242,7 @@ subscriptionDelivery serv senderID subList = do
enqueueSubscription subscriberSTM (normaliseTag tag) sub postList leaseTime enqueueSubscription subscriberSTM (normaliseTag tag) sub postList leaseTime
-- | 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 postID = do
postSet <- liftIO . readTVarIO . ownPosts $ serv postSet <- liftIO . readTVarIO . ownPosts $ serv
@ -249,6 +252,7 @@ postFetch serv postID = do
else throwError $ err404 { errBody = "No post found with this ID" } else throwError $ err404 { errBody = "No post found with this ID" }
-- | 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 idList = Txt.lines postIDs
@ -261,6 +265,7 @@ postMultiFetch serv postIDs = do
) "" idList ) "" idList
-- | delivery endpoint: inbox for initially publishing a post at an instance
postInbox :: PostService d -> Text -> Handler NoContent postInbox :: PostService d -> Text -> Handler NoContent
postInbox serv post = do postInbox serv post = do
-- extract contained hashtags -- extract contained hashtags
@ -277,6 +282,7 @@ postInbox serv post = do
pure NoContent pure NoContent
-- | delivery endpoint: receive postIDs of a certain subscribed hashtag
tagDelivery :: PostService d -> Text -> Text -> Handler Text tagDelivery :: PostService d -> Text -> Text -> Handler Text
tagDelivery serv hashtag posts = do tagDelivery serv hashtag posts = do
let postIDs = Txt.lines posts let postIDs = Txt.lines posts
@ -288,6 +294,8 @@ tagDelivery serv hashtag posts = do
pure () pure ()
pure $ "Received a postID for tag " <> hashtag pure $ "Received a postID for tag " <> hashtag
-- | receive subscription requests to a handled hashtag
tagSubscribe :: DHT d => PostService d -> Text -> Maybe Text -> Handler Integer tagSubscribe :: DHT d => PostService d -> Text -> Maybe Text -> Handler Integer
tagSubscribe serv hashtag origin = do tagSubscribe serv hashtag origin = do
responsible <- liftIO $ isResponsibleFor (baseDHT serv) (hashtagToId hashtag) responsible <- liftIO $ isResponsibleFor (baseDHT serv) (hashtagToId hashtag)
@ -307,6 +315,7 @@ tagSubscribe serv hashtag origin = do
pure $ round leaseTime pure $ round leaseTime
-- | receive and handle unsubscription requests regarding a handled tag
tagUnsubscribe :: DHT d => PostService d -> Text -> Maybe Text -> Handler Text tagUnsubscribe :: DHT d => PostService d -> Text -> Maybe Text -> Handler Text
tagUnsubscribe serv hashtag origin = do tagUnsubscribe serv hashtag origin = do
responsible <- liftIO $ isResponsibleFor (baseDHT serv) (hashtagToId hashtag) responsible <- liftIO $ isResponsibleFor (baseDHT serv) (hashtagToId hashtag)