{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Galley.API.Query
  ( getBotConversation,
    getUnqualifiedConversation,
    getConversation,
    getConversationRoles,
    conversationIdsPageFromUnqualified,
    conversationIdsPageFromV2,
    conversationIdsPageFrom,
    getConversations,
    listConversations,
    iterateConversations,
    getLocalSelf,
    internalGetMember,
    getConversationMeta,
    getConversationByReusableCode,
    ensureGuestLinksEnabled,
    getConversationGuestLinksStatus,
    ensureConvAdmin,
    getMLSSelfConversation,
    getMLSSelfConversationWithError,
    getMLSOne2OneConversationV5,
    getMLSOne2OneConversationV6,
    getMLSOne2OneConversationInternal,
    getMLSOne2OneConversation,
    isMLSOne2OneEstablished,
  )
where

import Cassandra qualified as C
import Control.Lens
import Control.Monad.Extra
import Data.ByteString.Conversion
import Data.ByteString.Lazy qualified as LBS
import Data.Code
import Data.CommaSeparatedList
import Data.Domain (Domain)
import Data.Id as Id
import Data.Map qualified as Map
import Data.Maybe
import Data.Proxy
import Data.Qualified
import Data.Range
import Data.Set qualified as Set
import Galley.API.Error
import Galley.API.MLS
import Galley.API.MLS.Enabled
import Galley.API.MLS.One2One
import Galley.API.MLS.Types
import Galley.API.Mapping
import Galley.API.Mapping qualified as Mapping
import Galley.API.One2One
import Galley.API.Teams.Features.Get
import Galley.API.Util
import Galley.Data.Conversation qualified as Data
import Galley.Data.Conversation.Types qualified as Data
import Galley.Data.Types (Code (codeConversation))
import Galley.Data.Types qualified as Data
import Galley.Effects
import Galley.Effects.ConversationStore qualified as E
import Galley.Effects.FederatorAccess qualified as E
import Galley.Effects.ListItems qualified as E
import Galley.Effects.MemberStore qualified as E
import Galley.Env
import Galley.Options
import Galley.Types.Conversations.Members
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Polysemy.TinyLog (TinyLog)
import Polysemy.TinyLog qualified as P
import System.Logger.Class qualified as Logger
import Wire.API.Conversation hiding (Member)
import Wire.API.Conversation qualified as Public
import Wire.API.Conversation.Code
import Wire.API.Conversation.Protocol
import Wire.API.Conversation.Role
import Wire.API.Conversation.Role qualified as Public
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Federation.API
import Wire.API.Federation.API.Galley
import Wire.API.Federation.Client (FederatorClient, getNegotiatedVersion)
import Wire.API.Federation.Error
import Wire.API.Federation.Version qualified as Federation
import Wire.API.MLS.Keys
import Wire.API.Provider.Bot qualified as Public
import Wire.API.Routes.MultiTablePaging qualified as Public
import Wire.API.Team.Feature as Public
import Wire.API.User
import Wire.Sem.Paging.Cassandra

getBotConversation ::
  ( Member ConversationStore r,
    Member (ErrorS 'ConvNotFound) r,
    Member (Input (Local ())) r
  ) =>
  BotId ->
  ConvId ->
  Sem r Public.BotConvView
getBotConversation :: forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (Input (Local ())) r) =>
BotId -> ConvId -> Sem r BotConvView
getBotConversation BotId
zbot ConvId
cnv = do
  Local ConvId
lcnv <- ConvId -> Sem r (Local ConvId)
forall (r :: EffectRow) a.
Member (Input (Local ())) r =>
a -> Sem r (Local a)
qualifyLocal ConvId
cnv
  (Conversation
c, LocalMember
_) <- forall {k1} (e :: k1) uid mem (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS e) r, IsConvMemberId uid mem) =>
uid -> Local ConvId -> Sem r (Conversation, mem)
forall (e :: GalleyError) uid mem (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS e) r, IsConvMemberId uid mem) =>
uid -> Local ConvId -> Sem r (Conversation, mem)
getConversationAndMemberWithError @'ConvNotFound (BotId -> UserId
botUserId BotId
zbot) Local ConvId
lcnv
  let domain :: Domain
domain = Local ConvId -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Local ConvId
lcnv
      cmems :: [OtherMember]
cmems = (LocalMember -> Maybe OtherMember)
-> [LocalMember] -> [OtherMember]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Domain -> LocalMember -> Maybe OtherMember
mkMember Domain
domain) ([LocalMember] -> [LocalMember]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Conversation -> [LocalMember]
Data.convLocalMembers Conversation
c))
  BotConvView -> Sem r BotConvView
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotConvView -> Sem r BotConvView)
-> BotConvView -> Sem r BotConvView
forall a b. (a -> b) -> a -> b
$ ConvId -> Maybe Text -> [OtherMember] -> BotConvView
Public.botConvView (Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvId
lcnv) (Conversation -> Maybe Text
Data.convName Conversation
c) [OtherMember]
cmems
  where
    mkMember :: Domain -> LocalMember -> Maybe OtherMember
    mkMember :: Domain -> LocalMember -> Maybe OtherMember
mkMember Domain
domain LocalMember
m
      | LocalMember -> UserId
lmId LocalMember
m UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
== BotId -> UserId
botUserId BotId
zbot =
          Maybe OtherMember
forall a. Maybe a
Nothing -- no need to list the bot itself
      | Bool
otherwise =
          OtherMember -> Maybe OtherMember
forall a. a -> Maybe a
Just (Qualified UserId -> Maybe ServiceRef -> RoleName -> OtherMember
OtherMember (UserId -> Domain -> Qualified UserId
forall a. a -> Domain -> Qualified a
Qualified (LocalMember -> UserId
lmId LocalMember
m) Domain
domain) (LocalMember -> Maybe ServiceRef
lmService LocalMember
m) (LocalMember -> RoleName
lmConvRoleName LocalMember
m))

getUnqualifiedConversation ::
  ( Member ConversationStore r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (Error InternalError) r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  ConvId ->
  Sem r Public.Conversation
getUnqualifiedConversation :: forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (Error InternalError) r, Member TinyLog r) =>
Local UserId -> ConvId -> Sem r Conversation
getUnqualifiedConversation Local UserId
lusr ConvId
cnv = do
  Conversation
c <- Qualified UserId -> Local ConvId -> Sem r Conversation
forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvAccessDenied) r) =>
Qualified UserId -> Local ConvId -> Sem r Conversation
getConversationAndCheckMembership (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) (Local UserId -> ConvId -> Local ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr ConvId
cnv)
  Local UserId -> Conversation -> Sem r Conversation
forall (r :: EffectRow).
(Member (Error InternalError) r, Member TinyLog r) =>
Local UserId -> Conversation -> Sem r Conversation
Mapping.conversationView Local UserId
lusr Conversation
c

getConversation ::
  forall r.
  ( Member ConversationStore r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member FederatorAccess r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  Qualified ConvId ->
  Sem r Public.Conversation
getConversation :: forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (Error FederationError) r, Member (Error InternalError) r,
 Member FederatorAccess r, Member TinyLog r) =>
Local UserId -> Qualified ConvId -> Sem r Conversation
getConversation Local UserId
lusr Qualified ConvId
cnv = do
  Local UserId
-> (Local ConvId -> Sem r Conversation)
-> (Remote ConvId -> Sem r Conversation)
-> Qualified ConvId
-> Sem r Conversation
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
    Local UserId
lusr
    (Local UserId -> ConvId -> Sem r Conversation
forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (Error InternalError) r, Member TinyLog r) =>
Local UserId -> ConvId -> Sem r Conversation
getUnqualifiedConversation Local UserId
lusr (ConvId -> Sem r Conversation)
-> (Local ConvId -> ConvId) -> Local ConvId -> Sem r Conversation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified)
    Remote ConvId -> Sem r Conversation
getRemoteConversation
    Qualified ConvId
cnv
  where
    getRemoteConversation :: Remote ConvId -> Sem r Public.Conversation
    getRemoteConversation :: Remote ConvId -> Sem r Conversation
getRemoteConversation Remote ConvId
remoteConvId = do
      [Conversation]
