{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Subscriptions.ClientConnectionStore
  ( SessionID (..),
    ClientConnectionStore,
    ClientConnection,
    Updates (..),
    startSession,
    endSession,
    empty,
    insertConnection,
    delete,
    publish,
    toList,
    connectionSessionIds,
    storedChannels,
    storedSessions,
  )
where

import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.HashMap.Lazy as HM
import Data.Morpheus.App.Internal.Resolving
  ( EventHandler (..),
  )
import Data.Morpheus.Internal.Utils
  ( Empty (..),
    KeyOf (..),
  )
import Data.Morpheus.Subscriptions.Apollo
  ( toApolloResponse,
  )
import Data.Morpheus.Subscriptions.Event (Event (..))
import Data.Morpheus.Types.IO (GQLResponse)
import Data.UUID (UUID)
import Relude hiding
  ( ByteString,
    Show,
    empty,
    show,
    toList,
  )
import Prelude (Show (..))

data SessionID = SessionID
  { SessionID -> UUID
cid :: UUID,
    SessionID -> Text
sid :: Text
  }
  deriving (Int -> SessionID -> ShowS
[SessionID] -> ShowS
SessionID -> String
(Int -> SessionID -> ShowS)
-> (SessionID -> String)
-> ([SessionID] -> ShowS)
-> Show SessionID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SessionID] -> ShowS
$cshowList :: [SessionID] -> ShowS
show :: SessionID -> String
$cshow :: SessionID -> String
showsPrec :: Int -> SessionID -> ShowS
$cshowsPrec :: Int -> SessionID -> ShowS
Show, (forall x. SessionID -> Rep SessionID x)
-> (forall x. Rep SessionID x -> SessionID) -> Generic SessionID
forall x. Rep SessionID x -> SessionID
forall x. SessionID -> Rep SessionID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SessionID x -> SessionID
$cfrom :: forall x. SessionID -> Rep SessionID x
Generic, SessionID -> SessionID -> Bool
(SessionID -> SessionID -> Bool)
-> (SessionID -> SessionID -> Bool) -> Eq SessionID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionID -> SessionID -> Bool
$c/= :: SessionID -> SessionID -> Bool
== :: SessionID -> SessionID -> Bool
$c== :: SessionID -> SessionID -> Bool
Eq, Int -> SessionID -> Int
SessionID -> Int
(Int -> SessionID -> Int)
-> (SessionID -> Int) -> Hashable SessionID
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SessionID -> Int
$chash :: SessionID -> Int
hashWithSalt :: Int -> SessionID -> Int
$chashWithSalt :: Int -> SessionID -> Int
Hashable)

data ClientConnection (m :: Type -> Type) = ClientConnection
  { ClientConnection m -> UUID
connectionId :: UUID,
    ClientConnection m -> ByteString -> m ()
connectionCallback :: ByteString -> m (),
    -- one connection can have multiple subscription session
    ClientConnection m -> [Text]
connectionSessionIds :: [Text]
  }

addConnectionSession ::
  Text ->
  ClientConnection m ->
  ClientConnection m
addConnectionSession :: Text -> ClientConnection m -> ClientConnection m
addConnectionSession
  Text
sid
  ClientConnection {[Text]
UUID
ByteString -> m ()
connectionSessionIds :: [Text]
connectionCallback :: ByteString -> m ()
connectionId :: UUID
connectionCallback :: forall (m :: * -> *). ClientConnection m -> ByteString -> m ()
connectionId :: forall (m :: * -> *). ClientConnection m -> UUID
connectionSessionIds :: forall (m :: * -> *). ClientConnection m -> [Text]
..} = ClientConnection :: forall (m :: * -> *).
UUID -> (ByteString -> m ()) -> [Text] -> ClientConnection m
ClientConnection {connectionSessionIds :: [Text]
connectionSessionIds = [Text]
connectionSessionIds [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
sid], UUID
ByteString -> m ()
connectionCallback :: ByteString -> m ()
connectionId :: UUID
connectionCallback :: ByteString -> m ()
connectionId :: UUID
..}

