-- 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/>.
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}

module Galley.API.Update
  ( -- * Managing Conversations
    acceptConv,
    blockConv,
    blockConvUnqualified,
    unblockConv,
    unblockConvUnqualified,
    checkReusableCode,
    joinConversationByReusableCode,
    joinConversationById,
    addCodeUnqualified,
    addCodeUnqualifiedWithReqBody,
    rmCodeUnqualified,
    getCode,
    updateUnqualifiedConversationName,
    updateConversationName,
    updateConversationReceiptModeUnqualified,
    updateConversationReceiptMode,
    updateConversationMessageTimerUnqualified,
    updateConversationMessageTimer,
    updateConversationAccessUnqualified,
    updateConversationAccess,
    deleteLocalConversation,
    updateRemoteConversation,
    updateConversationProtocolWithLocalUser,
    updateLocalStateOfRemoteConv,

    -- * Managing Members
    addMembersUnqualified,
    addMembersUnqualifiedV2,
    addMembers,
    updateUnqualifiedSelfMember,
    updateSelfMember,
    updateOtherMember,
    updateOtherMemberUnqualified,
    removeMemberQualified,
    removeMemberUnqualified,
    removeMemberFromLocalConv,
    removeMemberFromRemoteConv,

    -- * Talking
    postProteusMessage,
    postOtrMessageUnqualified,
    postProteusBroadcast,
    postOtrBroadcastUnqualified,
    memberTypingUnqualified,
    memberTyping,

    -- * External Services
    addBot,
    rmBot,
    postBotMessageUnqualified,
  )
where

import Control.Error.Util (hush)
import Control.Lens
import Data.Code
import Data.Id
import Data.Json.Util
import Data.List1
import Data.Map.Strict qualified as Map
import Data.Misc (HttpsUrl)
import Data.Qualified
import Data.Set qualified as Set
import Data.Singletons
import Data.Time
import Galley.API.Action
import Galley.API.Error
import Galley.API.Mapping
import Galley.API.Message
import Galley.API.Query qualified as Query
import Galley.API.Util
import Galley.App
import Galley.Data.Conversation qualified as Data
import Galley.Data.Conversation.Types qualified as Data
import Galley.Data.Services as Data
import Galley.Data.Types hiding (Conversation)
import Galley.Effects
import Galley.Effects.ClientStore qualified as E
import Galley.Effects.CodeStore qualified as E
import Galley.Effects.ConversationStore qualified as E
import Galley.Effects.ExternalAccess qualified as E
import Galley.Effects.FederatorAccess qualified as E
import Galley.Effects.MemberStore qualified as E
import Galley.Options
import Galley.Types.Conversations.Members (LocalMember (..))
import Galley.Types.UserList
import Imports hiding (forkIO)
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Polysemy.TinyLog
import Wire.API.Bot hiding (addBot)
import Wire.API.Conversation hiding (Member)
import Wire.API.Conversation.Action
import Wire.API.Conversation.Code
import Wire.API.Conversation.Protocol qualified as P
import Wire.API.Conversation.Role
import Wire.API.Conversation.Typing
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Event.Conversation
import Wire.API.Event.LeaveReason
import Wire.API.Federation.API
import Wire.API.Federation.API.Galley
import Wire.API.Federation.Error
import Wire.API.Message
import Wire.API.Password (mkSafePasswordScrypt)
import Wire.API.Routes.Public (ZHostValue)
import Wire.API.Routes.Public.Galley.Messaging
import Wire.API.Routes.Public.Util (UpdateResult (..))
import Wire.API.ServantProto (RawProto (..))
import Wire.API.User.Client
import Wire.NotificationSubsystem

acceptConv ::
  ( Member ConversationStore r,
    Member (Error InternalError) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member TinyLog r
  ) =>
  Local UserId ->
  Maybe ConnId ->
  ConvId ->
  Sem r Conversation
acceptConv :: forall (r :: EffectRow).
(Member ConversationStore r, Member (Error InternalError) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member MemberStore r, Member TinyLog r) =>
Local UserId -> Maybe ConnId -> ConvId -> Sem r Conversation
acceptConv Local UserId
lusr Maybe ConnId
conn ConvId
cnv = do
  Conversation
conv <-
    ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
E.getConversation ConvId
cnv 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
  Conversation
conv' <- Local UserId -> Conversation -> Maybe ConnId -> Sem r Conversation
forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (Error InternalError) r,
 Member (ErrorS 'InvalidOperation) r, Member (Input UTCTime) r,
 Member MemberStore r, Member NotificationSubsystem r) =>
Local UserId -> Conversation -> Maybe ConnId -> Sem r Conversation
acceptOne2One Local UserId
lusr Conversation
conv Maybe ConnId
conn
  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
conv'

blockConv ::
  ( Member ConversationStore r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member MemberStore r
  ) =>
  Local UserId ->
  Qualified ConvId ->
  Sem r ()
blockConv :: forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member MemberStore r) =>
Local UserId -> Qualified ConvId -> Sem r ()
blockConv Local UserId
lusr Qualified ConvId
qcnv =
  Local UserId
-> (Local ConvId -> Sem r ())
-> (Remote ConvId -> Sem r ())
-> Qualified ConvId
-> Sem r ()
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
    Local UserId
lusr
    (UserId -> ConvId -> Sem r ()
forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member MemberStore r) =>
UserId -> ConvId -> Sem r ()
blockConvUnqualified (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) (ConvId -> Sem r ())
-> (Local ConvId -> ConvId) -> Local ConvId -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified)
    (Local UserId -> Remote ConvId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'ConvNotFound) r, Member MemberStore r) =>
Local UserId -> Remote ConvId -> Sem r ()
blockRemoteConv Local UserId
lusr)
    Qualified ConvId
qcnv

blockConvUnqualified ::
  ( Member ConversationStore r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member MemberStore r
  ) =>
  UserId ->
  ConvId ->
  Sem r ()
blockConvUnqualified :: forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member MemberStore r) =>
UserId -> ConvId -> Sem r ()
blockConvUnqualified UserId
zusr ConvId
cnv = do
  Conversation
conv <- ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
E.getConversation ConvId
cnv 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
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Conversation -> ConvType
Data.convType Conversation
conv ConvType -> [ConvType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ConvType
ConnectConv, ConvType
One2OneConv]) (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 @'InvalidOperation
  let mems :: [LocalMember]
mems = Conversation -> [LocalMember]
Data.convLocalMembers Conversation
conv
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UserId
zusr UserId -> [LocalMember] -> Bool
forall (m :: * -> *). Foldable m => UserId -> m LocalMember -> Bool
`isMember` [LocalMember]
mems) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    ConvId -> UserList UserId -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
ConvId -> UserList UserId -> Sem r ()
E.deleteMembers ConvId
cnv ([UserId] -> [Remote UserId] -> UserList UserId
forall a. [a] -> [Remote a] -> UserList a
UserList [UserId
zusr] [])

blockRemoteConv ::
  ( Member (ErrorS 'ConvNotFound) r,
    Member MemberStore r
  ) =>
  Local UserId ->
  Remote ConvId ->
  Sem r ()
blockRemoteConv :: forall (r :: EffectRow).
(Member (ErrorS 'ConvNotFound) r, Member MemberStore r) =>
Local UserId -> Remote ConvId -> Sem r ()
blockRemoteConv (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified -> UserId
usr) Remote ConvId
rcnv = do
  Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (UserId -> Remote ConvId -> Sem r Bool
forall (r :: EffectRow).
Member MemberStore r =>
UserId -> Remote ConvId -> Sem r Bool
E.checkLocalMemberRemoteConv UserId
usr Remote ConvId
rcnv) (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 @'ConvNotFound
  Remote ConvId -> [UserId] -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
Remote ConvId -> [UserId] -> Sem r ()
E.deleteMembersInRemoteConversation Remote ConvId
rcnv [UserId
usr]

unblockConv ::
  ( Member ConversationStore r,
    Member (Error InternalError) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member TinyLog r
  ) =>
  Local UserId ->
  Maybe ConnId ->
  Qualified ConvId ->
  Sem r ()
unblockConv :: forall (r :: EffectRow).
(Member ConversationStore r, Member (Error InternalError) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member MemberStore r, Member TinyLog r) =>
Local UserId -> Maybe ConnId -> Qualified ConvId -> Sem r ()
unblockConv Local UserId
lusr Maybe ConnId
conn =
  Local UserId
-> (Local ConvId -> Sem r ())
-> (Remote ConvId -> Sem r ())
-> Qualified ConvId
-> Sem r ()
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
    Local UserId
lusr
    (Sem r Conversation -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Conversation -> Sem r ())
-> (Local ConvId -> Sem r Conversation) -> Local ConvId -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local UserId -> Maybe ConnId -> ConvId -> Sem r Conversation
forall (r :: EffectRow).
(Member ConversationStore r, Member (Error InternalError) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member MemberStore r, Member TinyLog r) =>
Local UserId -> Maybe ConnId -> ConvId -> Sem r Conversation
unblockConvUnqualified Local UserId
lusr Maybe ConnId
conn (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)
    (Local UserId -> Remote ConvId -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
Local UserId -> Remote ConvId -> Sem r ()
unblockRemoteConv Local UserId
lusr)

unblockConvUnqualified ::
  ( Member ConversationStore r,
    Member (Error InternalError) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member TinyLog r
  ) =>
  Local UserId ->
  Maybe ConnId ->
  ConvId ->
  Sem r Conversation
unblockConvUnqualified :: forall (r :: EffectRow).
(Member ConversationStore r, Member (Error InternalError) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member MemberStore r, Member TinyLog r) =>
Local UserId -> Maybe ConnId -> ConvId -> Sem r Conversation
unblockConvUnqualified Local UserId
lusr Maybe ConnId
conn ConvId
cnv = do
  Conversation
conv <-
    ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
E.getConversation ConvId
cnv 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
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Conversation -> ConvType
Data.convType Conversation
conv ConvType -> [ConvType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ConvType
ConnectConv, ConvType
One2OneConv]) (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 @'InvalidOperation
  Conversation
conv' <- Local UserId -> Conversation -> Maybe ConnId -> Sem r Conversation
forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member (Error InternalError) r,
 Member (ErrorS 'InvalidOperation) r, Member (Input UTCTime) r,
 Member MemberStore r, Member NotificationSubsystem r) =>
Local UserId -> Conversation -> Maybe ConnId -> Sem r Conversation
acceptOne2One Local UserId
lusr Conversation
conv Maybe ConnId
conn
  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
conv'

unblockRemoteConv ::
  ( Member MemberStore r
  ) =>
  Local UserId ->
  Remote ConvId ->
  Sem r ()
unblockRemoteConv :: forall (r :: EffectRow).
Member MemberStore r =>
Local UserId -> Remote ConvId -> Sem r ()
unblockRemoteConv Local UserId
lusr Remote ConvId
rcnv = do
  Remote ConvId -> [UserId] -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
Remote ConvId -> [UserId] -> Sem r ()
E.createMembersInRemoteConversation Remote ConvId
rcnv [Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr]

-- conversation updates

type UpdateConversationAccessEffects =
  '[ BackendNotificationQueueAccess,
     BotAccess,
     BrigAccess,
     CodeStore,
     ConversationStore,
     Error FederationError,
     Error InternalError,
     Error InvalidInput,
     ErrorS ('ActionDenied 'ModifyConversationAccess),
     ErrorS ('ActionDenied 'RemoveConversationMember),
     ErrorS 'ConvNotFound,
     ErrorS 'InvalidOperation,
     ErrorS 'InvalidTargetAccess,
     ExternalAccess,
     FederatorAccess,
     FireAndForget,
     NotificationSubsystem,
     Input Env,
     Input UTCTime,
     MemberStore,
     ProposalStore,
     Random,
     SubConversationStore,
     TeamStore,
     TinyLog
   ]

updateConversationAccess ::
  ( Members UpdateConversationAccessEffects r
  ) =>
  Local UserId ->
  ConnId ->
  Qualified ConvId ->
  ConversationAccessData ->
  Sem r (UpdateResult Event)
updateConversationAccess :: forall (r :: EffectRow).
Members UpdateConversationAccessEffects r =>
Local UserId
-> ConnId
-> Qualified ConvId
-> ConversationAccessData
-> Sem r (UpdateResult Event)
updateConversationAccess Local UserId
lusr ConnId
con Qualified ConvId
qcnv ConversationAccessData
update = do
  Local ConvId
lcnv <- Local UserId -> Qualified ConvId -> Sem r (Local ConvId)
forall (r :: EffectRow) x a.
Member (Error FederationError) r =>
Local x -> Qualified a -> Sem r (Local a)
ensureLocal Local UserId
lusr Qualified ConvId
qcnv
  Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event)
forall (r :: EffectRow) a.
Sem (Error NoChanges : r) a -> Sem r (UpdateResult a)
getUpdateResult (Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event))
-> (Sem (Error NoChanges : r) LocalConversationUpdate
    -> Sem (Error NoChanges : r) Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (UpdateResult Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalConversationUpdate -> Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem (Error NoChanges : r) Event
forall a b.
(a -> b)
-> Sem (Error NoChanges : r) a -> Sem (Error NoChanges : r) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalConversationUpdate -> Event
lcuEvent (Sem (Error NoChanges : r) LocalConversationUpdate
 -> Sem r (UpdateResult Event))
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$
    forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 HasConversationActionEffects tag r, SingI tag) =>
Local ConvId
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversation @'ConversationAccessDataTag Local ConvId
lcnv (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
con) ConversationAccessData
ConversationAction 'ConversationAccessDataTag
update

updateConversationAccessUnqualified ::
  ( Members UpdateConversationAccessEffects r
  ) =>
  Local UserId ->
  ConnId ->
  ConvId ->
  ConversationAccessData ->
  Sem r (UpdateResult Event)
updateConversationAccessUnqualified :: forall (r :: EffectRow).
Members UpdateConversationAccessEffects r =>
Local UserId
-> ConnId
-> ConvId
-> ConversationAccessData
-> Sem r (UpdateResult Event)
updateConversationAccessUnqualified Local UserId
lusr ConnId
con ConvId
cnv ConversationAccessData
update =
  Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event)
forall (r :: EffectRow) a.
Sem (Error NoChanges : r) a -> Sem r (UpdateResult a)
getUpdateResult (Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event))
-> (Sem (Error NoChanges : r) LocalConversationUpdate
    -> Sem (Error NoChanges : r) Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (UpdateResult Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalConversationUpdate -> Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem (Error NoChanges : r) Event
forall a b.
(a -> b)
-> Sem (Error NoChanges : r) a -> Sem (Error NoChanges : r) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalConversationUpdate -> Event
lcuEvent (Sem (Error NoChanges : r) LocalConversationUpdate
 -> Sem r (UpdateResult Event))
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$
    forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 HasConversationActionEffects tag r, SingI tag) =>
Local ConvId
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversation @'ConversationAccessDataTag
      (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 -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr)
      (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
con)
      ConversationAccessData
ConversationAction 'ConversationAccessDataTag
update

updateConversationReceiptMode ::
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'ModifyConversationReceiptMode)) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member (Input (Local ())) r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  Qualified ConvId ->
  ConversationReceiptModeUpdate ->
  Sem r (UpdateResult Event)
updateConversationReceiptMode :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'ModifyConversationReceiptMode)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input (Local ())) r, Member (Input UTCTime) r,
 Member MemberStore r, Member TinyLog r) =>
Local UserId
-> ConnId
-> Qualified ConvId
-> ConversationReceiptModeUpdate
-> Sem r (UpdateResult Event)
updateConversationReceiptMode Local UserId
lusr ConnId
zcon Qualified ConvId
qcnv ConversationReceiptModeUpdate
update =
  forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError @UnreachableBackends @InternalError (\UnreachableBackends
_ -> LText -> InternalError
InternalErrorWithDescription LText
"Unexpected UnreachableBackends error when updating remote receipt mode")
    (Sem (Error UnreachableBackends : r) (UpdateResult Event)
 -> Sem r (UpdateResult Event))
-> (Sem
      (Error NonFederatingBackends : Error UnreachableBackends : r)
      (UpdateResult Event)
    -> Sem (Error UnreachableBackends : r) (UpdateResult Event))
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (UpdateResult Event)
-> Sem r (UpdateResult Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError @NonFederatingBackends @InternalError (\NonFederatingBackends
_ -> LText -> InternalError
InternalErrorWithDescription LText
"Unexpected NonFederatingBackends error when updating remote receipt mode")
    (Sem
   (Error NonFederatingBackends : Error UnreachableBackends : r)
   (UpdateResult Event)
 -> Sem r (UpdateResult Event))
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (UpdateResult Event)
-> Sem r (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$ Local UserId
-> (Local ConvId
    -> Sem
         (Error NonFederatingBackends : Error UnreachableBackends : r)
         (UpdateResult Event))
-> (Remote ConvId
    -> Sem
         (Error NonFederatingBackends : Error UnreachableBackends : r)
         (UpdateResult Event))
-> Qualified ConvId
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (UpdateResult Event)
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
      Local UserId
lusr
      ( \Local ConvId
lcnv ->
          Sem
  (Error NoChanges
     : Error NonFederatingBackends : Error UnreachableBackends : r)
  Event
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (UpdateResult Event)
forall (r :: EffectRow) a.
Sem (Error NoChanges : r) a -> Sem r (UpdateResult a)
getUpdateResult (Sem
   (Error NoChanges
      : Error NonFederatingBackends : Error UnreachableBackends : r)
   Event
 -> Sem
      (Error NonFederatingBackends : Error UnreachableBackends : r)
      (UpdateResult Event))
-> (Sem
      (Error NoChanges
         : Error NonFederatingBackends : Error UnreachableBackends : r)
      LocalConversationUpdate
    -> Sem
         (Error NoChanges
            : Error NonFederatingBackends : Error UnreachableBackends : r)
         Event)
-> Sem
     (Error NoChanges
        : Error NonFederatingBackends : Error UnreachableBackends : r)
     LocalConversationUpdate
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (UpdateResult Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalConversationUpdate -> Event)
-> Sem
     (Error NoChanges
        : Error NonFederatingBackends : Error UnreachableBackends : r)
     LocalConversationUpdate
-> Sem
     (Error NoChanges
        : Error NonFederatingBackends : Error UnreachableBackends : r)
     Event
forall a b.
(a -> b)
-> Sem
     (Error NoChanges
        : Error NonFederatingBackends : Error UnreachableBackends : r)
     a
-> Sem
     (Error NoChanges
        : Error NonFederatingBackends : Error UnreachableBackends : r)
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalConversationUpdate -> Event
lcuEvent (Sem
   (Error NoChanges
      : Error NonFederatingBackends : Error UnreachableBackends : r)
   LocalConversationUpdate
 -> Sem
      (Error NonFederatingBackends : Error UnreachableBackends : r)
      (UpdateResult Event))
-> Sem
     (Error NoChanges
        : Error NonFederatingBackends : Error UnreachableBackends : r)
     LocalConversationUpdate
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$
            forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 HasConversationActionEffects tag r, SingI tag) =>
Local ConvId
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversation
              @'ConversationReceiptModeUpdateTag
              Local ConvId
lcnv
              (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr)
              (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon)
              ConversationReceiptModeUpdate
ConversationAction 'ConversationReceiptModeUpdateTag
update
      )
      (\Remote ConvId
rcnv -> forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BrigAccess r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input (Local ())) r, Member MemberStore r,
 Member TinyLog r,
 RethrowErrors (HasConversationActionGalleyErrors tag) r,
 Member (Error NonFederatingBackends) r,
 Member (Error UnreachableBackends) r, SingI tag) =>