conversations <- Local UserId -> [Remote ConvId] -> Sem r [Conversation]
forall (r :: EffectRow).
(Member ConversationStore r, Member (Error FederationError) r,
 Member (ErrorS 'ConvNotFound) r, Member FederatorAccess r,
 Member TinyLog r) =>
Local UserId -> [Remote ConvId] -> Sem r [Conversation]
getRemoteConversations Local UserId
lusr [Remote ConvId
remoteConvId]
      case [Conversation]
conversations of
        [] -> forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'ConvNotFound
        [Conversation
conv] -> Conversation -> Sem r Conversation
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Conversation
conv
        -- _convs -> throw (federationUnexpectedBody "expected one conversation, got multiple")
        [Conversation]
_convs -> FederationError -> Sem r Conversation
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (FederationError -> Sem r Conversation)
-> FederationError -> Sem r Conversation
forall a b. (a -> b) -> a -> b
$ Text -> FederationError
FederationUnexpectedBody Text
"expected one conversation, got multiple"

getRemoteConversations ::
  ( Member ConversationStore r,
    Member (Error FederationError) r,
    Member (ErrorS 'ConvNotFound) r,
    Member FederatorAccess r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  [Remote ConvId] ->
  Sem r [Public.Conversation]
getRemoteConversations :: forall (r :: EffectRow).
(Member ConversationStore r, Member (Error FederationError) r,
 Member (ErrorS 'ConvNotFound) r, Member FederatorAccess r,
 Member TinyLog r) =>
Local UserId -> [Remote ConvId] -> Sem r [Conversation]
getRemoteConversations Local UserId
lusr [Remote ConvId]
remoteConvs =
  Local UserId
-> [Remote ConvId]
-> Sem r ([FailedGetConversation], [Conversation])
forall (r :: EffectRow).
(Member ConversationStore r, Member FederatorAccess r,
 Member TinyLog r) =>
Local UserId
-> [Remote ConvId]
-> Sem r ([FailedGetConversation], [Conversation])
getRemoteConversationsWithFailures Local UserId
lusr [Remote ConvId]
remoteConvs Sem r ([FailedGetConversation], [Conversation])
-> (([FailedGetConversation], [Conversation])
    -> Sem r [Conversation])
-> Sem r [Conversation]
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    -- throw first error
    (FailedGetConversation
failed : [FailedGetConversation]
_, [Conversation]
_) -> FailedGetConversation -> Sem r [Conversation]
forall (r :: EffectRow) a.
(Member (ErrorS 'ConvNotFound) r,
 Member (Error FederationError) r) =>
FailedGetConversation -> Sem r a
throwFgcError (FailedGetConversation -> Sem r [Conversation])
-> FailedGetConversation -> Sem r [Conversation]
forall a b. (a -> b) -> a -> b
$ FailedGetConversation
failed
    ([], [Conversation]
result) -> [Conversation] -> Sem r [Conversation]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Conversation]
result

data FailedGetConversationReason
  = FailedGetConversationLocally
  | FailedGetConversationRemotely FederationError

throwFgcrError ::
  ( Member (ErrorS 'ConvNotFound) r,
    Member (Error FederationError) r
  ) =>
  FailedGetConversationReason ->
  Sem r a
throwFgcrError :: forall (r :: EffectRow) a.
(Member (ErrorS 'ConvNotFound) r,
 Member (Error FederationError) r) =>
FailedGetConversationReason -> Sem r a
throwFgcrError FailedGetConversationReason
FailedGetConversationLocally = forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'ConvNotFound
throwFgcrError (FailedGetConversationRemotely FederationError
e) = FederationError -> Sem r a
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw FederationError
e

data FailedGetConversation
  = FailedGetConversation
      [Qualified ConvId]
      FailedGetConversationReason

throwFgcError ::
  ( Member (ErrorS 'ConvNotFound) r,
    Member (Error FederationError) r
  ) =>
  FailedGetConversation ->
  Sem r a
throwFgcError :: forall (r :: EffectRow) a.
(Member (ErrorS 'ConvNotFound) r,
 Member (Error FederationError) r) =>
FailedGetConversation -> Sem r a
throwFgcError (FailedGetConversation [Qualified ConvId]
_ FailedGetConversationReason
r) = FailedGetConversationReason -> Sem r a
forall (r :: EffectRow) a.
(Member (ErrorS 'ConvNotFound) r,
 Member (Error FederationError) r) =>
FailedGetConversationReason -> Sem r a
throwFgcrError FailedGetConversationReason
r

failedGetConversationRemotely ::
  [Remote ConvId] -> FederationError -> FailedGetConversation
failedGetConversationRemotely :: [Remote ConvId] -> FederationError -> FailedGetConversation
failedGetConversationRemotely [Remote ConvId]
qconvs =
  [Qualified ConvId]
-> FailedGetConversationReason -> FailedGetConversation
FailedGetConversation ((Remote ConvId -> Qualified ConvId)
-> [Remote ConvId] -> [Qualified ConvId]
forall a b. (a -> b) -> [a] -> [b]
map Remote ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged [Remote ConvId]
qconvs) (FailedGetConversationReason -> FailedGetConversation)
-> (FederationError -> FailedGetConversationReason)
-> FederationError
-> FailedGetConversation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FederationError -> FailedGetConversationReason
FailedGetConversationRemotely

failedGetConversationLocally ::
  [Qualified ConvId] -> FailedGetConversation
failedGetConversationLocally :: [Qualified ConvId] -> FailedGetConversation
failedGetConversationLocally [Qualified ConvId]
qconvs =
  [Qualified ConvId]
-> FailedGetConversationReason -> FailedGetConversation
FailedGetConversation [Qualified ConvId]
qconvs FailedGetConversationReason
FailedGetConversationLocally

partitionGetConversationFailures ::
  [FailedGetConversation] -> ([Qualified ConvId], [Qualified ConvId])
partitionGetConversationFailures :: [FailedGetConversation] -> ([Qualified ConvId], [Qualified ConvId])
partitionGetConversationFailures = ([[Qualified ConvId]] -> [Qualified ConvId])
-> ([[Qualified ConvId]] -> [Qualified ConvId])
-> ([[Qualified ConvId]], [[Qualified ConvId]])
-> ([Qualified ConvId], [Qualified ConvId])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [[Qualified ConvId]] -> [Qualified ConvId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Qualified ConvId]] -> [Qualified ConvId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([[Qualified ConvId]], [[Qualified ConvId]])
 -> ([Qualified ConvId], [Qualified ConvId]))
-> ([FailedGetConversation]
    -> ([[Qualified ConvId]], [[Qualified ConvId]]))
-> [FailedGetConversation]
-> ([Qualified ConvId], [Qualified ConvId])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either [Qualified ConvId] [Qualified ConvId]]
-> ([[Qualified ConvId]], [[Qualified ConvId]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either [Qualified ConvId] [Qualified ConvId]]
 -> ([[Qualified ConvId]], [[Qualified ConvId]]))
-> ([FailedGetConversation]
    -> [Either [Qualified ConvId] [Qualified ConvId]])
-> [FailedGetConversation]
-> ([[Qualified ConvId]], [[Qualified ConvId]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FailedGetConversation
 -> Either [Qualified ConvId] [Qualified ConvId])
-> [FailedGetConversation]
-> [Either [Qualified ConvId] [Qualified ConvId]]
forall a b. (a -> b) -> [a] -> [b]
map FailedGetConversation
-> Either [Qualified ConvId] [Qualified ConvId]
split
  where
    split :: FailedGetConversation
-> Either [Qualified ConvId] [Qualified ConvId]
split (FailedGetConversation [Qualified ConvId]
convs FailedGetConversationReason
FailedGetConversationLocally) = [Qualified ConvId] -> Either [Qualified ConvId] [Qualified ConvId]
forall a b. a -> Either a b
Left [Qualified ConvId]
convs
    split (FailedGetConversation [Qualified ConvId]
convs (FailedGetConversationRemotely FederationError
_)) = [Qualified ConvId] -> Either [Qualified ConvId] [Qualified ConvId]
forall a b. b -> Either a b
Right [Qualified ConvId]
convs

getRemoteConversationsWithFailures ::
  ( Member ConversationStore r,
    Member FederatorAccess r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  [Remote ConvId] ->
  Sem r ([FailedGetConversation], [Public.Conversation])
getRemoteConversationsWithFailures :: forall (r :: EffectRow).
(Member ConversationStore r, Member FederatorAccess r,
 Member TinyLog r) =>
Local UserId
-> [Remote ConvId]
-> Sem r ([FailedGetConversation], [Conversation])
getRemoteConversationsWithFailures Local UserId
lusr [Remote ConvId]
convs = do
  -- get self member statuses from the database
  Map (Remote ConvId) MemberStatus
statusMap <- UserId
-> [Remote ConvId] -> Sem r (Map (Remote ConvId) MemberStatus)
forall (r :: EffectRow).
Member ConversationStore r =>
UserId
-> [Remote ConvId] -> Sem r (Map (Remote ConvId) MemberStatus)
E.getRemoteConversationStatus (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) [Remote ConvId]
convs
  let remoteView :: Remote RemoteConversationV2 -> Conversation
      remoteView :: Remote RemoteConversationV2 -> Conversation
remoteView Remote RemoteConversationV2
rconv =
        Local UserId
-> MemberStatus -> Remote RemoteConversationV2 -> Conversation
Mapping.remoteConversationView
          Local UserId
lusr
          ( MemberStatus
-> Remote ConvId
-> Map (Remote ConvId) MemberStatus
-> MemberStatus
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault
              MemberStatus
defMemberStatus
              ((.id) (RemoteConversationV2 -> ConvId)
-> Remote RemoteConversationV2 -> Remote ConvId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Remote RemoteConversationV2
rconv)
              Map (Remote ConvId) MemberStatus
statusMap
          )
          Remote RemoteConversationV2
rconv
      ([Remote ConvId]
locallyFound, [Remote ConvId]
locallyNotFound) = (Remote ConvId -> Bool)
-> [Remote ConvId] -> ([Remote ConvId], [Remote ConvId])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Remote ConvId -> Map (Remote ConvId) MemberStatus -> Bool)
-> Map (Remote ConvId) MemberStatus -> Remote ConvId -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Remote ConvId -> Map (Remote ConvId) MemberStatus -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Map (Remote ConvId) MemberStatus
statusMap) [Remote ConvId]
convs
      localFailures :: [FailedGetConversation]
localFailures
        | [Remote ConvId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Remote ConvId]
locallyNotFound = []
        | Bool
otherwise = [[Qualified ConvId] -> FailedGetConversation
failedGetConversationLocally ((Remote ConvId -> Qualified ConvId)
-> [Remote ConvId] -> [Qualified ConvId]
forall a b. (a -> b) -> [a] -> [b]
map Remote ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged [Remote ConvId]
locallyNotFound)]

  -- request conversations from remote backends
  let rpc :: GetConversationsRequest -> FederatorClient 'Galley GetConversationsResponseV2
      rpc :: GetConversationsRequest
-> FederatorClient 'Galley GetConversationsResponseV2
rpc GetConversationsRequest
req = do
        Maybe Version
mFedVersion <- FederatorClient 'Galley (Maybe Version)
forall (c :: Component). FederatorClient c (Maybe Version)
getNegotiatedVersion
        case Maybe Version
mFedVersion of
          Maybe Version
Nothing -> [Char] -> FederatorClient 'Galley GetConversationsResponseV2
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"
          Just Version
fedVersion ->
            if Version
fedVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
Federation.V2
              then GetConversationsResponse -> GetConversationsResponseV2
getConversationsResponseToV2 (GetConversationsResponse -> GetConversationsResponseV2)
-> FederatorClient 'Galley GetConversationsResponse
-> FederatorClient 'Galley GetConversationsResponseV2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (comp :: Component) (name :: k)
       (fedM :: Component -> * -> *) (showcomp :: Symbol) api x.
(AddAnnotation 'Remote showcomp (FedPath name) x,
 showcomp ~ ShowComponent comp, HasFedEndpoint comp api name,
 HasClient (fedM comp) api, KnownComponent comp, IsNamed name,
 FederationMonad fedM, Typeable (Client (fedM comp) api)) =>
Client (fedM comp) api
forall (comp :: Component) (name :: Symbol)
       (fedM :: Component -> * -> *) (showcomp :: Symbol) api x.
(AddAnnotation 'Remote showcomp (FedPath name) x,
 showcomp ~ ShowComponent comp, HasFedEndpoint comp api name,
 HasClient (fedM comp) api, KnownComponent comp, IsNamed name,
 FederationMonad fedM, Typeable (Client (fedM comp) api)) =>
Client (fedM comp) api
fedClient @'Galley @"get-conversations@v1" GetConversationsRequest
req
              else forall {k} (comp :: Component) (name :: k)
       (fedM :: Component -> * -> *) (showcomp :: Symbol) api x.
(AddAnnotation 'Remote showcomp (FedPath name) x,
 showcomp ~ ShowComponent comp, HasFedEndpoint comp api name,
 HasClient (fedM comp) api, KnownComponent comp, IsNamed name,
 FederationMonad fedM, Typeable (Client (fedM comp) api)) =>
Client (fedM comp) api
forall (comp :: Component) (name :: Symbol)
       (fedM :: Component -> * -> *) (showcomp :: Symbol) api x.
(AddAnnotation 'Remote showcomp (FedPath name) x,
 showcomp ~ ShowComponent comp, HasFedEndpoint comp api name,
 HasClient (fedM comp) api, KnownComponent comp, IsNamed name,
 FederationMonad fedM, Typeable (Client (fedM comp) api)) =>
Client (fedM comp) api
fedClient @'Galley @"get-conversations" GetConversationsRequest
req
  [Either
   (Remote [ConvId], FederationError)
   (Remote GetConversationsResponseV2)]
resp <-
    [Remote ConvId]
-> (Remote [ConvId]
    -> FederatorClient 'Galley GetConversationsResponseV2)
-> Sem
     r
     [Either
        (Remote [ConvId], FederationError)
        (Remote GetConversationsResponseV2)]
forall (r :: EffectRow) (c :: Component) (f :: * -> *) x a.
(Member FederatorAccess r, KnownComponent c, Foldable f,
 Functor f) =>
f (Remote x)
-> (Remote [x] -> FederatorClient c a)
-> Sem r [Either (Remote [x], FederationError) (Remote a)]
E.runFederatedConcurrentlyEither [Remote ConvId]
locallyFound ((Remote [ConvId]
  -> FederatorClient 'Galley GetConversationsResponseV2)
 -> Sem
      r
      [Either
         (Remote [ConvId], FederationError)
         (Remote GetConversationsResponseV2)])
-> (Remote [ConvId]
    -> FederatorClient 'Galley GetConversationsResponseV2)
-> Sem
     r
     [Either
        (Remote [ConvId], FederationError)
        (Remote GetConversationsResponseV2)]
forall a b. (a -> b) -> a -> b
$ \Remote [ConvId]
someConvs ->
      GetConversationsRequest
-> FederatorClient 'Galley GetConversationsResponseV2
rpc (GetConversationsRequest
 -> FederatorClient 'Galley GetConversationsResponseV2)
-> GetConversationsRequest
-> FederatorClient 'Galley GetConversationsResponseV2
forall a b. (a -> b) -> a -> b
$ UserId -> [ConvId] -> GetConversationsRequest
GetConversationsRequest (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) (Remote [ConvId] -> [ConvId]
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Remote [ConvId]
someConvs)
  ([FailedGetConversation] -> [FailedGetConversation])
-> ([[Remote RemoteConversationV2]] -> [Conversation])
-> ([FailedGetConversation], [[Remote RemoteConversationV2]])
-> ([FailedGetConversation], [Conversation])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ([FailedGetConversation]
localFailures <>) ((Remote RemoteConversationV2 -> Conversation)
-> [Remote RemoteConversationV2] -> [Conversation]
forall a b. (a -> b) -> [a] -> [b]
map Remote RemoteConversationV2 -> Conversation
remoteView ([Remote RemoteConversationV2] -> [Conversation])
-> ([[Remote RemoteConversationV2]]
    -> [Remote RemoteConversationV2])
-> [[Remote RemoteConversationV2]]
-> [Conversation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Remote RemoteConversationV2]] -> [Remote RemoteConversationV2]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)
    (([FailedGetConversation], [[Remote RemoteConversationV2]])
 -> ([FailedGetConversation], [Conversation]))
-> ([Either FailedGetConversation [Remote RemoteConversationV2]]
    -> ([FailedGetConversation], [[Remote RemoteConversationV2]]))
-> [Either FailedGetConversation [Remote RemoteConversationV2]]
-> ([FailedGetConversation], [Conversation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either FailedGetConversation [Remote RemoteConversationV2]]
-> ([FailedGetConversation], [[Remote RemoteConversationV2]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
    ([Either FailedGetConversation [Remote RemoteConversationV2]]
 -> ([FailedGetConversation], [Conversation]))
-> Sem
     r [Either FailedGetConversation [Remote RemoteConversationV2]]
-> Sem r ([FailedGetConversation], [Conversation])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either
   (Remote [ConvId], FederationError)
   (Remote GetConversationsResponseV2)
 -> Sem
      r (Either FailedGetConversation [Remote RemoteConversationV2]))
-> [Either
      (Remote [ConvId], FederationError)
      (Remote GetConversationsResponseV2)]
-> Sem
     r [Either FailedGetConversation [Remote RemoteConversationV2]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Either
  (Remote [ConvId], FederationError)
  (Remote GetConversationsResponseV2)
-> Sem
     r (Either FailedGetConversation [Remote RemoteConversationV2])
forall (r :: EffectRow).
Member TinyLog r =>
Either
  (Remote [ConvId], FederationError)
  (Remote GetConversationsResponseV2)
-> Sem
     r (Either FailedGetConversation [Remote RemoteConversationV2])
handleFailure [Either
   (Remote [ConvId], FederationError)
   (Remote GetConversationsResponseV2)]
resp
  where
    handleFailure ::
      (Member P.TinyLog r) =>
      Either (Remote [ConvId], FederationError) (Remote GetConversationsResponseV2) ->
      Sem r (Either FailedGetConversation [Remote RemoteConversationV2])
    handleFailure :: forall (r :: EffectRow).
Member TinyLog r =>
Either
  (Remote [ConvId], FederationError)
  (Remote GetConversationsResponseV2)
-> Sem
     r (Either FailedGetConversation [Remote RemoteConversationV2])
handleFailure (Left (Remote [ConvId]
rcids, FederationError
e)) = do
      (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.warn ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
        ByteString -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
Logger.msg (ByteString
"Error occurred while fetching remote conversations" :: ByteString)
          (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char] -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Logger.field ByteString
"error" (FederationError -> [Char]
forall a. Show a => a -> [Char]
show FederationError
e)
      Either FailedGetConversation [Remote RemoteConversationV2]
-> Sem
     r (Either FailedGetConversation [Remote RemoteConversationV2])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FailedGetConversation [Remote RemoteConversationV2]
 -> Sem
      r (Either FailedGetConversation [Remote RemoteConversationV2]))
-> (FailedGetConversation
    -> Either FailedGetConversation [Remote RemoteConversationV2])
-> FailedGetConversation
-> Sem
     r (Either FailedGetConversation [Remote RemoteConversationV2])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailedGetConversation
-> Either FailedGetConversation [Remote RemoteConversationV2]
forall a b. a -> Either a b
Left (FailedGetConversation
 -> Sem
      r (Either FailedGetConversation [Remote RemoteConversationV2]))
-> FailedGetConversation
-> Sem
     r (Either FailedGetConversation [Remote RemoteConversationV2])
forall a b. (a -> b) -> a -> b
$ [Remote ConvId] -> FederationError -> FailedGetConversation
failedGetConversationRemotely (Remote [ConvId] -> [Remote ConvId]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
QualifiedWithTag 'QRemote (f a) -> f (QualifiedWithTag 'QRemote a)
sequenceA Remote [ConvId]
rcids) FederationError
e
    handleFailure (Right Remote GetConversationsResponseV2
c) = Either FailedGetConversation [Remote RemoteConversationV2]
-> Sem
     r (Either FailedGetConversation [Remote RemoteConversationV2])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FailedGetConversation [Remote RemoteConversationV2]
 -> Sem
      r (Either FailedGetConversation [Remote RemoteConversationV2]))
-> (Remote GetConversationsResponseV2
    -> Either FailedGetConversation [Remote RemoteConversationV2])
-> Remote GetConversationsResponseV2
-> Sem
     r (Either FailedGetConversation [Remote RemoteConversationV2])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Remote RemoteConversationV2]
-> Either FailedGetConversation [Remote RemoteConversationV2]
forall a b. b -> Either a b
Right ([Remote RemoteConversationV2]
 -> Either FailedGetConversation [Remote RemoteConversationV2])
-> (Remote GetConversationsResponseV2
    -> [Remote RemoteConversationV2])
-> Remote GetConversationsResponseV2
-> Either FailedGetConversation [Remote RemoteConversationV2]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GetConversationsResponseV2 -> [RemoteConversationV2])
-> Remote GetConversationsResponseV2
-> [Remote RemoteConversationV2]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> QualifiedWithTag 'QRemote a -> f (QualifiedWithTag 'QRemote b)
traverse (.convs) (Remote GetConversationsResponseV2
 -> Sem
      r (Either FailedGetConversation [Remote RemoteConversationV2]))
-> Remote GetConversationsResponseV2
-> Sem
     r (Either FailedGetConversation [Remote RemoteConversationV2])
forall a b. (a -> b) -> a -> b
$ Remote GetConversationsResponseV2
c

getConversationRoles ::
  ( Member ConversationStore r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'ConvAccessDenied) r
  ) =>
  Local UserId ->
  ConvId ->
  Sem r Public.ConversationRolesList
getConversationRoles :: forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvAccessDenied) r) =>
Local UserId -> ConvId -> Sem r ConversationRolesList
getConversationRoles Local UserId
lusr ConvId
cnv = do
  Sem r Conversation -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Conversation -> Sem r ()) -> Sem r Conversation -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Qualified UserId -> Local ConvId -> Sem r Conversation
forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvAccessDenied) r) =>
Qualified UserId -> Local ConvId -> Sem r Conversation
getConversationAndCheckMembership (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) (Local UserId -> ConvId -> Local ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr ConvId
cnv)
  -- NOTE: If/when custom roles are added, these roles should
  --       be merged with the team roles (if they exist)
  ConversationRolesList -> Sem r ConversationRolesList
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConversationRolesList -> Sem r ConversationRolesList)
-> ConversationRolesList -> Sem r ConversationRolesList
forall a b. (a -> b) -> a -> b
$ [ConversationRole] -> ConversationRolesList
Public.ConversationRolesList [ConversationRole]
wireConvRoles

conversationIdsPageFromUnqualified ::
  (Member (ListItems LegacyPaging ConvId) r) =>
  Local UserId ->
  Maybe ConvId ->
  Maybe (Range 1 1000 Int32) ->
  Sem r (Public.ConversationList ConvId)
conversationIdsPageFromUnqualified :: forall (r :: EffectRow).
Member (ListItems LegacyPaging ConvId) r =>
Local UserId
-> Maybe ConvId
-> Maybe (Range 1 1000 Int32)
-> Sem r (ConversationList ConvId)
conversationIdsPageFromUnqualified Local UserId
lusr Maybe ConvId
start Maybe (Range 1 1000 Int32)
msize = do
  let size :: Range 1 1000 Int32
size = Range 1 1000 Int32
-> Maybe (Range 1 1000 Int32) -> Range 1 1000 Int32
forall a. a -> Maybe a -> a
fromMaybe (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)) Maybe (Range 1 1000 Int32)
msize
  ResultSet ConvId
ids <- UserId
-> Maybe (PagingState LegacyPaging ConvId)
-> PagingBounds LegacyPaging ConvId
-> Sem r (Page LegacyPaging ConvId)
forall p i (r :: EffectRow).
Member (ListItems p i) r =>
UserId
-> Maybe (PagingState p i) -> PagingBounds p i -> Sem r (Page p i)
E.listItems (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) Maybe (PagingState LegacyPaging ConvId)
Maybe ConvId
start PagingBounds LegacyPaging ConvId
Range 1 1000 Int32
size
  ConversationList ConvId -> Sem r (ConversationList ConvId)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConversationList ConvId -> Sem r (ConversationList ConvId))
