{-| Module : Gargantext.Core.Notifications.Dispatcher.Subscriptions Description : Dispatcher (manage websocket subscriptions) Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/341 Docs: https://dev.sub.gargantext.org/#/share/Notes/187918 -} module Gargantext.Core.Notifications.Dispatcher.Subscriptions where import DeferredFolds.UnfoldlM qualified as UnfoldlM import Gargantext.Core.Notifications.Dispatcher.Types import Gargantext.Prelude import StmContainers.Set as SSet -- | TODO Allow only 1 topic subscription per connection. It doesn't -- | make sense to send multiple notifications of the same type to the -- | same connection. insertSubscription :: SSet.Set Subscription -> Subscription -> IO () insertSubscription subscriptions sub = do atomically $ SSet.insert sub subscriptions -- s <- readTVar subscriptions -- let ss = nubBy eqSub $ s <> [sub] -- writeTVar subscriptions ss -- -- pure ss -- pure () removeSubscription :: SSet.Set Subscription -> Subscription -> IO () removeSubscription subscriptions sub = do atomically $ SSet.delete sub subscriptions -- s <- readTVar subscriptions -- let ss = filter (\sub' -> not $ sub `eqSub` sub') s -- writeTVar subscriptions ss -- pure ss removeSubscriptionsForWSKey :: SSet.Set Subscription -> WSKeyConnection -> IO () removeSubscriptionsForWSKey subscriptions ws = do atomically $ do let toDelete = UnfoldlM.filter (\sub -> return $ subKey sub == wsKey ws) $ SSet.unfoldlM subscriptions UnfoldlM.mapM_ (\sub -> SSet.delete sub subscriptions) toDelete -- atomically $ do -- s <- readTVar subscriptions -- let ss = filter (\sub -> subKey sub /= wsKey ws) s -- writeTVar subscriptions ss -- pure ss