data ClientSession e (m :: Type -> Type) = ClientSession
  { ClientSession e m -> Channel e
sessionChannel :: Channel e,
    ClientSession e m -> e -> m ByteString
sessionCallback :: e -> m ByteString
  }

instance Show (ClientSession e m) where
  show :: ClientSession e m -> String
show ClientSession {} = String
"ClientSession"

instance Show (ClientConnection m) where
  show :: ClientConnection m -> String
show ClientConnection {UUID
connectionId :: UUID
connectionId :: forall (m :: * -> *). ClientConnection m -> UUID
connectionId, [Text]
connectionSessionIds :: [Text]
connectionSessionIds :: forall (m :: * -> *). ClientConnection m -> [Text]
connectionSessionIds} =
    String
"ClientConnection { id = "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UUID -> String
forall a. Show a => a -> String
show UUID
connectionId
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", sessions = "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Text] -> String
forall a. Show a => a -> String
show [Text]
connectionSessionIds
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" }"

mapAt :: (Eq k, Hashable k) => c -> (a -> c) -> k -> HashMap k a -> c
mapAt :: c -> (a -> c) -> k -> HashMap k a -> c
mapAt c
fallback a -> c
f k
key = c -> (a -> c) -> Maybe a -> c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe c
fallback a -> c
f (Maybe a -> c) -> (HashMap k a -> Maybe a) -> HashMap k a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
key

publish ::
  ( Monad m,
    Eq channel,
    Hashable channel,
    Show channel
  ) =>
  Event channel content ->
  ClientConnectionStore (Event channel content) m ->
  m ()
publish :: Event channel content
-> ClientConnectionStore (Event channel content) m -> m ()
publish event :: Event channel content
event@Event {[channel]
channels :: forall ch con. Event ch con -> [ch]
channels :: [channel]
channels} ClientConnectionStore {HashMap channel [SessionID]
activeChannels :: forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap channel [SessionID]
activeChannels :: HashMap channel [SessionID]
activeChannels, HashMap UUID (ClientConnection m)
clientConnections :: forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap UUID (ClientConnection m)
clientConnections :: HashMap UUID (ClientConnection m)
clientConnections, HashMap SessionID (ClientSession (Event channel content) m)
clientSessions :: forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap SessionID (ClientSession (Event channel content) m)
clientSessions :: HashMap SessionID (ClientSession (Event channel content) m)
clientSessions} =
  (channel -> m ()) -> [channel] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ channel -> m ()
onChannel [channel]
[channel]
channels
  where
    onChannel :: channel -> m ()
onChannel channel
ch = m ()
-> ([SessionID] -> m ())
-> channel
-> HashMap channel [SessionID]
-> m ()
forall k c a.
(Eq k, Hashable k) =>
c -> (a -> c) -> k -> HashMap k a -> c
mapAt (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) [SessionID] -> m ()
sendBy channel
ch HashMap channel [SessionID]
activeChannels
    sendBy :: [SessionID] -> m ()
sendBy = (SessionID -> m ()) -> [SessionID] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ SessionID -> m ()
sendByChannel
    sendByChannel :: SessionID -> m ()