-> ConversationList ConvId -> Sem r (ConversationList ConvId)
forall a b. (a -> b) -> a -> b
$
    [ConvId] -> Bool -> ConversationList ConvId
forall a. [a] -> Bool -> ConversationList a
Public.ConversationList
      (ResultSet ConvId -> [ConvId]
forall a. ResultSet a -> [a]
resultSetResult ResultSet ConvId
ids)
      (ResultSet ConvId -> ResultSetType
forall a. ResultSet a -> ResultSetType
resultSetType ResultSet ConvId
ids ResultSetType -> ResultSetType -> Bool
forall a. Eq a => a -> a -> Bool
== ResultSetType
ResultSetTruncated)

-- | Lists conversation ids for the logged in user in a paginated way.
--
-- Pagination requires an order, in this case the order is defined as:
--
-- - First all the local conversations are listed ordered by their id
--
-- - After local conversations, remote conversations are listed ordered
-- - lexicographically by their domain and then by their id.
--
-- FUTUREWORK: Move the body of this function to 'conversationIdsPageFrom' once
-- support for V2 is dropped.
conversationIdsPageFromV2 ::
  forall p r.
  ( 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 P.TinyLog r
    )
  ) =>
  ListGlobalSelfConvs ->
  Local UserId ->
  Public.GetPaginatedConversationIds ->
  Sem r Public.ConvIdsPage
conversationIdsPageFromV2 :: 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)) =>
ListGlobalSelfConvs
-> Local UserId -> GetPaginatedConversationIds -> Sem r ConvIdsPage
conversationIdsPageFromV2 ListGlobalSelfConvs
listGlobalSelf Local UserId
lusr Public.GetMultiTablePageRequest {Maybe
  (MultiTablePagingState ConversationPagingName LocalOrRemoteTable)
Range 1 1000 Int32
gmtprSize :: Range 1 1000 Int32
gmtprState :: Maybe
  (MultiTablePagingState ConversationPagingName LocalOrRemoteTable)
$sel:gmtprSize:GetMultiTablePageRequest :: forall (name :: Symbol) tables (max :: Nat) (def :: Nat).
GetMultiTablePageRequest name tables max def -> Range 1 max Int32
$sel:gmtprState:GetMultiTablePageRequest :: forall (name :: Symbol) tables (max :: Nat) (def :: Nat).
GetMultiTablePageRequest name tables max def
-> Maybe (MultiTablePagingState name tables)
..} = do
  let localDomain :: Domain
localDomain = Local UserId -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Local UserId
lusr
  case Maybe
  (MultiTablePagingState ConversationPagingName LocalOrRemoteTable)
gmtprState of
    Just (Public.ConversationPagingState LocalOrRemoteTable
Public.PagingRemotes Maybe ByteString
stateBS) ->
      Maybe PagingState -> Range 1 1000 Int32 -> Sem r ConvIdsPage
remotesOnly (ByteString -> PagingState
mkState (ByteString -> PagingState)
-> Maybe ByteString -> Maybe PagingState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
stateBS) Range 1 1000 Int32
gmtprSize
    Maybe
  (MultiTablePagingState ConversationPagingName LocalOrRemoteTable)
_ -> Domain
-> Maybe PagingState -> Range 1 1000 Int32 -> Sem r ConvIdsPage
localsAndRemotes Domain
localDomain ((ByteString -> PagingState)
-> Maybe ByteString -> Maybe PagingState
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> PagingState
mkState (Maybe ByteString -> Maybe PagingState)
-> (MultiTablePagingState ConversationPagingName LocalOrRemoteTable
    -> Maybe ByteString)
-> MultiTablePagingState ConversationPagingName LocalOrRemoteTable
-> Maybe PagingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiTablePagingState ConversationPagingName LocalOrRemoteTable
-> Maybe ByteString
forall (name :: Symbol) tables.
MultiTablePagingState name tables -> Maybe ByteString
Public.mtpsState (MultiTablePagingState ConversationPagingName LocalOrRemoteTable
 -> Maybe PagingState)
-> Maybe
     (MultiTablePagingState ConversationPagingName LocalOrRemoteTable)
-> Maybe PagingState
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe
  (MultiTablePagingState ConversationPagingName LocalOrRemoteTable)
gmtprState) Range 1 1000 Int32
gmtprSize
  where
    mkState :: ByteString -> C.PagingState
    mkState :: ByteString -> PagingState
mkState = ByteString -> PagingState
C.PagingState (ByteString -> PagingState)
-> (ByteString -> ByteString) -> ByteString -> PagingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict

    localsAndRemotes ::
      Domain ->
      Maybe C.PagingState ->
      Range 1 1000 Int32 ->
      Sem r Public.ConvIdsPage
    localsAndRemotes :: Domain
-> Maybe PagingState -> Range 1 1000 Int32 -> Sem r ConvIdsPage
localsAndRemotes Domain
localDomain Maybe PagingState
pagingState Range 1 1000 Int32
size = do
      ConvIdsPage
localPage <- Domain
-> Maybe PagingState -> Range 1 1000 Int32 -> Sem r ConvIdsPage
localsOnly Domain
localDomain Maybe PagingState
pagingState Range 1 1000 Int32
size
      let remainingSize :: Int32
remainingSize = Range 1 1000 Int32 -> Int32
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange Range 1 1000 Int32
size Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Qualified ConvId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ConvIdsPage -> [Qualified ConvId]
forall (name :: Symbol) (resultsKey :: Symbol) tables a.
MultiTablePage name resultsKey tables a -> [a]
Public.mtpResults ConvIdsPage
localPage))
      if ConvIdsPage -> Bool
forall (name :: Symbol) (resultsKey :: Symbol) tables a.
MultiTablePage name resultsKey tables a -> Bool
Public.mtpHasMore ConvIdsPage
localPage Bool -> Bool -> Bool
|| Int32
remainingSize Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
0
        then -- We haven't checked the remotes yet, so has_more must always be True here.
          ConvIdsPage -> Sem r ConvIdsPage
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConvIdsPage -> ConvIdsPage
filterOut ConvIdsPage
localPage) {Public.mtpHasMore = True}
        else do
          -- remainingSize <= size and remainingSize >= 1, so it is safe to convert to Range
          ConvIdsPage
remotePage <- Maybe PagingState -> Range 1 1000 Int32 -> Sem r ConvIdsPage
remotesOnly Maybe PagingState
forall a. Maybe a
Nothing (Int32 -> Range 1 1000 Int32
forall a (n :: Nat) (m :: Nat).
(Show a, KnownNat n, KnownNat m, Within a n m) =>
a -> Range n m a
unsafeRange Int32
remainingSize)
          ConvIdsPage -> Sem r ConvIdsPage
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConvIdsPage -> Sem r ConvIdsPage)
-> ConvIdsPage -> Sem r ConvIdsPage
forall a b. (a -> b) -> a -> b
$
            ConvIdsPage
remotePage
              { Public.mtpResults =
                  Public.mtpResults (filterOut localPage)
                    <> Public.mtpResults remotePage
              }

    localsOnly ::
      Domain ->
      Maybe C.PagingState ->
      Range 1 1000 Int32 ->
      Sem r Public.ConvIdsPage
    localsOnly :: Domain
-> Maybe PagingState -> Range 1 1000 Int32 -> Sem r ConvIdsPage
localsOnly Domain
localDomain Maybe PagingState
pagingState Range 1 1000 Int32
size =
      LocalOrRemoteTable
-> PageWithState (Qualified ConvId) -> ConvIdsPage
pageToConvIdPage LocalOrRemoteTable
Public.PagingLocals
        (PageWithState (Qualified ConvId) -> ConvIdsPage)
-> (PageWithState ConvId -> PageWithState (Qualified ConvId))
-> PageWithState ConvId
-> ConvIdsPage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConvId -> Qualified ConvId)
-> PageWithState ConvId -> PageWithState (Qualified ConvId)
forall a b. (a -> b) -> PageWithState a -> PageWithState b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ConvId -> Domain -> Qualified ConvId
forall a. a -> Domain -> Qualified a
`Qualified` Domain
localDomain)
        (PageWithState ConvId -> ConvIdsPage)
-> Sem r (PageWithState ConvId) -> Sem r ConvIdsPage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserId
-> Maybe (PagingState CassandraPaging ConvId)
-> PagingBounds CassandraPaging ConvId
-> Sem r (Page CassandraPaging ConvId)
forall p i (r :: EffectRow).
Member (ListItems p i) r =>
UserId
-> Maybe (PagingState p i) -> PagingBounds p i -> Sem r (Page p i)
E.listItems (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) Maybe PagingState
Maybe (PagingState CassandraPaging ConvId)
pagingState PagingBounds CassandraPaging ConvId
Range 1 1000 Int32
size

    remotesOnly ::
      Maybe C.PagingState ->
      Range 1 1000 Int32 ->
      Sem r Public.ConvIdsPage
    remotesOnly :: Maybe PagingState -> Range 1 1000 Int32 -> Sem r ConvIdsPage
remotesOnly Maybe PagingState
pagingState Range 1 1000 Int32
size =
      LocalOrRemoteTable
-> PageWithState (Qualified ConvId) -> ConvIdsPage
pageToConvIdPage LocalOrRemoteTable
Public.PagingRemotes
        (PageWithState (Qualified ConvId) -> ConvIdsPage)
-> (PageWithState (Remote ConvId)
    -> PageWithState (Qualified ConvId))
-> PageWithState (Remote ConvId)
-> ConvIdsPage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Remote ConvId -> Qualified ConvId)
-> PageWithState (Remote ConvId)
-> PageWithState (Qualified ConvId)
forall a b. (a -> b) -> PageWithState a -> PageWithState b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged @'QRemote)
        (PageWithState (Remote ConvId) -> ConvIdsPage)