Remote ConvId
-> Local UserId
-> ConnId
-> ConversationAction tag
-> Sem r (UpdateResult Event)
updateRemoteConversation @'ConversationReceiptModeUpdateTag Remote ConvId
rcnv Local UserId
lusr ConnId
zcon ConversationReceiptModeUpdate
ConversationAction 'ConversationReceiptModeUpdateTag
update)
      Qualified ConvId
qcnv

updateRemoteConversation ::
  forall tag r.
  ( Member BrigAccess r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member (Input (Local ())) r,
    Member MemberStore r,
    Member TinyLog r,
    RethrowErrors (HasConversationActionGalleyErrors tag) r,
    Member (Error NonFederatingBackends) r,
    Member (Error UnreachableBackends) r,
    SingI tag
  ) =>
  Remote ConvId ->
  Local UserId ->
  ConnId ->
  ConversationAction tag ->
  Sem r (UpdateResult Event)
updateRemoteConversation :: forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BrigAccess r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input (Local ())) r, Member MemberStore r,
 Member TinyLog r,
 RethrowErrors (HasConversationActionGalleyErrors tag) r,
 Member (Error NonFederatingBackends) r,
 Member (Error UnreachableBackends) r, SingI tag) =>
Remote ConvId
-> Local UserId
-> ConnId
-> ConversationAction tag
-> Sem r (UpdateResult Event)
updateRemoteConversation Remote ConvId
rcnv Local UserId
lusr ConnId
conn ConversationAction tag
action = Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event)
forall (r :: EffectRow) a.
Sem (Error NoChanges : r) a -> Sem r (UpdateResult a)
getUpdateResult (Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event))
-> Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$ do
  let updateRequest :: ConversationUpdateRequest
updateRequest =
        ConversationUpdateRequest
          { $sel:user:ConversationUpdateRequest :: UserId
user = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr,
            $sel:convId:ConversationUpdateRequest :: ConvId
convId = Remote ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Remote ConvId
rcnv,
            $sel:action:ConversationUpdateRequest :: SomeConversationAction
action = Sing tag -> ConversationAction tag -> SomeConversationAction
forall (tag :: ConversationActionTag).
Sing tag -> ConversationAction tag -> SomeConversationAction
SomeConversationAction (forall {k} (a :: k). SingI a => Sing a
forall (a :: ConversationActionTag). SingI a => Sing a
sing @tag) ConversationAction tag
action
          }
  ConversationUpdateResponse
response <- Remote ConvId
-> FederatorClient 'Galley ConversationUpdateResponse
-> Sem (Error NoChanges : r) ConversationUpdateResponse
forall (r :: EffectRow) (c :: Component) x a.
(Member FederatorAccess r, KnownComponent c) =>
Remote x -> FederatorClient c a -> Sem r a
E.runFederated Remote ConvId
rcnv (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 @"update-conversation" ConversationUpdateRequest
updateRequest)
  ConversationUpdate
convUpdate <- case ConversationUpdateResponse
response of
    ConversationUpdateResponse
ConversationUpdateResponseNoChanges -> NoChanges -> Sem (Error NoChanges : r) ConversationUpdate
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw NoChanges
NoChanges
    ConversationUpdateResponseError GalleyError
err' -> Sem r ConversationUpdate
-> Sem (Error NoChanges : r) ConversationUpdate
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (Sem r ConversationUpdate
 -> Sem (Error NoChanges : r) ConversationUpdate)
-> Sem r ConversationUpdate
-> Sem (Error NoChanges : r) ConversationUpdate
forall a b. (a -> b) -> a -> b
$ forall (effs :: EffectRow) (r :: EffectRow) a.
RethrowErrors effs r =>
GalleyError -> Sem r a
rethrowErrors @(HasConversationActionGalleyErrors tag) GalleyError
err'
    ConversationUpdateResponseUpdate ConversationUpdate
convUpdate -> ConversationUpdate -> Sem (Error NoChanges : r) ConversationUpdate
forall a. a -> Sem (Error NoChanges : r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConversationUpdate
convUpdate
    ConversationUpdateResponseNonFederatingBackends NonFederatingBackends
e -> NonFederatingBackends
-> Sem (Error NoChanges : r) ConversationUpdate
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw NonFederatingBackends
e
    ConversationUpdateResponseUnreachableBackends UnreachableBackends
e -> UnreachableBackends -> Sem (Error NoChanges : r) ConversationUpdate
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw UnreachableBackends
e
  Remote ConversationUpdate
-> Maybe ConnId -> Sem (Error NoChanges : r) (Maybe Event)
forall (r :: EffectRow).
(Member BrigAccess r, Member NotificationSubsystem r,
 Member ExternalAccess r, Member (Input (Local ())) r,
 Member MemberStore r, Member TinyLog r) =>
Remote ConversationUpdate -> Maybe ConnId -> Sem r (Maybe Event)
updateLocalStateOfRemoteConv (Remote ConvId -> ConversationUpdate -> Remote ConversationUpdate
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Remote ConvId
rcnv ConversationUpdate
convUpdate) (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
conn) Sem (Error NoChanges : r) (Maybe Event)
-> (Maybe Event -> Sem (Error NoChanges : r) Event)
-> Sem (Error NoChanges : r) Event
forall a b.
Sem (Error NoChanges : r) a
-> (a -> Sem (Error NoChanges : r) b)
-> Sem (Error NoChanges : r) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NoChanges -> Maybe Event -> Sem (Error NoChanges : r) Event
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note NoChanges
NoChanges

updateConversationReceiptModeUnqualified ::
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'ModifyConversationReceiptMode)) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member (Input (Local ())) r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  ConvId ->
  ConversationReceiptModeUpdate ->
  Sem r (UpdateResult Event)
updateConversationReceiptModeUnqualified :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'ModifyConversationReceiptMode)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input (Local ())) r, Member (Input UTCTime) r,
 Member MemberStore r, Member TinyLog r) =>
Local UserId
-> ConnId
-> ConvId
-> ConversationReceiptModeUpdate
-> Sem r (UpdateResult Event)
updateConversationReceiptModeUnqualified Local UserId
lusr ConnId
zcon ConvId
cnv = Local UserId
-> ConnId
-> Qualified ConvId
-> ConversationReceiptModeUpdate
-> Sem r (UpdateResult Event)
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'ModifyConversationReceiptMode)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input (Local ())) r, Member (Input UTCTime) r,
 Member MemberStore r, Member TinyLog r) =>
Local UserId
-> ConnId
-> Qualified ConvId
-> ConversationReceiptModeUpdate
-> Sem r (UpdateResult Event)
updateConversationReceiptMode Local UserId
lusr ConnId
zcon (Local ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (Local UserId -> ConvId -> Local ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr ConvId
cnv))

updateConversationMessageTimer ::
  ( Member BackendNotificationQueueAccess r,
    Member ConversationStore r,
    Member (ErrorS ('ActionDenied 'ModifyConversationMessageTimer)) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member (Error FederationError) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r
  ) =>
  Local UserId ->
  ConnId ->
  Qualified ConvId ->
  ConversationMessageTimerUpdate ->
  Sem r (UpdateResult Event)
updateConversationMessageTimer :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r,
 Member (ErrorS ('ActionDenied 'ModifyConversationMessageTimer)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (Error FederationError) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r) =>
Local UserId
-> ConnId
-> Qualified ConvId
-> ConversationMessageTimerUpdate
-> Sem r (UpdateResult Event)
updateConversationMessageTimer Local UserId
lusr ConnId
zcon Qualified ConvId
qcnv ConversationMessageTimerUpdate
update =
  Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event)
forall (r :: EffectRow) a.
Sem (Error NoChanges : r) a -> Sem r (UpdateResult a)
getUpdateResult (Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event))
-> Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$
    Local UserId
-> (Local ConvId -> Sem (Error NoChanges : r) Event)
-> (Remote ConvId -> Sem (Error NoChanges : r) Event)
-> Qualified ConvId
-> Sem (Error NoChanges : r) Event
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
      Local UserId
lusr
      ( \Local ConvId
lcnv ->
          LocalConversationUpdate -> Event
lcuEvent
            (LocalConversationUpdate -> Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem (Error NoChanges : r) Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 HasConversationActionEffects tag r, SingI tag) =>
Local ConvId
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversation
              @'ConversationMessageTimerUpdateTag
              Local ConvId
lcnv
              (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr)
              (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon)
              ConversationMessageTimerUpdate
ConversationAction 'ConversationMessageTimerUpdateTag
update
      )
      (\Remote ConvId
_ -> FederationError -> Sem (Error NoChanges : r) Event
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw FederationError
FederationNotImplemented)
      Qualified ConvId
qcnv

updateConversationMessageTimerUnqualified ::
  ( Member BackendNotificationQueueAccess r,
    Member ConversationStore r,
    Member (ErrorS ('ActionDenied 'ModifyConversationMessageTimer)) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member (Error FederationError) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r
  ) =>
  Local UserId ->
  ConnId ->
  ConvId ->
  ConversationMessageTimerUpdate ->
  Sem r (UpdateResult Event)
updateConversationMessageTimerUnqualified :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r,
 Member (ErrorS ('ActionDenied 'ModifyConversationMessageTimer)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (Error FederationError) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r) =>
Local UserId
-> ConnId
-> ConvId
-> ConversationMessageTimerUpdate
-> Sem r (UpdateResult Event)
updateConversationMessageTimerUnqualified Local UserId
lusr ConnId
zcon ConvId
cnv = Local UserId
-> ConnId
-> Qualified ConvId
-> ConversationMessageTimerUpdate
-> Sem r (UpdateResult Event)
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r,
 Member (ErrorS ('ActionDenied 'ModifyConversationMessageTimer)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (Error FederationError) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r) =>
Local UserId
-> ConnId
-> Qualified ConvId
-> ConversationMessageTimerUpdate
-> Sem r (UpdateResult Event)
updateConversationMessageTimer Local UserId
lusr ConnId
zcon (Local ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (Local UserId -> ConvId -> Local ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr ConvId
cnv))

deleteLocalConversation ::
  ( Member BrigAccess r,
    Member BackendNotificationQueueAccess r,
    Member CodeStore r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS ('ActionDenied 'DeleteConversation)) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member SubConversationStore r,
    Member MemberStore r,
    Member ProposalStore r,
    Member (Input UTCTime) r,
    Member TeamStore r
  ) =>
  Local UserId ->
  ConnId ->
  Local ConvId ->
  Sem r (UpdateResult Event)
deleteLocalConversation :: forall (r :: EffectRow).
(Member BrigAccess r, Member BackendNotificationQueueAccess r,
 Member CodeStore r, Member ConversationStore r,
 Member (Error FederationError) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS ('ActionDenied 'DeleteConversation)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member SubConversationStore r, Member MemberStore r,
 Member ProposalStore r, Member (Input UTCTime) r,
 Member TeamStore r) =>
Local UserId
-> ConnId -> Local ConvId -> Sem r (UpdateResult Event)
deleteLocalConversation Local UserId
lusr ConnId
con Local ConvId
lcnv =
  Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event)
forall (r :: EffectRow) a.
Sem (Error NoChanges : r) a -> Sem r (UpdateResult a)
getUpdateResult (Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event))
-> (Sem (Error NoChanges : r) LocalConversationUpdate
    -> Sem (Error NoChanges : r) Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (UpdateResult Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalConversationUpdate -> Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem (Error NoChanges : r) Event
forall a b.
(a -> b)
-> Sem (Error NoChanges : r) a -> Sem (Error NoChanges : r) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalConversationUpdate -> Event
lcuEvent (Sem (Error NoChanges : r) LocalConversationUpdate
 -> Sem r (UpdateResult Event))
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$
    forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 HasConversationActionEffects tag r, SingI tag) =>
Local ConvId
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversation @'ConversationDeleteTag Local ConvId
lcnv (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
con) ()

getUpdateResult :: Sem (Error NoChanges ': r) a -> Sem r (UpdateResult a)
getUpdateResult :: forall (r :: EffectRow) a.
Sem (Error NoChanges : r) a -> Sem r (UpdateResult a)
getUpdateResult = (Either NoChanges a -> UpdateResult a)
-> Sem r (Either NoChanges a) -> Sem r (UpdateResult a)
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NoChanges -> UpdateResult a)
-> (a -> UpdateResult a) -> Either NoChanges a -> UpdateResult a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (UpdateResult a -> NoChanges -> UpdateResult a
forall a b. a -> b -> a
const UpdateResult a
forall a. UpdateResult a
Unchanged) a -> UpdateResult a
forall a. a -> UpdateResult a
Updated) (Sem r (Either NoChanges a) -> Sem r (UpdateResult a))
-> (Sem (Error NoChanges : r) a -> Sem r (Either NoChanges a))
-> Sem (Error NoChanges : r) a
-> Sem r (UpdateResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Error NoChanges : r) a -> Sem r (Either NoChanges a)
forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError

