module Galley.API.Clients
( getClients,
rmClient,
)
where
import Data.Id
import Data.Proxy
import Data.Qualified
import Data.Range
import Data.Time
import Galley.API.Error
import Galley.API.MLS.Removal
import Galley.API.Query qualified as Query
import Galley.API.Util
import Galley.Effects
import Galley.Effects.BackendNotificationQueueAccess
import Galley.Effects.ClientStore qualified as E
import Galley.Effects.ConversationStore (getConversation)
import Galley.Env
import Galley.Types.Clients (clientIds)
import Imports
import Network.AMQP qualified as Q
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Polysemy.TinyLog qualified as P
import System.Logger.Message
import Wire.API.Conversation hiding (Member)
import Wire.API.Federation.API
import Wire.API.Federation.API.Galley
import Wire.API.Federation.Error
import Wire.API.Routes.MultiTablePaging
import Wire.NotificationSubsystem
import Wire.Sem.Paging.Cassandra (CassandraPaging)
getClients ::
( Member BrigAccess r,
Member ClientStore r
) =>
UserId ->
Sem r [ClientId]
getClients :: forall (r :: EffectRow).
(Member BrigAccess r, Member ClientStore r) =>
UserId -> Sem r [ClientId]
getClients UserId
usr = UserId -> Clients -> [ClientId]
clientIds UserId
usr (Clients -> [ClientId]) -> Sem r Clients -> Sem r [ClientId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId] -> Sem r Clients
forall (r :: EffectRow).
(Member BrigAccess r, Member ClientStore r) =>
[UserId] -> Sem r Clients
getBrigClients [UserId
usr]
rmClient ::
forall p1 r.
( p1 ~ CassandraPaging,
Member ClientStore r,
Member ConversationStore r,
Member (Error FederationError) r,
Member ExternalAccess r,
Member BackendNotificationQueueAccess r,
Member NotificationSubsystem r,
Member (Input Env) r,
Member (Input (Local ())) r,
Member (Input UTCTime) r,
Member (ListItems p1 ConvId) r,
Member (ListItems p1 (Remote ConvId)) r,
Member MemberStore r,
Member (Error InternalError) r,
Member ProposalStore r,
Member Random r,
Member SubConversationStore r,
Member P.TinyLog r
) =>
UserId ->
ClientId ->
Sem r ()
rmClient :: forall p1 (r :: EffectRow).
(p1 ~ CassandraPaging, Member ClientStore r,
Member ConversationStore r, Member (Error FederationError) r,
Member ExternalAccess r, Member BackendNotificationQueueAccess r,
Member NotificationSubsystem r, Member (Input Env) r,
Member (Input (Local ())) r, Member (Input UTCTime) r,
Member (ListItems p1 ConvId) r,
Member (ListItems p1 (Remote ConvId)) r, Member MemberStore r,
Member (Error InternalError) r, Member ProposalStore r,
Member Random r, Member SubConversationStore r,
Member TinyLog r) =>
UserId -> ClientId -> Sem r ()
rmClient UserId
usr ClientId
cid = do
Clients
clients <- [UserId] -> Sem r Clients
forall (r :: EffectRow).
Member ClientStore r =>
[UserId] -> Sem r Clients
E.getClients [UserId
usr]
if (ClientId
cid ClientId -> [ClientId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` UserId -> Clients -> [ClientId]
clientIds UserId
usr Clients
clients)
then do
Local UserId
lusr <- UserId -> Sem r (Local UserId)
forall (r :: EffectRow) a.
Member (Input (Local ())) r =>
a -> Sem r (Local a)
qualifyLocal UserId
usr
let nRange1000 :: Range 1 1000 Int32
nRange1000 = Proxy 1000 -> Range 1 1000 Int32
forall (n :: Nat) (x :: Nat) (m :: Nat) a.
(n <= x, x <= m, KnownNat x, Num a) =>
Proxy x -> Range n m a
toRange (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @1000) :: Range 1 1000 Int32
ConvIdsPage
firstConvIds <- Local UserId -> GetPaginatedConversationIds -> Sem r ConvIdsPage
forall p (r :: EffectRow).
(p ~ CassandraPaging,
(Member ConversationStore r, Member (Error InternalError) r,
Member (Input Env) r, Member (ListItems p ConvId) r,
Member (ListItems p (Remote ConvId)) r, Member TinyLog r)) =>
Local UserId -> GetPaginatedConversationIds -> Sem r ConvIdsPage
Query.conversationIdsPageFrom Local UserId
lusr (Maybe
(MultiTablePagingState ConversationPagingName LocalOrRemoteTable)
-> Range 1 1000 Int32 -> GetPaginatedConversationIds
forall (name :: Symbol) tables (max :: Nat) (def :: Nat).
Maybe (MultiTablePagingState name tables)
-> Range 1 max Int32
-> GetMultiTablePageRequest name tables max def
GetPaginatedConversationIds Maybe
(MultiTablePagingState ConversationPagingName LocalOrRemoteTable)
forall a. Maybe a
Nothing Range 1 1000 Int32
nRange1000)
Range 1 1000 Int32 -> ConvIdsPage -> Local UserId -> Sem r ()
goConvs Range 1 1000 Int32
nRange1000 ConvIdsPage
firstConvIds Local UserId
lusr
UserId -> ClientId -> Sem r ()
forall (r :: EffectRow).
Member ClientStore r =>
UserId -> ClientId -> Sem r ()
E.deleteClient UserId
usr ClientId
cid
else
(Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.debug
( ByteString -> Text -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"user" (UserId -> Text
forall {k} (a :: k). Id a -> Text
idToText UserId
usr)
(Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"client" (ClientId -> Text
clientToText ClientId
cid)
(Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
msg (ByteString -> Builder
val ByteString
"rmClientH: client already gone")
)
where
goConvs :: Range 1 1000 Int32 -> ConvIdsPage -> Local UserId -> Sem r ()
goConvs :: Range 1 1000 Int32 -> ConvIdsPage -> Local UserId -> Sem r ()
goConvs Range 1 1000 Int32
range ConvIdsPage
page Local UserId
lusr = do
let ([ConvId]
localConvs, [Remote ConvId]
remoteConvs) = Local UserId -> [Qualified ConvId] -> ([ConvId], [Remote ConvId])
forall (f :: * -> *) x a.
Foldable f =>
Local x -> f (Qualified a) -> ([a], [Remote a])
partitionQualified Local UserId
lusr (ConvIdsPage -> [Qualified ConvId]
forall (name :: Symbol) (resultsKey :: Symbol) tables a.
MultiTablePage name resultsKey tables a -> [a]
mtpResults ConvIdsPage
page)
[ConvId] -> (ConvId -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ConvId]
localConvs ((ConvId -> Sem r ()) -> Sem r ())
-> (ConvId -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \ConvId
convId -> do
Maybe Conversation
mConv <- ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
getConversation ConvId
convId
Maybe Conversation -> (Conversation -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Conversation
mConv ((Conversation -> Sem r ()) -> Sem r ())
-> (Conversation -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \Conversation
conv -> do
Local Conversation
lconv <- Conversation -> Sem r (Local Conversation)
forall (r :: EffectRow) a.
Member (Input (Local ())) r =>
a -> Sem r (Local a)
qualifyLocal Conversation
conv
Local Conversation -> Qualified UserId -> ClientId -> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
Member (Error FederationError) r, Member ExternalAccess r,
Member NotificationSubsystem r, Member (Input Env) r,
Member (Input UTCTime) r, Member MemberStore r,
Member ProposalStore r, Member Random r,
Member SubConversationStore r, Member TinyLog r) =>
Local Conversation -> Qualified UserId -> ClientId -> Sem r ()
removeClient Local Conversation
lconv (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) ClientId
cid
(Range 1 1000 [Remote ConvId] -> Sem r ())
-> [Range 1 1000 [Remote ConvId]] -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Range 1 1000 [Remote ConvId] -> Sem r ()
removeRemoteMLSClients ([Remote ConvId] -> [Range 1 1000 [Remote ConvId]]
forall a (n :: Nat).
(Within [a] 1 n, KnownNat n) =>
[a] -> [Range 1 n [a]]
rangedChunks [Remote ConvId]
remoteConvs)
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConvIdsPage -> Bool
forall (name :: Symbol) (resultsKey :: Symbol) tables a.
MultiTablePage name resultsKey tables a -> Bool
mtpHasMore ConvIdsPage
page) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
let nextState :: MultiTablePagingState ConversationPagingName LocalOrRemoteTable
nextState = ConvIdsPage
-> MultiTablePagingState ConversationPagingName LocalOrRemoteTable
forall (name :: Symbol) (resultsKey :: Symbol) tables a.
MultiTablePage name resultsKey tables a
-> MultiTablePagingState name tables
mtpPagingState ConvIdsPage
page
nextQuery :: GetPaginatedConversationIds
nextQuery = Maybe
(MultiTablePagingState ConversationPagingName LocalOrRemoteTable)
-> Range 1 1000 Int32 -> GetPaginatedConversationIds
forall (name :: Symbol) tables (max :: Nat) (def :: Nat).
Maybe (MultiTablePagingState name tables)
-> Range 1 max Int32
-> GetMultiTablePageRequest name tables max def
GetPaginatedConversationIds (MultiTablePagingState ConversationPagingName LocalOrRemoteTable
-> Maybe
(MultiTablePagingState ConversationPagingName LocalOrRemoteTable)
forall a. a -> Maybe a
Just MultiTablePagingState ConversationPagingName LocalOrRemoteTable
nextState) Range 1 1000 Int32
range
ConvIdsPage
newCids <- Local UserId -> GetPaginatedConversationIds -> Sem r ConvIdsPage
forall p (r :: EffectRow).
(p ~ CassandraPaging,
(Member ConversationStore r, Member (Error InternalError) r,
Member (Input Env) r, Member (ListItems p ConvId) r,
Member (ListItems p (Remote ConvId)) r, Member TinyLog r)) =>
Local UserId -> GetPaginatedConversationIds -> Sem r ConvIdsPage
Query.conversationIdsPageFrom Local UserId
lusr GetPaginatedConversationIds
nextQuery
Range 1 1000 Int32 -> ConvIdsPage -> Local UserId -> Sem r ()
goConvs Range 1 1000 Int32
range ConvIdsPage
newCids Local UserId
lusr
removeRemoteMLSClients :: Range 1 1000 [Remote ConvId] -> Sem r ()
removeRemoteMLSClients :: Range 1 1000 [Remote ConvId] -> Sem r ()
removeRemoteMLSClients Range 1 1000 [Remote ConvId]
convIds = do
[Remote [ConvId]] -> (Remote [ConvId] -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([Remote ConvId] -> [Remote [ConvId]]
forall (f :: * -> *) a.
(Functor f, Foldable f) =>
f (Remote a) -> [Remote [a]]
bucketRemote (Range 1 1000 [Remote ConvId] -> [Remote ConvId]
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange Range 1 1000 [Remote ConvId]
convIds)) ((Remote [ConvId] -> Sem r ()) -> Sem r ())
-> (Remote [ConvId] -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \Remote [ConvId]
remoteConvs ->
let rpc :: FedQueueClient 'Galley ()
rpc =
forall {k} (tag :: k) (c :: Component).
(HasNotificationEndpoint tag, HasVersionRange tag, HasFedPath tag,
KnownComponent (NotificationComponent k), ToJSON (Payload tag),
c ~ NotificationComponent k) =>
Payload tag -> FedQueueClient c ()
forall (tag :: GalleyNotificationTag) (c :: Component).
(HasNotificationEndpoint tag, HasVersionRange tag, HasFedPath tag,
KnownComponent (NotificationComponent GalleyNotificationTag),
ToJSON (Payload tag),
c ~ NotificationComponent GalleyNotificationTag) =>
Payload tag -> FedQueueClient c ()
fedQueueClient
@'OnClientRemovedTag
(UserId -> ClientId -> [ConvId] -> ClientRemovedRequest
ClientRemovedRequest UserId
usr ClientId
cid (Remote [ConvId] -> [ConvId]
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Remote [ConvId]
remoteConvs))
in DeliveryMode
-> Remote [ConvId] -> FedQueueClient 'Galley () -> Sem r ()
forall (c :: Component) (r :: EffectRow) x a.
(KnownComponent c, Member (Error FederationError) r,
Member BackendNotificationQueueAccess r) =>
DeliveryMode -> Remote x -> FedQueueClient c a -> Sem r a
enqueueNotification DeliveryMode
Q.Persistent Remote [ConvId]
remoteConvs FedQueueClient 'Galley ()
rpc