server endpoint for tag unsubscription

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