addCodeUnqualifiedWithReqBody ::
  forall r.
  ( Member CodeStore r,
    Member ConversationStore r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'GuestLinksDisabled) r,
    Member (ErrorS 'CreateConversationCodeConflict) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input (Local ())) r,
    Member (Input UTCTime) r,
    Member (Embed IO) r,
    Member (Input Opts) r,
    Member TeamFeatureStore r
  ) =>
  UserId ->
  Maybe Text ->
  Maybe ConnId ->
  ConvId ->
  CreateConversationCodeRequest ->
  Sem r AddCodeResult
addCodeUnqualifiedWithReqBody :: forall (r :: EffectRow).
(Member CodeStore r, Member ConversationStore r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'GuestLinksDisabled) r,
 Member (ErrorS 'CreateConversationCodeConflict) r,
 Member ExternalAccess r, Member NotificationSubsystem r,
 Member (Input (Local ())) r, Member (Input UTCTime) r,
 Member (Embed IO) r, Member (Input Opts) r,
 Member TeamFeatureStore r) =>
UserId
-> Maybe Text
-> Maybe ConnId
-> ConvId
-> CreateConversationCodeRequest
-> Sem r AddCodeResult
addCodeUnqualifiedWithReqBody UserId
usr Maybe Text
mbZHost Maybe ConnId
mZcon ConvId
cnv CreateConversationCodeRequest
req = Maybe CreateConversationCodeRequest
-> UserId
-> Maybe Text
-> Maybe ConnId
-> ConvId
-> Sem r AddCodeResult
forall (r :: EffectRow).
(Member CodeStore r, Member ConversationStore r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'GuestLinksDisabled) r,
 Member (ErrorS 'CreateConversationCodeConflict) r,
 Member ExternalAccess r, Member NotificationSubsystem r,
 Member (Input (Local ())) r, Member (Input UTCTime) r,
 Member (Input Opts) r, Member (Embed IO) r,
 Member TeamFeatureStore r) =>
Maybe CreateConversationCodeRequest
-> UserId
-> Maybe Text
-> Maybe ConnId
-> ConvId
-> Sem r AddCodeResult
addCodeUnqualified (CreateConversationCodeRequest
-> Maybe CreateConversationCodeRequest
forall a. a -> Maybe a
Just CreateConversationCodeRequest
req) UserId
usr Maybe Text
mbZHost Maybe ConnId
mZcon ConvId
cnv

addCodeUnqualified ::
  forall r.
  ( Member CodeStore r,
    Member ConversationStore r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'GuestLinksDisabled) r,
    Member (ErrorS 'CreateConversationCodeConflict) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input (Local ())) r,
    Member (Input UTCTime) r,
    Member (Input Opts) r,
    Member (Embed IO) r,
    Member TeamFeatureStore r
  ) =>
  Maybe CreateConversationCodeRequest ->
  UserId ->
  Maybe ZHostValue ->
  Maybe ConnId ->
  ConvId ->
  Sem r AddCodeResult
addCodeUnqualified :: forall (r :: EffectRow).
(Member CodeStore r, Member ConversationStore r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'GuestLinksDisabled) r,
 Member (ErrorS 'CreateConversationCodeConflict) r,
 Member ExternalAccess r, Member NotificationSubsystem r,
 Member (Input (Local ())) r, Member (Input UTCTime) r,
 Member (Input Opts) r, Member (Embed IO) r,
 Member TeamFeatureStore r) =>
Maybe CreateConversationCodeRequest
-> UserId
-> Maybe Text
-> Maybe ConnId
-> ConvId
-> Sem r AddCodeResult
addCodeUnqualified Maybe CreateConversationCodeRequest
mReq UserId
usr Maybe Text
mbZHost Maybe ConnId
mZcon ConvId
cnv = 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 ConvId
lcnv <- ConvId -> Sem r (Local ConvId)
forall (r :: EffectRow) a.
Member (Input (Local ())) r =>
a -> Sem r (Local a)
qualifyLocal ConvId
cnv
  Local UserId
-> Maybe Text
-> Maybe ConnId
-> Local ConvId
-> Maybe CreateConversationCodeRequest
-> Sem r AddCodeResult
forall (r :: EffectRow).
(Member CodeStore r, Member ConversationStore r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'GuestLinksDisabled) r,
 Member (ErrorS 'CreateConversationCodeConflict) r,
 Member ExternalAccess r, Member NotificationSubsystem r,
 Member (Input UTCTime) r, Member (Input Opts) r,
 Member TeamFeatureStore r, Member (Embed IO) r) =>
Local UserId
-> Maybe Text
-> Maybe ConnId
-> Local ConvId
-> Maybe CreateConversationCodeRequest
-> Sem r AddCodeResult
addCode Local UserId
lusr Maybe Text
mbZHost Maybe ConnId
mZcon Local ConvId
lcnv Maybe CreateConversationCodeRequest
mReq

addCode ::
  forall r.
  ( Member CodeStore r,
    Member ConversationStore r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (ErrorS 'GuestLinksDisabled) r,
    Member (ErrorS 'CreateConversationCodeConflict) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member (Input Opts) r,
    Member TeamFeatureStore r,
    Member (Embed IO) r
  ) =>
  Local UserId ->
  Maybe ZHostValue ->
  Maybe ConnId ->
  Local ConvId ->
  Maybe CreateConversationCodeRequest ->
  Sem r AddCodeResult
addCode :: forall (r :: EffectRow).
(Member CodeStore r, Member ConversationStore r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'GuestLinksDisabled) r,
 Member (ErrorS 'CreateConversationCodeConflict) r,
 Member ExternalAccess r, Member NotificationSubsystem r,
 Member (Input UTCTime) r, Member (Input Opts) r,
 Member TeamFeatureStore r, Member (Embed IO) r) =>
Local UserId
-> Maybe Text
-> Maybe ConnId
-> Local ConvId
-> Maybe CreateConversationCodeRequest
-> Sem r AddCodeResult
addCode Local UserId
lusr Maybe Text
mbZHost Maybe ConnId
mZcon Local ConvId
lcnv Maybe CreateConversationCodeRequest
mReq = do
  Conversation
conv <- 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
lcnv) 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
  Maybe TeamId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'GuestLinksDisabled) r, Member TeamFeatureStore r,
 Member (Input Opts) r) =>
Maybe TeamId -> Sem r ()
Query.ensureGuestLinksEnabled (Conversation -> Maybe TeamId
Data.convTeam Conversation
conv)
  [LocalMember] -> UserId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r) =>
[LocalMember] -> UserId -> Sem r ()
Query.ensureConvAdmin (Conversation -> [LocalMember]
Data.convLocalMembers Conversation
conv) (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr)
  Conversation -> Access -> Sem r ()
forall (r :: EffectRow).
Member (ErrorS 'ConvAccessDenied) r =>
Conversation -> Access -> Sem r ()
ensureAccess Conversation
conv Access
CodeAccess
  Conversation -> Sem r ()
ensureGuestsOrNonTeamMembersAllowed Conversation
conv
  HttpsUrl
convUri <- Maybe Text -> Sem r HttpsUrl
forall (r :: EffectRow).
(Member (ErrorS 'ConvAccessDenied) r, Member CodeStore r) =>
Maybe Text -> Sem r HttpsUrl
getConversationCodeURI Maybe Text
mbZHost
  Key
key <- ConvId -> Sem r Key
forall (r :: EffectRow). Member CodeStore r => ConvId -> Sem r Key
E.makeKey (Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvId
lcnv)
  Key -> Scope -> Sem r (Maybe (Code, Maybe Password))
forall (r :: EffectRow).
Member CodeStore r =>
Key -> Scope -> Sem r (Maybe (Code, Maybe Password))
E.getCode Key
key Scope
ReusableCode Sem r (Maybe (Code, Maybe Password))
-> (Maybe (Code, Maybe Password) -> Sem r AddCodeResult)
-> Sem r AddCodeResult
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
    Maybe (Code, Maybe Password)
Nothing -> do
      NominalDiffTime
ttl <- Int -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Int -> NominalDiffTime)
-> (Opts -> Int) -> Opts -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuestLinkTTLSeconds -> Int
unGuestLinkTTLSeconds (GuestLinkTTLSeconds -> Int)
-> (Opts -> GuestLinkTTLSeconds) -> Opts -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuestLinkTTLSeconds
-> Maybe GuestLinkTTLSeconds -> GuestLinkTTLSeconds
forall a. a -> Maybe a -> a
fromMaybe GuestLinkTTLSeconds
defGuestLinkTTLSeconds (Maybe GuestLinkTTLSeconds -> GuestLinkTTLSeconds)
-> (Opts -> Maybe GuestLinkTTLSeconds)
-> Opts
-> GuestLinkTTLSeconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Maybe GuestLinkTTLSeconds) Opts (Maybe GuestLinkTTLSeconds)
-> Opts -> Maybe GuestLinkTTLSeconds
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Settings -> Const (Maybe GuestLinkTTLSeconds) Settings)
-> Opts -> Const (Maybe GuestLinkTTLSeconds) Opts
Lens' Opts Settings
settings ((Settings -> Const (Maybe GuestLinkTTLSeconds) Settings)
 -> Opts -> Const (Maybe GuestLinkTTLSeconds) Opts)
-> ((Maybe GuestLinkTTLSeconds
     -> Const (Maybe GuestLinkTTLSeconds) (Maybe GuestLinkTTLSeconds))
    -> Settings -> Const (Maybe GuestLinkTTLSeconds) Settings)
-> Getting
     (Maybe GuestLinkTTLSeconds) Opts (Maybe GuestLinkTTLSeconds)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe GuestLinkTTLSeconds
 -> Const (Maybe GuestLinkTTLSeconds) (Maybe GuestLinkTTLSeconds))
-> Settings -> Const (Maybe GuestLinkTTLSeconds) Settings
Lens' Settings (Maybe GuestLinkTTLSeconds)
guestLinkTTLSeconds) (Opts -> NominalDiffTime) -> Sem r Opts -> Sem r NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r Opts
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
      Code
code <- ConvId -> Scope -> Timeout -> Sem r Code
forall (r :: EffectRow).
Member CodeStore r =>
ConvId -> Scope -> Timeout -> Sem r Code
E.generateCode (Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvId
lcnv) Scope
ReusableCode (NominalDiffTime -> Timeout
Timeout NominalDiffTime
ttl)
      Maybe Password
mPw <- Maybe (PlainTextPassword' 8)
-> (PlainTextPassword' 8 -> Sem r Password)
-> Sem r (Maybe Password)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Maybe CreateConversationCodeRequest
mReq Maybe CreateConversationCodeRequest
-> (CreateConversationCodeRequest -> Maybe (PlainTextPassword' 8))
-> Maybe (PlainTextPassword' 8)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (.password)) PlainTextPassword' 8 -> Sem r Password
forall (m :: * -> *) (t :: Nat).
MonadIO m =>
PlainTextPassword' t -> m Password
mkSafePasswordScrypt
      Code -> Maybe Password -> Sem r ()
forall (r :: EffectRow).
Member CodeStore r =>
Code -> Maybe Password -> Sem r ()
E.createCode Code
code Maybe Password
mPw
      UTCTime
now <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
      let event :: Event
event = Qualified ConvId
-> Maybe SubConvId
-> Qualified UserId
-> UTCTime
-> EventData
-> Event
Event (Local ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local ConvId
lcnv) Maybe SubConvId
forall a. Maybe a
Nothing (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) UTCTime
now (ConversationCodeInfo -> EventData
EdConvCodeUpdate (Bool -> Key -> Value -> HttpsUrl -> ConversationCodeInfo
mkConversationCodeInfo (Maybe Password -> Bool
forall a. Maybe a -> Bool
isJust Maybe Password
mPw) (Code -> Key
codeKey Code
code) (Code -> Value
codeValue Code
code) HttpsUrl
convUri))
      let ([BotMember]
bots, [LocalMember]
users) = [LocalMember] -> ([BotMember], [LocalMember])
forall (f :: * -> *).
Foldable f =>
f LocalMember -> ([BotMember], [LocalMember])
localBotsAndUsers ([LocalMember] -> ([BotMember], [LocalMember]))
-> [LocalMember] -> ([BotMember], [LocalMember])
forall a b. (a -> b) -> a -> b
$ Conversation -> [LocalMember]
Data.convLocalMembers Conversation
conv
      Maybe ConnId -> Event -> Local [UserId] -> [BotMember] -> Sem r ()
forall (r :: EffectRow) (f :: * -> *).
(Member ExternalAccess r, Member NotificationSubsystem r,
 Foldable f) =>
Maybe ConnId
-> Event -> Local (f UserId) -> f BotMember -> Sem r ()
pushConversationEvent Maybe ConnId
mZcon Event
event (Local UserId -> [UserId] -> Local [UserId]
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr ((LocalMember -> UserId) -> [LocalMember] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
map LocalMember -> UserId
lmId [LocalMember]
users)) [BotMember]
bots
      AddCodeResult -> Sem r AddCodeResult
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddCodeResult -> Sem r AddCodeResult)
-> AddCodeResult -> Sem r AddCodeResult
forall a b. (a -> b) -> a -> b
$ Event -> AddCodeResult
CodeAdded Event
event
    -- In case conversation already has a code this case covers the allowed no-ops
    Just (Code
code, Maybe Password
mPw) -> do
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Password -> Bool
forall a. Maybe a -> Bool
isJust Maybe Password
mPw Bool -> Bool -> Bool
|| Maybe (PlainTextPassword' 8) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe CreateConversationCodeRequest
mReq Maybe CreateConversationCodeRequest
-> (CreateConversationCodeRequest -> Maybe (PlainTextPassword' 8))
-> Maybe (PlainTextPassword' 8)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (.password))) (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 @'CreateConversationCodeConflict
      AddCodeResult -> Sem r AddCodeResult
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddCodeResult -> Sem r AddCodeResult)
-> AddCodeResult -> Sem r AddCodeResult
forall a b. (a -> b) -> a -> b
$ ConversationCodeInfo -> AddCodeResult
CodeAlreadyExisted (Bool -> Key -> Value -> HttpsUrl -> ConversationCodeInfo
mkConversationCodeInfo (Maybe Password -> Bool
forall a. Maybe a -> Bool
isJust Maybe Password
mPw) (Code -> Key
codeKey Code
code) (Code -> Value
codeValue Code
code) HttpsUrl
convUri)
  where
    ensureGuestsOrNonTeamMembersAllowed :: Data.Conversation -> Sem r ()
    ensureGuestsOrNonTeamMembersAllowed :: Conversation -> Sem r ()
ensureGuestsOrNonTeamMembersAllowed Conversation
conv =
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
        ( AccessRole
GuestAccessRole AccessRole -> Set AccessRole -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Conversation -> Set AccessRole
Data.convAccessRoles Conversation
conv
            Bool -> Bool -> Bool
|| AccessRole
NonTeamMemberAccessRole AccessRole -> Set AccessRole -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Conversation -> Set AccessRole
Data.convAccessRoles Conversation
conv
        )
        (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

rmCodeUnqualified ::
  ( Member CodeStore r,
    Member ConversationStore r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input (Local ())) r,
    Member (Input UTCTime) r
  ) =>
  Local UserId ->
  ConnId ->
  ConvId ->
  Sem r Event
rmCodeUnqualified :: forall (r :: EffectRow).
(Member CodeStore r, Member ConversationStore r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvAccessDenied) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input (Local ())) r,
 Member (Input UTCTime) r) =>
Local UserId -> ConnId -> ConvId -> Sem r Event
rmCodeUnqualified Local UserId
lusr ConnId
zcon 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
  Local UserId -> ConnId -> Local ConvId -> Sem r Event
forall (r :: EffectRow).
(Member CodeStore r, Member ConversationStore r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r) =>
Local UserId -> ConnId -> Local ConvId -> Sem r Event
rmCode Local UserId
lusr ConnId
zcon Local ConvId
lcnv

rmCode ::
  ( Member CodeStore r,
    Member ConversationStore r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (ErrorS 'ConvNotFound) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r
  ) =>
  Local UserId ->
  ConnId ->
  Local ConvId ->
  Sem r Event
rmCode :: forall (r :: EffectRow).
(Member CodeStore r, Member ConversationStore r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r) =>
Local UserId -> ConnId -> Local ConvId -> Sem r Event
rmCode Local UserId
lusr ConnId
zcon Local ConvId
lcnv = do
  Conversation
conv <-
    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
lcnv) 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 ()
Query.ensureConvAdmin (Conversation -> [LocalMember]
Data.convLocalMembers Conversation
conv) (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr)
  Conversation -> Access -> Sem r ()
forall (r :: EffectRow).
Member (ErrorS 'ConvAccessDenied) r =>
Conversation -> Access -> Sem r ()
ensureAccess Conversation
conv Access
CodeAccess
  let ([BotMember]
bots, [LocalMember]
users) = [LocalMember] -> ([BotMember], [LocalMember])
forall (f :: * -> *).
Foldable f =>
f LocalMember -> ([BotMember], [LocalMember])
localBotsAndUsers ([LocalMember] -> ([BotMember], [LocalMember]))
-> [LocalMember] -> ([BotMember], [LocalMember])
forall a b. (a -> b) -> a -> b
$ Conversation -> [LocalMember]
Data.convLocalMembers Conversation
conv
  Key
key <- ConvId -> Sem r Key
forall (r :: EffectRow). Member CodeStore r => ConvId -> Sem r Key
E.makeKey (Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvId
lcnv)
  Key -> Scope -> Sem r ()
forall (r :: EffectRow).
Member CodeStore r =>
Key -> Scope -> Sem r ()
E.deleteCode Key
key Scope
ReusableCode
  UTCTime
now <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  let event :: Event
event = Qualified ConvId
-> Maybe SubConvId
-> Qualified UserId
-> UTCTime
-> EventData
-> Event
Event (Local ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local ConvId
lcnv) Maybe SubConvId
forall a. Maybe a
Nothing (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) UTCTime
now EventData
EdConvCodeDelete
  Maybe ConnId -> Event -> Local [UserId] -> [BotMember] -> Sem r ()
forall (r :: EffectRow) (f :: * -> *).
(Member ExternalAccess r, Member NotificationSubsystem r,
 Foldable f) =>
Maybe ConnId
-> Event -> Local (f UserId) -> f BotMember -> Sem r ()
pushConversationEvent (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon) Event
event (Local UserId -> [UserId] -> Local [UserId]
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr ((LocalMember -> UserId) -> [LocalMember] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
map LocalMember -> UserId
lmId [LocalMember]
users)) [BotMember]
bots
  Event -> Sem r Event
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Event
event

getCode ::
  forall r.
  ( Member CodeStore r,
    Member ConversationStore r,
    Member (ErrorS 'CodeNotFound) r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'GuestLinksDisabled) r,
    Member (Input Opts) r,
    Member TeamFeatureStore r
  ) =>
  Maybe ZHostValue ->
  Local UserId ->
  ConvId ->
  Sem r ConversationCodeInfo
getCode :: forall (r :: EffectRow).
(Member CodeStore r, Member ConversationStore r,
 Member (ErrorS 'CodeNotFound) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'GuestLinksDisabled) r, Member (Input Opts) r,
 Member TeamFeatureStore r) =>
Maybe Text -> Local UserId -> ConvId -> Sem r ConversationCodeInfo
getCode Maybe Text
mbZHost Local UserId
lusr ConvId
cnv = do
  Conversation
conv <-
    ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
E.getConversation ConvId
cnv 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
  Maybe TeamId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'GuestLinksDisabled) r, Member TeamFeatureStore r,
 Member (Input Opts) r) =>
Maybe TeamId -> Sem r ()
Query.ensureGuestLinksEnabled (Conversation -> Maybe TeamId
Data.convTeam Conversation
conv)
  Conversation -> Access -> Sem r ()
forall (r :: EffectRow).
Member (ErrorS 'ConvAccessDenied) r =>
Conversation -> Access -> Sem r ()
ensureAccess Conversation
conv Access
CodeAccess
  [LocalMember] -> UserId -> Sem r ()
forall (r :: EffectRow).
Member (ErrorS 'ConvNotFound) r =>
[LocalMember] -> UserId -> Sem r ()
ensureConvMember (Conversation -> [LocalMember]
Data.convLocalMembers Conversation
conv) (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr)
  Key
key <- ConvId -> Sem r Key
forall (r :: EffectRow). Member CodeStore r => ConvId -> Sem r Key
E.makeKey ConvId
cnv
  (Code
c, Maybe Password
mPw) <- Key -> Scope -> Sem r (Maybe (Code, Maybe Password))
forall (r :: EffectRow).
Member CodeStore r =>
Key -> Scope -> Sem r (Maybe (Code, Maybe Password))
E.getCode Key
key Scope
ReusableCode Sem r (Maybe (Code, Maybe Password))
-> (Maybe (Code, Maybe Password) -> Sem r (Code, Maybe Password))
-> Sem r (Code, Maybe Password)
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 @'CodeNotFound
  HttpsUrl
convUri <- Maybe Text -> Sem r HttpsUrl
forall (r :: EffectRow).
(Member (ErrorS 'ConvAccessDenied) r, Member CodeStore r) =>
Maybe Text -> Sem r HttpsUrl
getConversationCodeURI Maybe Text
mbZHost
  ConversationCodeInfo -> Sem r ConversationCodeInfo
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConversationCodeInfo -> Sem r ConversationCodeInfo)
-> ConversationCodeInfo -> Sem r ConversationCodeInfo
forall a b. (a -> b) -> a -> b
$ Bool -> Key -> Value -> HttpsUrl -> ConversationCodeInfo
mkConversationCodeInfo (Maybe Password -> Bool
forall a. Maybe a -> Bool
isJust Maybe Password
mPw) (Code -> Key
codeKey Code
c) (Code -> Value
codeValue Code
c) HttpsUrl
convUri

checkReusableCode ::
  forall r.
  ( Member CodeStore r,
    Member ConversationStore r,
    Member TeamFeatureStore r,
    Member (ErrorS 'CodeNotFound) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidConversationPassword) r,
    Member (Input Opts) r
  ) =>
  ConversationCode ->
  Sem r ()
checkReusableCode :: forall (r :: EffectRow).
(Member CodeStore r, Member ConversationStore r,
 Member TeamFeatureStore r, Member (ErrorS 'CodeNotFound) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidConversationPassword) r,
 Member (Input Opts) r) =>
ConversationCode -> Sem r ()
checkReusableCode ConversationCode
convCode = do
  Code
code <- Bool
-> Maybe (PlainTextPassword' 8) -> ConversationCode -> Sem r Code
forall (r :: EffectRow).
(Member CodeStore r, Member (ErrorS 'CodeNotFound) r,
 Member (ErrorS 'InvalidConversationPassword) r) =>
Bool
-> Maybe (PlainTextPassword' 8) -> ConversationCode -> Sem r Code
verifyReusableCode Bool
False Maybe (PlainTextPassword' 8)
forall a. Maybe a
Nothing ConversationCode
convCode
  Conversation
conv <- ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
E.getConversation (Code -> ConvId
codeConversation Code
code) 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
  forall {k1} {k2} (e :: k1) (e' :: k2) (r :: EffectRow) a.
Member (ErrorS e') r =>
Sem (ErrorS e : r) a -> Sem r a
forall (e :: GalleyError) (e' :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e') r =>
Sem (ErrorS e : r) a -> Sem r a
mapErrorS @'GuestLinksDisabled @'CodeNotFound (Sem (ErrorS 'GuestLinksDisabled : r) () -> Sem r ())
-> Sem (ErrorS 'GuestLinksDisabled : r) () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    Maybe TeamId -> Sem (ErrorS 'GuestLinksDisabled : r) ()
forall (r :: EffectRow).
(Member (ErrorS 'GuestLinksDisabled) r, Member TeamFeatureStore r,
 Member (Input Opts) r) =>
Maybe TeamId -> Sem r ()
Query.ensureGuestLinksEnabled (Conversation -> Maybe TeamId
Data.convTeam Conversation
conv)

updateConversationProtocolWithLocalUser ::
  forall r.
  ( Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'ConvInvalidProtocolTransition) r,
    Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
    Member (ErrorS 'InvalidOperation) r,
    Member (Error FederationError) r,
    Member (ErrorS 'MLSMigrationCriteriaNotSatisfied) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS OperationDenied) r,
    Member (ErrorS 'TeamNotFound) r,
    Member (Error InternalError) r,
    Member (Input UTCTime) r,
    Member (Input Env) r,
    Member (Input (Local ())) r,
    Member (Input Opts) r,
    Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member MemberStore r,
    Member TinyLog r,
    Member NotificationSubsystem r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member Random r,
    Member ProposalStore r,
    Member SubConversationStore r,
    Member TeamFeatureStore r
  ) =>
  Local UserId ->
  ConnId ->
  Qualified ConvId ->
  P.ProtocolUpdate ->
  Sem r (UpdateResult Event)
updateConversationProtocolWithLocalUser :: forall (r :: EffectRow).
(Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvInvalidProtocolTransition) r,
 Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (Error FederationError) r,
 Member (ErrorS 'MLSMigrationCriteriaNotSatisfied) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r, Member (ErrorS 'TeamNotFound) r,
 Member (Error InternalError) r, Member (Input UTCTime) r,
 Member (Input Env) r, Member (Input (Local ())) r,
 Member (Input Opts) r, Member BackendNotificationQueueAccess r,
 Member BrigAccess r, Member ConversationStore r,
 Member MemberStore r, Member TinyLog r,
 Member NotificationSubsystem r, Member ExternalAccess r,
 Member FederatorAccess r, Member Random r, Member ProposalStore r,
 Member SubConversationStore r, Member TeamFeatureStore r) =>
Local UserId
-> ConnId
-> Qualified ConvId
-> ProtocolUpdate
-> Sem r (UpdateResult Event)
updateConversationProtocolWithLocalUser Local UserId
lusr ConnId
conn Qualified ConvId
qcnv (P.ProtocolUpdate ProtocolTag
newProtocol) =
  forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError @UnreachableBackends @InternalError (\UnreachableBackends
_ -> LText -> InternalError
InternalErrorWithDescription LText
"Unexpected UnreachableBackends error when updating remote protocol")
    (Sem (Error UnreachableBackends : r) (UpdateResult Event)
 -> Sem r (UpdateResult Event))
-> (Sem
      (Error NonFederatingBackends : Error UnreachableBackends : r)
      (UpdateResult Event)
    -> Sem (Error UnreachableBackends : r) (UpdateResult Event))
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (UpdateResult Event)
-> Sem r (UpdateResult Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError @NonFederatingBackends @InternalError (\NonFederatingBackends
_ -> LText -> InternalError
InternalErrorWithDescription LText
"Unexpected NonFederatingBackends error when updating remote protocol")
    (Sem
   (Error NonFederatingBackends : Error UnreachableBackends : r)
   (UpdateResult Event)
 -> Sem r (UpdateResult Event))
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (UpdateResult Event)
-> Sem r (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$ Local UserId
-> (Local ConvId
    -> Sem
         (Error NonFederatingBackends : Error UnreachableBackends : r)
         (UpdateResult Event))
-> (Remote ConvId
    -> Sem
         (Error NonFederatingBackends : Error UnreachableBackends : r)
         (UpdateResult Event))
-> Qualified ConvId
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (UpdateResult Event)
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
      Local UserId
lusr
      ( \Local ConvId
lcnv -> do
          (Either NoChanges LocalConversationUpdate -> UpdateResult Event)
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (Either NoChanges LocalConversationUpdate)
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (UpdateResult Event)
forall a b.
(a -> b)
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r) a
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UpdateResult Event
-> (LocalConversationUpdate -> UpdateResult Event)
-> Maybe LocalConversationUpdate
-> UpdateResult Event
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UpdateResult Event
forall a. UpdateResult a
Unchanged (Event -> UpdateResult Event
forall a. a -> UpdateResult a
Updated (Event -> UpdateResult Event)
-> (LocalConversationUpdate -> Event)
-> LocalConversationUpdate
-> UpdateResult Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalConversationUpdate -> Event
lcuEvent) (Maybe LocalConversationUpdate -> UpdateResult Event)
-> (Either NoChanges LocalConversationUpdate
    -> Maybe LocalConversationUpdate)
-> Either NoChanges LocalConversationUpdate
-> UpdateResult Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either NoChanges LocalConversationUpdate
-> Maybe LocalConversationUpdate
forall a b. Either a b -> Maybe b
hush)
            (Sem
   (Error NonFederatingBackends : Error UnreachableBackends : r)
   (Either NoChanges LocalConversationUpdate)
 -> Sem
      (Error NonFederatingBackends : Error UnreachableBackends : r)
      (UpdateResult Event))
-> (ProtocolTag
    -> Sem
         (Error NonFederatingBackends : Error UnreachableBackends : r)
         (Either NoChanges LocalConversationUpdate))
-> ProtocolTag
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (UpdateResult Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError @NoChanges
            (Sem
   (Error NoChanges
      : Error NonFederatingBackends : Error UnreachableBackends : r)
   LocalConversationUpdate
 -> Sem
      (Error NonFederatingBackends : Error UnreachableBackends : r)
      (Either NoChanges LocalConversationUpdate))
-> (ProtocolTag
    -> Sem
         (Error NoChanges
            : Error NonFederatingBackends : Error UnreachableBackends : r)
         LocalConversationUpdate)
-> ProtocolTag
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (Either NoChanges LocalConversationUpdate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 HasConversationActionEffects tag r, SingI tag) =>
Local ConvId
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversation @'ConversationUpdateProtocolTag Local ConvId
lcnv (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
conn)
            (ProtocolTag
 -> Sem
      (Error NonFederatingBackends : Error UnreachableBackends : r)
      (UpdateResult Event))
-> ProtocolTag
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$ ProtocolTag
newProtocol
      )
      ( \Remote ConvId
rcnv ->
          forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BrigAccess r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input (Local ())) r, Member MemberStore r,
 Member TinyLog r,
 RethrowErrors (HasConversationActionGalleyErrors tag) r,
 Member (Error NonFederatingBackends) r,
 Member (Error UnreachableBackends) r, SingI tag) =>
Remote ConvId
-> Local UserId
-> ConnId
-> ConversationAction tag
-> Sem r (UpdateResult Event)
updateRemoteConversation @'ConversationUpdateProtocolTag Remote ConvId
rcnv Local UserId
lusr ConnId
conn (ConversationAction 'ConversationUpdateProtocolTag
 -> Sem
      (Error NonFederatingBackends : Error UnreachableBackends : r)
      (UpdateResult Event))
-> ConversationAction 'ConversationUpdateProtocolTag
-> Sem
     (Error NonFederatingBackends : Error UnreachableBackends : r)
     (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$
            ProtocolTag
ConversationAction 'ConversationUpdateProtocolTag
newProtocol
      )
      Qualified ConvId
qcnv

joinConversationByReusableCode ::
  forall r.
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member CodeStore r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (ErrorS 'CodeNotFound) r,
    Member (ErrorS 'InvalidConversationPassword) r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'GuestLinksDisabled) r,
    Member (ErrorS 'InvalidOperation) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS 'TooManyMembers) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member TeamStore r,
    Member TeamFeatureStore r
  ) =>
  Local UserId ->
  ConnId ->
  JoinConversationByCode ->
  Sem r (UpdateResult Event)
joinConversationByReusableCode :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member CodeStore r, Member ConversationStore r,
 Member (Error FederationError) r, Member (ErrorS 'CodeNotFound) r,
 Member (ErrorS 'InvalidConversationPassword) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'GuestLinksDisabled) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS 'TooManyMembers) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member MemberStore r, Member TeamStore r,
 Member TeamFeatureStore r) =>
Local UserId
-> ConnId -> JoinConversationByCode -> Sem r (UpdateResult Event)
joinConversationByReusableCode Local UserId
lusr ConnId
zcon JoinConversationByCode
req = do
  Code
c <- Bool
-> Maybe (PlainTextPassword' 8) -> ConversationCode -> Sem r Code
forall (r :: EffectRow).
(Member CodeStore r, Member (ErrorS 'CodeNotFound) r,
 Member (ErrorS 'InvalidConversationPassword) r) =>
Bool
-> Maybe (PlainTextPassword' 8) -> ConversationCode -> Sem r Code
verifyReusableCode Bool
True JoinConversationByCode
req.password JoinConversationByCode
req.code
  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
  Maybe TeamId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'GuestLinksDisabled) r, Member TeamFeatureStore r,
 Member (Input Opts) r) =>
Maybe TeamId -> Sem r ()
Query.ensureGuestLinksEnabled (Conversation -> Maybe TeamId
Data.convTeam Conversation
conv)
  Local UserId
-> ConnId -> Conversation -> Access -> Sem r (UpdateResult Event)
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member (Error FederationError) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS 'TooManyMembers) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member MemberStore r,
 Member TeamStore r) =>
Local UserId
-> ConnId -> Conversation -> Access -> Sem r (UpdateResult Event)
joinConversation Local UserId
lusr ConnId
zcon Conversation
conv Access
CodeAccess

joinConversationById ::
  forall r.
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS 'TooManyMembers) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member TeamStore r
  ) =>
  Local UserId ->
  ConnId ->
  ConvId ->
  Sem r (UpdateResult Event)
joinConversationById :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS 'TooManyMembers) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member MemberStore r,
 Member TeamStore r) =>
Local UserId -> ConnId -> ConvId -> Sem r (UpdateResult Event)
joinConversationById Local UserId
lusr ConnId
zcon ConvId
cnv = do
  Conversation
conv <- ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
E.getConversation ConvId
cnv 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
  Local UserId
-> ConnId -> Conversation -> Access -> Sem r (UpdateResult Event)
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member (Error FederationError) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS 'TooManyMembers) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member MemberStore r,
 Member TeamStore r) =>
Local UserId
-> ConnId -> Conversation -> Access -> Sem r (UpdateResult Event)
joinConversation Local UserId
lusr ConnId
zcon Conversation
conv Access
LinkAccess

joinConversation ::
  forall r.
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member (Error FederationError) r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (ErrorS 'InvalidOperation) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS 'TooManyMembers) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member TeamStore r
  ) =>
  Local UserId ->
  ConnId ->
  Data.Conversation ->
  Access ->
  Sem r (UpdateResult Event)
joinConversation :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member (Error FederationError) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS 'TooManyMembers) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member MemberStore r,
 Member TeamStore r) =>
Local UserId
-> ConnId -> Conversation -> Access -> Sem r (UpdateResult Event)
joinConversation Local UserId
lusr ConnId
zcon Conversation
conv Access
access = do
  let lcnv :: Local ConvId
lcnv = Local UserId -> ConvId -> Local ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr Conversation
conv.convId
  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
access
  Conversation -> Sem r ()
forall (r :: EffectRow).
Member (ErrorS 'InvalidOperation) r =>
Conversation -> Sem r ()
ensureGroupConversation Conversation
conv
  -- FUTUREWORK: remote users?
  ProtocolTag -> [LocalMember] -> [UserId] -> Sem r ()
forall (f :: * -> *) (r :: EffectRow) a.
(Foldable f,
 (Member (ErrorS 'TooManyMembers) r, Member (Input Opts) r)) =>
ProtocolTag -> [LocalMember] -> f a -> Sem r ()
ensureMemberLimit (Conversation -> ProtocolTag
Data.convProtocolTag Conversation
conv) ([LocalMember] -> [LocalMember]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([LocalMember] -> [LocalMember]) -> [LocalMember] -> [LocalMember]
forall a b. (a -> b) -> a -> b
$ Conversation -> [LocalMember]
Data.convLocalMembers Conversation
conv) [Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr]
  Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event)
forall (r :: EffectRow) a.
Sem (Error NoChanges : r) a -> Sem r (UpdateResult a)
getUpdateResult (Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event))
-> Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$ do
    -- NOTE: When joining conversations, all users become members
    -- as this is our desired behavior for these types of conversations
    -- where there is no way to control who joins, etc.
    let users :: [UserId]
users = (UserId -> Bool) -> [UserId] -> [UserId]
forall a. (a -> Bool) -> [a] -> [a]
filter (Local UserId -> Conversation -> UserId -> Bool
forall x. Local x -> Conversation -> UserId -> Bool
forall uid mem x.
IsConvMemberId uid mem =>
Local x -> Conversation -> uid -> Bool
notIsConvMember Local UserId
lusr Conversation
conv) [Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr]
    (BotsAndMembers
extraTargets, ConversationJoin
action) <-
      Local ConvId
-> UserList UserId
-> RoleName
-> Sem (Error NoChanges : r) (BotsAndMembers, ConversationJoin)
forall (r :: EffectRow).
(Member MemberStore r, Member (Error NoChanges) r) =>
Local ConvId
-> UserList UserId
-> RoleName
-> Sem r (BotsAndMembers, ConversationJoin)
addMembersToLocalConversation Local ConvId
lcnv ([UserId] -> [Remote UserId] -> UserList UserId
forall a. [a] -> [Remote a] -> UserList a
UserList [UserId]
users []) RoleName
roleNameWireMember
    LocalConversationUpdate -> Event
lcuEvent
      (LocalConversationUpdate -> Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem (Error NoChanges : r) Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing 'ConversationJoinTag
-> Qualified UserId
-> Bool
-> Maybe ConnId
-> Local Conversation
-> BotsAndMembers
-> ConversationAction 'ConversationJoinTag
-> Sem (Error NoChanges : r) LocalConversationUpdate
forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member ExternalAccess r,
 Member (Error FederationError) r, Member NotificationSubsystem r,
 Member (Input UTCTime) r) =>
Sing tag
-> Qualified UserId
-> Bool
-> Maybe ConnId
-> Local Conversation
-> BotsAndMembers
-> ConversationAction tag
-> Sem r LocalConversationUpdate
notifyConversationAction
        (forall {k} (a :: k). SingI a => Sing a
forall (a :: ConversationActionTag). SingI a => Sing a
sing @'ConversationJoinTag)
        (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr)
        Bool
False
        (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon)
        (Local UserId -> Conversation -> Local Conversation
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr Conversation
conv)
        (Conversation -> BotsAndMembers
convBotsAndMembers Conversation
conv BotsAndMembers -> BotsAndMembers -> BotsAndMembers
forall a. Semigroup a => a -> a -> a
<> BotsAndMembers
extraTargets)
        ConversationJoin
ConversationAction 'ConversationJoinTag
action

addMembers ::
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'AddConversationMember)) r,
    Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member (ErrorS 'NotConnected) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS 'TooManyMembers) r,
    Member (ErrorS 'MissingLegalholdConsent) r,
    Member (Error FederationError) r,
    Member (Error NonFederatingBackends) r,
    Member (Error UnreachableBackends) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member (Input Env) r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member LegalHoldStore r,
    Member MemberStore r,
    Member ProposalStore r,
    Member Random r,
    Member SubConversationStore r,
    Member TeamStore r,
    Member TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  Qualified ConvId ->
  InviteQualified ->
  Sem r (UpdateResult Event)
addMembers :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'AddConversationMember)) r,
 Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'NotConnected) r, Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS 'TooManyMembers) r,
 Member (ErrorS 'MissingLegalholdConsent) r,
 Member (Error FederationError) r,
 Member (Error NonFederatingBackends) r,
 Member (Error UnreachableBackends) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input Env) r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member MemberStore r, Member ProposalStore r, Member Random r,
 Member SubConversationStore r, Member TeamStore r,
 Member TinyLog r) =>
Local UserId
-> ConnId
-> Qualified ConvId
-> InviteQualified
-> Sem r (UpdateResult Event)
addMembers Local UserId
lusr ConnId
zcon Qualified ConvId
qcnv (InviteQualified NonEmpty (Qualified UserId)
users RoleName
role) = do
  Local ConvId
lcnv <- Local UserId -> Qualified ConvId -> Sem r (Local ConvId)
forall (r :: EffectRow) x a.
Member (Error FederationError) r =>
Local x -> Qualified a -> Sem r (Local a)
ensureLocal Local UserId
lusr Qualified ConvId
qcnv
  Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event)
forall (r :: EffectRow) a.
Sem (Error NoChanges : r) a -> Sem r (UpdateResult a)
getUpdateResult (Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event))
-> (Sem (Error NoChanges : r) LocalConversationUpdate
    -> Sem (Error NoChanges : r) Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (UpdateResult Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalConversationUpdate -> Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem (Error NoChanges : r) Event
forall a b.
(a -> b)
-> Sem (Error NoChanges : r) a -> Sem (Error NoChanges : r) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalConversationUpdate -> Event
lcuEvent (Sem (Error NoChanges : r) LocalConversationUpdate
 -> Sem r (UpdateResult Event))
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$
    forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 HasConversationActionEffects tag r, SingI tag) =>
Local ConvId
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversation @'ConversationJoinTag Local ConvId
lcnv (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon) (ConversationAction 'ConversationJoinTag
 -> Sem (Error NoChanges : r) LocalConversationUpdate)
-> ConversationAction 'ConversationJoinTag
-> Sem (Error NoChanges : r) LocalConversationUpdate
forall a b. (a -> b) -> a -> b
$
      NonEmpty (Qualified UserId) -> RoleName -> ConversationJoin
ConversationJoin NonEmpty (Qualified UserId)
users RoleName
role

addMembersUnqualifiedV2 ::
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'AddConversationMember)) r,
    Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member (ErrorS 'NotConnected) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS 'TooManyMembers) r,
    Member (ErrorS 'MissingLegalholdConsent) r,
    Member (Error NonFederatingBackends) r,
    Member (Error UnreachableBackends) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member (Input Env) r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member LegalHoldStore r,
    Member MemberStore r,
    Member ProposalStore r,
    Member Random r,
    Member SubConversationStore r,
    Member TeamStore r,
    Member TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  ConvId ->
  InviteQualified ->
  Sem r (UpdateResult Event)
addMembersUnqualifiedV2 :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'AddConversationMember)) r,
 Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'NotConnected) r, Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS 'TooManyMembers) r,
 Member (ErrorS 'MissingLegalholdConsent) r,
 Member (Error NonFederatingBackends) r,
 Member (Error UnreachableBackends) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input Env) r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member MemberStore r, Member ProposalStore r, Member Random r,
 Member SubConversationStore r, Member TeamStore r,
 Member TinyLog r) =>
Local UserId
-> ConnId
-> ConvId
-> InviteQualified
-> Sem r (UpdateResult Event)
addMembersUnqualifiedV2 Local UserId
lusr ConnId
zcon ConvId
cnv (InviteQualified NonEmpty (Qualified UserId)
users RoleName
role) = do
  let lcnv :: Local ConvId
lcnv = Local UserId -> ConvId -> Local ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr ConvId
cnv
  Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event)
forall (r :: EffectRow) a.
Sem (Error NoChanges : r) a -> Sem r (UpdateResult a)
getUpdateResult (Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event))
-> (Sem (Error NoChanges : r) LocalConversationUpdate
    -> Sem (Error NoChanges : r) Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (UpdateResult Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalConversationUpdate -> Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem (Error NoChanges : r) Event
forall a b.
(a -> b)
-> Sem (Error NoChanges : r) a -> Sem (Error NoChanges : r) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalConversationUpdate -> Event
lcuEvent (Sem (Error NoChanges : r) LocalConversationUpdate
 -> Sem r (UpdateResult Event))
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$
    forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 HasConversationActionEffects tag r, SingI tag) =>
Local ConvId
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversation @'ConversationJoinTag Local ConvId
lcnv (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon) (ConversationAction 'ConversationJoinTag
 -> Sem (Error NoChanges : r) LocalConversationUpdate)
-> ConversationAction 'ConversationJoinTag
-> Sem (Error NoChanges : r) LocalConversationUpdate
forall a b. (a -> b) -> a -> b
$
      NonEmpty (Qualified UserId) -> RoleName -> ConversationJoin
ConversationJoin NonEmpty (Qualified UserId)
users RoleName
role

addMembersUnqualified ::
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'AddConversationMember)) r,
    Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
    Member (ErrorS 'ConvAccessDenied) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member (ErrorS 'NotConnected) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS 'TooManyMembers) r,
    Member (ErrorS 'MissingLegalholdConsent) r,
    Member (Error NonFederatingBackends) r,
    Member (Error UnreachableBackends) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member (Input Env) r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member LegalHoldStore r,
    Member MemberStore r,
    Member ProposalStore r,
    Member Random r,
    Member SubConversationStore r,
    Member TeamStore r,
    Member TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  ConvId ->
  Invite ->
  Sem r (UpdateResult Event)
addMembersUnqualified :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'AddConversationMember)) r,
 Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'NotConnected) r, Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS 'TooManyMembers) r,
 Member (ErrorS 'MissingLegalholdConsent) r,
 Member (Error NonFederatingBackends) r,
 Member (Error UnreachableBackends) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input Env) r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member MemberStore r, Member ProposalStore r, Member Random r,
 Member SubConversationStore r, Member TeamStore r,
 Member TinyLog r) =>
Local UserId
-> ConnId -> ConvId -> Invite -> Sem r (UpdateResult Event)
addMembersUnqualified Local UserId
lusr ConnId
zcon ConvId
cnv (Invite List1 UserId
users RoleName
role) = do
  let qusers :: NonEmpty (Qualified UserId)
qusers = (UserId -> Qualified UserId)
-> NonEmpty UserId -> NonEmpty (Qualified UserId)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (Local UserId -> Qualified UserId)
-> (UserId -> Local UserId) -> UserId -> Qualified UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local UserId -> UserId -> Local UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr) (List1 UserId -> NonEmpty UserId
forall a. List1 a -> NonEmpty a
toNonEmpty List1 UserId
users)
  Local UserId
-> ConnId
-> Qualified ConvId
-> InviteQualified
-> Sem r (UpdateResult Event)
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'AddConversationMember)) r,
 Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
 Member (ErrorS 'ConvAccessDenied) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'NotConnected) r, Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS 'TooManyMembers) r,
 Member (ErrorS 'MissingLegalholdConsent) r,
 Member (Error FederationError) r,
 Member (Error NonFederatingBackends) r,
 Member (Error UnreachableBackends) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input Env) r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member MemberStore r, Member ProposalStore r, Member Random r,
 Member SubConversationStore r, Member TeamStore r,
 Member TinyLog r) =>
Local UserId
-> ConnId
-> Qualified ConvId
-> InviteQualified
-> Sem r (UpdateResult Event)
addMembers Local UserId
lusr ConnId
zcon (Local ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (Local UserId -> ConvId -> Local ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr ConvId
cnv)) (NonEmpty (Qualified UserId) -> RoleName -> InviteQualified
InviteQualified NonEmpty (Qualified UserId)
qusers RoleName
role)

updateSelfMember ::
  ( Member ConversationStore r,
    Member (ErrorS 'ConvNotFound) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member MemberStore r
  ) =>
  Local UserId ->
  ConnId ->
  Qualified ConvId ->
  MemberUpdate ->
  Sem r ()
updateSelfMember :: forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member ExternalAccess r, Member NotificationSubsystem r,
 Member (Input UTCTime) r, Member MemberStore r) =>
Local UserId
-> ConnId -> Qualified ConvId -> MemberUpdate -> Sem r ()
updateSelfMember Local UserId
lusr ConnId
zcon Qualified ConvId
qcnv MemberUpdate
update = do
  Bool
exists <- 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
lusr Local ConvId -> Sem r Bool
forall (r :: EffectRow).
Member MemberStore r =>
Local ConvId -> Sem r Bool
checkLocalMembership Remote ConvId -> Sem r Bool
forall (r :: EffectRow).
Member ConversationStore r =>
Remote ConvId -> Sem r Bool
checkRemoteMembership Qualified ConvId
qcnv
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (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 @'ConvNotFound
  Qualified ConvId -> Local UserId -> MemberUpdate -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
Qualified ConvId -> Local UserId -> MemberUpdate -> Sem r ()
E.setSelfMember Qualified ConvId
qcnv Local UserId
lusr MemberUpdate
update
  UTCTime
now <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  let e :: Event
e = Qualified ConvId
-> Maybe SubConvId
-> Qualified UserId
-> UTCTime
-> EventData
-> Event
Event Qualified ConvId
qcnv Maybe SubConvId
forall a. Maybe a
Nothing (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) UTCTime
now (MemberUpdateData -> EventData
EdMemberUpdate (Local UserId -> MemberUpdateData
updateData Local UserId
lusr))
  Maybe ConnId -> Event -> Local [UserId] -> [BotMember] -> Sem r ()
forall (r :: EffectRow) (f :: * -> *).
(Member ExternalAccess r, Member NotificationSubsystem r,
 Foldable f) =>
Maybe ConnId
-> Event -> Local (f UserId) -> f BotMember -> Sem r ()
pushConversationEvent (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon) Event
e ((UserId -> [UserId]) -> Local UserId -> Local [UserId]
forall a b.
(a -> b)
-> QualifiedWithTag 'QLocal a -> QualifiedWithTag 'QLocal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UserId -> [UserId]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Local UserId
lusr) []
  where
    checkLocalMembership ::
      (Member MemberStore r) =>
      Local ConvId ->
      Sem r Bool
    checkLocalMembership :: forall (r :: EffectRow).
Member MemberStore r =>
Local ConvId -> Sem r Bool
checkLocalMembership Local ConvId
lcnv =
      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
lusr)
        ([LocalMember] -> Bool) -> Sem r [LocalMember] -> Sem r Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConvId -> Sem r [LocalMember]
forall (r :: EffectRow).
Member MemberStore r =>
ConvId -> Sem r [LocalMember]
E.getLocalMembers (Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvId
lcnv)
    checkRemoteMembership ::
      (Member ConversationStore r) =>
      Remote ConvId ->
      Sem r Bool
    checkRemoteMembership :: forall (r :: EffectRow).
Member ConversationStore r =>
Remote ConvId -> Sem r Bool
checkRemoteMembership Remote ConvId
rcnv =
      Maybe MemberStatus -> Bool
forall a. Maybe a -> Bool
isJust (Maybe MemberStatus -> Bool)
-> (Map (Remote ConvId) MemberStatus -> Maybe MemberStatus)
-> Map (Remote ConvId) MemberStatus
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Remote ConvId
-> Map (Remote ConvId) MemberStatus -> Maybe MemberStatus
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Remote ConvId
rcnv
        (Map (Remote ConvId) MemberStatus -> Bool)
-> Sem r (Map (Remote ConvId) MemberStatus) -> Sem r Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
rcnv]
    updateData :: Local UserId -> MemberUpdateData
updateData Local UserId
luid =
      MemberUpdateData
        { $sel:misTarget:MemberUpdateData :: Qualified UserId
misTarget = Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
luid,
          $sel:misOtrMutedStatus:MemberUpdateData :: Maybe MutedStatus
misOtrMutedStatus = MemberUpdate -> Maybe MutedStatus
mupOtrMuteStatus MemberUpdate
update,
          $sel:misOtrMutedRef:MemberUpdateData :: Maybe Text
misOtrMutedRef = MemberUpdate -> Maybe Text
mupOtrMuteRef MemberUpdate
update,
          $sel:misOtrArchived:MemberUpdateData :: Maybe Bool
misOtrArchived = MemberUpdate -> Maybe Bool
mupOtrArchive MemberUpdate
update,
          $sel:misOtrArchivedRef:MemberUpdateData :: Maybe Text
misOtrArchivedRef = MemberUpdate -> Maybe Text
mupOtrArchiveRef MemberUpdate
update,
          $sel:misHidden:MemberUpdateData :: Maybe Bool
misHidden = MemberUpdate -> Maybe Bool
mupHidden MemberUpdate
update,
          $sel:misHiddenRef:MemberUpdateData :: Maybe Text
misHiddenRef = MemberUpdate -> Maybe Text
mupHiddenRef MemberUpdate
update,
          $sel:misConvRoleName:MemberUpdateData :: Maybe RoleName
misConvRoleName = Maybe RoleName
forall a. Maybe a
Nothing
        }

updateUnqualifiedSelfMember ::
  ( Member ConversationStore r,
    Member (ErrorS 'ConvNotFound) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member MemberStore r
  ) =>
  Local UserId ->
  ConnId ->
  ConvId ->
  MemberUpdate ->
  Sem r ()
updateUnqualifiedSelfMember :: forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member ExternalAccess r, Member NotificationSubsystem r,
 Member (Input UTCTime) r, Member MemberStore r) =>
Local UserId -> ConnId -> ConvId -> MemberUpdate -> Sem r ()
updateUnqualifiedSelfMember Local UserId
lusr ConnId
zcon ConvId
cnv MemberUpdate
update = do
  let lcnv :: Local ConvId
lcnv = 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
-> ConnId -> Qualified ConvId -> MemberUpdate -> Sem r ()
forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member ExternalAccess r, Member NotificationSubsystem r,
 Member (Input UTCTime) r, Member MemberStore r) =>
Local UserId
-> ConnId -> Qualified ConvId -> MemberUpdate -> Sem r ()
updateSelfMember Local UserId
lusr ConnId
zcon (Local ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local ConvId
lcnv) MemberUpdate
update

updateOtherMemberLocalConv ::
  ( Member BackendNotificationQueueAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (ErrorS ('ActionDenied 'ModifyOtherConversationMember)) r,
    Member (ErrorS 'InvalidTarget) r,
    Member (ErrorS 'InvalidOperation) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'ConvMemberNotFound) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member MemberStore r
  ) =>
  Local ConvId ->
  Local UserId ->
  ConnId ->
  Qualified UserId ->
  OtherMemberUpdate ->
  Sem r ()
updateOtherMemberLocalConv :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (ErrorS ('ActionDenied 'ModifyOtherConversationMember)) r,
 Member (ErrorS 'InvalidTarget) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvMemberNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member MemberStore r) =>
Local ConvId
-> Local UserId
-> ConnId
-> Qualified UserId
-> OtherMemberUpdate
-> Sem r ()
updateOtherMemberLocalConv Local ConvId
lcnv Local UserId
lusr ConnId
con Qualified UserId
qvictim OtherMemberUpdate
update = Sem r (UpdateResult Event) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (UpdateResult Event) -> Sem r ())
-> (Sem (Error NoChanges : r) LocalConversationUpdate
    -> Sem r (UpdateResult Event))
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event)
forall (r :: EffectRow) a.
Sem (Error NoChanges : r) a -> Sem r (UpdateResult a)
getUpdateResult (Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event))
-> (Sem (Error NoChanges : r) LocalConversationUpdate
    -> Sem (Error NoChanges : r) Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (UpdateResult Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalConversationUpdate -> Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem (Error NoChanges : r) Event
forall a b.
(a -> b)
-> Sem (Error NoChanges : r) a -> Sem (Error NoChanges : r) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalConversationUpdate -> Event
lcuEvent (Sem (Error NoChanges : r) LocalConversationUpdate -> Sem r ())
-> Sem (Error NoChanges : r) LocalConversationUpdate -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
  Bool
-> Sem (Error NoChanges : r) () -> Sem (Error NoChanges : r) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr Qualified UserId -> Qualified UserId -> Bool
forall a. Eq a => a -> a -> Bool
== Qualified UserId
qvictim) (Sem (Error NoChanges : r) () -> Sem (Error NoChanges : r) ())
-> Sem (Error NoChanges : r) () -> Sem (Error NoChanges : 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 @'InvalidTarget
  forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 HasConversationActionEffects tag r, SingI tag) =>
Local ConvId
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversation @'ConversationMemberUpdateTag Local ConvId
lcnv (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
con) (ConversationAction 'ConversationMemberUpdateTag
 -> Sem (Error NoChanges : r) LocalConversationUpdate)
-> ConversationAction 'ConversationMemberUpdateTag
-> Sem (Error NoChanges : r) LocalConversationUpdate
forall a b. (a -> b) -> a -> b
$
    Qualified UserId -> OtherMemberUpdate -> ConversationMemberUpdate
ConversationMemberUpdate Qualified UserId
qvictim OtherMemberUpdate
update

updateOtherMemberUnqualified ::
  ( Member BackendNotificationQueueAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (ErrorS ('ActionDenied 'ModifyOtherConversationMember)) r,
    Member (ErrorS 'InvalidTarget) r,
    Member (ErrorS 'InvalidOperation) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'ConvMemberNotFound) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member MemberStore r
  ) =>
  Local UserId ->
  ConnId ->
  ConvId ->
  UserId ->
  OtherMemberUpdate ->
  Sem r ()
updateOtherMemberUnqualified :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (ErrorS ('ActionDenied 'ModifyOtherConversationMember)) r,
 Member (ErrorS 'InvalidTarget) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvMemberNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member MemberStore r) =>
Local UserId
-> ConnId -> ConvId -> UserId -> OtherMemberUpdate -> Sem r ()
updateOtherMemberUnqualified Local UserId
lusr ConnId
zcon ConvId
cnv UserId
victim OtherMemberUpdate
update = do
  let lcnv :: Local ConvId
lcnv = Local UserId -> ConvId -> Local ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr ConvId
cnv
  let lvictim :: Local UserId
lvictim = Local UserId -> UserId -> Local UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr UserId
victim
  Local ConvId
-> Local UserId
-> ConnId
-> Qualified UserId
-> OtherMemberUpdate
-> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (ErrorS ('ActionDenied 'ModifyOtherConversationMember)) r,
 Member (ErrorS 'InvalidTarget) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvMemberNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member MemberStore r) =>
Local ConvId
-> Local UserId
-> ConnId
-> Qualified UserId
-> OtherMemberUpdate
-> Sem r ()
updateOtherMemberLocalConv Local ConvId
lcnv Local UserId
lusr ConnId
zcon (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lvictim) OtherMemberUpdate
update

updateOtherMember ::
  ( Member BackendNotificationQueueAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (ErrorS ('ActionDenied 'ModifyOtherConversationMember)) r,
    Member (ErrorS 'InvalidTarget) r,
    Member (ErrorS 'InvalidOperation) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'ConvMemberNotFound) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member MemberStore r
  ) =>
  Local UserId ->
  ConnId ->
  Qualified ConvId ->
  Qualified UserId ->
  OtherMemberUpdate ->
  Sem r ()
updateOtherMember :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (ErrorS ('ActionDenied 'ModifyOtherConversationMember)) r,
 Member (ErrorS 'InvalidTarget) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvMemberNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member MemberStore r) =>
Local UserId
-> ConnId
-> Qualified ConvId
-> Qualified UserId
-> OtherMemberUpdate
-> Sem r ()
updateOtherMember Local UserId
lusr ConnId
zcon Qualified ConvId
qcnv Qualified UserId
qvictim OtherMemberUpdate
update = do
  let doUpdate :: Qualified ConvId
-> Local UserId
-> ConnId
-> Qualified UserId
-> OtherMemberUpdate
-> Sem r ()
doUpdate = Local UserId
-> (Local ConvId
    -> Local UserId
    -> ConnId
    -> Qualified UserId
    -> OtherMemberUpdate
    -> Sem r ())
-> (Remote ConvId
    -> Local UserId
    -> ConnId
    -> Qualified UserId
    -> OtherMemberUpdate
    -> Sem r ())
-> Qualified ConvId
-> Local UserId
-> ConnId
-> Qualified UserId
-> OtherMemberUpdate
-> Sem r ()
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified Local UserId
lusr Local ConvId
-> Local UserId
-> ConnId
-> Qualified UserId
-> OtherMemberUpdate
-> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (ErrorS ('ActionDenied 'ModifyOtherConversationMember)) r,
 Member (ErrorS 'InvalidTarget) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'ConvMemberNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member MemberStore r) =>
Local ConvId
-> Local UserId
-> ConnId
-> Qualified UserId
-> OtherMemberUpdate
-> Sem r ()
updateOtherMemberLocalConv Remote ConvId
-> Local UserId
-> ConnId
-> Qualified UserId
-> OtherMemberUpdate
-> Sem r ()
forall (r :: EffectRow).
Member (Error FederationError) r =>
Remote ConvId
-> Local UserId
-> ConnId
-> Qualified UserId
-> OtherMemberUpdate
-> Sem r ()
updateOtherMemberRemoteConv
  Qualified ConvId
-> Local UserId
-> ConnId
-> Qualified UserId
-> OtherMemberUpdate
-> Sem r ()
doUpdate Qualified ConvId
qcnv Local UserId
lusr ConnId
zcon Qualified UserId
qvictim OtherMemberUpdate
update

updateOtherMemberRemoteConv ::
  (Member (Error FederationError) r) =>
  Remote ConvId ->
  Local UserId ->
  ConnId ->
  Qualified UserId ->
  OtherMemberUpdate ->
  Sem r ()
updateOtherMemberRemoteConv :: forall (r :: EffectRow).
Member (Error FederationError) r =>
Remote ConvId
-> Local UserId
-> ConnId
-> Qualified UserId
-> OtherMemberUpdate
-> Sem r ()
updateOtherMemberRemoteConv Remote ConvId
_ Local UserId
_ ConnId
_ Qualified UserId
_ OtherMemberUpdate
_ = FederationError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw FederationError
FederationNotImplemented

removeMemberUnqualified ::
  ( Member BackendNotificationQueueAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member (Input Env) r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member ProposalStore r,
    Member Random r,
    Member SubConversationStore r,
    Member TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  ConvId ->
  UserId ->
  Sem r (Maybe Event)
removeMemberUnqualified :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member
   (Error (Tagged ('ActionDenied 'RemoveConversationMember) ())) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input Env) r, Member (Input UTCTime) r,
 Member MemberStore r, Member ProposalStore r, Member Random r,
 Member SubConversationStore r, Member TinyLog r) =>
Local UserId -> ConnId -> ConvId -> UserId -> Sem r (Maybe Event)
removeMemberUnqualified Local UserId
lusr ConnId
con ConvId
cnv UserId
victim = do
  let lvictim :: Local UserId
lvictim = Local UserId -> UserId -> Local UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr UserId
victim
      lcnv :: Local ConvId
lcnv = 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
-> ConnId
-> Qualified ConvId
-> Qualified UserId
-> Sem r (Maybe Event)
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member
   (Error (Tagged ('ActionDenied 'RemoveConversationMember) ())) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input Env) r, Member (Input UTCTime) r,
 Member MemberStore r, Member ProposalStore r, Member Random r,
 Member SubConversationStore r, Member TinyLog r) =>
Local UserId
-> ConnId
-> Qualified ConvId
-> Qualified UserId
-> Sem r (Maybe Event)
removeMemberQualified Local UserId
lusr ConnId
con (Local ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local ConvId
lcnv) (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lvictim)

removeMemberQualified ::
  ( Member BackendNotificationQueueAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member (Input Env) r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member ProposalStore r,
    Member Random r,
    Member SubConversationStore r,
    Member TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  Qualified ConvId ->
  Qualified UserId ->
  Sem r (Maybe Event)
removeMemberQualified :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member
   (Error (Tagged ('ActionDenied 'RemoveConversationMember) ())) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input Env) r, Member (Input UTCTime) r,
 Member MemberStore r, Member ProposalStore r, Member Random r,
 Member SubConversationStore r, Member TinyLog r) =>
Local UserId
-> ConnId
-> Qualified ConvId
-> Qualified UserId
-> Sem r (Maybe Event)
removeMemberQualified Local UserId
lusr ConnId
con Qualified ConvId
qcnv Qualified UserId
victim =
  forall {k1} {k2} (e :: k1) (e' :: k2) (r :: EffectRow) a.
Member (ErrorS e') r =>
Sem (ErrorS e : r) a -> Sem r a
forall (e :: GalleyError) (e' :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e') r =>
Sem (ErrorS e : r) a -> Sem r a
mapErrorS @('ActionDenied 'LeaveConversation) @('ActionDenied 'RemoveConversationMember) (Sem (ErrorS ('ActionDenied 'LeaveConversation) : r) (Maybe Event)
 -> Sem r (Maybe Event))
-> Sem
     (ErrorS ('ActionDenied 'LeaveConversation) : r) (Maybe Event)
-> Sem r (Maybe Event)
forall a b. (a -> b) -> a -> b
$
    Local UserId
-> (Local ConvId
    -> Qualified UserId
    -> Sem
         (ErrorS ('ActionDenied 'LeaveConversation) : r) (Maybe Event))
-> (Remote ConvId
    -> Qualified UserId
    -> Sem
         (ErrorS ('ActionDenied 'LeaveConversation) : r) (Maybe Event))
-> Qualified ConvId
-> Qualified UserId
-> Sem
     (ErrorS ('ActionDenied 'LeaveConversation) : r) (Maybe Event)
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
      Local UserId
lusr
      (\Local ConvId
lcnv -> Local ConvId
-> Local UserId
-> Maybe ConnId
-> Qualified UserId
-> Sem
     (ErrorS ('ActionDenied 'LeaveConversation) : r) (Maybe Event)
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
 Member
   (Error (Tagged ('ActionDenied 'RemoveConversationMember) ())) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input Env) r, Member (Input UTCTime) r,
 Member MemberStore r, Member ProposalStore r, Member Random r,
 Member SubConversationStore r, Member TinyLog r) =>
Local ConvId
-> Local UserId
-> Maybe ConnId
-> Qualified UserId
-> Sem r (Maybe Event)
removeMemberFromLocalConv Local ConvId
lcnv Local UserId
lusr (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
con))
      (\Remote ConvId
rcnv -> Remote ConvId
-> Local UserId
-> Qualified UserId
-> Sem
     (ErrorS ('ActionDenied 'LeaveConversation) : r) (Maybe Event)
forall (r :: EffectRow).
(Member FederatorAccess r,
 Member
   (Error (Tagged ('ActionDenied 'RemoveConversationMember) ())) r,
 Member (ErrorS 'ConvNotFound) r, Member (Input UTCTime) r) =>
Remote ConvId
-> Local UserId -> Qualified UserId -> Sem r (Maybe Event)
removeMemberFromRemoteConv Remote ConvId
rcnv Local UserId
lusr)
      Qualified ConvId
qcnv
      Qualified UserId
victim

-- | if the public member leave api was called, we can assume that
--   it was called by a user
pattern EdMembersLeaveRemoved :: QualifiedUserIdList -> EventData
pattern $mEdMembersLeaveRemoved :: forall {r}.
EventData -> (QualifiedUserIdList -> r) -> ((# #) -> r) -> r
$bEdMembersLeaveRemoved :: QualifiedUserIdList -> EventData
EdMembersLeaveRemoved l = EdMembersLeave EdReasonRemoved l

removeMemberFromRemoteConv ::
  ( Member FederatorAccess r,
    Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (Input UTCTime) r
  ) =>
  Remote ConvId ->
  Local UserId ->
  Qualified UserId ->
  Sem r (Maybe Event)
removeMemberFromRemoteConv :: forall (r :: EffectRow).
(Member FederatorAccess r,
 Member
   (Error (Tagged ('ActionDenied 'RemoveConversationMember) ())) r,
 Member (ErrorS 'ConvNotFound) r, Member (Input UTCTime) r) =>
Remote ConvId
-> Local UserId -> Qualified UserId -> Sem r (Maybe Event)
removeMemberFromRemoteConv Remote ConvId
cnv Local UserId
lusr Qualified UserId
victim
  | Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr Qualified UserId -> Qualified UserId -> Bool
forall a. Eq a => a -> a -> Bool
== Qualified UserId
victim = do
      let lc :: LeaveConversationRequest
lc = ConvId -> UserId -> LeaveConversationRequest
LeaveConversationRequest (Remote ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Remote ConvId
cnv) (Qualified UserId -> UserId
forall a. Qualified a -> a
qUnqualified Qualified UserId
victim)
      let rpc :: FederatorClient 'Galley LeaveConversationResponse
rpc = 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 @"leave-conversation" LeaveConversationRequest
lc
      Remote ConvId
-> FederatorClient 'Galley LeaveConversationResponse
-> Sem r LeaveConversationResponse
forall (r :: EffectRow) (c :: Component) x a.
(Member FederatorAccess r, KnownComponent c) =>
Remote x -> FederatorClient c a -> Sem r a
E.runFederated Remote ConvId
cnv FederatorClient 'Galley LeaveConversationResponse
rpc
        Sem r LeaveConversationResponse
-> (LeaveConversationResponse -> Sem r (Maybe Event))
-> Sem r (Maybe Event)
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
>>= (RemoveFromConversationError -> Sem r (Maybe Event))
-> (() -> Sem r (Maybe Event))
-> Either RemoveFromConversationError ()
-> Sem r (Maybe Event)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either RemoveFromConversationError -> Sem r (Maybe Event)
forall (r :: EffectRow).
(Member
   (Error (Tagged ('ActionDenied 'RemoveConversationMember) ())) r,
 Member (ErrorS 'ConvNotFound) r) =>
RemoveFromConversationError -> Sem r (Maybe Event)
handleError () -> Sem r (Maybe Event)
forall (r :: EffectRow).
Member (Input UTCTime) r =>
() -> Sem r (Maybe Event)
handleSuccess (Either RemoveFromConversationError () -> Sem r (Maybe Event))
-> (LeaveConversationResponse
    -> Either RemoveFromConversationError ())
-> LeaveConversationResponse
-> Sem r (Maybe Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RemoveFromConversationError ()
-> Either RemoveFromConversationError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Either RemoveFromConversationError ()
 -> Either RemoveFromConversationError ())
-> (LeaveConversationResponse
    -> Either RemoveFromConversationError ())
-> LeaveConversationResponse
-> Either RemoveFromConversationError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.response)
  | Bool
otherwise = 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 @('ActionDenied 'RemoveConversationMember)
  where
    handleError ::
      ( Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
        Member (ErrorS 'ConvNotFound) r
      ) =>
      RemoveFromConversationError ->
      Sem r (Maybe Event)
    handleError :: forall (r :: EffectRow).
(Member
   (Error (Tagged ('ActionDenied 'RemoveConversationMember) ())) r,
 Member (ErrorS 'ConvNotFound) r) =>
RemoveFromConversationError -> Sem r (Maybe Event)
handleError RemoveFromConversationError
RemoveFromConversationErrorRemovalNotAllowed =
      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 @('ActionDenied 'RemoveConversationMember)
    handleError RemoveFromConversationError
RemoveFromConversationErrorNotFound = 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
    handleError RemoveFromConversationError
RemoveFromConversationErrorUnchanged = Maybe Event -> Sem r (Maybe Event)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Event
forall a. Maybe a
Nothing

    handleSuccess :: (Member (Input UTCTime) r) => () -> Sem r (Maybe Event)
    handleSuccess :: forall (r :: EffectRow).
Member (Input UTCTime) r =>
() -> Sem r (Maybe Event)
handleSuccess ()
_ = do
      UTCTime
t <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
      Maybe Event -> Sem r (Maybe Event)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Event -> Sem r (Maybe Event))
-> (Event -> Maybe Event) -> Event -> Sem r (Maybe Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Maybe Event
forall a. a -> Maybe a
Just (Event -> Sem r (Maybe Event)) -> Event -> Sem r (Maybe Event)
forall a b. (a -> b) -> a -> b
$
        Qualified ConvId
-> Maybe SubConvId
-> Qualified UserId
-> UTCTime
-> EventData
-> Event
Event (Remote ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Remote ConvId
cnv) Maybe SubConvId
forall a. Maybe a
Nothing (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) UTCTime
t (EventData -> Event) -> EventData -> Event
forall a b. (a -> b) -> a -> b
$
          QualifiedUserIdList -> EventData
EdMembersLeaveRemoved ([Qualified UserId] -> QualifiedUserIdList
QualifiedUserIdList [Qualified UserId
victim])

-- | Remove a member from a local conversation.
removeMemberFromLocalConv ::
  ( Member BackendNotificationQueueAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
    Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member (Input Env) r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member ProposalStore r,
    Member Random r,
    Member SubConversationStore r,
    Member TinyLog r
  ) =>
  Local ConvId ->
  Local UserId ->
  Maybe ConnId ->
  Qualified UserId ->
  Sem r (Maybe Event)
removeMemberFromLocalConv :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
 Member
   (Error (Tagged ('ActionDenied 'RemoveConversationMember) ())) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input Env) r, Member (Input UTCTime) r,
 Member MemberStore r, Member ProposalStore r, Member Random r,
 Member SubConversationStore r, Member TinyLog r) =>
Local ConvId
-> Local UserId
-> Maybe ConnId
-> Qualified UserId
-> Sem r (Maybe Event)
removeMemberFromLocalConv Local ConvId
lcnv Local UserId
lusr Maybe ConnId
con Qualified UserId
victim
  | Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr Qualified UserId -> Qualified UserId -> Bool
forall a. Eq a => a -> a -> Bool
== Qualified UserId
victim =
      (Either NoChanges LocalConversationUpdate -> Maybe Event)
-> Sem r (Either NoChanges LocalConversationUpdate)
-> Sem r (Maybe Event)
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LocalConversationUpdate -> Event)
-> Maybe LocalConversationUpdate -> Maybe Event
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalConversationUpdate -> Event
lcuEvent (Maybe LocalConversationUpdate -> Maybe Event)
-> (Either NoChanges LocalConversationUpdate
    -> Maybe LocalConversationUpdate)
-> Either NoChanges LocalConversationUpdate
-> Maybe Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either NoChanges LocalConversationUpdate
-> Maybe LocalConversationUpdate
forall a b. Either a b -> Maybe b
hush)
        (Sem r (Either NoChanges LocalConversationUpdate)
 -> Sem r (Maybe Event))
-> (() -> Sem r (Either NoChanges LocalConversationUpdate))
-> ()
-> Sem r (Maybe Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError @NoChanges
        (Sem (Error NoChanges : r) LocalConversationUpdate
 -> Sem r (Either NoChanges LocalConversationUpdate))
-> (() -> Sem (Error NoChanges : r) LocalConversationUpdate)
-> ()
-> Sem r (Either NoChanges LocalConversationUpdate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 HasConversationActionEffects tag r, SingI tag) =>
Local ConvId
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversation @'ConversationLeaveTag Local ConvId
lcnv (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) Maybe ConnId
con
        (() -> Sem r (Maybe Event)) -> () -> Sem r (Maybe Event)
forall a b. (a -> b) -> a -> b
$ ()
  | Bool
otherwise =
      (Either NoChanges LocalConversationUpdate -> Maybe Event)
-> Sem r (Either NoChanges LocalConversationUpdate)
-> Sem r (Maybe Event)
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LocalConversationUpdate -> Event)
-> Maybe LocalConversationUpdate -> Maybe Event
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalConversationUpdate -> Event
lcuEvent (Maybe LocalConversationUpdate -> Maybe Event)
-> (Either NoChanges LocalConversationUpdate
    -> Maybe LocalConversationUpdate)
-> Either NoChanges LocalConversationUpdate
-> Maybe Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either NoChanges LocalConversationUpdate
-> Maybe LocalConversationUpdate
forall a b. Either a b -> Maybe b
hush)
        (Sem r (Either NoChanges LocalConversationUpdate)
 -> Sem r (Maybe Event))
-> (Sem (Error NoChanges : r) LocalConversationUpdate
    -> Sem r (Either NoChanges LocalConversationUpdate))
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (Maybe Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError @NoChanges
        (Sem (Error NoChanges : r) LocalConversationUpdate
 -> Sem r (Maybe Event))
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (Maybe Event)
forall a b. (a -> b) -> a -> b
$ forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 HasConversationActionEffects tag r, SingI tag) =>
Local ConvId
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversation @'ConversationRemoveMembersTag
          Local ConvId
lcnv
          (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr)
          Maybe ConnId
con
          (NonEmpty (Qualified UserId)
-> EdMemberLeftReason -> ConversationRemoveMembers
ConversationRemoveMembers (Qualified UserId -> NonEmpty (Qualified UserId)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Qualified UserId
victim) EdMemberLeftReason
EdReasonRemoved)

-- OTR

postProteusMessage ::
  ( Member BrigAccess r,
    Member ClientStore r,
    Member ConversationStore r,
    Member FederatorAccess r,
    Member BackendNotificationQueueAccess r,
    Member NotificationSubsystem r,
    Member ExternalAccess r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member TeamStore r,
    Member TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  Qualified ConvId ->
  RawProto QualifiedNewOtrMessage ->
  Sem r (PostOtrResponse MessageSendingStatus)
postProteusMessage :: forall (r :: EffectRow).
(Member BrigAccess r, Member ClientStore r,
 Member ConversationStore r, Member FederatorAccess r,
 Member BackendNotificationQueueAccess r,
 Member NotificationSubsystem r, Member ExternalAccess r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member TeamStore r, Member TinyLog r) =>
Local UserId
-> ConnId
-> Qualified ConvId
-> RawProto QualifiedNewOtrMessage
-> Sem r (PostOtrResponse MessageSendingStatus)
postProteusMessage Local UserId
sender ConnId
zcon Qualified ConvId
conv RawProto QualifiedNewOtrMessage
msg = Local UserId
-> Sem
     (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus)
-> Sem r (PostOtrResponse MessageSendingStatus)
forall x (r :: EffectRow) a.
Local x -> Sem (Input (Local ()) : r) a -> Sem r a
runLocalInput Local UserId
sender (Sem (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus)
 -> Sem r (PostOtrResponse MessageSendingStatus))
-> Sem
     (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus)
-> Sem r (PostOtrResponse MessageSendingStatus)
forall a b. (a -> b) -> a -> b
$ do
  Local UserId
-> (Local ConvId
    -> Sem
         (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus))
-> (Remote ConvId
    -> Sem
         (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus))
-> Qualified ConvId
-> Sem
     (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus)
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
    Local UserId
sender
    (\Local ConvId
c -> UserType
-> Qualified UserId
-> Maybe ConnId
-> Local ConvId
-> QualifiedNewOtrMessage
-> Sem
     (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus)
forall (r :: EffectRow).
(Member BrigAccess r, Member ClientStore r,
 Member ConversationStore r, Member FederatorAccess r,
 Member BackendNotificationQueueAccess r, Member ExternalAccess r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member TeamStore r, Member TinyLog r,
 Member NotificationSubsystem r) =>
UserType
-> Qualified UserId
-> Maybe ConnId
-> Local ConvId
-> QualifiedNewOtrMessage
-> Sem r (PostOtrResponse MessageSendingStatus)
postQualifiedOtrMessage UserType
User (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
sender) (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon) Local ConvId
c (RawProto QualifiedNewOtrMessage -> QualifiedNewOtrMessage
forall a. RawProto a -> a
rpValue RawProto QualifiedNewOtrMessage
msg))
    (\Remote ConvId
c -> Local UserId
-> Remote ConvId
-> ByteString
-> Sem
     (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus)
forall (r :: EffectRow).
Member FederatorAccess r =>
Local UserId
-> Remote ConvId
-> ByteString
-> Sem r (PostOtrResponse MessageSendingStatus)
postRemoteOtrMessage Local UserId
sender Remote ConvId
c (RawProto QualifiedNewOtrMessage -> ByteString
forall a. RawProto a -> ByteString
rpRaw RawProto QualifiedNewOtrMessage
msg))
    Qualified ConvId
conv

postProteusBroadcast ::
  ( Member BrigAccess r,
    Member ClientStore r,
    Member (ErrorS 'TeamNotFound) r,
    Member (ErrorS 'NonBindingTeam) r,
    Member (ErrorS 'BroadcastLimitExceeded) r,
    Member NotificationSubsystem r,
    Member ExternalAccess r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member TeamStore r,
    Member TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  QualifiedNewOtrMessage ->
  Sem r (PostOtrResponse MessageSendingStatus)
postProteusBroadcast :: forall (r :: EffectRow).
(Member BrigAccess r, Member ClientStore r,
 Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NonBindingTeam) r,
 Member (ErrorS 'BroadcastLimitExceeded) r,
 Member NotificationSubsystem r, Member ExternalAccess r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member TeamStore r, Member TinyLog r) =>
Local UserId
-> ConnId
-> QualifiedNewOtrMessage
-> Sem r (PostOtrResponse MessageSendingStatus)
postProteusBroadcast Local UserId
sender ConnId
zcon = Local UserId
-> Maybe ConnId
-> QualifiedNewOtrMessage
-> Sem r (PostOtrResponse MessageSendingStatus)
forall (r :: EffectRow).
(Member BrigAccess r, Member ClientStore r,
 Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NonBindingTeam) r,
 Member (ErrorS 'BroadcastLimitExceeded) r, Member ExternalAccess r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member TeamStore r, Member TinyLog r,
 Member NotificationSubsystem r) =>
Local UserId
-> Maybe ConnId
-> QualifiedNewOtrMessage
-> Sem r (PostOtrResponse MessageSendingStatus)
postBroadcast Local UserId
sender (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon)

unqualifyEndpoint ::
  (Functor f) =>
  Local x ->
  (QualifiedNewOtrMessage -> f (PostOtrResponse MessageSendingStatus)) ->
  Maybe IgnoreMissing ->
  Maybe ReportMissing ->
  NewOtrMessage ->
  f (PostOtrResponse ClientMismatch)
unqualifyEndpoint :: forall (f :: * -> *) x.
Functor f =>
Local x
-> (QualifiedNewOtrMessage
    -> f (PostOtrResponse MessageSendingStatus))
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> NewOtrMessage
-> f (PostOtrResponse ClientMismatch)
unqualifyEndpoint Local x
loc QualifiedNewOtrMessage -> f (PostOtrResponse MessageSendingStatus)
f Maybe IgnoreMissing
ignoreMissing Maybe ReportMissing
reportMissing NewOtrMessage
message = do
  let qualifiedRecipients :: QualifiedOtrRecipients
qualifiedRecipients =
        QualifiedUserClientMap ByteString -> QualifiedOtrRecipients
QualifiedOtrRecipients
          (QualifiedUserClientMap ByteString -> QualifiedOtrRecipients)
-> (NewOtrMessage -> QualifiedUserClientMap ByteString)
-> NewOtrMessage
-> QualifiedOtrRecipients
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Domain (Map UserId (Map ClientId ByteString))
-> QualifiedUserClientMap ByteString
forall a.
Map Domain (Map UserId (Map ClientId a))
-> QualifiedUserClientMap a
QualifiedUserClientMap
          (Map Domain (Map UserId (Map ClientId ByteString))
 -> QualifiedUserClientMap ByteString)
-> (NewOtrMessage
    -> Map Domain (Map UserId (Map ClientId ByteString)))
-> NewOtrMessage
-> QualifiedUserClientMap ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain
-> Map UserId (Map ClientId ByteString)
-> Map Domain (Map UserId (Map ClientId ByteString))
forall k a. k -> a -> Map k a
Map.singleton (Local x -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Local x
loc)
          (Map UserId (Map ClientId ByteString)
 -> Map Domain (Map UserId (Map ClientId ByteString)))
-> (NewOtrMessage -> Map UserId (Map ClientId ByteString))
-> NewOtrMessage
-> Map Domain (Map UserId (Map ClientId ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserClientMap ByteString -> Map UserId (Map ClientId ByteString)
forall a. UserClientMap a -> Map UserId (Map ClientId a)
userClientMap
          (UserClientMap ByteString -> Map UserId (Map ClientId ByteString))
-> (NewOtrMessage -> UserClientMap ByteString)
-> NewOtrMessage
-> Map UserId (Map ClientId ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> ByteString)
-> UserClientMap Text -> UserClientMap ByteString
forall a b. (a -> b) -> UserClientMap a -> UserClientMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
fromBase64TextLenient
          (UserClientMap Text -> UserClientMap ByteString)
-> (NewOtrMessage -> UserClientMap Text)
-> NewOtrMessage
-> UserClientMap ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtrRecipients -> UserClientMap Text
otrRecipientsMap
          (OtrRecipients -> UserClientMap Text)
-> (NewOtrMessage -> OtrRecipients)
-> NewOtrMessage
-> UserClientMap Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewOtrMessage -> OtrRecipients
newOtrRecipients
          (NewOtrMessage -> QualifiedOtrRecipients)
-> NewOtrMessage -> QualifiedOtrRecipients
forall a b. (a -> b) -> a -> b
$ NewOtrMessage
message
      clientMismatchStrategy :: ClientMismatchStrategy
clientMismatchStrategy = Domain
-> Maybe [UserId]
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> ClientMismatchStrategy
legacyClientMismatchStrategy (Local x -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Local x
loc) (NewOtrMessage -> Maybe [UserId]
newOtrReportMissing NewOtrMessage
message) Maybe IgnoreMissing
ignoreMissing Maybe ReportMissing
reportMissing
      qualifiedMessage :: QualifiedNewOtrMessage
qualifiedMessage =
        QualifiedNewOtrMessage
          { $sel:qualifiedNewOtrSender:QualifiedNewOtrMessage :: ClientId
qualifiedNewOtrSender = NewOtrMessage -> ClientId
newOtrSender NewOtrMessage
message,
            $sel:qualifiedNewOtrRecipients:QualifiedNewOtrMessage :: QualifiedOtrRecipients
qualifiedNewOtrRecipients = QualifiedOtrRecipients
qualifiedRecipients,
            $sel:qualifiedNewOtrNativePush:QualifiedNewOtrMessage :: Bool
qualifiedNewOtrNativePush = NewOtrMessage -> Bool
newOtrNativePush NewOtrMessage
message,
            $sel:qualifiedNewOtrTransient:QualifiedNewOtrMessage :: Bool
qualifiedNewOtrTransient = NewOtrMessage -> Bool
newOtrTransient NewOtrMessage
message,
            $sel:qualifiedNewOtrNativePriority:QualifiedNewOtrMessage :: Maybe Priority
qualifiedNewOtrNativePriority = NewOtrMessage -> Maybe Priority
newOtrNativePriority NewOtrMessage
message,
            $sel:qualifiedNewOtrData:QualifiedNewOtrMessage :: ByteString
qualifiedNewOtrData = (Text -> ByteString) -> Maybe Text -> ByteString
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> ByteString
fromBase64TextLenient (NewOtrMessage -> Maybe Text
newOtrData NewOtrMessage
message),
            $sel:qualifiedNewOtrClientMismatchStrategy:QualifiedNewOtrMessage :: ClientMismatchStrategy
qualifiedNewOtrClientMismatchStrategy = ClientMismatchStrategy
clientMismatchStrategy
          }
  Domain
-> PostOtrResponse MessageSendingStatus
-> PostOtrResponse ClientMismatch
forall a b. Unqualify a b => Domain -> a -> b
unqualify (Local x -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Local x
loc) (PostOtrResponse MessageSendingStatus
 -> PostOtrResponse ClientMismatch)
-> f (PostOtrResponse MessageSendingStatus)
-> f (PostOtrResponse ClientMismatch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualifiedNewOtrMessage -> f (PostOtrResponse MessageSendingStatus)
f QualifiedNewOtrMessage
qualifiedMessage

postBotMessageUnqualified ::
  ( Member BrigAccess r,
    Member ClientStore r,
    Member ConversationStore r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member BackendNotificationQueueAccess r,
    Member NotificationSubsystem r,
    Member (Input (Local ())) r,
    Member (Input Opts) r,
    Member TeamStore r,
    Member TinyLog r,
    Member (Input UTCTime) r
  ) =>
  BotId ->
  ConvId ->
  Maybe IgnoreMissing ->
  Maybe ReportMissing ->
  NewOtrMessage ->
  Sem r (PostOtrResponse ClientMismatch)
postBotMessageUnqualified :: forall (r :: EffectRow).
(Member BrigAccess r, Member ClientStore r,
 Member ConversationStore r, Member ExternalAccess r,
 Member FederatorAccess r, Member BackendNotificationQueueAccess r,
 Member NotificationSubsystem r, Member (Input (Local ())) r,
 Member (Input Opts) r, Member TeamStore r, Member TinyLog r,
 Member (Input UTCTime) r) =>
BotId
-> ConvId
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> NewOtrMessage
-> Sem r (PostOtrResponse ClientMismatch)
postBotMessageUnqualified BotId
sender ConvId
cnv Maybe IgnoreMissing
ignoreMissing Maybe ReportMissing
reportMissing NewOtrMessage
message = do
  Local UserId
lusr <- UserId -> Sem r (Local UserId)
forall (r :: EffectRow) a.
Member (Input (Local ())) r =>
a -> Sem r (Local a)
qualifyLocal (BotId -> UserId
botUserId BotId
sender)
  Local ConvId
lcnv <- ConvId -> Sem r (Local ConvId)
forall (r :: EffectRow) a.
Member (Input (Local ())) r =>
a -> Sem r (Local a)
qualifyLocal ConvId
cnv
  Local UserId
-> (QualifiedNewOtrMessage
    -> Sem r (PostOtrResponse MessageSendingStatus))
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> NewOtrMessage
-> Sem r (PostOtrResponse ClientMismatch)
forall (f :: * -> *) x.
Functor f =>
Local x
-> (QualifiedNewOtrMessage
    -> f (PostOtrResponse MessageSendingStatus))
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> NewOtrMessage
-> f (PostOtrResponse ClientMismatch)
unqualifyEndpoint
    Local UserId
lusr
    (Local UserId
-> Sem
     (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus)
-> Sem r (PostOtrResponse MessageSendingStatus)
forall x (r :: EffectRow) a.
Local x -> Sem (Input (Local ()) : r) a -> Sem r a
runLocalInput Local UserId
lusr (Sem (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus)
 -> Sem r (PostOtrResponse MessageSendingStatus))
-> (QualifiedNewOtrMessage
    -> Sem
         (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus))
-> QualifiedNewOtrMessage
-> Sem r (PostOtrResponse MessageSendingStatus)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserType
-> Qualified UserId
-> Maybe ConnId
-> Local ConvId
-> QualifiedNewOtrMessage
-> Sem
     (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus)
forall (r :: EffectRow).
(Member BrigAccess r, Member ClientStore r,
 Member ConversationStore r, Member FederatorAccess r,
 Member BackendNotificationQueueAccess r, Member ExternalAccess r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member TeamStore r, Member TinyLog r,
 Member NotificationSubsystem r) =>
UserType
-> Qualified UserId
-> Maybe ConnId
-> Local ConvId
-> QualifiedNewOtrMessage
-> Sem r (PostOtrResponse MessageSendingStatus)
postQualifiedOtrMessage UserType
Bot (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) Maybe ConnId
forall a. Maybe a
Nothing Local ConvId
lcnv)
    Maybe IgnoreMissing
ignoreMissing
    Maybe ReportMissing
reportMissing
    NewOtrMessage
message

postOtrBroadcastUnqualified ::
  ( Member BrigAccess r,
    Member ClientStore r,
    Member (ErrorS 'TeamNotFound) r,
    Member (ErrorS 'NonBindingTeam) r,
    Member (ErrorS 'BroadcastLimitExceeded) r,
    Member NotificationSubsystem r,
    Member ExternalAccess r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member TeamStore r,
    Member TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  Maybe IgnoreMissing ->
  Maybe ReportMissing ->
  NewOtrMessage ->
  Sem r (PostOtrResponse ClientMismatch)
postOtrBroadcastUnqualified :: forall (r :: EffectRow).
(Member BrigAccess r, Member ClientStore r,
 Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NonBindingTeam) r,
 Member (ErrorS 'BroadcastLimitExceeded) r,
 Member NotificationSubsystem r, Member ExternalAccess r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member TeamStore r, Member TinyLog r) =>
Local UserId
-> ConnId
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> NewOtrMessage
-> Sem r (PostOtrResponse ClientMismatch)
postOtrBroadcastUnqualified Local UserId
sender ConnId
zcon =
  Local UserId
-> (QualifiedNewOtrMessage
    -> Sem r (PostOtrResponse MessageSendingStatus))
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> NewOtrMessage
-> Sem r (PostOtrResponse ClientMismatch)
forall (f :: * -> *) x.
Functor f =>
Local x
-> (QualifiedNewOtrMessage
    -> f (PostOtrResponse MessageSendingStatus))
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> NewOtrMessage
-> f (PostOtrResponse ClientMismatch)
unqualifyEndpoint
    Local UserId
sender
    (Local UserId
-> Maybe ConnId
-> QualifiedNewOtrMessage
-> Sem r (PostOtrResponse MessageSendingStatus)
forall (r :: EffectRow).
(Member BrigAccess r, Member ClientStore r,
 Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NonBindingTeam) r,
 Member (ErrorS 'BroadcastLimitExceeded) r, Member ExternalAccess r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member TeamStore r, Member TinyLog r,
 Member NotificationSubsystem r) =>
Local UserId
-> Maybe ConnId
-> QualifiedNewOtrMessage
-> Sem r (PostOtrResponse MessageSendingStatus)
postBroadcast Local UserId
sender (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon))

postOtrMessageUnqualified ::
  ( Member BrigAccess r,
    Member ClientStore r,
    Member ConversationStore r,
    Member FederatorAccess r,
    Member BackendNotificationQueueAccess r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member TeamStore r,
    Member TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  ConvId ->
  Maybe IgnoreMissing ->
  Maybe ReportMissing ->
  NewOtrMessage ->
  Sem r (PostOtrResponse ClientMismatch)
postOtrMessageUnqualified :: forall (r :: EffectRow).
(Member BrigAccess r, Member ClientStore r,
 Member ConversationStore r, Member FederatorAccess r,
 Member BackendNotificationQueueAccess r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member TeamStore r, Member TinyLog r) =>
Local UserId
-> ConnId
-> ConvId
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> NewOtrMessage
-> Sem r (PostOtrResponse ClientMismatch)
postOtrMessageUnqualified Local UserId
sender ConnId
zcon ConvId
cnv =
  let lcnv :: Local ConvId
lcnv = Local UserId -> ConvId -> Local ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
sender ConvId
cnv
   in Local UserId
-> (QualifiedNewOtrMessage
    -> Sem r (PostOtrResponse MessageSendingStatus))
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> NewOtrMessage
-> Sem r (PostOtrResponse ClientMismatch)
forall (f :: * -> *) x.
Functor f =>
Local x
-> (QualifiedNewOtrMessage
    -> f (PostOtrResponse MessageSendingStatus))
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> NewOtrMessage
-> f (PostOtrResponse ClientMismatch)
unqualifyEndpoint
        Local UserId
sender
        (Local UserId
-> Sem
     (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus)
-> Sem r (PostOtrResponse MessageSendingStatus)
forall x (r :: EffectRow) a.
Local x -> Sem (Input (Local ()) : r) a -> Sem r a
runLocalInput Local UserId
sender (Sem (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus)
 -> Sem r (PostOtrResponse MessageSendingStatus))
-> (QualifiedNewOtrMessage
    -> Sem
         (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus))
-> QualifiedNewOtrMessage
-> Sem r (PostOtrResponse MessageSendingStatus)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserType
-> Qualified UserId
-> Maybe ConnId
-> Local ConvId
-> QualifiedNewOtrMessage
-> Sem
     (Input (Local ()) : r) (PostOtrResponse MessageSendingStatus)
forall (r :: EffectRow).
(Member BrigAccess r, Member ClientStore r,
 Member ConversationStore r, Member FederatorAccess r,
 Member BackendNotificationQueueAccess r, Member ExternalAccess r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member TeamStore r, Member TinyLog r,
 Member NotificationSubsystem r) =>
UserType
-> Qualified UserId
-> Maybe ConnId
-> Local ConvId
-> QualifiedNewOtrMessage
-> Sem r (PostOtrResponse MessageSendingStatus)
postQualifiedOtrMessage UserType
User (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
sender) (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon) Local ConvId
lcnv)

updateConversationName ::
  ( Member BackendNotificationQueueAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (Error InvalidInput) r,
    Member (ErrorS ('ActionDenied 'ModifyConversationName)) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member TeamStore r
  ) =>
  Local UserId ->
  ConnId ->
  Qualified ConvId ->
  ConversationRename ->
  Sem r (UpdateResult Event)
updateConversationName :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InvalidInput) r,
 Member (ErrorS ('ActionDenied 'ModifyConversationName)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member TeamStore r) =>
Local UserId
-> ConnId
-> Qualified ConvId
-> ConversationRename
-> Sem r (UpdateResult Event)
updateConversationName Local UserId
lusr ConnId
zcon Qualified ConvId
qcnv ConversationRename
convRename = do
  Local UserId
-> (Local ConvId
    -> ConversationRename -> Sem r (UpdateResult Event))
-> (Remote ConvId
    -> ConversationRename -> Sem r (UpdateResult Event))
-> Qualified ConvId
-> ConversationRename
-> Sem r (UpdateResult Event)
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
    Local UserId
lusr
    (Local UserId
-> ConnId
-> Local ConvId
-> ConversationRename
-> Sem r (UpdateResult Event)
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InvalidInput) r,
 Member (ErrorS ('ActionDenied 'ModifyConversationName)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member TeamStore r) =>
Local UserId
-> ConnId
-> Local ConvId
-> ConversationRename
-> Sem r (UpdateResult Event)
updateLocalConversationName Local UserId
lusr ConnId
zcon)
    (\Remote ConvId
_ ConversationRename
_ -> FederationError -> Sem r (UpdateResult Event)
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw FederationError
FederationNotImplemented)
    Qualified ConvId
qcnv
    ConversationRename
convRename

updateUnqualifiedConversationName ::
  ( Member BackendNotificationQueueAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (Error InvalidInput) r,
    Member (ErrorS ('ActionDenied 'ModifyConversationName)) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member TeamStore r
  ) =>
  Local UserId ->
  ConnId ->
  ConvId ->
  ConversationRename ->
  Sem r (UpdateResult Event)
updateUnqualifiedConversationName :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InvalidInput) r,
 Member (ErrorS ('ActionDenied 'ModifyConversationName)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member TeamStore r) =>
Local UserId
-> ConnId
-> ConvId
-> ConversationRename
-> Sem r (UpdateResult Event)
updateUnqualifiedConversationName Local UserId
lusr ConnId
zcon ConvId
cnv ConversationRename
rename = do
  let lcnv :: Local ConvId
lcnv = 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
-> ConnId
-> Local ConvId
-> ConversationRename
-> Sem r (UpdateResult Event)
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InvalidInput) r,
 Member (ErrorS ('ActionDenied 'ModifyConversationName)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member TeamStore r) =>
Local UserId
-> ConnId
-> Local ConvId
-> ConversationRename
-> Sem r (UpdateResult Event)
updateLocalConversationName Local UserId
lusr ConnId
zcon Local ConvId
lcnv ConversationRename
rename

updateLocalConversationName ::
  ( Member BackendNotificationQueueAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (Error InvalidInput) r,
    Member (ErrorS ('ActionDenied 'ModifyConversationName)) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member TeamStore r
  ) =>
  Local UserId ->
  ConnId ->
  Local ConvId ->
  ConversationRename ->
  Sem r (UpdateResult Event)
updateLocalConversationName :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InvalidInput) r,
 Member (ErrorS ('ActionDenied 'ModifyConversationName)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member TeamStore r) =>
Local UserId
-> ConnId
-> Local ConvId
-> ConversationRename
-> Sem r (UpdateResult Event)
updateLocalConversationName Local UserId
lusr ConnId
zcon Local ConvId
lcnv ConversationRename
rename =
  Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event)
forall (r :: EffectRow) a.
Sem (Error NoChanges : r) a -> Sem r (UpdateResult a)
getUpdateResult (Sem (Error NoChanges : r) Event -> Sem r (UpdateResult Event))
-> (Sem (Error NoChanges : r) LocalConversationUpdate
    -> Sem (Error NoChanges : r) Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (UpdateResult Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalConversationUpdate -> Event)
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem (Error NoChanges : r) Event
forall a b.
(a -> b)
-> Sem (Error NoChanges : r) a -> Sem (Error NoChanges : r) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalConversationUpdate -> Event
lcuEvent (Sem (Error NoChanges : r) LocalConversationUpdate
 -> Sem r (UpdateResult Event))
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$
    forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 HasConversationActionEffects tag r, SingI tag) =>
Local ConvId
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversation @'ConversationRenameTag Local ConvId
lcnv (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon) ConversationRename
ConversationAction 'ConversationRenameTag
rename

memberTyping ::
  ( Member NotificationSubsystem r,
    Member (ErrorS 'ConvNotFound) r,
    Member (Input (Local ())) r,
    Member (Input UTCTime) r,
    Member ConversationStore r,
    Member MemberStore r,
    Member FederatorAccess r
  ) =>
  Local UserId ->
  ConnId ->
  Qualified ConvId ->
  TypingStatus ->
  Sem r ()
memberTyping :: forall (r :: EffectRow).
(Member NotificationSubsystem r, Member (ErrorS 'ConvNotFound) r,
 Member (Input (Local ())) r, Member (Input UTCTime) r,
 Member ConversationStore r, Member MemberStore r,
 Member FederatorAccess r) =>
Local UserId
-> ConnId -> Qualified ConvId -> TypingStatus -> Sem r ()
memberTyping Local UserId
lusr ConnId
zcon Qualified ConvId
qcnv TypingStatus
ts = do
  Local UserId
-> (Local ConvId -> Sem r ())
-> (Remote ConvId -> Sem r ())
-> Qualified ConvId
-> Sem r ()
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
    Local UserId
lusr
    ( \Local ConvId
lcnv -> do
        (Conversation
conv, Either LocalMember RemoteMember
_) <- 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 (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) Local ConvId
lcnv
        Sem r TypingDataUpdated -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r TypingDataUpdated -> Sem r ())
-> Sem r TypingDataUpdated -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Conversation
-> Qualified UserId
-> Maybe ConnId
-> TypingStatus
-> Sem r TypingDataUpdated
forall (r :: EffectRow).
(Member (Input UTCTime) r, Member (Input (Local ())) r,
 Member NotificationSubsystem r, Member FederatorAccess r) =>
Conversation
-> Qualified UserId
-> Maybe ConnId
-> TypingStatus
-> Sem r TypingDataUpdated
notifyTypingIndicator Conversation
conv (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon) TypingStatus
ts
    )
    ( \Remote ConvId
rcnv -> do
        Bool
isMemberRemoteConv <- UserId -> Remote ConvId -> Sem r Bool
forall (r :: EffectRow).
Member MemberStore r =>
UserId -> Remote ConvId -> Sem r Bool
E.checkLocalMemberRemoteConv (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) Remote ConvId
rcnv
        Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isMemberRemoteConv (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 @'ConvNotFound
        let rpc :: TypingDataUpdateRequest
rpc =
              TypingDataUpdateRequest
                { $sel:typingStatus:TypingDataUpdateRequest :: TypingStatus
typingStatus = TypingStatus
ts,
                  $sel:userId:TypingDataUpdateRequest :: UserId
userId = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr,
                  $sel:convId:TypingDataUpdateRequest :: ConvId
convId = Remote ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Remote ConvId
rcnv
                }
        TypingDataUpdateResponse
res <- Remote ConvId
-> FederatorClient 'Galley TypingDataUpdateResponse
-> Sem r TypingDataUpdateResponse
forall (r :: EffectRow) (c :: Component) x a.
(Member FederatorAccess r, KnownComponent c) =>
Remote x -> FederatorClient c a -> Sem r a
E.runFederated Remote ConvId
rcnv (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 @"update-typing-indicator" TypingDataUpdateRequest
rpc)
        case TypingDataUpdateResponse
res of
          TypingDataUpdateSuccess (TypingDataUpdated {[UserId]
UTCTime
ConvId
Qualified UserId
TypingStatus
time :: UTCTime
origUserId :: Qualified UserId
convId :: ConvId
usersInConv :: [UserId]
typingStatus :: TypingStatus
$sel:time:TypingDataUpdated :: TypingDataUpdated -> UTCTime
$sel:origUserId:TypingDataUpdated :: TypingDataUpdated -> Qualified UserId
$sel:convId:TypingDataUpdated :: TypingDataUpdated -> ConvId
$sel:usersInConv:TypingDataUpdated :: TypingDataUpdated -> [UserId]
$sel:typingStatus:TypingDataUpdated :: TypingDataUpdated -> TypingStatus
..}) -> do
            Qualified UserId
-> UTCTime
-> [UserId]
-> Maybe ConnId
-> Qualified ConvId
-> TypingStatus
-> Sem r ()
forall (r :: EffectRow).
Member NotificationSubsystem r =>
Qualified UserId
-> UTCTime
-> [UserId]
-> Maybe ConnId
-> Qualified ConvId
-> TypingStatus
-> Sem r ()
pushTypingIndicatorEvents Qualified UserId
origUserId UTCTime
time [UserId]
usersInConv (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon) Qualified ConvId
qcnv TypingStatus
typingStatus
          TypingDataUpdateError GalleyError
_ -> () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    )
    Qualified ConvId
qcnv

memberTypingUnqualified ::
  ( Member NotificationSubsystem r,
    Member (ErrorS 'ConvNotFound) r,
    Member (Input (Local ())) r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member ConversationStore r,
    Member FederatorAccess r
  ) =>
  Local UserId ->
  ConnId ->
  ConvId ->
  TypingStatus ->
  Sem r ()
memberTypingUnqualified :: forall (r :: EffectRow).
(Member NotificationSubsystem r, Member (ErrorS 'ConvNotFound) r,
 Member (Input (Local ())) r, Member (Input UTCTime) r,
 Member MemberStore r, Member ConversationStore r,
 Member FederatorAccess r) =>
Local UserId -> ConnId -> ConvId -> TypingStatus -> Sem r ()
memberTypingUnqualified Local UserId
lusr ConnId
zcon ConvId
cnv TypingStatus
ts = 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
  Local UserId
-> ConnId -> Qualified ConvId -> TypingStatus -> Sem r ()
forall (r :: EffectRow).
(Member NotificationSubsystem r, Member (ErrorS 'ConvNotFound) r,
 Member (Input (Local ())) r, Member (Input UTCTime) r,
 Member ConversationStore r, Member MemberStore r,
 Member FederatorAccess r) =>
Local UserId
-> ConnId -> Qualified ConvId -> TypingStatus -> Sem r ()
memberTyping Local UserId
lusr ConnId
zcon (Local ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local ConvId
lcnv) TypingStatus
ts

addBot ::
  forall r.
  ( Member ClientStore r,
    Member ConversationStore r,
    Member (ErrorS ('ActionDenied 'AddConversationMember)) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member (ErrorS 'TooManyMembers) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member MemberStore r
  ) =>
  Local UserId ->
  ConnId ->
  AddBot ->
  Sem r Event
addBot :: forall (r :: EffectRow).
(Member ClientStore r, Member ConversationStore r,
 Member (ErrorS ('ActionDenied 'AddConversationMember)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'TooManyMembers) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member MemberStore r) =>
Local UserId -> ConnId -> AddBot -> Sem r Event
addBot Local UserId
lusr ConnId
zcon AddBot
b = do
  Conversation
c <-
    ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
E.getConversation (AddBot
b AddBot -> Getting ConvId AddBot ConvId -> ConvId
forall s a. s -> Getting a s a -> a
^. Getting ConvId AddBot ConvId
Lens' AddBot ConvId
addBotConv) 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
  -- Check some preconditions on adding bots to a conversation
  ([BotMember]
bots, [LocalMember]
users) <- Conversation -> Sem r ([BotMember], [LocalMember])
regularConvChecks Conversation
c
  UTCTime
t <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  UserId -> ClientId -> Sem r ()
forall (r :: EffectRow).
Member ClientStore r =>
UserId -> ClientId -> Sem r ()
E.createClient (BotId -> UserId
botUserId (AddBot
b AddBot -> Getting BotId AddBot BotId -> BotId
forall s a. s -> Getting a s a -> a
^. Getting BotId AddBot BotId
Lens' AddBot BotId
addBotId)) (AddBot
b AddBot -> Getting ClientId AddBot ClientId -> ClientId
forall s a. s -> Getting a s a -> a
^. Getting ClientId AddBot ClientId
Lens' AddBot ClientId
addBotClient)
  BotMember
bm <- ServiceRef -> BotId -> ConvId -> Sem r BotMember
forall (r :: EffectRow).
Member MemberStore r =>
ServiceRef -> BotId -> ConvId -> Sem r BotMember
E.createBotMember (AddBot
b AddBot -> Getting ServiceRef AddBot ServiceRef -> ServiceRef
forall s a. s -> Getting a s a -> a
^. Getting ServiceRef AddBot ServiceRef
Lens' AddBot ServiceRef
addBotService) (AddBot
b AddBot -> Getting BotId AddBot BotId -> BotId
forall s a. s -> Getting a s a -> a
^. Getting BotId AddBot BotId
Lens' AddBot BotId
addBotId) (AddBot
b AddBot -> Getting ConvId AddBot ConvId -> ConvId
forall s a. s -> Getting a s a -> a
^. Getting ConvId AddBot ConvId
Lens' AddBot ConvId
addBotConv)
  let e :: Event
e =
        Qualified ConvId
-> Maybe SubConvId
-> Qualified UserId
-> UTCTime
-> EventData
-> Event
Event
          (Local ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (Local UserId -> ConvId -> Local ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr (AddBot
b AddBot -> Getting ConvId AddBot ConvId -> ConvId
forall s a. s -> Getting a s a -> a
^. Getting ConvId AddBot ConvId
Lens' AddBot ConvId
addBotConv)))
          Maybe SubConvId
forall a. Maybe a
Nothing
          (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr)
          UTCTime
t
          ( SimpleMembers -> EventData
EdMembersJoin
              ( [SimpleMember] -> SimpleMembers
SimpleMembers
                  [ Qualified UserId -> RoleName -> SimpleMember
SimpleMember
                      (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (Local UserId -> UserId -> Local UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr (BotId -> UserId
botUserId (BotMember -> BotId
botMemId BotMember
bm))))
                      RoleName
roleNameWireAdmin
                  ]
              )
          )
  Maybe Push -> (Push -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (UserId -> Object -> [Recipient] -> Maybe Push
newPushLocal (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) (Event -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject Event
e) (LocalMember -> Recipient
localMemberToRecipient (LocalMember -> Recipient) -> [LocalMember] -> [Recipient]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocalMember]
users)) ((Push -> Sem r ()) -> Sem r ()) -> (Push -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \Push
p ->
    [Push] -> Sem r ()
forall (r :: EffectRow).
Member NotificationSubsystem r =>
[Push] -> Sem r ()
pushNotifications [Push
p Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Maybe ConnId -> Identity (Maybe ConnId)) -> Push -> Identity Push
Lens' Push (Maybe ConnId)
pushConn ((Maybe ConnId -> Identity (Maybe ConnId))
 -> Push -> Identity Push)
-> ConnId -> Push -> Push
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ConnId
zcon]
  [(BotMember, Event)] -> Sem r ()
forall (r :: EffectRow) (f :: * -> *).
(Member ExternalAccess r, Foldable f) =>
f (BotMember, Event) -> Sem r ()
E.deliverAsync ((BotMember -> (BotMember, Event))
-> [BotMember] -> [(BotMember, Event)]
forall a b. (a -> b) -> [a] -> [b]
map (,Event
e) (BotMember
bm BotMember -> [BotMember] -> [BotMember]
forall a. a -> [a] -> [a]
: [BotMember]
bots))
  Event -> Sem r Event
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Event
e
  where
    regularConvChecks :: Conversation -> Sem r ([BotMember], [LocalMember])
regularConvChecks Conversation
c = do
      let ([BotMember]
bots, [LocalMember]
users) = [LocalMember] -> ([BotMember], [LocalMember])
forall (f :: * -> *).
Foldable f =>
f LocalMember -> ([BotMember], [LocalMember])
localBotsAndUsers (Conversation -> [LocalMember]
Data.convLocalMembers Conversation
c)
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr UserId -> [LocalMember] -> Bool
forall (m :: * -> *). Foldable m => UserId -> m LocalMember -> Bool
`isMember` [LocalMember]
users) (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 @'ConvNotFound
      Conversation -> Sem r ()
forall (r :: EffectRow).
Member (ErrorS 'InvalidOperation) r =>
Conversation -> Sem r ()
ensureGroupConversation Conversation
c
      LocalMember
self <- UserId -> [LocalMember] -> Sem r LocalMember
forall (t :: * -> *) (r :: EffectRow).
(Foldable t, Member (ErrorS 'ConvNotFound) r) =>
UserId -> t LocalMember -> Sem r LocalMember
getSelfMemberFromLocals (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) [LocalMember]
users
      -- Note that in brig from where this internal handler is called, we additionally check for conversation admin role.
      -- Remember to change this if we ever want to allow non admins to add bots.
      Sing 'AddConversationMember -> LocalMember -> Sem r ()
forall (action :: Action) mem (r :: EffectRow).
(IsConvMember mem, Member (ErrorS ('ActionDenied action)) r) =>
Sing action -> mem -> Sem r ()
ensureActionAllowed Sing 'AddConversationMember
SAction 'AddConversationMember
SAddConversationMember LocalMember
self
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((BotMember -> Bool) -> [BotMember] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((BotId -> BotId -> Bool
forall a. Eq a => a -> a -> Bool
== AddBot
b AddBot -> Getting BotId AddBot BotId -> BotId
forall s a. s -> Getting a s a -> a
^. Getting BotId AddBot BotId
Lens' AddBot BotId
addBotId) (BotId -> Bool) -> (BotMember -> BotId) -> BotMember -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotMember -> BotId
botMemId) [BotMember]
bots) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
        let botId :: Local UserId
botId = Local UserId -> UserId -> Local UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr (BotId -> UserId
botUserId (AddBot
b AddBot -> Getting BotId AddBot BotId -> BotId
forall s a. s -> Getting a s a -> a
^. Getting BotId AddBot BotId
Lens' AddBot BotId
addBotId))
        ProtocolTag -> [LocalMember] -> [Qualified UserId] -> Sem r ()
forall (f :: * -> *) (r :: EffectRow) a.
(Foldable f,
 (Member (ErrorS 'TooManyMembers) r, Member (Input Opts) r)) =>
ProtocolTag -> [LocalMember] -> f a -> Sem r ()
ensureMemberLimit (Conversation -> ProtocolTag
Data.convProtocolTag Conversation
c) ([LocalMember] -> [LocalMember]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([LocalMember] -> [LocalMember]) -> [LocalMember] -> [LocalMember]
forall a b. (a -> b) -> a -> b
$ Conversation -> [LocalMember]
Data.convLocalMembers Conversation
c) [Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
botId]
      ([BotMember], [LocalMember]) -> Sem r ([BotMember], [LocalMember])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([BotMember]
bots, [LocalMember]
users)

rmBot ::
  ( Member ClientStore r,
    Member ConversationStore r,
    Member (ErrorS 'ConvNotFound) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r
  ) =>
  Local UserId ->
  Maybe ConnId ->
  RemoveBot ->
  Sem r (UpdateResult Event)
rmBot :: forall (r :: EffectRow).
(Member ClientStore r, Member ConversationStore r,
 Member (ErrorS 'ConvNotFound) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member MemberStore r,
 Member
   (Error (Tagged ('ActionDenied 'RemoveConversationMember) ())) r) =>
Local UserId
-> Maybe ConnId -> RemoveBot -> Sem r (UpdateResult Event)
rmBot Local UserId
lusr Maybe ConnId
zcon RemoveBot
b = do
  Conversation
c <-
    ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
E.getConversation (RemoveBot
b RemoveBot -> Getting ConvId RemoveBot ConvId -> ConvId
forall s a. s -> Getting a s a -> a
^. Getting ConvId RemoveBot ConvId
Lens' RemoveBot ConvId
rmBotConv) 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
  let ([BotMember]
bots, [LocalMember]
users) = [LocalMember] -> ([BotMember], [LocalMember])
forall (f :: * -> *).
Foldable f =>
f LocalMember -> ([BotMember], [LocalMember])
localBotsAndUsers (Conversation -> [LocalMember]
Data.convLocalMembers Conversation
c)
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr UserId -> [LocalMember] -> Bool
forall (m :: * -> *). Foldable m => UserId -> m LocalMember -> Bool
`isMember` Conversation -> [LocalMember]
Data.convLocalMembers Conversation
c) (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 @'ConvNotFound
  -- A bot can remove itself (which will internally be triggered when a service is deleted),
  -- otherwise we have to check for the correct permissions
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BotId -> UserId
botUserId (RemoveBot
b RemoveBot -> Getting BotId RemoveBot BotId -> BotId
forall s a. s -> Getting a s a -> a
^. Getting BotId RemoveBot BotId
Lens' RemoveBot BotId
rmBotId) UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
== Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
    -- Note that in brig from where this internal handler is called, we additionally check for conversation admin role.
    -- Remember to change this if we ever want to allow non admins to remove bots.
    LocalMember
self <- UserId -> [LocalMember] -> Sem r LocalMember
forall (t :: * -> *) (r :: EffectRow).
(Foldable t, Member (ErrorS 'ConvNotFound) r) =>
UserId -> t LocalMember -> Sem r LocalMember
getSelfMemberFromLocals (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) [LocalMember]
users
    Sing 'RemoveConversationMember -> LocalMember -> Sem r ()
forall (action :: Action) mem (r :: EffectRow).
(IsConvMember mem, Member (ErrorS ('ActionDenied action)) r) =>
Sing action -> mem -> Sem r ()
ensureActionAllowed Sing 'RemoveConversationMember
SAction 'RemoveConversationMember
SRemoveConversationMember LocalMember
self
  let lcnv :: Local ConvId
lcnv = Local UserId -> ConvId -> Local ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr (Conversation -> ConvId
Data.convId Conversation
c)
  if Bool -> Bool
not ((BotMember -> Bool) -> [BotMember] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((BotId -> BotId -> Bool
forall a. Eq a => a -> a -> Bool
== RemoveBot
b RemoveBot -> Getting BotId RemoveBot BotId -> BotId
forall s a. s -> Getting a s a -> a
^. Getting BotId RemoveBot BotId
Lens' RemoveBot BotId
rmBotId) (BotId -> Bool) -> (BotMember -> BotId) -> BotMember -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotMember -> BotId
botMemId) [BotMember]
bots)
    then UpdateResult Event -> Sem r (UpdateResult Event)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UpdateResult Event
forall a. UpdateResult a
Unchanged
    else do
      UTCTime
t <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
      do
        let evd :: EventData
evd = QualifiedUserIdList -> EventData
EdMembersLeaveRemoved ([Qualified UserId] -> QualifiedUserIdList
QualifiedUserIdList [Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (Local UserId -> UserId -> Local UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr (BotId -> UserId
botUserId (RemoveBot
b RemoveBot -> Getting BotId RemoveBot BotId -> BotId
forall s a. s -> Getting a s a -> a
^. Getting BotId RemoveBot BotId
Lens' RemoveBot BotId
rmBotId)))])
        let e :: Event
e = Qualified ConvId
-> Maybe SubConvId
-> Qualified UserId
-> UTCTime
-> EventData
-> Event
Event (Local ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local ConvId
lcnv) Maybe SubConvId
forall a. Maybe a
Nothing (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) UTCTime
t EventData
evd
        Maybe Push -> (Push -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (UserId -> Object -> [Recipient] -> Maybe Push
newPushLocal (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) (Event -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject Event
e) (LocalMember -> Recipient
localMemberToRecipient (LocalMember -> Recipient) -> [LocalMember] -> [Recipient]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocalMember]
users)) ((Push -> Sem r ()) -> Sem r ()) -> (Push -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \Push
p ->
          [Push] -> Sem r ()
forall (r :: EffectRow).
Member NotificationSubsystem r =>
[Push] -> Sem r ()
pushNotifications [Push
p Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Maybe ConnId -> Identity (Maybe ConnId)) -> Push -> Identity Push
Lens' Push (Maybe ConnId)
pushConn ((Maybe ConnId -> Identity (Maybe ConnId))
 -> Push -> Identity Push)
-> Maybe ConnId -> Push -> Push
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ConnId
zcon]
        ConvId -> UserList UserId -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
ConvId -> UserList UserId -> Sem r ()
E.deleteMembers (Conversation -> ConvId
Data.convId Conversation
c) ([UserId] -> [Remote UserId] -> UserList UserId
forall a. [a] -> [Remote a] -> UserList a
UserList [BotId -> UserId
botUserId (RemoveBot
b RemoveBot -> Getting BotId RemoveBot BotId -> BotId
forall s a. s -> Getting a s a -> a
^. Getting BotId RemoveBot BotId
Lens' RemoveBot BotId
rmBotId)] [])
        UserId -> Sem r ()
forall (r :: EffectRow). Member ClientStore r => UserId -> Sem r ()
E.deleteClients (BotId -> UserId
botUserId (RemoveBot
b RemoveBot -> Getting BotId RemoveBot BotId -> BotId
forall s a. s -> Getting a s a -> a
^. Getting BotId RemoveBot BotId
Lens' RemoveBot BotId
rmBotId))
        [(BotMember, Event)] -> Sem r ()
forall (r :: EffectRow) (f :: * -> *).
(Member ExternalAccess r, Foldable f) =>
f (BotMember, Event) -> Sem r ()
E.deliverAsync ((BotMember -> (BotMember, Event))
-> [BotMember] -> [(BotMember, Event)]
forall a b. (a -> b) -> [a] -> [b]
map (,Event
e) [BotMember]
bots)
        UpdateResult Event -> Sem r (UpdateResult Event)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdateResult Event -> Sem r (UpdateResult Event))
-> UpdateResult Event -> Sem r (UpdateResult Event)
forall a b. (a -> b) -> a -> b
$ Event -> UpdateResult Event
forall a. a -> UpdateResult a
Updated Event
e

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

ensureConvMember :: (Member (ErrorS 'ConvNotFound) r) => [LocalMember] -> UserId -> Sem r ()
ensureConvMember :: forall (r :: EffectRow).
Member (ErrorS 'ConvNotFound) r =>
[LocalMember] -> UserId -> Sem r ()
ensureConvMember [LocalMember]
users UserId
usr =
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (UserId
usr UserId -> [LocalMember] -> Bool
forall (m :: * -> *). Foldable m => UserId -> m LocalMember -> Bool
`isMember` [LocalMember]
users) (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 @'ConvNotFound

getConversationCodeURI ::
  ( Member (ErrorS 'ConvAccessDenied) r,
    Member CodeStore r
  ) =>
  Maybe ZHostValue ->
  Sem r HttpsUrl
getConversationCodeURI :: forall (r :: EffectRow).
(Member (ErrorS 'ConvAccessDenied) r, Member CodeStore r) =>
Maybe Text -> Sem r HttpsUrl
getConversationCodeURI Maybe Text
mbZHost = do
  Maybe HttpsUrl
mbURI <- Maybe Text -> Sem r (Maybe HttpsUrl)
forall (r :: EffectRow).
Member CodeStore r =>
Maybe Text -> Sem r (Maybe HttpsUrl)
E.getConversationCodeURI Maybe Text
mbZHost
  case Maybe HttpsUrl
mbURI of
    Just HttpsUrl
uri -> HttpsUrl -> Sem r HttpsUrl
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HttpsUrl
uri
    Maybe HttpsUrl
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 @'ConvAccessDenied