-> Sem r (PageWithState (Remote ConvId)) -> Sem r ConvIdsPage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserId
-> Maybe (PagingState CassandraPaging (Remote ConvId))
-> PagingBounds CassandraPaging (Remote ConvId)
-> Sem r (Page CassandraPaging (Remote ConvId))
forall p i (r :: EffectRow).
Member (ListItems p i) r =>
UserId
-> Maybe (PagingState p i) -> PagingBounds p i -> Sem r (Page p i)
E.listItems (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) Maybe PagingState
Maybe (PagingState CassandraPaging (Remote ConvId))
pagingState PagingBounds CassandraPaging (Remote ConvId)
Range 1 1000 Int32
size

    pageToConvIdPage :: Public.LocalOrRemoteTable -> C.PageWithState (Qualified ConvId) -> Public.ConvIdsPage
    pageToConvIdPage :: LocalOrRemoteTable
-> PageWithState (Qualified ConvId) -> ConvIdsPage
pageToConvIdPage LocalOrRemoteTable
table page :: PageWithState (Qualified ConvId)
page@C.PageWithState {[Qualified ConvId]
Maybe PagingState
pwsResults :: [Qualified ConvId]
pwsState :: Maybe PagingState
$sel:pwsResults:PageWithState :: forall a. PageWithState a -> [a]
$sel:pwsState:PageWithState :: forall a. PageWithState a -> Maybe PagingState
..} =
      Public.MultiTablePage
        { $sel:mtpResults:MultiTablePage :: [Qualified ConvId]
mtpResults = [Qualified ConvId]
pwsResults,
          $sel:mtpHasMore:MultiTablePage :: Bool
mtpHasMore = PageWithState (Qualified ConvId) -> Bool
forall a. PageWithState a -> Bool
C.pwsHasMore PageWithState (Qualified ConvId)
page,
          $sel:mtpPagingState:MultiTablePage :: MultiTablePagingState ConversationPagingName LocalOrRemoteTable
mtpPagingState = LocalOrRemoteTable
-> Maybe ByteString
-> MultiTablePagingState ConversationPagingName LocalOrRemoteTable
forall tables (name :: Symbol).
tables -> Maybe ByteString -> MultiTablePagingState name tables
Public.ConversationPagingState LocalOrRemoteTable
table (ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (PagingState -> ByteString) -> PagingState -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PagingState -> ByteString
C.unPagingState (PagingState -> ByteString)
-> Maybe PagingState -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PagingState
pwsState)
        }

    -- MLS self-conversation of this user
    selfConvId :: ConvId
selfConvId = UserId -> ConvId
mlsSelfConvId (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr)
    isNotSelfConv :: Qualified ConvId -> Bool
isNotSelfConv = (ConvId -> ConvId -> Bool
forall a. Eq a => a -> a -> Bool
/= ConvId
selfConvId) (ConvId -> Bool)
-> (Qualified ConvId -> ConvId) -> Qualified ConvId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified ConvId -> ConvId
forall a. Qualified a -> a
qUnqualified

    -- If this is an old client making a request (i.e., a V1 or V2 client), make
    -- sure to filter out the MLS global team conversation and the MLS
    -- self-conversation.
    --
    -- FUTUREWORK: This is yet to be implemented for global team conversations.
    filterOut :: ConvIdsPage -> ConvIdsPage
    filterOut :: ConvIdsPage -> ConvIdsPage
filterOut ConvIdsPage
page | ListGlobalSelfConvs
listGlobalSelf ListGlobalSelfConvs -> ListGlobalSelfConvs -> Bool
forall a. Eq a => a -> a -> Bool
== ListGlobalSelfConvs
ListGlobalSelf = ConvIdsPage
page
    filterOut ConvIdsPage
page =
      ConvIdsPage
page
        { Public.mtpResults = filter isNotSelfConv $ Public.mtpResults page
        }

-- | Lists conversation ids for the logged in user in a paginated way.
--
-- Pagination requires an order, in this case the order is defined as:
--
-- - First all the local conversations are listed ordered by their id
--
-- - After local conversations, remote conversations are listed ordered
-- - lexicographically by their domain and then by their id.
conversationIdsPageFrom ::
  forall p r.
  ( 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 P.TinyLog r
    )
  ) =>
  Local UserId ->
  Public.GetPaginatedConversationIds ->
  Sem r Public.ConvIdsPage
conversationIdsPageFrom :: 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
conversationIdsPageFrom Local UserId
lusr GetPaginatedConversationIds
state = do
  -- NOTE: Getting the MLS self-conversation creates it in case it does not
  -- exist yet. This is to ensure it is automatically listed without needing to
  -- create it separately.
  --
  -- Make sure that in case MLS is not configured (the non-existance of the
  -- backend removal key is a proxy for it) the self-conversation is not
  -- returned or attempted to be created; in that case we skip anything related
  -- to it.
  Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM Sem r Bool
forall (r :: EffectRow). Member (Input Env) r => Sem r Bool
isMLSEnabled (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Sem r Conversation -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Conversation -> Sem r ()) -> Sem r Conversation -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Local UserId -> Sem r Conversation
forall (r :: EffectRow).
(Member ConversationStore r, Member (Error InternalError) r,
 Member TinyLog r) =>
Local UserId -> Sem r Conversation
getMLSSelfConversation Local UserId
lusr
  ListGlobalSelfConvs
-> 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)) =>
ListGlobalSelfConvs
-> Local UserId -> GetPaginatedConversationIds -> Sem r ConvIdsPage
conversationIdsPageFromV2 ListGlobalSelfConvs
ListGlobalSelf Local UserId
lusr GetPaginatedConversationIds
state

getConversations ::
  ( Member (Error InternalError) r,
    Member (ListItems LegacyPaging ConvId) r,
    Member ConversationStore r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  Maybe (Range 1 32 (CommaSeparatedList ConvId)) ->
  Maybe ConvId ->
  Maybe (Range 1 500 Int32) ->
  Sem r (Public.ConversationList Public.Conversation)
getConversations :: forall (r :: EffectRow).
(Member (Error InternalError) r,
 Member (ListItems LegacyPaging ConvId) r,
 Member ConversationStore r, Member TinyLog r) =>
Local UserId
-> Maybe (Range 1 32 (CommaSeparatedList ConvId))
-> Maybe ConvId
-> Maybe (Range 1 500 Int32)
-> Sem r (ConversationList Conversation)
getConversations Local UserId
luser Maybe (Range 1 32 (CommaSeparatedList ConvId))
mids Maybe ConvId
mstart Maybe (Range 1 500 Int32)
msize = do
  ConversationList [Conversation]
cs Bool
more <- Local UserId
-> Maybe (Range 1 32 (CommaSeparatedList ConvId))
-> Maybe ConvId
-> Maybe (Range 1 500 Int32)
-> Sem r (ConversationList Conversation)
forall (r :: EffectRow).
(Member ConversationStore r,
 Member (ListItems LegacyPaging ConvId) r) =>
Local UserId
-> Maybe (Range 1 32 (CommaSeparatedList ConvId))
-> Maybe ConvId
-> Maybe (Range 1 500 Int32)
-> Sem r (ConversationList Conversation)
getConversationsInternal Local UserId
luser Maybe (Range 1 32 (CommaSeparatedList ConvId))
mids Maybe ConvId
mstart Maybe (Range 1 500 Int32)
msize
  ([Conversation] -> Bool -> ConversationList Conversation)
-> Bool -> [Conversation] -> ConversationList Conversation
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Conversation] -> Bool -> ConversationList Conversation
forall a. [a] -> Bool -> ConversationList a
ConversationList Bool
more ([Conversation] -> ConversationList Conversation)
-> Sem r [Conversation] -> Sem r (ConversationList Conversation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Conversation -> Sem r Conversation)
-> [Conversation] -> Sem r [Conversation]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Local UserId -> Conversation -> Sem r Conversation
forall (r :: EffectRow).
(Member (Error InternalError) r, Member TinyLog r) =>
Local UserId -> Conversation -> Sem r Conversation
Mapping.conversationView Local UserId
luser) [Conversation]
cs

getConversationsInternal ::
  ( Member ConversationStore r,
    Member (ListItems LegacyPaging ConvId) r
  ) =>
  Local UserId ->
  Maybe (Range 1 32 (CommaSeparatedList ConvId)) ->
  Maybe ConvId ->
  Maybe (Range 1 500 Int32) ->
  Sem r (Public.ConversationList Data.Conversation)
getConversationsInternal :: forall (r :: EffectRow).
(Member ConversationStore r,
 Member (ListItems LegacyPaging ConvId) r) =>
Local UserId
-> Maybe (Range 1 32 (CommaSeparatedList ConvId))
-> Maybe ConvId
-> Maybe (Range 1 500 Int32)
-> Sem r (ConversationList Conversation)
getConversationsInternal Local UserId
luser Maybe (Range 1 32 (CommaSeparatedList ConvId))
mids Maybe ConvId
mstart Maybe (Range 1 500 Int32)
msize = do
  (Bool
more, [ConvId]
ids) <- Maybe (Range 1 32 (CommaSeparatedList ConvId))
-> Sem r (Bool, [ConvId])
forall (r :: EffectRow).
(Member ConversationStore r,
 Member (ListItems LegacyPaging ConvId) r) =>
Maybe (Range 1 32 (CommaSeparatedList ConvId))
-> Sem r (Bool, [ConvId])
getIds Maybe (Range 1 32 (CommaSeparatedList ConvId))
mids
  let localConvIds :: [ConvId]
localConvIds = [ConvId]
ids
  [Conversation]
cs <-
    [ConvId] -> Sem r [Conversation]
forall (r :: EffectRow).
Member ConversationStore r =>
[ConvId] -> Sem r [Conversation]
E.getConversations [ConvId]
localConvIds
      Sem r [Conversation]
-> ([Conversation] -> Sem r [Conversation]) -> Sem r [Conversation]
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Conversation -> Sem r Bool)
-> [Conversation] -> Sem r [Conversation]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Conversation -> Sem r Bool
forall (r :: EffectRow).
Member ConversationStore r =>
Conversation -> Sem r Bool
removeDeleted
      Sem r [Conversation]
-> ([Conversation] -> Sem r [Conversation]) -> Sem r [Conversation]
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Conversation -> Sem r Bool)
-> [Conversation] -> Sem r [Conversation]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Sem r Bool)
-> (Conversation -> Bool) -> Conversation -> Sem r Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> [LocalMember] -> Bool
forall (m :: * -> *). Foldable m => UserId -> m LocalMember -> Bool
isMember (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luser) ([LocalMember] -> Bool)
-> (Conversation -> [LocalMember]) -> Conversation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> [LocalMember]
Data.convLocalMembers)
  ConversationList Conversation
-> Sem r (ConversationList Conversation)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConversationList Conversation
 -> Sem r (ConversationList Conversation))
-> ConversationList Conversation
-> Sem r (ConversationList Conversation)
forall a b. (a -> b) -> a -> b
$ [Conversation] -> Bool -> ConversationList Conversation
forall a. [a] -> Bool -> ConversationList a
Public.ConversationList [Conversation]
cs Bool
more
  where
    size :: Range 1 500 Int32
size = Range 1 500 Int32 -> Maybe (Range 1 500 Int32) -> Range 1 500 Int32
forall a. a -> Maybe a -> a
fromMaybe (Proxy 32 -> Range 1 500 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 @32)) Maybe (Range 1 500 Int32)
msize

    -- get ids and has_more flag
    getIds ::
      ( Member ConversationStore r,
        Member (ListItems LegacyPaging ConvId) r
      ) =>
      Maybe (Range 1 32 (CommaSeparatedList ConvId)) ->
      Sem r (Bool, [ConvId])
    getIds :: forall (r :: EffectRow).
(Member ConversationStore r,
 Member (ListItems LegacyPaging ConvId) r) =>
Maybe (Range 1 32 (CommaSeparatedList ConvId))
-> Sem r (Bool, [ConvId])
getIds (Just Range 1 32 (CommaSeparatedList ConvId)
ids) =
      (Bool
False,)
        ([ConvId] -> (Bool, [ConvId]))
-> Sem r [ConvId] -> Sem r (Bool, [ConvId])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserId -> [ConvId] -> Sem r [ConvId]
forall (r :: EffectRow).
Member ConversationStore r =>
UserId -> [ConvId] -> Sem r [ConvId]
E.selectConversations
          (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luser)
          (CommaSeparatedList ConvId -> [ConvId]
forall a. CommaSeparatedList a -> [a]
fromCommaSeparatedList (Range 1 32 (CommaSeparatedList ConvId) -> CommaSeparatedList ConvId
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange Range 1 32 (CommaSeparatedList ConvId)
ids))
    getIds Maybe (Range 1 32 (CommaSeparatedList ConvId))
Nothing = do
      ResultSet ConvId
r <- UserId
-> Maybe (PagingState LegacyPaging ConvId)
-> PagingBounds LegacyPaging ConvId
-> Sem r (Page LegacyPaging ConvId)
forall p i (r :: EffectRow).
Member (ListItems p i) r =>
UserId
-> Maybe (PagingState p i) -> PagingBounds p i -> Sem r (Page p i)
E.listItems (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luser) Maybe (PagingState LegacyPaging ConvId)
Maybe ConvId
mstart (Range 1 500 Int32 -> Range 1 1000 Int32
forall (n :: Nat) (m :: Nat) (m' :: Nat) (n' :: Nat) a.
(n <= m, m <= m', n >= n') =>
Range n m a -> Range n' m' a
rcast Range 1 500 Int32
size)
      let hasMore :: Bool
hasMore = ResultSet ConvId -> ResultSetType
forall a. ResultSet a -> ResultSetType
resultSetType ResultSet ConvId
r ResultSetType -> ResultSetType -> Bool
forall a. Eq a => a -> a -> Bool
== ResultSetType
ResultSetTruncated
      (Bool, [ConvId]) -> Sem r (Bool, [ConvId])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
hasMore, ResultSet ConvId -> [ConvId]
forall a. ResultSet a -> [a]
resultSetResult ResultSet ConvId
r)

    removeDeleted ::
      (Member ConversationStore r) =>
      Data.Conversation ->
      Sem r Bool
    removeDeleted :: forall (r :: EffectRow).
Member ConversationStore r =>
Conversation -> Sem r Bool
removeDeleted Conversation
c
      | Conversation -> Bool