sendByChannel SessionID
sid = m ()
-> (ClientSession (Event channel content) m -> m ())
-> SessionID
-> HashMap SessionID (ClientSession (Event channel content) m)
-> m ()
forall k c a.
(Eq k, Hashable k) =>
c -> (a -> c) -> k -> HashMap k a -> c
mapAt (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ClientSession (Event channel content) m -> m ()
sendMessage SessionID
sid HashMap SessionID (ClientSession (Event channel content) m)
HashMap SessionID (ClientSession (Event channel content) m)
clientSessions
      where
        sendMessage :: ClientSession (Event channel content) m -> m ()
sendMessage ClientSession {Event channel content -> m ByteString
sessionCallback :: Event channel content -> m ByteString
sessionCallback :: forall e (m :: * -> *). ClientSession e m -> e -> m ByteString
sessionCallback} = Event channel content -> m ByteString
sessionCallback Event channel content
event m ByteString -> (ByteString -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> m ()
upd
        upd :: ByteString -> m ()
upd = (ByteString -> m ())
-> (ClientConnection m -> ByteString -> m ())
-> UUID
-> HashMap UUID (ClientConnection m)
-> ByteString
-> m ()
forall k c a.
(Eq k, Hashable k) =>
c -> (a -> c) -> k -> HashMap k a -> c
mapAt ByteString -> m ()
forall (f :: * -> *) p. Applicative f => p -> f ()
cantFindConnection ClientConnection m -> ByteString -> m ()
forall (m :: * -> *). ClientConnection m -> ByteString -> m ()
connectionCallback (SessionID -> UUID
cid SessionID
sid) HashMap UUID (ClientConnection m)
clientConnections
        cantFindConnection :: p -> f ()
cantFindConnection p
_ = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

newtype Updates e (m :: Type -> Type) = Updates
  { Updates e m
-> ClientConnectionStore e m -> ClientConnectionStore e m
_runUpdate :: ClientConnectionStore e m -> ClientConnectionStore e m
  }

endSession ::
  ( Eq ch,
    Hashable ch
  ) =>
  SessionID ->
  Updates (Event ch con) m
endSession :: SessionID -> Updates (Event ch con) m
endSession sessionId :: SessionID
sessionId@SessionID {Text
sid :: Text
sid :: SessionID -> Text
sid, UUID
cid :: UUID
cid :: SessionID -> UUID
cid} = (ClientConnectionStore (Event ch con) m
 -> ClientConnectionStore (Event ch con) m)
-> Updates (Event ch con) m
forall e (m :: * -> *).
(ClientConnectionStore e m -> ClientConnectionStore e m)
-> Updates e m
Updates ClientConnectionStore (Event ch con) m
-> ClientConnectionStore (Event ch con) m
forall ch con (m :: * -> *).
(Eq ch, Hashable ch) =>
ClientConnectionStore (Event ch con) m
-> ClientConnectionStore (Event ch con) m
endSub
  where
    endSub ::
      ( Eq ch,
        Hashable ch
      ) =>
      ClientConnectionStore (Event ch con) m ->
      ClientConnectionStore (Event ch con) m
    endSub :: ClientConnectionStore (Event ch con) m
-> ClientConnectionStore (Event ch con) m
endSub ClientConnectionStore {HashMap channel [SessionID]
HashMap UUID (ClientConnection m)
HashMap SessionID (ClientSession (Event channel content) m)
activeChannels :: HashMap channel [SessionID]
clientSessions :: HashMap SessionID (ClientSession (Event channel content) m)
clientConnections :: HashMap UUID (ClientConnection m)
clientSessions :: forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap SessionID (ClientSession (Event channel content) m)
clientConnections :: forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap UUID (ClientConnection m)
activeChannels :: forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap channel [SessionID]
..} =
      ClientConnectionStore :: forall (m :: * -> *) channel content.
HashMap UUID (ClientConnection m)
-> HashMap SessionID (ClientSession (Event channel content) m)
-> HashMap channel [SessionID]
-> ClientConnectionStore (Event channel content) m
ClientConnectionStore
        { clientConnections :: HashMap UUID (ClientConnection m)
clientConnections = (ClientConnection m -> ClientConnection m)
-> UUID
-> HashMap UUID (ClientConnection m)
-> HashMap UUID (ClientConnection m)
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HM.adjust (Text -> ClientConnection m -> ClientConnection m
forall (m :: * -> *).
Text -> ClientConnection m -> ClientConnection m
removeSessionId Text
sid) UUID
cid HashMap UUID (ClientConnection m)
clientConnections,
          clientSessions :: HashMap SessionID (ClientSession (Event ch con) m)
clientSessions = SessionID
-> HashMap SessionID (ClientSession (Event channel content) m)
-> HashMap SessionID (ClientSession (Event channel content) m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete SessionID
sessionId HashMap SessionID (ClientSession (Event channel content) m)
clientSessions,
          activeChannels :: HashMap ch [SessionID]
activeChannels = SessionID
-> HashMap channel [SessionID] -> HashMap channel [SessionID]
forall ch.
(Eq ch, Hashable ch) =>
SessionID -> HashMap ch [SessionID] -> HashMap ch [SessionID]
removeActiveChannel SessionID
sessionId HashMap channel [SessionID]
activeChannels
        }

removeSessionId :: Text -> ClientConnection m -> ClientConnection m
removeSessionId :: Text -> ClientConnection m -> ClientConnection m
removeSessionId Text
sid ClientConnection m
conn =
  ClientConnection m
conn
    { connectionSessionIds :: [Text]
connectionSessionIds = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
sid) (ClientConnection m -> [Text]
forall (m :: * -> *). ClientConnection m -> [Text]
connectionSessionIds ClientConnection m
conn)
    }

startSession ::
  ( Monad m,
    Eq (Channel e),
    Hashable (Channel e)
  ) =>
  Channel e ->
  (e -> m GQLResponse) ->
  SessionID ->
  Updates e m
startSession :: Channel e -> (e -> m GQLResponse) -> SessionID -> Updates e m
startSession Channel e
sessionChannel e -> m GQLResponse
resolver sessionId :: SessionID
sessionId@SessionID {UUID
cid :: UUID
cid :: SessionID -> UUID
cid, Text
sid :: Text
sid :: SessionID -> Text
sid} = (ClientConnectionStore e m -> ClientConnectionStore e m)
-> Updates e m
forall e (m :: * -> *).
(ClientConnectionStore e m -> ClientConnectionStore e m)
-> Updates e m
Updates ClientConnectionStore e m -> ClientConnectionStore e m
startSub
  where
    startSub :: ClientConnectionStore e m -> ClientConnectionStore e m
startSub ClientConnectionStore {HashMap channel [SessionID]
HashMap UUID (ClientConnection m)
HashMap SessionID (ClientSession (Event channel content) m)
activeChannels :: HashMap channel [SessionID]
clientSessions :: HashMap SessionID (ClientSession (Event channel content) m)
clientConnections :: HashMap UUID (ClientConnection m)
clientSessions :: forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap SessionID (ClientSession (Event channel content) m)
clientConnections :: forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap UUID (ClientConnection m)
activeChannels :: forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap channel [SessionID]
..} =
      ClientConnectionStore :: forall (m :: * -> *) channel content.
HashMap UUID (ClientConnection m)
-> HashMap SessionID (ClientSession (Event channel content) m)
-> HashMap channel [SessionID]
-> ClientConnectionStore (Event channel content) m
ClientConnectionStore
        { clientSessions :: HashMap SessionID (ClientSession (Event channel content) m)
clientSessions =
            SessionID
-> ClientSession e m
-> HashMap SessionID (ClientSession e m)
-> HashMap SessionID (ClientSession e m)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert
              SessionID
sessionId
              ClientSession :: forall e (m :: * -> *).
Channel e -> (e -> m ByteString) -> ClientSession e m
ClientSession
                { Channel e
sessionChannel :: Channel e
sessionChannel :: Channel e
sessionChannel,
                  sessionCallback :: e -> m ByteString
sessionCallback = (GQLResponse -> ByteString) -> m GQLResponse -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> GQLResponse -> ByteString
toApolloResponse Text
sid) (m GQLResponse -> m ByteString)
-> (e -> m GQLResponse) -> e -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m GQLResponse
resolver
                }
              HashMap SessionID (ClientSession e m)
HashMap SessionID (ClientSession (Event channel content) m)
clientSessions,
          clientConnections :: HashMap UUID (ClientConnection m)
clientConnections = (ClientConnection m -> ClientConnection m)
-> UUID
-> HashMap UUID (ClientConnection m)
-> HashMap UUID (ClientConnection m)
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HM.adjust (Text -> ClientConnection m -> ClientConnection m
forall (m :: * -> *).
Text -> ClientConnection m -> ClientConnection m
addConnectionSession Text
sid) UUID
cid HashMap UUID (ClientConnection m)
clientConnections,
          activeChannels :: HashMap channel [SessionID]
activeChannels = channel
-> SessionID
-> HashMap channel [SessionID]
-> HashMap channel [SessionID]
forall ch.
(Eq ch, Hashable ch) =>
ch -> SessionID -> HashMap ch [SessionID] -> HashMap ch [SessionID]
addActiveChannel channel
Channel e
sessionChannel SessionID
sessionId HashMap channel [SessionID]
activeChannels
        }

addActiveChannel ::
  (Eq ch, Hashable ch) =>
  ch ->
  SessionID ->
  HashMap ch [SessionID] ->
  HashMap ch [SessionID]
addActiveChannel :: ch -> SessionID -> HashMap ch [SessionID] -> HashMap ch [SessionID]
addActiveChannel ch
sessionChannel SessionID
sessionId = (Maybe [SessionID] -> Maybe [SessionID])
-> ch -> HashMap ch [SessionID] -> HashMap ch [SessionID]
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter Maybe [SessionID] -> Maybe [SessionID]
update ch
sessionChannel
  where
    update :: Maybe [SessionID] -> Maybe [SessionID]
update Maybe [SessionID]
Nothing = [SessionID] -> Maybe [SessionID]
forall a. a -> Maybe a
Just [SessionID
sessionId]
    update (Just [SessionID]
ids) = [SessionID] -> Maybe [SessionID]
forall a. a -> Maybe a
Just ([SessionID]
ids [SessionID] -> [SessionID] -> [SessionID]
forall a. Semigroup a => a -> a -> a
<> [SessionID
sessionId])

removeActiveChannel ::
  (Eq ch, Hashable ch) =>
  SessionID ->
  HashMap ch [SessionID] ->
  HashMap ch [SessionID]
removeActiveChannel :: SessionID -> HashMap ch [SessionID] -> HashMap ch [SessionID]
removeActiveChannel SessionID
sessionId = ([SessionID] -> [SessionID])
-> HashMap ch [SessionID] -> HashMap ch [SessionID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SessionID] -> [SessionID]
update
  where
    update :: [SessionID] -> [SessionID]
update = (SessionID -> Bool) -> [SessionID] -> [SessionID]
forall a. (a -> Bool) -> [a] -> [a]
filter (SessionID -> SessionID -> Bool
forall a. Eq a => a -> a -> Bool
/= SessionID
sessionId)

-- stores active client connections
-- every registered client has ID
-- when client connection is closed client(including all its subscriptions) can By removed By its ID
data ClientConnectionStore e (m :: Type -> Type) where
  ClientConnectionStore ::
    { ClientConnectionStore (Event channel content) m
-> HashMap UUID (ClientConnection m)
clientConnections :: HashMap UUID (ClientConnection m),
      ClientConnectionStore (Event channel content) m
-> HashMap SessionID (ClientSession (Event channel content) m)
clientSessions :: HashMap SessionID (ClientSession (Event channel content) m),
      ClientConnectionStore (Event channel content) m
-> HashMap channel [SessionID]
activeChannels :: HashMap channel [SessionID]
    } ->
    ClientConnectionStore (Event channel content) m

deriving instance
  Show e =>
  Show (ClientConnectionStore (Event e c) m)

type StoreMap e m =
  ClientConnectionStore e m ->
  ClientConnectionStore e m

toList :: ClientConnectionStore (Event channel content) m -> [(UUID, ClientConnection m)]
toList :: ClientConnectionStore (Event channel content) m
-> [(UUID, ClientConnection m)]
toList = HashMap UUID (ClientConnection m) -> [(UUID, ClientConnection m)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap UUID (ClientConnection m) -> [(UUID, ClientConnection m)])
-> (ClientConnectionStore (Event channel content) m
    -> HashMap UUID (ClientConnection m))
-> ClientConnectionStore (Event channel content) m
-> [(UUID, ClientConnection m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientConnectionStore (Event channel content) m
-> HashMap UUID (ClientConnection m)
forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap UUID (ClientConnection m)
clientConnections

storedSessions :: ClientConnectionStore (Event channel content) m -> [(SessionID, ClientSession (Event channel content) m)]
storedSessions :: ClientConnectionStore (Event channel content) m
-> [(SessionID, ClientSession (Event channel content) m)]
storedSessions = HashMap SessionID (ClientSession (Event channel content) m)
-> [(SessionID, ClientSession (Event channel content) m)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap SessionID (ClientSession (Event channel content) m)
 -> [(SessionID, ClientSession (Event channel content) m)])
-> (ClientConnectionStore (Event channel content) m
    -> HashMap SessionID (ClientSession (Event channel content) m))
-> ClientConnectionStore (Event channel content) m
-> [(SessionID, ClientSession (Event channel content) m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientConnectionStore (Event channel content) m
-> HashMap SessionID (ClientSession (Event channel content) m)
forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap SessionID (ClientSession (Event channel content) m)
clientSessions

storedChannels :: ClientConnectionStore (Event channel content) m -> [(channel, [SessionID])]
storedChannels :: ClientConnectionStore (Event channel content) m
-> [(channel, [SessionID])]
storedChannels = HashMap channel [SessionID] -> [(channel, [SessionID])]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap channel [SessionID] -> [(channel, [SessionID])])
-> (ClientConnectionStore (Event channel content) m
    -> HashMap channel [SessionID])
-> ClientConnectionStore (Event channel content) m
-> [(channel, [SessionID])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientConnectionStore (Event channel content) m
-> HashMap channel [SessionID]
forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap channel [SessionID]
activeChannels

instance KeyOf UUID (ClientConnection m) where
  keyOf :: ClientConnection m -> UUID
keyOf = ClientConnection m -> UUID
forall (m :: * -> *). ClientConnection m -> UUID
connectionId

instance Empty (ClientConnectionStore (Event ch con) m) where
  empty :: ClientConnectionStore (Event ch con) m
empty = HashMap UUID (ClientConnection m)
-> HashMap SessionID (ClientSession (Event ch con) m)
-> HashMap ch [SessionID]
-> ClientConnectionStore (Event ch con) m
forall (m :: * -> *) channel content.
HashMap UUID (ClientConnection m)
-> HashMap SessionID (ClientSession (Event channel content) m)
-> HashMap channel [SessionID]
-> ClientConnectionStore (Event channel content) m
ClientConnectionStore HashMap UUID (ClientConnection m)
forall coll. Empty coll => coll
empty HashMap SessionID (ClientSession (Event ch con) m)
forall k v. HashMap k v
HM.empty HashMap ch [SessionID]
forall k v. HashMap k v
HM.empty

mapConnections ::
  ( HashMap UUID (ClientConnection m) -> HashMap UUID (ClientConnection m)
  ) ->
  ClientConnectionStore e m ->
  ClientConnectionStore e m
mapConnections :: (HashMap UUID (ClientConnection m)
 -> HashMap UUID (ClientConnection m))
-> ClientConnectionStore e m -> ClientConnectionStore e m
mapConnections HashMap UUID (ClientConnection m)
-> HashMap UUID (ClientConnection m)
f ClientConnectionStore {HashMap channel [SessionID]
HashMap UUID (ClientConnection m)
HashMap SessionID (ClientSession (Event channel content) m)
activeChannels :: HashMap channel [SessionID]
clientSessions :: HashMap SessionID (ClientSession (Event channel content) m)
clientConnections :: HashMap UUID (ClientConnection m)
clientSessions :: forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap SessionID (ClientSession (Event channel content) m)
clientConnections :: forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap UUID (ClientConnection m)
activeChannels :: forall channel content (m :: * -> *).
ClientConnectionStore (Event channel content) m
-> HashMap channel [SessionID]
..} =
  ClientConnectionStore :: forall (m :: * -> *) channel content.
HashMap UUID (ClientConnection m)
-> HashMap SessionID (ClientSession (Event channel content) m)
-> HashMap channel [SessionID]
-> ClientConnectionStore (Event channel content) m
ClientConnectionStore
    { clientConnections :: HashMap UUID (ClientConnection m)
clientConnections = HashMap UUID (ClientConnection m)
-> HashMap UUID (ClientConnection m)
f HashMap UUID (ClientConnection m)
clientConnections,
      HashMap channel [SessionID]
HashMap SessionID (ClientSession (Event channel content) m)
activeChannels :: HashMap channel [SessionID]
clientSessions :: HashMap SessionID (ClientSession (Event channel content) m)
clientSessions :: HashMap SessionID (ClientSession (Event channel content) m)
activeChannels :: HashMap channel [SessionID]
..
    }

-- returns original store, if connection with same id already exist
insertConnection ::
  UUID ->
  (ByteString -> m ()) ->
  StoreMap e m
insertConnection :: UUID -> (ByteString -> m ()) -> StoreMap e m
insertConnection UUID
connectionId ByteString -> m ()
connectionCallback =
  (HashMap UUID (ClientConnection m)
 -> HashMap UUID (ClientConnection m))
-> StoreMap e m
forall (m :: * -> *) e.
(HashMap UUID (ClientConnection m)
 -> HashMap UUID (ClientConnection m))
-> ClientConnectionStore e m -> ClientConnectionStore e m
mapConnections ((ClientConnection m -> ClientConnection m -> ClientConnection m)
-> UUID
-> ClientConnection m
-> HashMap UUID (ClientConnection m)
-> HashMap UUID (ClientConnection m)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith ((ClientConnection m -> ClientConnection m)
-> ClientConnection m -> ClientConnection m -> ClientConnection m
forall a b. a -> b -> a
const ClientConnection m -> ClientConnection m
forall a. a -> a
id) UUID
connectionId ClientConnection m
c)
  where
    c :: ClientConnection m
c =
      ClientConnection :: forall (m :: * -> *).
UUID -> (ByteString -> m ()) -> [Text] -> ClientConnection m
ClientConnection
        { UUID
connectionId :: UUID
connectionId :: UUID
connectionId,
          ByteString -> m ()
connectionCallback :: ByteString -> m ()
connectionCallback :: ByteString -> m ()
connectionCallback,
          connectionSessionIds :: [Text]
connectionSessionIds = [Text]
forall coll. Empty coll => coll
empty
        }

delete ::
  UUID ->
  StoreMap e m
delete :: UUID -> StoreMap e m
delete UUID
key = (HashMap UUID (ClientConnection m)
 -> HashMap UUID (ClientConnection m))
-> StoreMap e m
forall (m :: * -> *) e.
(HashMap UUID (ClientConnection m)
 -> HashMap UUID (ClientConnection m))
-> ClientConnectionStore e m -> ClientConnectionStore e m
mapConnections (UUID
-> HashMap UUID (ClientConnection m)
-> HashMap UUID (ClientConnection m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete UUID
key)