diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs index d56eb4c..838b2c8 100644 --- a/src/Hash2Pub/PostService.hs +++ b/src/Hash2Pub/PostService.hs @@ -251,8 +251,14 @@ tagSubscribe serv hashtag origin = do tagUnsubscribe :: PostService d -> Txt.Text -> Maybe Txt.Text -> Handler Txt.Text -tagUnsubscribe serv hashtag origin = pure $ "Here be a dragon unsubscription from " <> fromMaybe "Nothing" origin <> " to " <> hashtag - +tagUnsubscribe serv hashtag origin = do + originURL <- maybe + (throwError $ err400 { errBody = "Missing Origin header" }) + pure + origin + req <- HTTP.parseUrlThrow (Txt.unpack originURL) + liftIO . atomically $ deleteSubscription (subscribers serv) hashtag (BSU.toString $ HTTP.host req, HTTP.port req) + pure "bye bye" -- ======= data structure manipulations ========= @@ -297,6 +303,25 @@ setupSubscriberChannel tagMapSTM tag subscriber leaseTime = do Just (tagOutChan, _) -> pure tagOutChan +-- | deletes a subscription from the passed subscriber map +deleteSubscription :: TVar RelayTags -> Hashtag -> (String, Int) -> STM () +deleteSubscription tagMapSTM tag subscriber = do + tagMap <- readTVar tagMapSTM + case lookupTagSubscriptions tag tagMap of + -- no subscribers to that tag, just return + Nothing -> pure () + Just (foundSubMapSTM, _, _) -> do + foundSubMap <- readTVar foundSubMapSTM + let newSubMap = HMap.delete subscriber foundSubMap + -- if there are no subscriptions for the tag anymore, remove its + -- data sttructure altogether + if HMap.null newSubMap + then writeTVar tagMapSTM $ deleteRMapEntry (genKeyID . Txt.unpack $ tag) tagMap + -- otherwise just remove the subscription of that node + else writeTVar foundSubMapSTM newSubMap + + + -- | returns the broadcast channel of a hashtag if there are any subscribers to it getTagBroadcastChannel :: PostService d -> Hashtag -> STM (Maybe (TChan PostID)) getTagBroadcastChannel serv tag = do