Data.isConvDeleted Conversation
c = ConvId -> Sem r ()
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r ()
E.deleteConversation (Conversation -> ConvId
Data.convId Conversation
c) Sem r () -> Sem r Bool -> Sem r Bool
forall a b. Sem r a -> Sem r b -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      | Bool
otherwise = Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

listConversations ::
  ( Member ConversationStore r,
    Member (Error InternalError) r,
    Member FederatorAccess r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  Public.ListConversations ->
  Sem r Public.ConversationsResponse
listConversations :: forall (r :: EffectRow).
(Member ConversationStore r, Member (Error InternalError) r,
 Member FederatorAccess r, Member TinyLog r) =>
Local UserId -> ListConversations -> Sem r ConversationsResponse
listConversations Local UserId
luser (Public.ListConversations Range 1 1000 [Qualified ConvId]
ids) = do
  let ([ConvId]
localIds, [Remote ConvId]
remoteIds) = Local UserId -> [Qualified ConvId] -> ([ConvId], [Remote ConvId])
forall (f :: * -> *) x a.
Foldable f =>
Local x -> f (Qualified a) -> ([a], [Remote a])
partitionQualified Local UserId
luser (Range 1 1000 [Qualified ConvId] -> [Qualified ConvId]
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange Range 1 1000 [Qualified ConvId]
ids)
  ([ConvId]
foundLocalIds, [ConvId]
notFoundLocalIds) <-
    ([ConvId] -> Sem r [ConvId])
-> [ConvId] -> Sem r ([ConvId], [ConvId])
forall (m :: * -> *) a.
(Monad m, Eq a) =>
([a] -> m [a]) -> [a] -> m ([a], [a])
foundsAndNotFounds (UserId -> [ConvId] -> Sem r [ConvId]
forall (r :: EffectRow).
Member ConversationStore r =>
UserId -> [ConvId] -> Sem r [ConvId]
E.selectConversations (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luser)) [ConvId]
localIds

  [Conversation]
localInternalConversations <-
    [ConvId] -> Sem r [Conversation]
forall (r :: EffectRow).
Member ConversationStore r =>
[ConvId] -> Sem r [Conversation]
E.getConversations [ConvId]
foundLocalIds
      Sem r [Conversation]
-> ([Conversation] -> Sem r [Conversation]) -> Sem r [Conversation]
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Conversation -> Sem r Bool)
-> [Conversation] -> Sem r [Conversation]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Conversation -> Sem r Bool
forall (r :: EffectRow).
Member ConversationStore r =>
Conversation -> Sem r Bool
removeDeleted
      Sem r [Conversation]
-> ([Conversation] -> Sem r [Conversation]) -> Sem r [Conversation]
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Conversation -> Sem r Bool)
-> [Conversation] -> Sem r [Conversation]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Sem r Bool)
-> (Conversation -> Bool) -> Conversation -> Sem r Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> [LocalMember] -> Bool
forall (m :: * -> *). Foldable m => UserId -> m LocalMember -> Bool
isMember (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luser) ([LocalMember] -> Bool)
-> (Conversation -> [LocalMember]) -> Conversation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> [LocalMember]
Data.convLocalMembers)
  [Conversation]
localConversations <- (Conversation -> Sem r Conversation)
-> [Conversation] -> Sem r [Conversation]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Local UserId -> Conversation -> Sem r Conversation
forall (r :: EffectRow).
(Member (Error InternalError) r, Member TinyLog r) =>
Local UserId -> Conversation -> Sem r Conversation
Mapping.conversationView Local UserId
luser) [Conversation]
localInternalConversations

  ([FailedGetConversation]
remoteFailures, [Conversation]
remoteConversations) <- Local UserId
-> [Remote ConvId]
-> Sem r ([FailedGetConversation], [Conversation])
forall (r :: EffectRow).
(Member ConversationStore r, Member FederatorAccess r,
 Member TinyLog r) =>
Local UserId
-> [Remote ConvId]
-> Sem r ([FailedGetConversation], [Conversation])
getRemoteConversationsWithFailures Local UserId
luser [Remote ConvId]
remoteIds
  let ([Qualified ConvId]
failedConvsLocally, [Qualified ConvId]
failedConvsRemotely) = [FailedGetConversation] -> ([Qualified ConvId], [Qualified ConvId])
partitionGetConversationFailures [FailedGetConversation]
remoteFailures
      failedConvs :: [Qualified ConvId]
failedConvs = [Qualified ConvId]
failedConvsLocally [Qualified ConvId] -> [Qualified ConvId] -> [Qualified ConvId]
forall a. Semigroup a => a -> a -> a
<> [Qualified ConvId]
failedConvsRemotely
      fetchedOrFailedRemoteIds :: Set (Qualified ConvId)
fetchedOrFailedRemoteIds = [Qualified ConvId] -> Set (Qualified ConvId)
forall a. Ord a => [a] -> Set a
Set.fromList ([Qualified ConvId] -> Set (Qualified ConvId))
-> [Qualified ConvId] -> Set (Qualified ConvId)
forall a b. (a -> b) -> a -> b
$ (Conversation -> Qualified ConvId)
-> [Conversation] -> [Qualified ConvId]
forall a b. (a -> b) -> [a] -> [b]
map Conversation -> Qualified ConvId
Public.cnvQualifiedId [Conversation]
remoteConversations [Qualified ConvId] -> [Qualified ConvId] -> [Qualified ConvId]
forall a. Semigroup a => a -> a -> a
<> [Qualified ConvId]
failedConvs
      remoteNotFoundRemoteIds :: [Qualified ConvId]
remoteNotFoundRemoteIds = (Qualified ConvId -> Bool)
-> [Qualified ConvId] -> [Qualified ConvId]
forall a. (a -> Bool) -> [a] -> [a]
filter (Qualified ConvId -> Set (Qualified ConvId) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set (Qualified ConvId)
fetchedOrFailedRemoteIds) ([Qualified ConvId] -> [Qualified ConvId])
-> [Qualified ConvId] -> [Qualified ConvId]
forall a b. (a -> b) -> a -> b
$ (Remote ConvId -> Qualified ConvId)
-> [Remote ConvId] -> [Qualified ConvId]
forall a b. (a -> b) -> [a] -> [b]
map Remote ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged [Remote ConvId]
remoteIds
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Qualified ConvId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Qualified ConvId]
remoteNotFoundRemoteIds) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    -- FUTUREWORK: This implies that the backends are out of sync. Maybe the
    -- current user should be considered removed from this conversation at this
    -- point.
    (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.warn ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
      ByteString -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
Logger.msg (ByteString
"Some locally found conversation ids were not returned by remotes" :: ByteString)
        (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char] -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Logger.field ByteString
"convIds" ([Qualified ConvId] -> [Char]
forall a. Show a => a -> [Char]
show [Qualified ConvId]
remoteNotFoundRemoteIds)

  let allConvs :: [Conversation]
allConvs = [Conversation]
localConversations [Conversation] -> [Conversation] -> [Conversation]
forall a. Semigroup a => a -> a -> a
<> [Conversation]
remoteConversations
  ConversationsResponse -> Sem r ConversationsResponse
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConversationsResponse -> Sem r ConversationsResponse)
-> ConversationsResponse -> Sem r ConversationsResponse
forall a b. (a -> b) -> a -> b
$
    Public.ConversationsResponse
      { $sel:crFound:ConversationsResponse :: [Conversation]
crFound = [Conversation]
allConvs,
        $sel:crNotFound:ConversationsResponse :: [Qualified ConvId]
crNotFound =
          [Qualified ConvId]
failedConvsLocally
            [Qualified ConvId] -> [Qualified ConvId] -> [Qualified ConvId]
forall a. Semigroup a => a -> a -> a
<> [Qualified ConvId]
remoteNotFoundRemoteIds
            [Qualified ConvId] -> [Qualified ConvId] -> [Qualified ConvId]
forall a. Semigroup a => a -> a -> a
<> (ConvId -> Qualified ConvId) -> [ConvId] -> [Qualified ConvId]
forall a b. (a -> b) -> [a] -> [b]
map (Local ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (Local ConvId -> Qualified ConvId)
-> (ConvId -> Local ConvId) -> ConvId -> Qualified ConvId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local UserId -> ConvId -> Local ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
luser) [ConvId]
notFoundLocalIds,
        $sel:crFailed:ConversationsResponse :: [Qualified ConvId]
crFailed = [Qualified ConvId]
failedConvsRemotely
      }
  where
    removeDeleted ::
      (Member ConversationStore r) =>
      Data.Conversation ->
      Sem r Bool
    removeDeleted :: forall (r :: EffectRow).
Member ConversationStore r =>
Conversation -> Sem r Bool
removeDeleted Conversation
c
      | Conversation -> Bool
Data.isConvDeleted Conversation
c = ConvId -> Sem r ()
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r ()
E.deleteConversation (Conversation -> ConvId
Data.convId Conversation
c) Sem r () -> Sem r Bool -> Sem r Bool
forall a b. Sem r a -> Sem r b -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      | Bool
otherwise = Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    foundsAndNotFounds :: (Monad m, Eq a) => ([a] -> m [a]) -> [a] -> m ([a], [a])
    foundsAndNotFounds :: forall (m :: * -> *) a.
(Monad m, Eq a) =>
([a] -> m [a]) -> [a] -> m ([a], [a])
foundsAndNotFounds [a] -> m [a]
f [a]
xs = do
      [a]
founds <- [a] -> m [a]
f [a]
xs
      let notFounds :: [a]
notFounds = [a]
xs [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
founds
      ([a], [a]) -> m ([a], [a])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a]
founds, [a]
notFounds)

iterateConversations ::
  ( Member (ListItems LegacyPaging ConvId) r,
    Member ConversationStore r
  ) =>
  Local UserId ->
  Range 1 500 Int32 ->
  ([Data.Conversation] -> Sem r a) ->
  Sem r [a]
iterateConversations :: forall (r :: EffectRow) a.
(Member (ListItems LegacyPaging ConvId) r,
 Member ConversationStore r) =>
Local UserId
-> Range 1 500 Int32 -> ([Conversation] -> Sem r a) -> Sem r [a]
iterateConversations Local UserId
luid Range 1 500 Int32
pageSize [Conversation] -> Sem r a
handleConvs = Maybe ConvId -> Sem r [a]
go Maybe ConvId
forall a. Maybe a
Nothing
  where
    go :: Maybe ConvId -> Sem r [a]
go Maybe ConvId
mbConv = do
      ConversationList Conversation
convResult <- Local UserId
-> Maybe (Range 1 32 (CommaSeparatedList ConvId))
-> Maybe ConvId
-> Maybe (Range 1 500 Int32)
-> Sem r (ConversationList Conversation)
forall (r :: EffectRow).
(Member ConversationStore r,
 Member (ListItems LegacyPaging ConvId) r) =>
Local UserId
-> Maybe (Range 1 32 (CommaSeparatedList ConvId))
-> Maybe ConvId
-> Maybe (Range 1 500 Int32)
-> Sem r (ConversationList Conversation)
getConversationsInternal Local UserId
luid Maybe (Range 1 32 (CommaSeparatedList ConvId))
forall a. Maybe a
Nothing Maybe ConvId
mbConv (Range 1 500 Int32 -> Maybe (Range 1 500 Int32)
forall a. a -> Maybe a
Just Range 1 500 Int32
pageSize)
      a
resultHead <- [Conversation] -> Sem r a
handleConvs (ConversationList Conversation -> [Conversation]
forall a. ConversationList a -> [a]
convList ConversationList Conversation
convResult)
      [a]
resultTail <- case ConversationList Conversation -> [Conversation]
forall a. ConversationList a -> [a]
convList ConversationList Conversation
convResult of
        (Conversation
conv : [Conversation]
rest) ->
          if ConversationList Conversation -> Bool
forall a. ConversationList a -> Bool
convHasMore ConversationList Conversation
convResult
            then Maybe ConvId -> Sem r [a]
go (ConvId -> Maybe ConvId
forall a. a -> Maybe a
Just ([ConvId] -> ConvId
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Conversation -> ConvId
Data.convId (Conversation -> ConvId) -> [Conversation] -> [ConvId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Conversation
conv Conversation -> [Conversation] -> [Conversation]
forall a. a -> [a] -> [a]
: [Conversation]
rest))))
            else [a] -> Sem r [a]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        [Conversation]
_ -> [a] -> Sem r [a]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      [a] -> Sem r [a]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Sem r [a]) -> [a] -> Sem r [a]
forall a b. (a -> b) -> a -> b
$ a
resultHead a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
resultTail

internalGetMember ::
  ( Member ConversationStore r,
    Member (Input (Local ())) r,
    Member MemberStore r
  ) =>
  ConvId ->
  UserId ->
  Sem r (Maybe Public.Member)
internalGetMember :: forall (r :: EffectRow).
(Member ConversationStore r, Member (Input (Local ())) r,
 Member MemberStore r) =>
ConvId -> UserId -> Sem r (Maybe Member)
internalGetMember ConvId
cnv UserId
usr = 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
  Local UserId -> ConvId -> Sem r (Maybe Member)
forall (r :: EffectRow).
(Member ConversationStore r, Member MemberStore r) =>
Local UserId -> ConvId -> Sem r (Maybe Member)
getLocalSelf Local UserId
lusr ConvId
cnv

getLocalSelf ::
  ( Member ConversationStore r,
    Member MemberStore r
  ) =>
  Local UserId ->
  ConvId ->
  Sem r (Maybe Public.Member)
getLocalSelf :: forall (r :: EffectRow).
(Member ConversationStore r, Member MemberStore r) =>
Local UserId -> ConvId -> Sem r (Maybe Member)
getLocalSelf Local UserId
lusr ConvId
cnv = do
  do
    Bool
alive <- ConvId -> Sem r Bool
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r Bool
E.isConversationAlive ConvId
cnv
    if Bool
alive
      then Local UserId -> LocalMember -> Member
forall x. Local x -> LocalMember -> Member
Mapping.localMemberToSelf Local UserId
lusr (LocalMember -> Member)
-> Sem r (Maybe LocalMember) -> Sem r (Maybe Member)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> ConvId -> UserId -> Sem r (Maybe LocalMember)
forall (r :: EffectRow).
Member MemberStore r =>
ConvId -> UserId -> Sem r (Maybe LocalMember)
E.getLocalMember ConvId
cnv (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr)
      else Maybe Member
