module Galley.Cassandra.Client
( interpretClientStoreToCassandra,
lookupClients,
)
where
import Cassandra
import Control.Arrow
import Control.Lens
import Data.Id
import Data.List.Split (chunksOf)
import Galley.Cassandra.Queries qualified as Cql
import Galley.Cassandra.Store
import Galley.Cassandra.Util
import Galley.Effects.ClientStore (ClientStore (..))
import Galley.Env
import Galley.Monad
import Galley.Options
import Galley.Types.Clients (Clients)
import Galley.Types.Clients qualified as Clients
import Imports
import Polysemy
import Polysemy.Input
import Polysemy.TinyLog
import UnliftIO qualified
updateClient :: Bool -> UserId -> ClientId -> Client ()
updateClient :: Bool -> UserId -> ClientId -> Client ()
updateClient Bool
add UserId
usr ClientId
cls = do
let q :: ClientId -> QueryString W (Identity UserId) ()
q = if Bool
add then ClientId -> QueryString W (Identity UserId) ()
Cql.upsertMemberAddClient else ClientId -> QueryString W (Identity UserId) ()
Cql.upsertMemberRmClient
RetrySettings -> Client () -> Client ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (Client () -> Client ()) -> Client () -> Client ()
forall a b. (a -> b) -> a -> b
$ QueryString W (Identity UserId) ()
-> QueryParams (Identity UserId) -> Client ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write (ClientId -> QueryString W (Identity UserId) ()
q ClientId
cls) (Consistency -> Identity UserId -> QueryParams (Identity UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (UserId -> Identity UserId
forall a. a -> Identity a
Identity UserId
usr))
lookupClients :: [UserId] -> Client Clients
lookupClients :: [UserId] -> Client Clients
lookupClients [UserId]
users =
[(UserId, [ClientId])] -> Clients
Clients.fromList ([(UserId, [ClientId])] -> Clients)
-> ([[[(UserId, [ClientId])]]] -> [(UserId, [ClientId])])
-> [[[(UserId, [ClientId])]]]
-> Clients
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(UserId, [ClientId])]] -> [(UserId, [ClientId])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(UserId, [ClientId])]] -> [(UserId, [ClientId])])
-> ([[[(UserId, [ClientId])]]] -> [[(UserId, [ClientId])]])
-> [[[(UserId, [ClientId])]]]
-> [(UserId, [ClientId])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[(UserId, [ClientId])]]] -> [[(UserId, [ClientId])]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
([[[(UserId, [ClientId])]]] -> Clients)
-> Client [[[(UserId, [ClientId])]]] -> Client Clients
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[UserId]]
-> ([UserId] -> Client [[(UserId, [ClientId])]])
-> Client [[[(UserId, [ClientId])]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Int -> [UserId] -> [[UserId]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
2048 [UserId]
users) (([UserId] -> Client [(UserId, [ClientId])])
-> [[UserId]] -> Client [[(UserId, [ClientId])]]
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
(a -> m b) -> t a -> m (t b)
UnliftIO.mapConcurrently [UserId] -> Client [(UserId, [ClientId])]
forall {f :: * -> *}.
MonadClient f =>
[UserId] -> f [(UserId, [ClientId])]
getClients ([[UserId]] -> Client [[(UserId, [ClientId])]])
-> ([UserId] -> [[UserId]])
-> [UserId]
-> Client [[(UserId, [ClientId])]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [UserId] -> [[UserId]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
128)
where
getClients :: [UserId] -> f [(UserId, [ClientId])]
getClients [UserId]
us =
((UserId, Set ClientId) -> (UserId, [ClientId]))
-> [(UserId, Set ClientId)] -> [(UserId, [ClientId])]
forall a b. (a -> b) -> [a] -> [b]
map ((Set ClientId -> [ClientId])
-> (UserId, Set ClientId) -> (UserId, [ClientId])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Set ClientId -> [ClientId]
forall a. Set a -> [a]
fromSet)
([(UserId, Set ClientId)] -> [(UserId, [ClientId])])
-> f [(UserId, Set ClientId)] -> f [(UserId, [ClientId])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RetrySettings
-> f [(UserId, Set ClientId)] -> f [(UserId, Set ClientId)]
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Identity [UserId]) (UserId, Set ClientId)
-> QueryParams (Identity [UserId]) -> f [(UserId, Set ClientId)]
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m [b]
query PrepQuery R (Identity [UserId]) (UserId, Set ClientId)
Cql.selectClients (Consistency -> Identity [UserId] -> QueryParams (Identity [UserId])
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum ([UserId] -> Identity [UserId]
forall a. a -> Identity a
Identity [UserId]
us)))
eraseClients :: UserId -> Client ()
eraseClients :: UserId -> Client ()
eraseClients UserId
user = RetrySettings -> Client () -> Client ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (PrepQuery W (Identity UserId) ()
-> QueryParams (Identity UserId) -> Client ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity UserId) ()
Cql.rmClients (Consistency -> Identity UserId -> QueryParams (Identity UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (UserId -> Identity UserId
forall a. a -> Identity a
Identity UserId
user)))
interpretClientStoreToCassandra ::
( Member (Embed IO) r,
Member (Input ClientState) r,
Member (Input Env) r,
Member TinyLog r
) =>
Sem (ClientStore ': r) a ->
Sem r a
interpretClientStoreToCassandra :: forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r,
Member (Input Env) r, Member TinyLog r) =>
Sem (ClientStore : r) a -> Sem r a
interpretClientStoreToCassandra = (forall (rInitial :: EffectRow) x.
ClientStore (Sem rInitial) x -> Sem r x)
-> Sem (ClientStore : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
ClientStore (Sem rInitial) x -> Sem r x)
-> Sem (ClientStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
ClientStore (Sem rInitial) x -> Sem r x)
-> Sem (ClientStore : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
GetClients [UserId]
uids -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ClientStore.GetClients"
Client Clients -> Sem r Clients
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client Clients -> Sem r Clients)
-> Client Clients -> Sem r Clients
forall a b. (a -> b) -> a -> b
$ [UserId] -> Client Clients
lookupClients [UserId]
uids
CreateClient UserId
uid ClientId
cid -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ClientStore.CreateClient"
Client () -> Sem r ()
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client () -> Sem r ()) -> Client () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Bool -> UserId -> ClientId -> Client ()
updateClient Bool
True UserId
uid ClientId
cid
DeleteClient UserId
uid ClientId
cid -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ClientStore.DeleteClient"
Client () -> Sem r ()
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client () -> Sem r ()) -> Client () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Bool -> UserId -> ClientId -> Client ()
updateClient Bool
False UserId
uid ClientId
cid
DeleteClients UserId
uid -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ClientStore.DeleteClients"
Client () -> Sem r ()
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client () -> Sem r ()) -> Client () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ UserId -> Client ()
eraseClients UserId
uid
ClientStore (Sem rInitial) x
UseIntraClientListing -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ClientStore.UseIntraClientListing"
App x -> Sem r x
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input Env) r) =>
App a -> Sem r a
embedApp (App x -> Sem r x)
-> (Getting x Env x -> App x) -> Getting x Env x -> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting x Env x -> App x
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting x Env x -> Sem r x) -> Getting x Env x -> Sem r x
forall a b. (a -> b) -> a -> b
$ (Opts -> Const x Opts) -> Env -> Const x Env
Lens' Env Opts
options ((Opts -> Const x Opts) -> Env -> Const x Env)
-> ((x -> Const x x) -> Opts -> Const x Opts) -> Getting x Env x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Settings -> Const x Settings) -> Opts -> Const x Opts
Lens' Opts Settings
settings ((Settings -> Const x Settings) -> Opts -> Const x Opts)
-> ((x -> Const x x) -> Settings -> Const x Settings)
-> (x -> Const x x)
-> Opts
-> Const x Opts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> Const x x) -> Settings -> Const x Settings
(Bool -> Const x Bool) -> Settings -> Const x Settings
Lens' Settings Bool
intraListing