forall a. Maybe a
Nothing Maybe Member -> Sem r () -> Sem r (Maybe Member)
forall a b. a -> Sem r b -> Sem r a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ConvId -> Sem r ()
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r ()
E.deleteConversation ConvId
cnv

getConversationMeta ::
  ( Member ConversationStore r,
    Member (ErrorS 'ConvNotFound) r
  ) =>
  ConvId ->
  Sem r ConversationMetadata
getConversationMeta :: forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r) =>
ConvId -> Sem r ConversationMetadata
getConversationMeta ConvId
cnv =
  Sem r Bool
-> Sem r ConversationMetadata
-> Sem r ConversationMetadata
-> Sem r ConversationMetadata
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM
    (ConvId -> Sem r Bool
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r Bool
E.isConversationAlive ConvId
cnv)
    (ConvId -> Sem r (Maybe ConversationMetadata)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe ConversationMetadata)
E.getConversationMetadata ConvId
cnv Sem r (Maybe ConversationMetadata)
-> (Maybe ConversationMetadata -> Sem r ConversationMetadata)
-> Sem r ConversationMetadata
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'ConvNotFound)
    (ConvId -> Sem r ()
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r ()
E.deleteConversation ConvId
cnv Sem r ()
-> Sem r ConversationMetadata -> Sem r ConversationMetadata
forall a b. Sem r a -> Sem r b -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'ConvNotFound)

getConversationByReusableCode ::
  forall r.
  ( Member BrigAccess r,
    Member CodeStore r,
    Member ConversationStore r,
    Member (ErrorS 'CodeNotFound) r,
    Member (ErrorS 'InvalidConversationPassword) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (ErrorS 'GuestLinksDisabled) r,
    Member (ErrorS 'NotATeamMember) r,
    Member TeamStore r,
    Member TeamFeatureStore r,
    Member (Input Opts) r
  ) =>
  Local UserId ->
  Key ->
  Value ->
  Sem r ConversationCoverView
getConversationByReusableCode :: forall (r :: EffectRow).
(Member BrigAccess r, Member CodeStore r,
 Member ConversationStore r, Member (ErrorS 'CodeNotFound) r,
 Member (ErrorS 'InvalidConversationPassword) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'GuestLinksDisabled) r,
 Member (ErrorS 'NotATeamMember) r, Member TeamStore r,
 Member TeamFeatureStore r, Member (Input Opts) r) =>
Local UserId -> Key -> Value -> Sem r ConversationCoverView
getConversationByReusableCode Local UserId
lusr Key
key Value
value = do
  Code
c <- Bool -> Maybe PlainTextPassword8 -> ConversationCode -> Sem r Code
forall (r :: EffectRow).
(Member CodeStore r, Member (ErrorS 'CodeNotFound) r,
 Member (ErrorS 'InvalidConversationPassword) r) =>
Bool -> Maybe PlainTextPassword8 -> ConversationCode -> Sem r Code
verifyReusableCode Bool
False Maybe PlainTextPassword8
forall a. Maybe a
Nothing (Key -> Value -> Maybe HttpsUrl -> ConversationCode
ConversationCode Key
key Value
value Maybe HttpsUrl
forall a. Maybe a
Nothing)
  Conversation
conv <- ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
E.getConversation (Code -> ConvId
codeConversation Code
c) Sem r (Maybe Conversation)
-> (Maybe Conversation -> Sem r Conversation) -> Sem r Conversation
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'ConvNotFound
  UserId -> Conversation -> Access -> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'NotATeamMember) r, Member TeamStore r) =>
UserId -> Conversation -> Access -> Sem r ()
ensureConversationAccess (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) Conversation
conv Access
CodeAccess
  Maybe TeamId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'GuestLinksDisabled) r, Member TeamFeatureStore r,
 Member (Input Opts) r) =>
Maybe TeamId -> Sem r ()
ensureGuestLinksEnabled (Conversation -> Maybe TeamId
Data.convTeam Conversation
conv)
  ConversationCoverView -> Sem r ConversationCoverView
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConversationCoverView -> Sem r ConversationCoverView)
-> ConversationCoverView -> Sem r ConversationCoverView
forall a b. (a -> b) -> a -> b
$ Code -> Conversation -> ConversationCoverView
coverView Code
c Conversation
conv
  where
    coverView :: Data.Code -> Data.Conversation -> ConversationCoverView
    coverView :: Code -> Conversation -> ConversationCoverView
coverView Code
c Conversation
conv =
      ConversationCoverView
        { $sel:cnvCoverConvId:ConversationCoverView :: ConvId
cnvCoverConvId = Conversation -> ConvId
Data.convId Conversation
conv,
          $sel:cnvCoverName:ConversationCoverView :: Maybe Text
cnvCoverName = Conversation -> Maybe Text
Data.convName Conversation
conv,
          $sel:cnvCoverHasPassword:ConversationCoverView :: Bool
cnvCoverHasPassword = Code -> Bool
Data.codeHasPassword Code
c
        }

ensureGuestLinksEnabled ::
  forall r.
  ( Member (ErrorS 'GuestLinksDisabled) r,
    Member TeamFeatureStore r,
    Member (Input Opts) r
  ) =>
  Maybe TeamId ->
  Sem r ()
ensureGuestLinksEnabled :: forall (r :: EffectRow).
(Member (ErrorS 'GuestLinksDisabled) r, Member TeamFeatureStore r,
 Member (Input Opts) r) =>
Maybe TeamId -> Sem r ()
ensureGuestLinksEnabled Maybe TeamId
mbTid =
  Maybe TeamId -> Sem r (LockableFeature GuestLinksConfig)
forall (r :: EffectRow).
(Member TeamFeatureStore r, Member (Input Opts) r) =>
Maybe TeamId -> Sem r (LockableFeature GuestLinksConfig)
getConversationGuestLinksFeatureStatus Maybe TeamId
mbTid Sem r (LockableFeature GuestLinksConfig)
-> (LockableFeature GuestLinksConfig -> Sem r ()) -> Sem r ()
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \LockableFeature GuestLinksConfig
ws -> case LockableFeature GuestLinksConfig
ws.status of
    FeatureStatus
FeatureStatusEnabled -> () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    FeatureStatus
FeatureStatusDisabled -> forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'GuestLinksDisabled

getConversationGuestLinksStatus ::
  forall r.
  ( Member ConversationStore r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (Input Opts) r,
    Member TeamFeatureStore r
  ) =>
  UserId ->
  ConvId ->
  Sem r (LockableFeature GuestLinksConfig)
getConversationGuestLinksStatus :: forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvAccessDenied) r, Member (Input Opts) r,
 Member TeamFeatureStore r) =>
UserId -> ConvId -> Sem r (LockableFeature GuestLinksConfig)
getConversationGuestLinksStatus UserId
uid ConvId
convId = do
  Conversation
conv <- ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
E.getConversation ConvId
convId Sem r (Maybe Conversation)
-> (Maybe Conversation -> Sem r Conversation) -> Sem r Conversation
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'ConvNotFound
  [LocalMember] -> UserId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r) =>
[LocalMember] -> UserId -> Sem r ()
ensureConvAdmin (Conversation -> [LocalMember]
Data.convLocalMembers Conversation
conv) UserId
uid
  Maybe TeamId -> Sem r (LockableFeature GuestLinksConfig)
forall (r :: EffectRow).
(Member TeamFeatureStore r, Member (Input Opts) r) =>
Maybe TeamId -> Sem r (LockableFeature GuestLinksConfig)
getConversationGuestLinksFeatureStatus (Conversation -> Maybe TeamId
Data.convTeam Conversation
conv)

getConversationGuestLinksFeatureStatus ::
  forall r.
  ( Member TeamFeatureStore r,
    Member (Input Opts) r
  ) =>
  Maybe TeamId ->
  Sem r (LockableFeature GuestLinksConfig)
getConversationGuestLinksFeatureStatus :: forall (r :: EffectRow).
(Member TeamFeatureStore r, Member (Input Opts) r) =>
Maybe TeamId -> Sem r (LockableFeature GuestLinksConfig)
getConversationGuestLinksFeatureStatus Maybe TeamId
Nothing = forall cfg (r :: EffectRow).
(GetFeatureDefaults (FeatureDefaults cfg), NpProject cfg Features,
 Member (Input Opts) r) =>
Sem r (LockableFeature cfg)
getFeatureForServer @GuestLinksConfig
getConversationGuestLinksFeatureStatus (Just TeamId
tid) = forall cfg (r :: EffectRow).
(GetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
 Member (Input Opts) r, Member TeamFeatureStore r) =>
TeamId -> Sem r (LockableFeature cfg)
getFeatureForTeam @GuestLinksConfig TeamId
tid

-- | The same as 'getMLSSelfConversation', but it throws an error in case the
-- backend is not configured for MLS (the proxy for it being the existance of
-- the backend removal key).
getMLSSelfConversationWithError ::
  forall r.
  ( Member ConversationStore r,
    Member (Error InternalError) r,
    Member (ErrorS 'MLSNotEnabled) r,
    Member (Input Env) r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  Sem r Conversation
getMLSSelfConversationWithError :: forall (r :: EffectRow).
(Member ConversationStore r, Member (Error InternalError) r,
 Member (ErrorS 'MLSNotEnabled) r, Member (Input Env) r,
 Member TinyLog r) =>
Local UserId -> Sem r Conversation
getMLSSelfConversationWithError Local UserId
lusr = do
  Sem r ()
forall (r :: EffectRow).
(Member (Input Env) r, Member (ErrorS 'MLSNotEnabled) r) =>
Sem r ()
assertMLSEnabled
  Local UserId -> Sem r Conversation
forall (r :: EffectRow).
(Member ConversationStore r, Member (Error InternalError) r,
 Member TinyLog r) =>
Local UserId -> Sem r Conversation
getMLSSelfConversation Local UserId
lusr

-- | Get an MLS self conversation. In case it does not exist, it is partially
-- created in the database. The part that is not written is the epoch number;
-- the number is inserted only upon the first commit. With this we avoid race
-- conditions where two clients concurrently try to create or update the self
-- conversation, where the only thing that can be updated is bumping the epoch
-- number.
getMLSSelfConversation ::
  forall r.
  ( Member ConversationStore r,
    Member (Error InternalError) r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  Sem r Conversation
getMLSSelfConversation :: forall (r :: EffectRow).
(Member ConversationStore r, Member (Error InternalError) r,
 Member TinyLog r) =>
Local UserId -> Sem r Conversation
getMLSSelfConversation Local UserId
lusr = do
  let selfConvId :: ConvId
selfConvId = UserId -> ConvId
mlsSelfConvId (UserId -> ConvId)
-> (Local UserId -> UserId) -> Local UserId -> ConvId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified (Local UserId -> ConvId) -> Local UserId -> ConvId
forall a b. (a -> b) -> a -> b
$ Local UserId
lusr
  Maybe Conversation
mconv <- ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
E.getConversation ConvId
selfConvId
  Conversation
cnv <- Sem r Conversation
-> (Conversation -> Sem r Conversation)
-> Maybe Conversation
-> Sem r Conversation
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Local UserId -> Sem r Conversation
forall (r :: EffectRow).
Member ConversationStore r =>
Local UserId -> Sem r Conversation
E.createMLSSelfConversation Local UserId
lusr) Conversation -> Sem r Conversation
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Conversation
mconv
  Local UserId -> Conversation -> Sem r Conversation
forall (r :: EffectRow).
(Member (Error InternalError) r, Member TinyLog r) =>
Local UserId -> Conversation -> Sem r Conversation
conversationView Local UserId
lusr Conversation
cnv

-- | Get an MLS 1-1 conversation. If not already existing, the conversation
-- object is created on the fly, but not persisted. The conversation will only
-- be stored in the database when its first commit arrives.
--
-- For the federated case, we do not make the assumption that the other backend
-- uses the same function to calculate the conversation ID and corresponding
-- group ID, however we /do/ assume that the two backends agree on which of the
-- two is responsible for hosting the conversation.
getMLSOne2OneConversationV5 ::
  ( Member BrigAccess r,
    Member ConversationStore r,
    Member (Input Env) r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS 'MLSNotEnabled) r,
    Member (ErrorS 'NotConnected) r,
    Member (ErrorS 'MLSFederatedOne2OneNotSupported) r,
    Member FederatorAccess r,
    Member TeamStore r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  Qualified UserId ->
  Sem r Conversation
getMLSOne2OneConversationV5 :: forall (r :: EffectRow).
(Member BrigAccess r, Member ConversationStore r,
 Member (Input Env) r, Member (Error FederationError) r,
 Member (Error InternalError) r, Member (ErrorS 'MLSNotEnabled) r,
 Member (ErrorS 'NotConnected) r,
 Member (ErrorS 'MLSFederatedOne2OneNotSupported) r,
 Member FederatorAccess r, Member TeamStore r, Member TinyLog r) =>
Local UserId -> Qualified UserId -> Sem r Conversation
getMLSOne2OneConversationV5 Local UserId
lself Qualified UserId
qother = do
  if Local UserId -> Qualified UserId -> Bool
forall x a. Local x -> Qualified a -> Bool
isLocal Local UserId
lself Qualified UserId
qother
    then Local UserId -> Qualified UserId -> Sem r Conversation
forall (r :: EffectRow).
(Member BrigAccess r, Member ConversationStore r,
 Member (Input Env) r, Member (Error FederationError) r,
 Member (Error InternalError) r, Member (ErrorS 'MLSNotEnabled) r,
 Member (ErrorS 'NotConnected) r, Member FederatorAccess r,
 Member TeamStore r, Member TinyLog r) =>
Local UserId -> Qualified UserId -> Sem r Conversation
getMLSOne2OneConversationInternal Local UserId
lself Qualified UserId
qother
    else forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @MLSFederatedOne2OneNotSupported

getMLSOne2OneConversationInternal ::
  ( Member BrigAccess r,
    Member ConversationStore r,
    Member (Input Env) r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS 'MLSNotEnabled) r,
    Member (ErrorS 'NotConnected) r,
    Member FederatorAccess r,
    Member TeamStore r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  Qualified UserId ->
  Sem r Conversation
getMLSOne2OneConversationInternal :: forall (r :: EffectRow).
(Member BrigAccess r, Member ConversationStore r,
 Member (Input Env) r, Member (Error FederationError) r,
 Member (Error InternalError) r, Member (ErrorS 'MLSNotEnabled) r,
 Member (ErrorS 'NotConnected) r, Member FederatorAccess r,
 Member TeamStore r, Member TinyLog r) =>
Local UserId -> Qualified UserId -> Sem r Conversation
getMLSOne2OneConversationInternal Local UserId
lself Qualified UserId
qother =
  (.conversation) (MLSOne2OneConversation SomeKey -> Conversation)
-> Sem r (MLSOne2OneConversation SomeKey) -> Sem r Conversation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Local UserId
-> Qualified UserId
-> Maybe MLSPublicKeyFormat
-> Sem r (MLSOne2OneConversation SomeKey)
forall (r :: EffectRow).
(Member BrigAccess r, Member ConversationStore r,
 Member (Input Env) r, Member (Error FederationError) r,
 Member (Error InternalError) r, Member (ErrorS 'MLSNotEnabled) r,
 Member (ErrorS 'NotConnected) r, Member FederatorAccess r,
 Member TeamStore r, Member TinyLog r) =>
Local UserId
-> Qualified UserId
-> Maybe MLSPublicKeyFormat
-> Sem r (MLSOne2OneConversation SomeKey)
getMLSOne2OneConversation Local UserId
lself Qualified UserId
qother Maybe MLSPublicKeyFormat
forall a. Maybe a
Nothing

getMLSOne2OneConversationV6 ::
  ( Member BrigAccess r,
    Member ConversationStore r,
    Member (Input Env) r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS 'MLSNotEnabled) r,
    Member (ErrorS 'NotConnected) r,
    Member FederatorAccess r,
    Member TeamStore r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  Qualified UserId ->
  Sem r (MLSOne2OneConversation MLSPublicKey)
getMLSOne2OneConversationV6 :: forall (r :: EffectRow).
(Member BrigAccess r, Member ConversationStore r,
 Member (Input Env) r, Member (Error FederationError) r,
 Member (Error InternalError) r, Member (ErrorS 'MLSNotEnabled) r,
 Member (ErrorS 'NotConnected) r, Member FederatorAccess r,
 Member TeamStore r, Member TinyLog r) =>
Local UserId
-> Qualified UserId -> Sem r (MLSOne2OneConversation MLSPublicKey)
getMLSOne2OneConversationV6 Local UserId
lself Qualified UserId
qother = do
  Sem r ()
forall (r :: EffectRow).
(Member (Input Env) r, Member (ErrorS 'MLSNotEnabled) r) =>
Sem r ()
assertMLSEnabled
  Local UserId -> [Qualified UserId] -> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'NotConnected) r,
 Member TeamStore r) =>
Local UserId -> [Qualified UserId] -> Sem r ()
ensureConnectedOrSameTeam Local UserId
lself [Qualified UserId
qother]
  let convId :: Qualified ConvId
convId = BaseProtocolTag
-> Qualified UserId -> Qualified UserId -> Qualified ConvId
one2OneConvId BaseProtocolTag
BaseProtocolMLSTag (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lself) Qualified UserId
qother
  Local UserId
-> (Local ConvId -> Sem r (MLSOne2OneConversation MLSPublicKey))
-> (Remote ConvId -> Sem r (MLSOne2OneConversation MLSPublicKey))
-> Qualified ConvId
-> Sem r (MLSOne2OneConversation MLSPublicKey)
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
    Local UserId
lself
    (Local UserId
-> Local ConvId -> Sem r (MLSOne2OneConversation MLSPublicKey)
forall (r :: EffectRow).
(Member ConversationStore r, Member (Error InternalError) r,
 Member TinyLog r, Member (Input Env) r,
 Member (ErrorS 'MLSNotEnabled) r) =>
Local UserId
-> Local ConvId -> Sem r (MLSOne2OneConversation MLSPublicKey)
getLocalMLSOne2OneConversation Local UserId
lself)
    (Local UserId
-> Qualified UserId
-> Remote ConvId
-> Sem r (MLSOne2OneConversation MLSPublicKey)
forall (r :: EffectRow) conv.
(Member (Error InternalError) r, Member (Error FederationError) r,
 Member (ErrorS 'NotConnected) r, Member FederatorAccess r,
 Member (ErrorS 'MLSNotEnabled) r, Member TinyLog r) =>
Local UserId
-> Qualified UserId
-> Remote conv
-> Sem r (MLSOne2OneConversation MLSPublicKey)
getRemoteMLSOne2OneConversation Local UserId
lself Qualified UserId
qother)
    Qualified ConvId
convId

getMLSOne2OneConversation ::
  ( Member BrigAccess r,
    Member ConversationStore r,
    Member (Input Env) r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS 'MLSNotEnabled) r,
    Member (ErrorS 'NotConnected) r,
    Member FederatorAccess r,
    Member TeamStore r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  Qualified UserId ->
  Maybe MLSPublicKeyFormat ->
  Sem r (MLSOne2OneConversation SomeKey)
getMLSOne2OneConversation :: forall (r :: EffectRow).
(Member BrigAccess r, Member ConversationStore r,
 Member (Input Env) r, Member (Error FederationError) r,
 Member (Error InternalError) r, Member (ErrorS 'MLSNotEnabled) r,
 Member (ErrorS 'NotConnected) r, Member FederatorAccess r,
 Member TeamStore r, Member TinyLog r) =>
Local UserId
-> Qualified UserId
-> Maybe MLSPublicKeyFormat
-> Sem r (MLSOne2OneConversation SomeKey)
getMLSOne2OneConversation Local UserId
lself Qualified UserId
qother Maybe MLSPublicKeyFormat
fmt = do
  MLSOne2OneConversation MLSPublicKey
convWithUnformattedKeys <- Local UserId
-> Qualified UserId -> Sem r (MLSOne2OneConversation MLSPublicKey)
forall (r :: EffectRow).
(Member BrigAccess r, Member ConversationStore r,
 Member (Input Env) r, Member (Error FederationError) r,
 Member (Error InternalError) r, Member (ErrorS 'MLSNotEnabled) r,
 Member (ErrorS 'NotConnected) r, Member FederatorAccess r,
 Member TeamStore r, Member TinyLog r) =>
Local UserId
-> Qualified UserId -> Sem r (MLSOne2OneConversation MLSPublicKey)
getMLSOne2OneConversationV6 Local UserId
lself Qualified UserId
qother
  Conversation
-> MLSKeysByPurpose (MLSKeys SomeKey)
-> MLSOne2OneConversation SomeKey
forall a.
Conversation
-> MLSKeysByPurpose (MLSKeys a) -> MLSOne2OneConversation a
MLSOne2OneConversation MLSOne2OneConversation MLSPublicKey
convWithUnformattedKeys.conversation
    (MLSKeysByPurpose (MLSKeys SomeKey)
 -> MLSOne2OneConversation SomeKey)
-> Sem r (MLSKeysByPurpose (MLSKeys SomeKey))
-> Sem r (MLSOne2OneConversation SomeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MLSPublicKeyFormat
-> MLSKeysByPurpose MLSPublicKeys
-> Sem r (MLSKeysByPurpose (MLSKeys SomeKey))
forall (r :: EffectRow).
Member (Error InternalError) r =>
Maybe MLSPublicKeyFormat
-> MLSKeysByPurpose MLSPublicKeys
-> Sem r (MLSKeysByPurpose (MLSKeys SomeKey))
formatPublicKeys Maybe MLSPublicKeyFormat
fmt MLSOne2OneConversation MLSPublicKey
convWithUnformattedKeys.publicKeys

getLocalMLSOne2OneConversation ::
  ( Member ConversationStore r,
    Member (Error InternalError) r,
    Member P.TinyLog r,
    Member (Input Env) r,
    Member (ErrorS MLSNotEnabled) r
  ) =>
  Local UserId ->
  Local ConvId ->
  Sem r (MLSOne2OneConversation MLSPublicKey)
getLocalMLSOne2OneConversation :: forall (r :: EffectRow).
(Member ConversationStore r, Member (Error InternalError) r,
 Member TinyLog r, Member (Input Env) r,
 Member (ErrorS 'MLSNotEnabled) r) =>
Local UserId
-> Local ConvId -> Sem r (MLSOne2OneConversation MLSPublicKey)
getLocalMLSOne2OneConversation Local UserId
lself Local ConvId
lconv = do
  Maybe Conversation
mconv <- ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
E.getConversation (Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvId
lconv)
  MLSKeysByPurpose MLSPublicKeys
keys <- MLSPrivateKeys -> MLSPublicKeys
mlsKeysToPublic (MLSPrivateKeys -> MLSPublicKeys)
-> Sem r (MLSKeysByPurpose MLSPrivateKeys)
-> Sem r (MLSKeysByPurpose MLSPublicKeys)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Sem r (MLSKeysByPurpose MLSPrivateKeys)
forall (r :: EffectRow).
(Member (Input Env) r, Member (ErrorS 'MLSNotEnabled) r) =>
Sem r (MLSKeysByPurpose MLSPrivateKeys)
getMLSPrivateKeys
  Conversation
conv <- case Maybe Conversation
mconv of
    Maybe Conversation
Nothing -> Conversation -> Sem r Conversation
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Local UserId -> Local ConvId -> Conversation
localMLSOne2OneConversation Local UserId
lself Local ConvId
lconv)
    Just Conversation
conv -> Local UserId -> Conversation -> Sem r Conversation
forall (r :: EffectRow).
(Member (Error InternalError) r, Member TinyLog r) =>
Local UserId -> Conversation -> Sem r Conversation
conversationView Local UserId
lself Conversation
conv
  MLSOne2OneConversation MLSPublicKey
-> Sem r (MLSOne2OneConversation MLSPublicKey)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MLSOne2OneConversation MLSPublicKey
 -> Sem r (MLSOne2OneConversation MLSPublicKey))
-> MLSOne2OneConversation MLSPublicKey
-> Sem r (MLSOne2OneConversation MLSPublicKey)
forall a b. (a -> b) -> a -> b
$
    MLSOne2OneConversation
      { $sel:conversation:MLSOne2OneConversation :: Conversation
conversation = Conversation
conv,
        $sel:publicKeys:MLSOne2OneConversation :: MLSKeysByPurpose MLSPublicKeys
publicKeys = MLSKeysByPurpose MLSPublicKeys
keys
      }

getRemoteMLSOne2OneConversation ::
  ( Member (Error InternalError) r,
    Member (Error FederationError) r,
    Member (ErrorS 'NotConnected) r,
    Member FederatorAccess r,
    Member (ErrorS MLSNotEnabled) r,
    Member TinyLog r
  ) =>
  Local UserId ->
  Qualified UserId ->
  Remote conv ->
  Sem r (MLSOne2OneConversation MLSPublicKey)
getRemoteMLSOne2OneConversation :: forall (r :: EffectRow) conv.
(Member (Error InternalError) r, Member (Error FederationError) r,
 Member (ErrorS 'NotConnected) r, Member FederatorAccess r,
 Member (ErrorS 'MLSNotEnabled) r, Member TinyLog r) =>
Local UserId
-> Qualified UserId
-> Remote conv
-> Sem r (MLSOne2OneConversation MLSPublicKey)
getRemoteMLSOne2OneConversation Local UserId
lself Qualified UserId
qother Remote conv
rconv = do
  -- a conversation can only be remote if it is hosted on the other user's domain
  QualifiedWithTag 'QRemote UserId
rother <-
    if Qualified UserId -> Domain
forall a. Qualified a -> Domain
qDomain Qualified UserId
qother Domain -> Domain -> Bool
forall a. Eq a => a -> a -> Bool
== Remote conv -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Remote conv
rconv
      then QualifiedWithTag 'QRemote UserId
-> Sem r (QualifiedWithTag 'QRemote UserId)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Remote conv -> UserId -> QualifiedWithTag 'QRemote UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Remote conv
rconv (Qualified UserId -> UserId
forall a. Qualified a -> a
qUnqualified Qualified UserId
qother))
      else InternalError -> Sem r (QualifiedWithTag 'QRemote UserId)
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (LText -> InternalError
InternalErrorWithDescription LText
"Unexpected 1-1 conversation domain")

  Either FederationError GetOne2OneConversationResponseV2
resp <-
    Remote conv
-> FederatorClient
     'Galley (Either FederationError GetOne2OneConversationResponseV2)
-> Sem r (Either FederationError GetOne2OneConversationResponseV2)
forall (r :: EffectRow) (c :: Component) x a.
(Member FederatorAccess r, KnownComponent c) =>
Remote x -> FederatorClient c a -> Sem r a
E.runFederated Remote conv
rconv (FederatorClient
   'Galley (Either FederationError GetOne2OneConversationResponseV2)
 -> Sem r (Either FederationError GetOne2OneConversationResponseV2))
-> FederatorClient
     'Galley (Either FederationError GetOne2OneConversationResponseV2)
-> Sem r (Either FederationError GetOne2OneConversationResponseV2)
forall a b. (a -> b) -> a -> b
$ do
      Maybe Version
negotiatedVersion <- FederatorClient 'Galley (Maybe Version)
forall (c :: Component). FederatorClient c (Maybe Version)
getNegotiatedVersion
      case Maybe Version
negotiatedVersion of
        Maybe Version
Nothing -> [Char]
-> FederatorClient
     'Galley (Either FederationError GetOne2OneConversationResponseV2)
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"
        Just Version
Federation.V0 -> Either FederationError GetOne2OneConversationResponseV2
-> FederatorClient
     'Galley (Either FederationError GetOne2OneConversationResponseV2)
forall a. a -> FederatorClient 'Galley a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FederationError GetOne2OneConversationResponseV2
 -> FederatorClient
      'Galley (Either FederationError GetOne2OneConversationResponseV2))
-> (FederatorClientError
    -> Either FederationError GetOne2OneConversationResponseV2)
-> FederatorClientError
-> FederatorClient
     'Galley (Either FederationError GetOne2OneConversationResponseV2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FederationError
-> Either FederationError GetOne2OneConversationResponseV2
forall a b. a -> Either a b
Left (FederationError
 -> Either FederationError GetOne2OneConversationResponseV2)
-> (FederatorClientError -> FederationError)
-> FederatorClientError
-> Either FederationError GetOne2OneConversationResponseV2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FederatorClientError -> FederationError
FederationCallFailure (FederatorClientError
 -> FederatorClient
      'Galley (Either FederationError GetOne2OneConversationResponseV2))
-> FederatorClientError
-> FederatorClient
     'Galley (Either FederationError GetOne2OneConversationResponseV2)
forall a b. (a -> b) -> a -> b
$ VersionNegotiationError -> FederatorClientError
FederatorClientVersionNegotiationError VersionNegotiationError
RemoteTooOld
        Just Version
Federation.V1 -> Either FederationError GetOne2OneConversationResponseV2
-> FederatorClient
     'Galley (Either FederationError GetOne2OneConversationResponseV2)
forall a. a -> FederatorClient 'Galley a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FederationError GetOne2OneConversationResponseV2
 -> FederatorClient
      'Galley (Either FederationError GetOne2OneConversationResponseV2))
-> (FederatorClientError
    -> Either FederationError GetOne2OneConversationResponseV2)
-> FederatorClientError
-> FederatorClient
     'Galley (Either FederationError GetOne2OneConversationResponseV2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FederationError
-> Either FederationError GetOne2OneConversationResponseV2
forall a b. a -> Either a b
Left (FederationError
 -> Either FederationError GetOne2OneConversationResponseV2)
-> (FederatorClientError -> FederationError)
-> FederatorClientError
-> Either FederationError GetOne2OneConversationResponseV2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FederatorClientError -> FederationError
FederationCallFailure (FederatorClientError
 -> FederatorClient
      'Galley (Either FederationError GetOne2OneConversationResponseV2))
-> FederatorClientError
-> FederatorClient
     'Galley (Either FederationError GetOne2OneConversationResponseV2)
forall a b. (a -> b) -> a -> b
$ VersionNegotiationError -> FederatorClientError
FederatorClientVersionNegotiationError VersionNegotiationError
RemoteTooOld
        Just Version
_ ->
          (GetOne2OneConversationResponseV2
 -> Either FederationError GetOne2OneConversationResponseV2)
-> FederatorClient 'Galley GetOne2OneConversationResponseV2
-> FederatorClient
     'Galley (Either FederationError GetOne2OneConversationResponseV2)
forall a b.
(a -> b) -> FederatorClient 'Galley a -> FederatorClient 'Galley b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GetOne2OneConversationResponseV2
-> Either FederationError GetOne2OneConversationResponseV2
forall a b. b -> Either a b
Right (FederatorClient 'Galley GetOne2OneConversationResponseV2
 -> FederatorClient
      'Galley (Either FederationError GetOne2OneConversationResponseV2))
-> (GetOne2OneConversationRequest
    -> FederatorClient 'Galley GetOne2OneConversationResponseV2)
-> GetOne2OneConversationRequest
-> FederatorClient
     'Galley (Either FederationError GetOne2OneConversationResponseV2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (comp :: Component) (name :: k)
       (fedM :: Component -> * -> *) (showcomp :: Symbol) api x.
(AddAnnotation 'Remote showcomp (FedPath name) x,
 showcomp ~ ShowComponent comp, HasFedEndpoint comp api name,
 HasClient (fedM comp) api, KnownComponent comp, IsNamed name,
 FederationMonad fedM, Typeable (Client (fedM comp) api)) =>
Client (fedM comp) api
forall (comp :: Component) (name :: Symbol)
       (fedM :: Component -> * -> *) (showcomp :: Symbol) api x.
(AddAnnotation 'Remote showcomp (FedPath name) x,
 showcomp ~ ShowComponent comp, HasFedEndpoint comp api name,
 HasClient (fedM comp) api, KnownComponent comp, IsNamed name,
 FederationMonad fedM, Typeable (Client (fedM comp) api)) =>
Client (fedM comp) api
fedClient @'Galley @"get-one2one-conversation" (GetOne2OneConversationRequest
 -> FederatorClient
      'Galley (Either FederationError GetOne2OneConversationResponseV2))
-> GetOne2OneConversationRequest
-> FederatorClient
     'Galley (Either FederationError GetOne2OneConversationResponseV2)
forall a b. (a -> b) -> a -> b
$
            UserId -> UserId -> GetOne2OneConversationRequest
GetOne2OneConversationRequest (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lself) (QualifiedWithTag 'QRemote UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified QualifiedWithTag 'QRemote UserId
rother)
  case Either FederationError GetOne2OneConversationResponseV2
resp of
    Right (GetOne2OneConversationV2Ok RemoteMLSOne2OneConversation
rc) ->
      MLSOne2OneConversation MLSPublicKey
-> Sem r (MLSOne2OneConversation MLSPublicKey)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Local UserId
-> QualifiedWithTag 'QRemote UserId
-> RemoteMLSOne2OneConversation
-> MLSOne2OneConversation MLSPublicKey
remoteMLSOne2OneConversation Local UserId
lself QualifiedWithTag 'QRemote UserId
rother RemoteMLSOne2OneConversation
rc)
    Right GetOne2OneConversationResponseV2
GetOne2OneConversationV2BackendMismatch ->
      FederationError -> Sem r (MLSOne2OneConversation MLSPublicKey)
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (Text -> FederationError
FederationUnexpectedBody Text
"Backend mismatch when retrieving a remote 1-1 conversation")
    Right GetOne2OneConversationResponseV2
GetOne2OneConversationV2NotConnected -> forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'NotConnected
    Right GetOne2OneConversationResponseV2
GetOne2OneConversationV2MLSNotEnabled -> do
      -- This is confusing to clients because we do not tell them which backend
      -- doesn't have MLS enabled, which would nice information for fixing
      -- problems in real world. We do the same thing when sending Welcome
      -- messages, so for now, let's do the same thing.
      (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.warn ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
        ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Logger.field ByteString
"domain" (Domain -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' (QualifiedWithTag 'QRemote UserId -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain QualifiedWithTag 'QRemote UserId
rother))
          (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
Logger.msg
            (ByteString
"Cannot get remote MLSOne2OneConversation because MLS is not enabled on remote" :: ByteString)
      forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'MLSNotEnabled
    Left FederationError
e -> FederationError -> Sem r (MLSOne2OneConversation MLSPublicKey)
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw FederationError
e

-- | Check if an MLS 1-1 conversation has been established, namely if its epoch
-- is non-zero. The conversation will only be stored in the database when its
-- first commit arrives.
--
-- For the federated case, we do not make the assumption that the other backend
-- uses the same function to calculate the conversation ID and corresponding
-- group ID, however we /do/ assume that the two backends agree on which of the
-- two is responsible for hosting the conversation.
isMLSOne2OneEstablished ::
  ( Member ConversationStore r,
    Member (Input Env) r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS 'MLSNotEnabled) r,
    Member (ErrorS 'NotConnected) r,
    Member FederatorAccess r,
    Member TinyLog r
  ) =>
  Local UserId ->
  Qualified UserId ->
  Sem r Bool
isMLSOne2OneEstablished :: forall (r :: EffectRow).
(Member ConversationStore r, Member (Input Env) r,
 Member (Error FederationError) r, Member (Error InternalError) r,
 Member (ErrorS 'MLSNotEnabled) r, Member (ErrorS 'NotConnected) r,
 Member FederatorAccess r, Member TinyLog r) =>
Local UserId -> Qualified UserId -> Sem r Bool
isMLSOne2OneEstablished Local UserId
lself Qualified UserId
qother = do
  Sem r ()
forall (r :: EffectRow).
(Member (Input Env) r, Member (ErrorS 'MLSNotEnabled) r) =>
Sem r ()
assertMLSEnabled
  let convId :: Qualified ConvId
convId = BaseProtocolTag
-> Qualified UserId -> Qualified UserId -> Qualified ConvId
one2OneConvId BaseProtocolTag
BaseProtocolMLSTag (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lself) Qualified UserId
qother
  Local UserId
-> (Local ConvId -> Sem r Bool)
-> (Remote ConvId -> Sem r Bool)
-> Qualified ConvId
-> Sem r Bool
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
    Local UserId
lself
    Local ConvId -> Sem r Bool
forall (r :: EffectRow).
Member ConversationStore r =>
Local ConvId -> Sem r Bool
isLocalMLSOne2OneEstablished
    (Local UserId -> Qualified UserId -> Remote ConvId -> Sem r Bool
forall (r :: EffectRow) conv.
(Member (ErrorS 'NotConnected) r, Member (Error FederationError) r,
 Member (Error InternalError) r, Member FederatorAccess r,
 Member (ErrorS 'MLSNotEnabled) r, Member TinyLog r) =>
Local UserId -> Qualified UserId -> Remote conv -> Sem r Bool
isRemoteMLSOne2OneEstablished Local UserId
lself Qualified UserId
qother)
    Qualified ConvId
convId

isLocalMLSOne2OneEstablished ::
  (Member ConversationStore r) =>
  Local ConvId ->
  Sem r Bool
isLocalMLSOne2OneEstablished :: forall (r :: EffectRow).
Member ConversationStore r =>
Local ConvId -> Sem r Bool
isLocalMLSOne2OneEstablished Local ConvId
lconv = do
  Maybe Conversation
mconv <- ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
E.getConversation (Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvId
lconv)
  Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Sem r Bool) -> Bool -> Sem r Bool
forall a b. (a -> b) -> a -> b
$ case Maybe Conversation
mconv of
    Maybe Conversation
Nothing -> Bool
False
    Just Conversation
conv -> do
      let meta :: Maybe ConversationMLSData
meta = (ConversationMLSData, MLSMigrationState) -> ConversationMLSData
forall a b. (a, b) -> a
fst ((ConversationMLSData, MLSMigrationState) -> ConversationMLSData)
-> Maybe (ConversationMLSData, MLSMigrationState)
-> Maybe ConversationMLSData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Conversation -> Maybe (ConversationMLSData, MLSMigrationState)
Data.mlsMetadata Conversation
conv
      Bool
-> (ConversationMLSData -> Bool)
-> Maybe ConversationMLSData
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
0) (Word64 -> Bool)
-> (ConversationMLSData -> Word64) -> ConversationMLSData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Epoch -> Word64
epochNumber (Epoch -> Word64)
-> (ConversationMLSData -> Epoch) -> ConversationMLSData -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConversationMLSData -> Epoch
cnvmlsEpoch) Maybe ConversationMLSData
meta

isRemoteMLSOne2OneEstablished ::
  ( Member (ErrorS 'NotConnected) r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member FederatorAccess r,
    Member (ErrorS MLSNotEnabled) r,
    Member TinyLog r
  ) =>
  Local UserId ->
  Qualified UserId ->
  Remote conv ->
  Sem r Bool
isRemoteMLSOne2OneEstablished :: forall (r :: EffectRow) conv.
(Member (ErrorS 'NotConnected) r, Member (Error FederationError) r,
 Member (Error InternalError) r, Member FederatorAccess r,
 Member (ErrorS 'MLSNotEnabled) r, Member TinyLog r) =>
Local UserId -> Qualified UserId -> Remote conv -> Sem r Bool
isRemoteMLSOne2OneEstablished Local UserId
lself Qualified UserId
qother Remote conv
rconv = do
  Conversation
conv <- (.conversation) (MLSOne2OneConversation MLSPublicKey -> Conversation)
-> Sem r (MLSOne2OneConversation MLSPublicKey)
-> Sem r Conversation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Local UserId
-> Qualified UserId
-> Remote conv
-> Sem r (MLSOne2OneConversation MLSPublicKey)
forall (r :: EffectRow) conv.
(Member (Error InternalError) r, Member (Error FederationError) r,
 Member (ErrorS 'NotConnected) r, Member FederatorAccess r,
 Member (ErrorS 'MLSNotEnabled) r, Member TinyLog r) =>
Local UserId
-> Qualified UserId
-> Remote conv
-> Sem r (MLSOne2OneConversation MLSPublicKey)
getRemoteMLSOne2OneConversation Local UserId
lself Qualified UserId
qother Remote conv
rconv
  Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Sem r Bool) -> (Word64 -> Bool) -> Word64 -> Sem r Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
0) (Word64 -> Sem r Bool) -> Word64 -> Sem r Bool
forall a b. (a -> b) -> a -> b
$ case Conversation -> Protocol
cnvProtocol Conversation
conv of
    Protocol
ProtocolProteus -> Word64
0
    ProtocolMLS ConversationMLSData
meta -> ConversationMLSData -> Word64
ep ConversationMLSData
meta
    ProtocolMixed ConversationMLSData
meta -> ConversationMLSData -> Word64
ep ConversationMLSData
meta
  where
    ep :: ConversationMLSData -> Word64
    ep :: ConversationMLSData -> Word64
ep = Epoch -> Word64
epochNumber (Epoch -> Word64)
-> (ConversationMLSData -> Epoch) -> ConversationMLSData -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConversationMLSData -> Epoch
cnvmlsEpoch

-------------------------------------------------------------------------------
-- Helpers

ensureConvAdmin ::
  ( Member (ErrorS 'ConvAccessDenied) r,
    Member (ErrorS 'ConvNotFound) r
  ) =>
  [LocalMember] ->
  UserId ->
  Sem r ()
ensureConvAdmin :: forall (r :: EffectRow).
(Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r) =>
[LocalMember] -> UserId -> Sem r ()
ensureConvAdmin [LocalMember]
users UserId
uid =
  case (LocalMember -> Bool) -> [LocalMember] -> Maybe LocalMember
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
== UserId
uid) (UserId -> Bool) -> (LocalMember -> UserId) -> LocalMember -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalMember -> UserId
lmId) [LocalMember]
users of
    Maybe LocalMember
Nothing -> forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'ConvNotFound
    Just LocalMember
lm -> Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LocalMember -> RoleName
lmConvRoleName LocalMember
lm RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
roleNameWireAdmin) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'ConvAccessDenied