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

module Galley.API.Action
  ( -- * Conversation action types
    ConversationActionTag (..),
    ConversationJoin (..),
    ConversationMemberUpdate (..),
    HasConversationActionEffects,
    HasConversationActionGalleyErrors,

    -- * Performing actions
    updateLocalConversation,
    updateLocalConversationUnchecked,
    NoChanges (..),
    LocalConversationUpdate (..),
    notifyTypingIndicator,
    pushTypingIndicatorEvents,

    -- * Utilities
    ensureConversationActionAllowed,
    addMembersToLocalConversation,
    notifyConversationAction,
    updateLocalStateOfRemoteConv,
    addLocalUsersToRemoteConv,
    ConversationUpdate,
    getFederationStatus,
    checkFederationStatus,
    firstConflictOrFullyConnected,
  )
where

import Control.Arrow ((&&&))
import Control.Error (headMay)
import Control.Lens
import Data.ByteString.Conversion (toByteString')
import Data.Domain (Domain (..))
import Data.Id
import Data.Json.Util
import Data.Kind
import Data.List qualified as List
import Data.List.Extra (nubOrd)
import Data.List.NonEmpty (nonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as Map
import Data.Misc
import Data.Qualified
import Data.Set ((\\))
import Data.Set qualified as Set
import Data.Singletons
import Data.Time.Clock
import Galley.API.Error
import Galley.API.MLS.Conversation
import Galley.API.MLS.Migration
import Galley.API.MLS.Removal
import Galley.API.Teams.Features.Get
import Galley.API.Util
import Galley.Data.Conversation
import Galley.Data.Conversation qualified as Data
import Galley.Data.Conversation.Types
import Galley.Data.Scope (Scope (ReusableCode))
import Galley.Data.Services
import Galley.Effects
import Galley.Effects.BackendNotificationQueueAccess
import Galley.Effects.BotAccess qualified as E
import Galley.Effects.BrigAccess qualified as E
import Galley.Effects.CodeStore qualified as E
import Galley.Effects.ConversationStore qualified as E
import Galley.Effects.FederatorAccess qualified as E
import Galley.Effects.FireAndForget qualified as E
import Galley.Effects.MemberStore qualified as E
import Galley.Effects.ProposalStore qualified as E
import Galley.Effects.SubConversationStore qualified as E
import Galley.Effects.TeamStore qualified as E
import Galley.Env (Env)
import Galley.Options
import Galley.Types.Conversations.Members
import Galley.Types.UserList
import Galley.Validation
import Gundeck.Types.Push.V2 qualified as PushV2
import Imports hiding ((\\))
import Network.AMQP qualified as Q
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Polysemy.TinyLog
import Polysemy.TinyLog qualified as P
import System.Logger qualified as Log
import Wire.API.Connection (Relation (Accepted))
import Wire.API.Conversation hiding (Conversation, Member)
import Wire.API.Conversation.Action
import Wire.API.Conversation.Protocol
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.Brig
import Wire.API.Federation.API.Galley
import Wire.API.Federation.API.Galley qualified as F
import Wire.API.Federation.Error
import Wire.API.FederationStatus
import Wire.API.Routes.Internal.Brig.Connection
import Wire.API.Team.Feature
import Wire.API.Team.LegalHold
import Wire.API.Team.Member
import Wire.API.Team.Permission (Perm (AddRemoveConvMember, ModifyConvName))
import Wire.API.User qualified as User
import Wire.NotificationSubsystem

data NoChanges = NoChanges

type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Constraint where
  HasConversationActionEffects 'ConversationJoinTag r =
    ( Member BrigAccess r,
      Member (Error FederationError) r,
      Member (Error InternalError) r,
      Member (ErrorS 'NotATeamMember) r,
      Member (ErrorS 'NotConnected) r,
      Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
      Member (ErrorS ('ActionDenied 'AddConversationMember)) r,
      Member (ErrorS 'InvalidOperation) r,
      Member (ErrorS 'ConvAccessDenied) r,
      Member (ErrorS 'ConvNotFound) 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,
      Member ConversationStore r,
      Member (Error NoChanges) r
    )
  HasConversationActionEffects 'ConversationLeaveTag r =
    ( Member MemberStore r,
      Member (Error InternalError) r,
      Member (Error NoChanges) r,
      Member ExternalAccess r,
      Member FederatorAccess r,
      Member NotificationSubsystem r,
      Member (Input UTCTime) r,
      Member (Input Env) r,
      Member ProposalStore r,
      Member SubConversationStore r,
      Member Random r,
      Member TinyLog r
    )
  HasConversationActionEffects 'ConversationRemoveMembersTag r =
    ( Member MemberStore r,
      Member (Error NoChanges) r,
      Member SubConversationStore r,
      Member ProposalStore r,
      Member (Input Env) r,
      Member (Input UTCTime) r,
      Member ExternalAccess r,
      Member FederatorAccess r,
      Member NotificationSubsystem r,
      Member (Error InternalError) r,
      Member Random r,
      Member TinyLog r,
      Member (Error NoChanges) r
    )
  HasConversationActionEffects 'ConversationMemberUpdateTag r =
    ( Member MemberStore r,
      Member (ErrorS 'ConvMemberNotFound) r
    )
  HasConversationActionEffects 'ConversationDeleteTag r =
    ( Member BrigAccess r,
      Member CodeStore r,
      Member ConversationStore r,
      Member (Error FederationError) r,
      Member (ErrorS 'NotATeamMember) r,
      Member FederatorAccess r,
      Member MemberStore r,
      Member ProposalStore r,
      Member SubConversationStore r,
      Member TeamStore r
    )
  HasConversationActionEffects 'ConversationRenameTag r =
    ( Member (Error InvalidInput) r,
      Member ConversationStore r,
      Member TeamStore r,
      Member (ErrorS InvalidOperation) r
    )
  HasConversationActionEffects 'ConversationAccessDataTag r =
    ( Member BotAccess r,
      Member BrigAccess r,
      Member CodeStore r,
      Member (Error InternalError) r,
      Member (Error InvalidInput) r,
      Member (Error NoChanges) r,
      Member (ErrorS 'InvalidTargetAccess) r,
      Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
      Member ExternalAccess r,
      Member FederatorAccess r,
      Member FireAndForget r,
      Member NotificationSubsystem r,
      Member (Input Env) r,
      Member MemberStore r,
      Member ProposalStore r,
      Member TeamStore r,
      Member TinyLog r,
      Member (Input UTCTime) r,
      Member ConversationStore r,
      Member SubConversationStore r,
      Member Random r
    )
  HasConversationActionEffects 'ConversationMessageTimerUpdateTag r =
    ( Member ConversationStore r,
      Member (Error NoChanges) r
    )
  HasConversationActionEffects 'ConversationReceiptModeUpdateTag r =
    ( Member ConversationStore r,
      Member (Error NoChanges) r
    )
  HasConversationActionEffects 'ConversationUpdateProtocolTag r =
    ( Member ConversationStore r,
      Member (ErrorS 'ConvInvalidProtocolTransition) r,
      Member (ErrorS 'MLSMigrationCriteriaNotSatisfied) r,
      Member (Error NoChanges) r,
      Member BrigAccess r,
      Member ExternalAccess r,
      Member FederatorAccess r,
      Member NotificationSubsystem r,
      Member (Input Env) r,
      Member (Input Opts) r,
      Member (Input UTCTime) r,
      Member MemberStore r,
      Member ProposalStore r,
      Member Random r,
      Member SubConversationStore r,
      Member TeamFeatureStore r,
      Member TinyLog r
    )

type family HasConversationActionGalleyErrors (tag :: ConversationActionTag) :: EffectRow where
  HasConversationActionGalleyErrors 'ConversationJoinTag =
    '[ ErrorS ('ActionDenied 'LeaveConversation),
       ErrorS ('ActionDenied 'AddConversationMember),
       ErrorS 'NotATeamMember,
       ErrorS 'InvalidOperation,
       ErrorS 'ConvNotFound,
       ErrorS 'NotConnected,
       ErrorS 'ConvAccessDenied,
       ErrorS 'TooManyMembers,
       ErrorS 'MissingLegalholdConsent
     ]
  HasConversationActionGalleyErrors 'ConversationLeaveTag =
    '[ ErrorS ('ActionDenied 'LeaveConversation),
       ErrorS 'InvalidOperation,
       ErrorS 'ConvNotFound
     ]
  HasConversationActionGalleyErrors 'ConversationRemoveMembersTag =
    '[ ErrorS ('ActionDenied 'RemoveConversationMember),
       ErrorS 'InvalidOperation,
       ErrorS 'ConvNotFound
     ]
  HasConversationActionGalleyErrors 'ConversationMemberUpdateTag =
    '[ ErrorS ('ActionDenied 'ModifyOtherConversationMember),
       ErrorS 'InvalidOperation,
       ErrorS 'ConvNotFound,
       ErrorS 'ConvMemberNotFound
     ]
  HasConversationActionGalleyErrors 'ConversationDeleteTag =
    '[ ErrorS ('ActionDenied 'DeleteConversation),
       ErrorS 'NotATeamMember,
       ErrorS 'InvalidOperation,
       ErrorS 'ConvNotFound
     ]
  HasConversationActionGalleyErrors 'ConversationRenameTag =
    '[ ErrorS ('ActionDenied 'ModifyConversationName),
       ErrorS 'InvalidOperation,
       ErrorS 'ConvNotFound
     ]
  HasConversationActionGalleyErrors 'ConversationMessageTimerUpdateTag =
    '[ ErrorS ('ActionDenied 'ModifyConversationMessageTimer),
       ErrorS 'InvalidOperation,
       ErrorS 'ConvNotFound
     ]
  HasConversationActionGalleyErrors 'ConversationReceiptModeUpdateTag =
    '[ ErrorS ('ActionDenied 'ModifyConversationReceiptMode),
       ErrorS 'InvalidOperation,
       ErrorS 'ConvNotFound
     ]
  HasConversationActionGalleyErrors 'ConversationAccessDataTag =
    '[ ErrorS ('ActionDenied 'RemoveConversationMember),
       ErrorS ('ActionDenied 'ModifyConversationAccess),
       ErrorS 'InvalidOperation,
       ErrorS 'InvalidTargetAccess,
       ErrorS 'ConvNotFound
     ]
  HasConversationActionGalleyErrors 'ConversationUpdateProtocolTag =
    '[ ErrorS ('ActionDenied 'LeaveConversation),
       ErrorS 'InvalidOperation,
       ErrorS 'ConvNotFound,
       ErrorS 'ConvInvalidProtocolTransition,
       ErrorS 'MLSMigrationCriteriaNotSatisfied,
       ErrorS 'NotATeamMember,
       ErrorS OperationDenied,
       ErrorS 'TeamNotFound
     ]

checkFederationStatus ::
  ( Member (Error UnreachableBackends) r,
    Member (Error NonFederatingBackends) r,
    Member FederatorAccess r
  ) =>
  RemoteDomains ->
  Sem r ()
checkFederationStatus :: forall (r :: EffectRow).
(Member (Error UnreachableBackends) r,
 Member (Error NonFederatingBackends) r,
 Member FederatorAccess r) =>
RemoteDomains -> Sem r ()
checkFederationStatus RemoteDomains
req = do
  FederationStatus
status <- RemoteDomains -> Sem r FederationStatus
forall (r :: EffectRow).
(Member (Error UnreachableBackends) r, Member FederatorAccess r) =>
RemoteDomains -> Sem r FederationStatus
getFederationStatus RemoteDomains
req
  case FederationStatus
status of
    FederationStatus
FullyConnected -> () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    NotConnectedDomains Domain
dom1 Domain
dom2 -> NonFederatingBackends -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (Domain -> Domain -> NonFederatingBackends
NonFederatingBackends Domain
dom1 Domain
dom2)

getFederationStatus ::
  ( Member (Error UnreachableBackends) r,
    Member FederatorAccess r
  ) =>
  RemoteDomains ->
  Sem r FederationStatus
getFederationStatus :: forall (r :: EffectRow).
(Member (Error UnreachableBackends) r, Member FederatorAccess r) =>
RemoteDomains -> Sem r FederationStatus
getFederationStatus RemoteDomains
req = do
  ([Remote NonConnectedBackends] -> FederationStatus)
-> Sem r [Remote NonConnectedBackends] -> Sem r FederationStatus
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Remote NonConnectedBackends] -> FederationStatus
firstConflictOrFullyConnected
    (Sem r [Remote NonConnectedBackends] -> Sem r FederationStatus)
-> (Sem
      r
      [Either
         (Remote [()], FederationError) (Remote NonConnectedBackends)]
    -> Sem r [Remote NonConnectedBackends])
-> Sem
     r
     [Either
        (Remote [()], FederationError) (Remote NonConnectedBackends)]
-> Sem r FederationStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Either
   (Remote [()], FederationError) (Remote NonConnectedBackends)]
-> Sem r [Remote NonConnectedBackends]
forall (r :: EffectRow) e b a.
Member (Error UnreachableBackends) r =>
[Either (Remote e, b) a] -> Sem r [a]
ensureNoUnreachableBackends =<<)
    (Sem
   r
   [Either
      (Remote [()], FederationError) (Remote NonConnectedBackends)]
 -> Sem r FederationStatus)
-> Sem
     r
     [Either
        (Remote [()], FederationError) (Remote NonConnectedBackends)]
-> Sem r FederationStatus
forall a b. (a -> b) -> a -> b
$ [Remote ()]
-> (Remote [()] -> FederatorClient 'Brig NonConnectedBackends)
-> Sem
     r
     [Either
        (Remote [()], FederationError) (Remote NonConnectedBackends)]
forall (r :: EffectRow) (c :: Component) (f :: * -> *) x a.
(Member FederatorAccess r, KnownComponent c, Foldable f,
 Functor f) =>
f (Remote x)
-> (Remote [x] -> FederatorClient c a)
-> Sem r [Either (Remote [x], FederationError) (Remote a)]
E.runFederatedConcurrentlyEither
      (Set (Remote ()) -> [Remote ()]
forall a. Set a -> [a]
Set.toList RemoteDomains
req.rdDomains)
      ( \Remote [()]
qds ->
          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 @'Brig @"get-not-fully-connected-backends"
            (Set Domain -> DomainSet
DomainSet (Set Domain -> DomainSet)
-> (Set (Remote ()) -> Set Domain) -> Set (Remote ()) -> DomainSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Remote () -> Domain) -> Set (Remote ()) -> Set Domain
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Remote () -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain (Set (Remote ()) -> DomainSet) -> Set (Remote ()) -> DomainSet
forall a b. (a -> b) -> a -> b
$ Remote [()] -> Remote ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Remote [()]
qds Remote () -> Set (Remote ()) -> Set (Remote ())
forall a. Ord a => a -> Set a -> Set a
`Set.delete` RemoteDomains
req.rdDomains)
      )

-- | "conflict" here means two remote domains that we are connected to
-- but are not connected to each other.
firstConflictOrFullyConnected :: [Remote NonConnectedBackends] -> FederationStatus
firstConflictOrFullyConnected :: [Remote NonConnectedBackends] -> FederationStatus
firstConflictOrFullyConnected =
  FederationStatus
-> ((Domain, Domain) -> FederationStatus)
-> Maybe (Domain, Domain)
-> FederationStatus
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    FederationStatus
FullyConnected
    ((Domain -> Domain -> FederationStatus)
-> (Domain, Domain) -> FederationStatus
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Domain -> Domain -> FederationStatus
NotConnectedDomains)
    (Maybe (Domain, Domain) -> FederationStatus)
-> ([Remote NonConnectedBackends] -> Maybe (Domain, Domain))
-> [Remote NonConnectedBackends]
-> FederationStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Domain, Domain)] -> Maybe (Domain, Domain)
forall a. [a] -> Maybe a
headMay
    ([(Domain, Domain)] -> Maybe (Domain, Domain))
-> ([Remote NonConnectedBackends] -> [(Domain, Domain)])
-> [Remote NonConnectedBackends]
-> Maybe (Domain, Domain)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Remote NonConnectedBackends -> Maybe (Domain, Domain))
-> [Remote NonConnectedBackends] -> [(Domain, Domain)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Remote NonConnectedBackends -> Maybe (Domain, Domain)
toMaybeConflict
  where
    toMaybeConflict :: Remote NonConnectedBackends -> Maybe (Domain, Domain)
    toMaybeConflict :: Remote NonConnectedBackends -> Maybe (Domain, Domain)
toMaybeConflict Remote NonConnectedBackends
r =
      [Domain] -> Maybe Domain
forall a. [a] -> Maybe a
headMay (Set Domain -> [Domain]
forall a. Set a -> [a]
Set.toList (NonConnectedBackends -> Set Domain
nonConnectedBackends (Remote NonConnectedBackends -> NonConnectedBackends
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Remote NonConnectedBackends
r))) Maybe Domain
-> (Domain -> (Domain, Domain)) -> Maybe (Domain, Domain)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Remote NonConnectedBackends -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Remote NonConnectedBackends
r,)

noChanges :: (Member (Error NoChanges) r) => Sem r a
noChanges :: forall (r :: EffectRow) a. Member (Error NoChanges) r => Sem r a
noChanges = NoChanges -> Sem r a
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw NoChanges
NoChanges

ensureAllowed ::
  forall tag mem r x.
  (IsConvMember mem, HasConversationActionEffects tag r) =>
  Sing tag ->
  Local x ->
  ConversationAction tag ->
  Conversation ->
  mem ->
  Sem r ()
ensureAllowed :: forall (tag :: ConversationActionTag) mem (r :: EffectRow) x.
(IsConvMember mem, HasConversationActionEffects tag r) =>
Sing tag
-> Local x
-> ConversationAction tag
-> Conversation
-> mem
-> Sem r ()
ensureAllowed Sing tag
tag Local x
loc ConversationAction tag
action Conversation
conv mem
origUser = do
  case Sing tag
tag of
    Sing tag
SConversationActionTag tag
SConversationJoinTag ->
      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 @'InvalidAction @('ActionDenied 'AddConversationMember) (Sem (ErrorS 'InvalidAction : r) () -> Sem r ())
-> Sem (ErrorS 'InvalidAction : r) () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
        mem -> RoleName -> Sem (ErrorS 'InvalidAction : r) ()
forall mem (r :: EffectRow).
(IsConvMember mem, Member (ErrorS 'InvalidAction) r) =>
mem -> RoleName -> Sem r ()
ensureConvRoleNotElevated mem
origUser (ConversationJoin -> RoleName
cjRole ConversationJoin
ConversationAction tag
action)
    Sing tag
SConversationActionTag tag
SConversationDeleteTag ->
      Maybe TeamId -> (TeamId -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Conversation -> Maybe TeamId
convTeam Conversation
conv) ((TeamId -> Sem r ()) -> Sem r ())
-> (TeamId -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tid -> do
        Local UserId
lusr <- Local x -> Qualified UserId -> Sem r (Local UserId)
forall (r :: EffectRow) x a.
Member (Error FederationError) r =>
Local x -> Qualified a -> Sem r (Local a)
ensureLocal Local x
loc (Local x -> mem -> Qualified UserId
forall x. Local x -> mem -> Qualified UserId
forall mem x.
IsConvMember mem =>
Local x -> mem -> Qualified UserId
convMemberId Local x
loc mem
origUser)
        Sem r TeamMember -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r TeamMember -> Sem r ()) -> Sem r TeamMember -> Sem r ()
forall a b. (a -> b) -> a -> b
$ TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) Sem r (Maybe TeamMember)
-> (Maybe TeamMember -> Sem r TeamMember) -> Sem r TeamMember
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 @'NotATeamMember
    Sing tag
SConversationActionTag tag
SConversationAccessDataTag -> do
      -- 'PrivateAccessRole' is for self-conversations, 1:1 conversations and
      -- so on; users not supposed to be able to make other conversations
      -- have 'PrivateAccessRole'
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Access
PrivateAccess Access -> Set Access -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ConversationAccessData -> Set Access
cupAccess ConversationAccessData
ConversationAction tag
action Bool -> Bool -> Bool
|| Set AccessRole -> Bool
forall a. Set a -> Bool
Set.null (ConversationAccessData -> Set AccessRole
cupAccessRoles ConversationAccessData
ConversationAction tag
action)) (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 @'InvalidTargetAccess
      -- Team conversations incur another round of checks
      case Conversation -> Maybe TeamId
convTeam Conversation
conv of
        Just TeamId
_ -> do
          -- Access mode change might result in members being removed from the
          -- conversation, so the user must have the necessary permission flag
          Sing 'RemoveConversationMember -> mem -> 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 mem
origUser
        Maybe TeamId
Nothing ->
          -- not a team conv, so one of the other access roles has to allow this.
          Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set AccessRole -> Bool
forall a. Set a -> Bool
Set.null (Set AccessRole -> Bool) -> Set AccessRole -> Bool
forall a b. (a -> b) -> a -> b
$ ConversationAccessData -> Set AccessRole
cupAccessRoles ConversationAccessData
ConversationAction tag
action Set AccessRole -> Set AccessRole -> Set AccessRole
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ [AccessRole] -> Set AccessRole
forall a. Ord a => [a] -> Set a
Set.fromList [AccessRole
TeamMemberAccessRole]) (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 @'InvalidTargetAccess
    Sing tag
_ -> () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Returns additional members that resulted from the action (e.g. ConversationJoin)
-- and also returns the (possible modified) action that was performed
performAction ::
  forall tag r.
  ( HasConversationActionEffects tag r,
    Member BackendNotificationQueueAccess r,
    Member (Error FederationError) r
  ) =>
  Sing tag ->
  Qualified UserId ->
  Local Conversation ->
  ConversationAction tag ->
  Sem r (BotsAndMembers, ConversationAction tag)
performAction :: forall (tag :: ConversationActionTag) (r :: EffectRow).
(HasConversationActionEffects tag r,
 Member BackendNotificationQueueAccess r,
 Member (Error FederationError) r) =>
Sing tag
-> Qualified UserId
-> Local Conversation
-> ConversationAction tag
-> Sem r (BotsAndMembers, ConversationAction tag)
performAction Sing tag
tag Qualified UserId
origUser Local Conversation
lconv ConversationAction tag
action = do
  let lcnv :: QualifiedWithTag 'QLocal ConvId
lcnv = (Conversation -> ConvId)
-> Local Conversation -> QualifiedWithTag 'QLocal ConvId
forall a b.
(a -> b)
-> QualifiedWithTag 'QLocal a -> QualifiedWithTag 'QLocal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.convId) Local Conversation
lconv
      conv :: Conversation
conv = Local Conversation -> Conversation
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local Conversation
lconv
  case Sing tag
tag of
    Sing tag
SConversationActionTag tag
SConversationJoinTag -> do
      Qualified UserId
-> Local Conversation
-> ConversationJoin
-> Sem r (BotsAndMembers, ConversationJoin)
forall (r :: EffectRow).
(HasConversationActionEffects 'ConversationJoinTag r,
 Member BackendNotificationQueueAccess r) =>
Qualified UserId
-> Local Conversation
-> ConversationJoin
-> Sem r (BotsAndMembers, ConversationJoin)
performConversationJoin Qualified UserId
origUser Local Conversation
lconv ConversationJoin
ConversationAction tag
action
    Sing tag
SConversationActionTag tag
SConversationLeaveTag -> do
      let victims :: [Qualified UserId]
victims = [Qualified UserId
origUser]
      Local Conversation
lconv' <- (Conversation -> Sem r Conversation)
-> Local Conversation -> Sem r (Local Conversation)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> QualifiedWithTag 'QLocal a -> f (QualifiedWithTag 'QLocal b)
traverse (UserList UserId -> Conversation -> Sem r Conversation
forall (r :: EffectRow).
Member MemberStore r =>
UserList UserId -> Conversation -> Sem r Conversation
convDeleteMembers (Local Conversation -> [Qualified UserId] -> UserList UserId
forall (f :: * -> *) x a.
Foldable f =>
Local x -> f (Qualified a) -> UserList a
toUserList Local Conversation
lconv [Qualified UserId]
victims)) Local Conversation
lconv
      -- send remove proposals in the MLS case
      (Qualified UserId -> Sem r ()) -> [Qualified UserId] -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Local Conversation
-> RemoveUserIncludeMain -> Qualified UserId -> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member (Error FederationError) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input Env) r,
 Member (Input UTCTime) r, Member MemberStore r,
 Member ProposalStore r, Member Random r,
 Member SubConversationStore r, Member TinyLog r) =>
Local Conversation
-> RemoveUserIncludeMain -> Qualified UserId -> Sem r ()
removeUser Local Conversation
lconv' RemoveUserIncludeMain
RemoveUserIncludeMain) [Qualified UserId]
victims
      (BotsAndMembers, ()) -> Sem r (BotsAndMembers, ())
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers
forall a. Monoid a => a
mempty, ()
ConversationAction tag
action)
    Sing tag
SConversationActionTag tag
SConversationRemoveMembersTag -> do
      let presentVictims :: [Qualified UserId]
presentVictims = (Qualified UserId -> Bool)
-> [Qualified UserId] -> [Qualified UserId]
forall a. (a -> Bool) -> [a] -> [a]
filter (Local Conversation -> Qualified UserId -> Bool
forall uid mem.
IsConvMemberId uid mem =>
Local Conversation -> uid -> Bool
isConvMemberL Local Conversation
lconv) (NonEmpty (Qualified UserId) -> [Qualified UserId]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (Qualified UserId) -> [Qualified UserId])
-> (ConversationAction tag -> NonEmpty (Qualified UserId))
-> ConversationAction tag
-> [Qualified UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConversationRemoveMembers -> NonEmpty (Qualified UserId)
ConversationAction tag -> NonEmpty (Qualified UserId)
crmTargets (ConversationAction tag -> [Qualified UserId])
-> ConversationAction tag -> [Qualified UserId]
forall a b. (a -> b) -> a -> b
$ ConversationAction tag
action)
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Qualified UserId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Qualified UserId]
presentVictims) Sem r ()
forall (r :: EffectRow) a. Member (Error NoChanges) r => Sem r a
noChanges
      (Conversation -> Sem r Conversation)
-> Local Conversation -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (UserList UserId -> Conversation -> Sem r Conversation
forall (r :: EffectRow).
Member MemberStore r =>
UserList UserId -> Conversation -> Sem r Conversation
convDeleteMembers (Local Conversation -> [Qualified UserId] -> UserList UserId
forall (f :: * -> *) x a.
Foldable f =>
Local x -> f (Qualified a) -> UserList a
toUserList Local Conversation
lconv [Qualified UserId]
presentVictims)) Local Conversation
lconv
      -- send remove proposals in the MLS case
      (Qualified UserId -> Sem r ()) -> [Qualified UserId] -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Local Conversation
-> RemoveUserIncludeMain -> Qualified UserId -> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member (Error FederationError) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input Env) r,
 Member (Input UTCTime) r, Member MemberStore r,
 Member ProposalStore r, Member Random r,
 Member SubConversationStore r, Member TinyLog r) =>
Local Conversation
-> RemoveUserIncludeMain -> Qualified UserId -> Sem r ()
removeUser Local Conversation
lconv RemoveUserIncludeMain
RemoveUserExcludeMain) [Qualified UserId]
presentVictims
      (BotsAndMembers, ConversationRemoveMembers)
-> Sem r (BotsAndMembers, ConversationRemoveMembers)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers
forall a. Monoid a => a
mempty, ConversationRemoveMembers
ConversationAction tag
action) -- FUTUREWORK: should we return the filtered action here?
    Sing tag
SConversationActionTag tag
SConversationMemberUpdateTag -> do
      Sem r (Either LocalMember RemoteMember) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (Either LocalMember RemoteMember) -> Sem r ())
-> Sem r (Either LocalMember RemoteMember) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Local Conversation
-> Qualified UserId
-> Conversation
-> Sem r (Either LocalMember RemoteMember)
forall (r :: EffectRow) a.
Member (ErrorS 'ConvMemberNotFound) r =>
Local a
-> Qualified UserId
-> Conversation
-> Sem r (Either LocalMember RemoteMember)
ensureOtherMember Local Conversation
lconv (ConversationMemberUpdate -> Qualified UserId
cmuTarget ConversationMemberUpdate
ConversationAction tag
action) Conversation
conv
      QualifiedWithTag 'QLocal ConvId
-> Qualified UserId -> OtherMemberUpdate -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
QualifiedWithTag 'QLocal ConvId
-> Qualified UserId -> OtherMemberUpdate -> Sem r ()
E.setOtherMember QualifiedWithTag 'QLocal ConvId
lcnv (ConversationMemberUpdate -> Qualified UserId
cmuTarget ConversationMemberUpdate
ConversationAction tag
action) (ConversationMemberUpdate -> OtherMemberUpdate
cmuUpdate ConversationMemberUpdate
ConversationAction tag
action)
      (BotsAndMembers, ConversationMemberUpdate)
-> Sem r (BotsAndMembers, ConversationMemberUpdate)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers
forall a. Monoid a => a
mempty, ConversationMemberUpdate
ConversationAction tag
action)
    Sing tag
SConversationActionTag tag
SConversationDeleteTag -> do
      let deleteGroup :: GroupId -> Sem r ()
deleteGroup GroupId
groupId = do
            GroupId -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
GroupId -> Sem r ()
E.removeAllMLSClients GroupId
groupId
            GroupId -> Sem r ()
forall (r :: EffectRow).
Member ProposalStore r =>
GroupId -> Sem r ()
E.deleteAllProposals GroupId
groupId

      let cid :: ConvId
cid = Conversation
conv.convId
      Maybe GroupId -> (GroupId -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Conversation
conv Conversation
-> (Conversation -> Maybe (ConversationMLSData, MLSMigrationState))
-> Maybe (ConversationMLSData, MLSMigrationState)
forall a b. a -> (a -> b) -> b
& Conversation -> Maybe (ConversationMLSData, MLSMigrationState)
mlsMetadata Maybe (ConversationMLSData, MLSMigrationState)
-> ((ConversationMLSData, MLSMigrationState) -> GroupId)
-> Maybe GroupId
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ConversationMLSData -> GroupId
cnvmlsGroupId (ConversationMLSData -> GroupId)
-> ((ConversationMLSData, MLSMigrationState)
    -> ConversationMLSData)
-> (ConversationMLSData, MLSMigrationState)
-> GroupId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConversationMLSData, MLSMigrationState) -> ConversationMLSData
forall a b. (a, b) -> a
fst) ((GroupId -> Sem r ()) -> Sem r ())
-> (GroupId -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \GroupId
gidParent -> do
        Map SubConvId ConversationMLSData
sconvs <- ConvId -> Sem r (Map SubConvId ConversationMLSData)
forall (r :: EffectRow).
Member SubConversationStore r =>
ConvId -> Sem r (Map SubConvId ConversationMLSData)
E.listSubConversations ConvId
cid
        [(SubConvId, ConversationMLSData)]
-> ((SubConvId, ConversationMLSData) -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map SubConvId ConversationMLSData
-> [(SubConvId, ConversationMLSData)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map SubConvId ConversationMLSData
sconvs) (((SubConvId, ConversationMLSData) -> Sem r ()) -> Sem r ())
-> ((SubConvId, ConversationMLSData) -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \(SubConvId
subid, ConversationMLSData
mlsData) -> do
          let gidSub :: GroupId
gidSub = ConversationMLSData -> GroupId
cnvmlsGroupId ConversationMLSData
mlsData
          ConvId -> SubConvId -> Sem r ()
forall (r :: EffectRow).
Member SubConversationStore r =>
ConvId -> SubConvId -> Sem r ()
E.deleteSubConversation ConvId
cid SubConvId
subid
          GroupId -> Sem r ()
forall {r :: EffectRow}.
(Member MemberStore r, Member ProposalStore r) =>
GroupId -> Sem r ()
deleteGroup GroupId
gidSub
        GroupId -> Sem r ()
forall {r :: EffectRow}.
(Member MemberStore r, Member ProposalStore r) =>
GroupId -> Sem r ()
deleteGroup GroupId
gidParent

      Key
key <- ConvId -> Sem r Key
forall (r :: EffectRow). Member CodeStore r => ConvId -> Sem r Key
E.makeKey (QualifiedWithTag 'QLocal ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified QualifiedWithTag 'QLocal ConvId
lcnv)
      Key -> Scope -> Sem r ()
forall (r :: EffectRow).
Member CodeStore r =>
Key -> Scope -> Sem r ()
E.deleteCode Key
key Scope
ReusableCode
      case Conversation -> Maybe TeamId
convTeam Conversation
conv of
        Maybe TeamId
Nothing -> ConvId -> Sem r ()
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r ()
E.deleteConversation (QualifiedWithTag 'QLocal ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified QualifiedWithTag 'QLocal ConvId
lcnv)
        Just TeamId
tid -> TeamId -> ConvId -> Sem r ()
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> ConvId -> Sem r ()
E.deleteTeamConversation TeamId
tid (QualifiedWithTag 'QLocal ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified QualifiedWithTag 'QLocal ConvId
lcnv)

      (BotsAndMembers, ()) -> Sem r (BotsAndMembers, ())
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers
forall a. Monoid a => a
mempty, ()
ConversationAction tag
action)
    Sing tag
SConversationActionTag tag
SConversationRenameTag -> do
      Maybe TeamMember
zusrMembership <- Maybe (Maybe TeamMember) -> Maybe TeamMember
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe TeamMember) -> Maybe TeamMember)
-> Sem r (Maybe (Maybe TeamMember)) -> Sem r (Maybe TeamMember)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TeamId
-> (TeamId -> Sem r (Maybe TeamMember))
-> Sem r (Maybe (Maybe TeamMember))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (ConversationMetadata -> Maybe TeamId
cnvmTeam (Conversation -> ConversationMetadata
convMetadata Conversation
conv)) ((TeamId -> UserId -> Sem r (Maybe TeamMember))
-> UserId -> TeamId -> Sem r (Maybe TeamMember)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember (Qualified UserId -> UserId
forall a. Qualified a -> a
qUnqualified Qualified UserId
origUser))
      Maybe TeamMember -> (TeamMember -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe TeamMember
zusrMembership ((TeamMember -> Sem r ()) -> Sem r ())
-> (TeamMember -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \TeamMember
tm -> Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TeamMember
tm TeamMember -> Perm -> Bool
forall perm. IsPerm perm => TeamMember -> perm -> Bool
`hasPermission` Perm
ModifyConvName) (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
      Range 1 256 Text
cn <- Text -> Sem r (Range 1 256 Text)
forall (n :: Nat) (m :: Nat) (r :: EffectRow) a.
(KnownNat n, KnownNat m, Member (Error InvalidInput) r,
 Within a n m) =>
a -> Sem r (Range n m a)
rangeChecked (ConversationRename -> Text
cupName ConversationRename
ConversationAction tag
action)
      ConvId -> Range 1 256 Text -> Sem r ()
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Range 1 256 Text -> Sem r ()
E.setConversationName (QualifiedWithTag 'QLocal ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified QualifiedWithTag 'QLocal ConvId
lcnv) Range 1 256 Text
cn
      (BotsAndMembers, ConversationRename)
-> Sem r (BotsAndMembers, ConversationRename)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers
forall a. Monoid a => a
mempty, ConversationRename
ConversationAction tag
action)
    Sing tag
SConversationActionTag tag
SConversationMessageTimerUpdateTag -> do
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Conversation -> Maybe Milliseconds
Data.convMessageTimer Conversation
conv Maybe Milliseconds -> Maybe Milliseconds -> Bool
forall a. Eq a => a -> a -> Bool
== ConversationMessageTimerUpdate -> Maybe Milliseconds
cupMessageTimer ConversationMessageTimerUpdate
ConversationAction tag
action) Sem r ()
forall (r :: EffectRow) a. Member (Error NoChanges) r => Sem r a
noChanges
      ConvId -> Maybe Milliseconds -> Sem r ()
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Maybe Milliseconds -> Sem r ()
E.setConversationMessageTimer (QualifiedWithTag 'QLocal ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified QualifiedWithTag 'QLocal ConvId
lcnv) (ConversationMessageTimerUpdate -> Maybe Milliseconds
cupMessageTimer ConversationMessageTimerUpdate
ConversationAction tag
action)
      (BotsAndMembers, ConversationMessageTimerUpdate)
-> Sem r (BotsAndMembers, ConversationMessageTimerUpdate)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers
forall a. Monoid a => a
mempty, ConversationMessageTimerUpdate
ConversationAction tag
action)
    Sing tag
SConversationActionTag tag
SConversationReceiptModeUpdateTag -> do
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Conversation -> Maybe ReceiptMode
Data.convReceiptMode Conversation
conv Maybe ReceiptMode -> Maybe ReceiptMode -> Bool
forall a. Eq a => a -> a -> Bool
== ReceiptMode -> Maybe ReceiptMode
forall a. a -> Maybe a
Just (ConversationReceiptModeUpdate -> ReceiptMode
cruReceiptMode ConversationReceiptModeUpdate
ConversationAction tag
action)) Sem r ()
forall (r :: EffectRow) a. Member (Error NoChanges) r => Sem r a
noChanges
      ConvId -> ReceiptMode -> Sem r ()
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> ReceiptMode -> Sem r ()
E.setConversationReceiptMode (QualifiedWithTag 'QLocal ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified QualifiedWithTag 'QLocal ConvId
lcnv) (ConversationReceiptModeUpdate -> ReceiptMode
cruReceiptMode ConversationReceiptModeUpdate
ConversationAction tag
action)
      (BotsAndMembers, ConversationReceiptModeUpdate)
-> Sem r (BotsAndMembers, ConversationReceiptModeUpdate)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers
forall a. Monoid a => a
mempty, ConversationReceiptModeUpdate
ConversationAction tag
action)
    Sing tag
SConversationActionTag tag
SConversationAccessDataTag -> do
      (BotsAndMembers
bm, ConversationAccessData
act) <- Qualified UserId
-> Local Conversation
-> ConversationAccessData
-> Sem r (BotsAndMembers, ConversationAccessData)
forall (r :: EffectRow).
(HasConversationActionEffects 'ConversationAccessDataTag r,
 Member (Error FederationError) r,
 Member BackendNotificationQueueAccess r) =>
Qualified UserId
-> Local Conversation
-> ConversationAccessData
-> Sem r (BotsAndMembers, ConversationAccessData)
performConversationAccessData Qualified UserId
origUser Local Conversation
lconv ConversationAccessData
ConversationAction tag
action
      (BotsAndMembers, ConversationAccessData)
-> Sem r (BotsAndMembers, ConversationAccessData)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers
bm, ConversationAccessData
act)
    Sing tag
SConversationActionTag tag
SConversationUpdateProtocolTag -> do
      case (Protocol -> ProtocolTag
protocolTag (Conversation -> Protocol
convProtocol (Local Conversation -> Conversation
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local Conversation
lconv)), ProtocolTag
ConversationAction tag
action, Conversation -> Maybe TeamId
convTeam (Local Conversation -> Conversation
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local Conversation
lconv)) of
        (ProtocolTag
ProtocolProteusTag, ProtocolTag
ProtocolMixedTag, Just TeamId
_) -> do
          QualifiedWithTag 'QLocal ConvId -> ConvType -> Sem r ()
forall (r :: EffectRow).
Member ConversationStore r =>
QualifiedWithTag 'QLocal ConvId -> ConvType -> Sem r ()
E.updateToMixedProtocol QualifiedWithTag 'QLocal ConvId
lcnv (Conversation -> ConvType
convType (Local Conversation -> Conversation
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local Conversation
lconv))
          (BotsAndMembers, ProtocolTag)
-> Sem r (BotsAndMembers, ProtocolTag)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers
forall a. Monoid a => a
mempty, ProtocolTag
ConversationAction tag
action)
        (ProtocolTag
ProtocolMixedTag, ProtocolTag
ProtocolMLSTag, Just TeamId
tid) -> do
          LockableFeature MlsMigrationConfig
mig <- forall cfg (r :: EffectRow).
(GetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
 Member (Input Opts) r, Member TeamFeatureStore r) =>
TeamId -> Sem r (LockableFeature cfg)
getFeatureForTeam @MlsMigrationConfig TeamId
tid
          UTCTime
now <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
          MLSConversation
mlsConv <- Conversation -> Sem r (Maybe MLSConversation)
forall (r :: EffectRow).
Member MemberStore r =>
Conversation -> Sem r (Maybe MLSConversation)
mkMLSConversation Conversation
conv Sem r (Maybe MLSConversation)
-> (Maybe MLSConversation -> Sem r MLSConversation)
-> Sem r MLSConversation
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 @'ConvInvalidProtocolTransition
          Bool
ok <- UTCTime
-> MLSConversation
-> LockableFeature MlsMigrationConfig
-> Sem r Bool
forall (r :: EffectRow).
(Member BrigAccess r, Member FederatorAccess r) =>
UTCTime
-> MLSConversation
-> LockableFeature MlsMigrationConfig
-> Sem r Bool
checkMigrationCriteria UTCTime
now MLSConversation
mlsConv LockableFeature MlsMigrationConfig
mig
          Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok (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 @'MLSMigrationCriteriaNotSatisfied
          Qualified UserId -> Local Conversation -> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member (Error FederationError) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input Env) r,
 Member (Input UTCTime) r, Member MemberStore r,
 Member ProposalStore r, Member Random r,
 Member SubConversationStore r, Member TinyLog r) =>
Qualified UserId -> Local Conversation -> Sem r ()
removeExtraneousClients Qualified UserId
origUser Local Conversation
lconv
          QualifiedWithTag 'QLocal ConvId -> Sem r ()
forall (r :: EffectRow).
Member ConversationStore r =>
QualifiedWithTag 'QLocal ConvId -> Sem r ()
E.updateToMLSProtocol QualifiedWithTag 'QLocal ConvId
lcnv
          (BotsAndMembers, ProtocolTag)
-> Sem r (BotsAndMembers, ProtocolTag)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers
forall a. Monoid a => a
mempty, ProtocolTag
ConversationAction tag
action)
        (ProtocolTag
ProtocolProteusTag, ProtocolTag
ProtocolProteusTag, Maybe TeamId
_) ->
          Sem r (BotsAndMembers, ProtocolTag)
Sem r (BotsAndMembers, ConversationAction tag)
forall (r :: EffectRow) a. Member (Error NoChanges) r => Sem r a
noChanges
        (ProtocolTag
ProtocolMixedTag, ProtocolTag
ProtocolMixedTag, Maybe TeamId
_) ->
          Sem r (BotsAndMembers, ProtocolTag)
Sem r (BotsAndMembers, ConversationAction tag)
forall (r :: EffectRow) a. Member (Error NoChanges) r => Sem r a
noChanges
        (ProtocolTag
ProtocolMLSTag, ProtocolTag
ProtocolMLSTag, Maybe TeamId
_) ->
          Sem r (BotsAndMembers, ProtocolTag)
Sem r (BotsAndMembers, ConversationAction tag)
forall (r :: EffectRow) a. Member (Error NoChanges) r => Sem r a
noChanges
        (ProtocolTag
_, ProtocolTag
_, Maybe TeamId
_) -> 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 @'ConvInvalidProtocolTransition

performConversationJoin ::
  forall r.
  ( HasConversationActionEffects 'ConversationJoinTag r,
    Member BackendNotificationQueueAccess r
  ) =>
  Qualified UserId ->
  Local Conversation ->
  ConversationJoin ->
  Sem r (BotsAndMembers, ConversationJoin)
performConversationJoin :: forall (r :: EffectRow).
(HasConversationActionEffects 'ConversationJoinTag r,
 Member BackendNotificationQueueAccess r) =>
Qualified UserId
-> Local Conversation
-> ConversationJoin
-> Sem r (BotsAndMembers, ConversationJoin)
performConversationJoin Qualified UserId
qusr Local Conversation
lconv (ConversationJoin NonEmpty (Qualified UserId)
invited RoleName
role) = do
  let newMembers :: UserList UserId
newMembers = Local Conversation
-> Conversation -> UserList UserId -> UserList UserId
forall x.
Local x -> Conversation -> UserList UserId -> UserList UserId
ulNewMembers Local Conversation
lconv Conversation
conv (UserList UserId -> UserList UserId)
-> (NonEmpty (Qualified UserId) -> UserList UserId)
-> NonEmpty (Qualified UserId)
-> UserList UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local Conversation
-> NonEmpty (Qualified UserId) -> UserList UserId
forall (f :: * -> *) x a.
Foldable f =>
Local x -> f (Qualified a) -> UserList a
toUserList Local Conversation
lconv (NonEmpty (Qualified UserId) -> UserList UserId)
-> NonEmpty (Qualified UserId) -> UserList UserId
forall a b. (a -> b) -> a -> b
$ NonEmpty (Qualified UserId)
invited

  Local UserId
lusr <- Local Conversation -> Qualified UserId -> Sem r (Local UserId)
forall (r :: EffectRow) x a.
Member (Error FederationError) r =>
Local x -> Qualified a -> Sem r (Local a)
ensureLocal Local Conversation
lconv Qualified UserId
qusr
  ProtocolTag -> [LocalMember] -> UserList 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
convProtocolTag Conversation
conv) ([LocalMember] -> [LocalMember]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Conversation -> [LocalMember]
convLocalMembers Conversation
conv)) UserList UserId
newMembers
  Conversation -> Access -> Sem r ()
forall (r :: EffectRow).
Member (ErrorS 'ConvAccessDenied) r =>
Conversation -> Access -> Sem r ()
ensureAccess Conversation
conv Access
InviteAccess
  Local UserId -> Maybe TeamId -> [UserId] -> Sem r ()
checkLocals Local UserId
lusr (Conversation -> Maybe TeamId
convTeam Conversation
conv) (UserList UserId -> [UserId]
forall a. UserList a -> [a]
ulLocals UserList UserId
newMembers)
  Local UserId -> [Remote UserId] -> Sem r ()
checkRemotes Local UserId
lusr (UserList UserId -> [Remote UserId]
forall a. UserList a -> [Remote a]
ulRemotes UserList UserId
newMembers)
  [UserId] -> Sem r ()
checkLHPolicyConflictsLocal (UserList UserId -> [UserId]
forall a. UserList a -> [a]
ulLocals UserList UserId
newMembers)
  FutureWork 'LegalholdPlusFederationNotImplemented [Remote UserId]
-> Sem r ()
checkLHPolicyConflictsRemote ([Remote UserId]
-> FutureWork
     'LegalholdPlusFederationNotImplemented [Remote UserId]
forall {k} (label :: k) payload.
payload -> FutureWork label payload
FutureWork (UserList UserId -> [Remote UserId]
forall a. UserList a -> [Remote a]
ulRemotes UserList UserId
newMembers))
  Local UserId -> Sem r ()
forall x. Local x -> Sem r ()
checkRemoteBackendsConnected Local UserId
lusr
  Local UserId -> Sem r ()
checkTeamMemberAddPermissions Local UserId
lusr
  QualifiedWithTag 'QLocal ConvId
-> UserList UserId
-> RoleName
-> Sem r (BotsAndMembers, ConversationJoin)
forall (r :: EffectRow).
(Member MemberStore r, Member (Error NoChanges) r) =>
QualifiedWithTag 'QLocal ConvId
-> UserList UserId
-> RoleName
-> Sem r (BotsAndMembers, ConversationJoin)
addMembersToLocalConversation ((Conversation -> ConvId)
-> Local Conversation -> QualifiedWithTag 'QLocal ConvId
forall a b.
(a -> b)
-> QualifiedWithTag 'QLocal a -> QualifiedWithTag 'QLocal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.convId) Local Conversation
lconv) UserList UserId
newMembers RoleName
role
  where
    checkRemoteBackendsConnected :: Local x -> Sem r ()
    checkRemoteBackendsConnected :: forall x. Local x -> Sem r ()
checkRemoteBackendsConnected Local x
loc = do
      let invitedRemoteUsers :: [Remote UserId]
invitedRemoteUsers = ([UserId], [Remote UserId]) -> [Remote UserId]
forall a b. (a, b) -> b
snd (([UserId], [Remote UserId]) -> [Remote UserId])
-> (NonEmpty (Qualified UserId) -> ([UserId], [Remote UserId]))
-> NonEmpty (Qualified UserId)
-> [Remote UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local x -> [Qualified UserId] -> ([UserId], [Remote UserId])
forall (f :: * -> *) x a.
Foldable f =>
Local x -> f (Qualified a) -> ([a], [Remote a])
partitionQualified Local x
loc ([Qualified UserId] -> ([UserId], [Remote UserId]))
-> (NonEmpty (Qualified UserId) -> [Qualified UserId])
-> NonEmpty (Qualified UserId)
-> ([UserId], [Remote UserId])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Qualified UserId) -> [Qualified UserId]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (Qualified UserId) -> [Remote UserId])
-> NonEmpty (Qualified UserId) -> [Remote UserId]
forall a b. (a -> b) -> a -> b
$ NonEmpty (Qualified UserId)
invited
          invitedRemoteDomains :: Set (Remote ())
invitedRemoteDomains = [Remote ()] -> Set (Remote ())
forall a. Ord a => [a] -> Set a
Set.fromList ([Remote ()] -> Set (Remote ())) -> [Remote ()] -> Set (Remote ())
forall a b. (a -> b) -> a -> b
$ Remote UserId -> Remote ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Remote UserId -> Remote ()) -> [Remote UserId] -> [Remote ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Remote UserId]
invitedRemoteUsers
          existingRemoteDomains :: Set (Remote ())
existingRemoteDomains = [Remote ()] -> Set (Remote ())
forall a. Ord a => [a] -> Set a
Set.fromList ([Remote ()] -> Set (Remote ())) -> [Remote ()] -> Set (Remote ())
forall a b. (a -> b) -> a -> b
$ Remote UserId -> Remote ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Remote UserId -> Remote ())
-> (RemoteMember -> Remote UserId) -> RemoteMember -> Remote ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteMember -> Remote UserId
rmId (RemoteMember -> Remote ()) -> [RemoteMember] -> [Remote ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Conversation -> [RemoteMember]
convRemoteMembers (Local Conversation -> Conversation
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local Conversation
lconv)
          allInvitedAlreadyInConversation :: Bool
allInvitedAlreadyInConversation = Set (Remote ()) -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set (Remote ()) -> Bool) -> Set (Remote ()) -> Bool
forall a b. (a -> b) -> a -> b
$ Set (Remote ())
invitedRemoteDomains Set (Remote ()) -> Set (Remote ()) -> Set (Remote ())
forall a. Ord a => Set a -> Set a -> Set a
\\ Set (Remote ())
existingRemoteDomains

      if Bool -> Bool
not Bool
allInvitedAlreadyInConversation
        then RemoteDomains -> Sem r ()
forall (r :: EffectRow).
(Member (Error UnreachableBackends) r,
 Member (Error NonFederatingBackends) r,
 Member FederatorAccess r) =>
RemoteDomains -> Sem r ()
checkFederationStatus (Set (Remote ()) -> RemoteDomains
RemoteDomains (Set (Remote ())
invitedRemoteDomains Set (Remote ()) -> Set (Remote ()) -> Set (Remote ())
forall a. Semigroup a => a -> a -> a
<> Set (Remote ())
existingRemoteDomains))
        else -- even if there are no new remotes, we still need to check they are reachable
        Sem r [Remote ()] -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r [Remote ()] -> Sem r ())
-> (Sem r [Either (Remote [UserId], FederationError) (Remote ())]
    -> Sem r [Remote ()])
-> Sem r [Either (Remote [UserId], FederationError) (Remote ())]
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Either (Remote [UserId], FederationError) (Remote ())]
-> Sem r [Remote ()]
forall (r :: EffectRow) e b a.
Member (Error UnreachableBackends) r =>
[Either (Remote e, b) a] -> Sem r [a]
ensureNoUnreachableBackends =<<) (Sem r [Either (Remote [UserId], FederationError) (Remote ())]
 -> Sem r ())
-> Sem r [Either (Remote [UserId], FederationError) (Remote ())]
-> Sem r ()
forall a b. (a -> b) -> a -> b
$
          forall (r :: EffectRow) (c :: Component) (f :: * -> *) x a.
(Member FederatorAccess r, KnownComponent c, Foldable f,
 Functor f) =>
f (Remote x)
-> (Remote [x] -> FederatorClient c a)
-> Sem r [Either (Remote [x], FederationError) (Remote a)]
E.runFederatedConcurrentlyEither @_ @'Brig [Remote UserId]
invitedRemoteUsers ((Remote [UserId] -> FederatorClient 'Brig ())
 -> Sem r [Either (Remote [UserId], FederationError) (Remote ())])
-> (Remote [UserId] -> FederatorClient 'Brig ())
-> Sem r [Either (Remote [UserId], FederationError) (Remote ())]
forall a b. (a -> b) -> a -> b
$ \Remote [UserId]
_ ->
            () -> FederatorClient 'Brig ()
forall a. a -> FederatorClient 'Brig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    conv :: Data.Conversation
    conv :: Conversation
conv = Local Conversation -> Conversation
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local Conversation
lconv

    checkLocals ::
      Local UserId ->
      Maybe TeamId ->
      [UserId] ->
      Sem r ()
    checkLocals :: Local UserId -> Maybe TeamId -> [UserId] -> Sem r ()
checkLocals Local UserId
lusr (Just TeamId
tid) [UserId]
newUsers = do
      Map UserId TeamMember
tms <-
        [(UserId, TeamMember)] -> Map UserId TeamMember
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(UserId, TeamMember)] -> Map UserId TeamMember)
-> ([TeamMember] -> [(UserId, TeamMember)])
-> [TeamMember]
-> Map UserId TeamMember
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TeamMember -> (UserId, TeamMember))
-> [TeamMember] -> [(UserId, TeamMember)]
forall a b. (a -> b) -> [a] -> [b]
map (Getting UserId TeamMember UserId -> TeamMember -> UserId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserId TeamMember UserId
Lens' TeamMember UserId
Wire.API.Team.Member.userId (TeamMember -> UserId)
-> (TeamMember -> TeamMember) -> TeamMember -> (UserId, TeamMember)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& TeamMember -> TeamMember
forall a. a -> a
Imports.id)
          ([TeamMember] -> Map UserId TeamMember)
-> Sem r [TeamMember] -> Sem r (Map UserId TeamMember)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> [UserId] -> Sem r [TeamMember]
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> [UserId] -> Sem r [TeamMember]
E.selectTeamMembers TeamId
tid [UserId]
newUsers
      let userMembershipMap :: [(UserId, Maybe TeamMember)]
userMembershipMap = (UserId -> (UserId, Maybe TeamMember))
-> [UserId] -> [(UserId, Maybe TeamMember)]
forall a b. (a -> b) -> [a] -> [b]
map (UserId -> UserId
forall a. a -> a
Imports.id (UserId -> UserId)
-> (UserId -> Maybe TeamMember)
-> UserId
-> (UserId, Maybe TeamMember)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (UserId -> Map UserId TeamMember -> Maybe TeamMember)
-> Map UserId TeamMember -> UserId -> Maybe TeamMember
forall a b c. (a -> b -> c) -> b -> a -> c
flip UserId -> Map UserId TeamMember -> Maybe TeamMember
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map UserId TeamMember
tms) [UserId]
newUsers
      Set AccessRole -> [(UserId, Maybe TeamMember)] -> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS 'ConvAccessDenied) r) =>
Set AccessRole -> [(UserId, Maybe TeamMember)] -> Sem r ()
ensureAccessRole (Conversation -> Set AccessRole
convAccessRoles Conversation
conv) [(UserId, Maybe TeamMember)]
userMembershipMap
      Local UserId -> [UserId] -> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'NotConnected) r,
 Member TeamStore r) =>
Local UserId -> [UserId] -> Sem r ()
ensureConnectedToLocalsOrSameTeam Local UserId
lusr [UserId]
newUsers
    checkLocals Local UserId
lusr Maybe TeamId
Nothing [UserId]
newUsers = do
      Set AccessRole -> [(UserId, Maybe TeamMember)] -> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS 'ConvAccessDenied) r) =>
Set AccessRole -> [(UserId, Maybe TeamMember)] -> Sem r ()
ensureAccessRole (Conversation -> Set AccessRole
convAccessRoles Conversation
conv) ((UserId -> (UserId, Maybe TeamMember))
-> [UserId] -> [(UserId, Maybe TeamMember)]
forall a b. (a -> b) -> [a] -> [b]
map (,Maybe TeamMember
forall a. Maybe a
Nothing) [UserId]
newUsers)
      Local UserId -> [UserId] -> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'NotConnected) r,
 Member TeamStore r) =>
Local UserId -> [UserId] -> Sem r ()
ensureConnectedToLocalsOrSameTeam Local UserId
lusr [UserId]
newUsers

    checkRemotes ::
      Local UserId ->
      [Remote UserId] ->
      Sem r ()
    checkRemotes :: Local UserId -> [Remote UserId] -> Sem r ()
checkRemotes Local UserId
lusr [Remote UserId]
remotes = do
      -- if federator is not configured, we fail early, so we avoid adding
      -- remote members to the database
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Remote UserId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Remote UserId]
remotes) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
        Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM Sem r Bool
forall (r :: EffectRow). Member FederatorAccess r => Sem r Bool
E.isFederationConfigured (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
          FederationError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw FederationError
FederationNotConfigured
      Local UserId -> [Remote UserId] -> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'NotConnected) r) =>
Local UserId -> [Remote UserId] -> Sem r ()
ensureConnectedToRemotes Local UserId
lusr [Remote UserId]
remotes

    checkLHPolicyConflictsLocal ::
      [UserId] ->
      Sem r ()
    checkLHPolicyConflictsLocal :: [UserId] -> Sem r ()
checkLHPolicyConflictsLocal [UserId]
newUsers = do
      let convUsers :: [LocalMember]
convUsers = Conversation -> [LocalMember]
convLocalMembers Conversation
conv

      Bool
allNewUsersGaveConsent <- [UserId] -> Sem r Bool
forall (r :: EffectRow).
(Member (Input Opts) r, Member LegalHoldStore r,
 Member TeamStore r) =>
[UserId] -> Sem r Bool
allLegalholdConsentGiven [UserId]
newUsers

      Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ([UserId] -> Sem r Bool
forall (r :: EffectRow).
(Member (Input Opts) r, Member TeamStore r) =>
[UserId] -> Sem r Bool
anyLegalholdActivated (LocalMember -> UserId
lmId (LocalMember -> UserId) -> [LocalMember] -> [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocalMember]
convUsers)) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
        Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allNewUsersGaveConsent (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 @'MissingLegalholdConsent

      Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ([UserId] -> Sem r Bool
forall (r :: EffectRow).
(Member (Input Opts) r, Member TeamStore r) =>
[UserId] -> Sem r Bool
anyLegalholdActivated [UserId]
newUsers) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
        Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allNewUsersGaveConsent (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 @'MissingLegalholdConsent

        [(LocalMember, UserLegalHoldStatus)]
convUsersLHStatus <- do
          [(UserId, UserLegalHoldStatus)]
uidsStatus <- [UserId] -> Sem r [(UserId, UserLegalHoldStatus)]
forall (r :: EffectRow).
Member TeamStore r =>
[UserId] -> Sem r [(UserId, UserLegalHoldStatus)]
getLHStatusForUsers (LocalMember -> UserId
lmId (LocalMember -> UserId) -> [LocalMember] -> [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocalMember]
convUsers)
          [(LocalMember, UserLegalHoldStatus)]
-> Sem r [(LocalMember, UserLegalHoldStatus)]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(LocalMember, UserLegalHoldStatus)]
 -> Sem r [(LocalMember, UserLegalHoldStatus)])
-> [(LocalMember, UserLegalHoldStatus)]
-> Sem r [(LocalMember, UserLegalHoldStatus)]
forall a b. (a -> b) -> a -> b
$ (LocalMember
 -> (UserId, UserLegalHoldStatus)
 -> (LocalMember, UserLegalHoldStatus))
-> [LocalMember]
-> [(UserId, UserLegalHoldStatus)]
-> [(LocalMember, UserLegalHoldStatus)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\LocalMember
mem (UserId
_, UserLegalHoldStatus
status) -> (LocalMember
mem, UserLegalHoldStatus
status)) [LocalMember]
convUsers [(UserId, UserLegalHoldStatus)]
uidsStatus

        if ((LocalMember, UserLegalHoldStatus) -> Bool)
-> [(LocalMember, UserLegalHoldStatus)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
          ( \(LocalMember
mem, UserLegalHoldStatus
status) ->
              LocalMember -> RoleName
lmConvRoleName LocalMember
mem RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
roleNameWireAdmin
                Bool -> Bool -> Bool
&& UserLegalHoldStatus -> ConsentGiven
consentGiven UserLegalHoldStatus
status ConsentGiven -> ConsentGiven -> Bool
forall a. Eq a => a -> a -> Bool
== ConsentGiven
ConsentGiven
          )
          [(LocalMember, UserLegalHoldStatus)]
convUsersLHStatus
          then do
            [(LocalMember, UserLegalHoldStatus)]
-> ((LocalMember, UserLegalHoldStatus) -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(LocalMember, UserLegalHoldStatus)]
convUsersLHStatus (((LocalMember, UserLegalHoldStatus) -> Sem r ()) -> Sem r ())
-> ((LocalMember, UserLegalHoldStatus) -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \(LocalMember
mem, UserLegalHoldStatus
status) ->
              Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UserLegalHoldStatus -> ConsentGiven
consentGiven UserLegalHoldStatus
status ConsentGiven -> ConsentGiven -> Bool
forall a. Eq a => a -> a -> Bool
== ConsentGiven
ConsentNotGiven) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
                Qualified UserId
-> Local Conversation
-> BotsAndMembers
-> Qualified UserId
-> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member (Error FederationError) r, Member (Error InternalError) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member NotificationSubsystem r, Member ProposalStore r,
 Member (Input UTCTime) r, Member (Input Env) r,
 Member MemberStore r, Member SubConversationStore r,
 Member TinyLog r, Member Random r) =>
Qualified UserId
-> Local Conversation
-> BotsAndMembers
-> Qualified UserId
-> Sem r ()
kickMember
                  Qualified UserId
qusr
                  Local Conversation
lconv
                  (Conversation -> BotsAndMembers
convBotsAndMembers (Local Conversation -> Conversation
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local Conversation
lconv))
                  (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (Local Conversation -> UserId -> Local UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local Conversation
lconv (LocalMember -> UserId
lmId LocalMember
mem)))
          else forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'MissingLegalholdConsent

    checkLHPolicyConflictsRemote ::
      FutureWork 'LegalholdPlusFederationNotImplemented [Remote UserId] ->
      Sem r ()
    checkLHPolicyConflictsRemote :: FutureWork 'LegalholdPlusFederationNotImplemented [Remote UserId]
-> Sem r ()
checkLHPolicyConflictsRemote FutureWork 'LegalholdPlusFederationNotImplemented [Remote UserId]
_remotes = () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    checkTeamMemberAddPermissions :: Local UserId -> Sem r ()
    checkTeamMemberAddPermissions :: Local UserId -> Sem r ()
checkTeamMemberAddPermissions Local UserId
lusr =
      Maybe TeamId
-> (TeamId -> Sem r (Maybe TeamMember))
-> Sem r (Maybe (Maybe TeamMember))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (ConversationMetadata -> Maybe TeamId
cnvmTeam (Conversation -> ConversationMetadata
convMetadata Conversation
conv)) ((TeamId -> UserId -> Sem r (Maybe TeamMember))
-> UserId -> TeamId -> Sem r (Maybe TeamMember)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr))
        Sem r (Maybe (Maybe TeamMember))
-> (Maybe (Maybe TeamMember) -> Sem r ()) -> Sem r ()
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Sem r ()
-> (TeamMember -> Sem r ()) -> Maybe TeamMember -> Sem r ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (\TeamMember
tm -> Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TeamMember
tm TeamMember -> Perm -> Bool
forall perm. IsPerm perm => TeamMember -> perm -> Bool
`hasPermission` Perm
AddRemoveConvMember) (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))
          (Maybe TeamMember -> Sem r ())
-> (Maybe (Maybe TeamMember) -> Maybe TeamMember)
-> Maybe (Maybe TeamMember)
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe TeamMember) -> Maybe TeamMember
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join

performConversationAccessData ::
  ( HasConversationActionEffects 'ConversationAccessDataTag r,
    Member (Error FederationError) r,
    Member BackendNotificationQueueAccess r
  ) =>
  Qualified UserId ->
  Local Conversation ->
  ConversationAccessData ->
  Sem r (BotsAndMembers, ConversationAccessData)
performConversationAccessData :: forall (r :: EffectRow).
(HasConversationActionEffects 'ConversationAccessDataTag r,
 Member (Error FederationError) r,
 Member BackendNotificationQueueAccess r) =>
Qualified UserId
-> Local Conversation
-> ConversationAccessData
-> Sem r (BotsAndMembers, ConversationAccessData)
performConversationAccessData Qualified UserId
qusr Local Conversation
lconv ConversationAccessData
action = do
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Conversation -> ConversationAccessData
convAccessData Conversation
conv ConversationAccessData -> ConversationAccessData -> Bool
forall a. Eq a => a -> a -> Bool
== ConversationAccessData
action) Sem r ()
forall (r :: EffectRow) a. Member (Error NoChanges) r => Sem r a
noChanges
  -- Remove conversation codes if CodeAccess is revoked
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    ( Access
CodeAccess Access -> [Access] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Conversation -> [Access]
convAccess Conversation
conv
        Bool -> Bool -> Bool
&& Access
CodeAccess Access -> Set Access -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ConversationAccessData -> Set Access
cupAccess ConversationAccessData
action
    )
    (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
      Key
key <- ConvId -> Sem r Key
forall (r :: EffectRow). Member CodeStore r => ConvId -> Sem r Key
E.makeKey (QualifiedWithTag 'QLocal ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified QualifiedWithTag 'QLocal ConvId
lcnv)
      Key -> Scope -> Sem r ()
forall (r :: EffectRow).
Member CodeStore r =>
Key -> Scope -> Sem r ()
E.deleteCode Key
key Scope
ReusableCode

  -- Determine bots and members to be removed
  let filterBotsAndMembers :: BotsAndMembers -> Sem r BotsAndMembers
filterBotsAndMembers =
        BotsAndMembers -> Sem r BotsAndMembers
forall (r :: EffectRow). BotsAndMembers -> Sem r BotsAndMembers
maybeRemoveBots (BotsAndMembers -> Sem r BotsAndMembers)
-> (BotsAndMembers -> Sem r BotsAndMembers)
-> BotsAndMembers
-> Sem r BotsAndMembers
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> BotsAndMembers -> Sem r BotsAndMembers
forall (r :: EffectRow).
Member BrigAccess r =>
BotsAndMembers -> Sem r BotsAndMembers
maybeRemoveGuests (BotsAndMembers -> Sem r BotsAndMembers)
-> (BotsAndMembers -> Sem r BotsAndMembers)
-> BotsAndMembers
-> Sem r BotsAndMembers
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> BotsAndMembers -> Sem r BotsAndMembers
forall (r :: EffectRow).
Member TeamStore r =>
BotsAndMembers -> Sem r BotsAndMembers
maybeRemoveNonTeamMembers (BotsAndMembers -> Sem r BotsAndMembers)
-> (BotsAndMembers -> Sem r BotsAndMembers)
-> BotsAndMembers
-> Sem r BotsAndMembers
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> BotsAndMembers -> Sem r BotsAndMembers
forall (r :: EffectRow).
Member TeamStore r =>
BotsAndMembers -> Sem r BotsAndMembers
maybeRemoveTeamMembers
  let current :: BotsAndMembers
current = Conversation -> BotsAndMembers
convBotsAndMembers Conversation
conv -- initial bots and members
  BotsAndMembers
desired <- BotsAndMembers -> Sem r BotsAndMembers
filterBotsAndMembers BotsAndMembers
current -- desired bots and members
  let toRemove :: BotsAndMembers
toRemove = BotsAndMembers -> BotsAndMembers -> BotsAndMembers
bmDiff BotsAndMembers
current BotsAndMembers
desired -- bots and members to be removed

  -- Update Cassandra
  ConvId -> ConversationAccessData -> Sem r ()
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> ConversationAccessData -> Sem r ()
E.setConversationAccess (QualifiedWithTag 'QLocal ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified QualifiedWithTag 'QLocal ConvId
lcnv) ConversationAccessData
action
  Sem r () -> Sem r ()
forall (r :: EffectRow).
Member FireAndForget r =>
Sem r () -> Sem r ()
E.fireAndForget (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
    -- Remove bots
    (BotMember -> Sem r ()) -> Set BotMember -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ConvId -> BotId -> Sem r ()
forall (r :: EffectRow).
Member BotAccess r =>
ConvId -> BotId -> Sem r ()
E.deleteBot (QualifiedWithTag 'QLocal ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified QualifiedWithTag 'QLocal ConvId
lcnv) (BotId -> Sem r ())
-> (BotMember -> BotId) -> BotMember -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotMember -> BotId
botMemId) (BotsAndMembers -> Set BotMember
bmBots BotsAndMembers
toRemove)

    -- Update current bots and members
    -- current bots and members but only desired bots
    let bmToNotify :: BotsAndMembers
bmToNotify = BotsAndMembers
current {bmBots = bmBots desired}

    -- Remove users and notify everyone
    [Qualified UserId] -> (Qualified UserId -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (QualifiedWithTag 'QLocal ConvId
-> BotsAndMembers -> [Qualified UserId]
forall x. Local x -> BotsAndMembers -> [Qualified UserId]
bmQualifiedMembers QualifiedWithTag 'QLocal ConvId
lcnv BotsAndMembers
toRemove) ((Qualified UserId -> Sem r ()) -> Sem r ())
-> (Qualified UserId -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
      Qualified UserId
-> Local Conversation
-> BotsAndMembers
-> Qualified UserId
-> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member (Error FederationError) r, Member (Error InternalError) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member NotificationSubsystem r, Member ProposalStore r,
 Member (Input UTCTime) r, Member (Input Env) r,
 Member MemberStore r, Member SubConversationStore r,
 Member TinyLog r, Member Random r) =>
Qualified UserId
-> Local Conversation
-> BotsAndMembers
-> Qualified UserId
-> Sem r ()
kickMember Qualified UserId
qusr Local Conversation
lconv BotsAndMembers
bmToNotify

  (BotsAndMembers, ConversationAccessData)
-> Sem r (BotsAndMembers, ConversationAccessData)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers
forall a. Monoid a => a
mempty, ConversationAccessData
action)
  where
    lcnv :: QualifiedWithTag 'QLocal ConvId
lcnv = (Conversation -> ConvId)
-> Local Conversation -> QualifiedWithTag 'QLocal ConvId
forall a b.
(a -> b)
-> QualifiedWithTag 'QLocal a -> QualifiedWithTag 'QLocal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.convId) Local Conversation
lconv
    conv :: Conversation
conv = Local Conversation -> Conversation
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local Conversation
lconv

    maybeRemoveBots :: BotsAndMembers -> Sem r BotsAndMembers
    maybeRemoveBots :: forall (r :: EffectRow). BotsAndMembers -> Sem r BotsAndMembers
maybeRemoveBots BotsAndMembers
bm =
      if AccessRole -> Set AccessRole -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member AccessRole
ServiceAccessRole (ConversationAccessData -> Set AccessRole
cupAccessRoles ConversationAccessData
action)
        then BotsAndMembers -> Sem r BotsAndMembers
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BotsAndMembers
bm
        else BotsAndMembers -> Sem r BotsAndMembers
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers -> Sem r BotsAndMembers)
-> BotsAndMembers -> Sem r BotsAndMembers
forall a b. (a -> b) -> a -> b
$ BotsAndMembers
bm {bmBots = mempty}

    maybeRemoveGuests :: (Member BrigAccess r) => BotsAndMembers -> Sem r BotsAndMembers
    maybeRemoveGuests :: forall (r :: EffectRow).
Member BrigAccess r =>
BotsAndMembers -> Sem r BotsAndMembers
maybeRemoveGuests BotsAndMembers
bm =
      if AccessRole -> Set AccessRole -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member AccessRole
GuestAccessRole (ConversationAccessData -> Set AccessRole
cupAccessRoles ConversationAccessData
action)
        then BotsAndMembers -> Sem r BotsAndMembers
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BotsAndMembers
bm
        else do
          [UserId]
activated <- (User -> UserId) -> [User] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
map User -> UserId
User.userId ([User] -> [UserId]) -> Sem r [User] -> Sem r [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId] -> Sem r [User]
forall (r :: EffectRow).
Member BrigAccess r =>
[UserId] -> Sem r [User]
E.lookupActivatedUsers (Set UserId -> [UserId]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (BotsAndMembers -> Set UserId
bmLocals BotsAndMembers
bm))
          -- FUTUREWORK: should we also remove non-activated remote users?
          BotsAndMembers -> Sem r BotsAndMembers
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers -> Sem r BotsAndMembers)
-> BotsAndMembers -> Sem r BotsAndMembers
forall a b. (a -> b) -> a -> b
$ BotsAndMembers
bm {bmLocals = Set.fromList activated}

    maybeRemoveNonTeamMembers :: (Member TeamStore r) => BotsAndMembers -> Sem r BotsAndMembers
    maybeRemoveNonTeamMembers :: forall (r :: EffectRow).
Member TeamStore r =>
BotsAndMembers -> Sem r BotsAndMembers
maybeRemoveNonTeamMembers BotsAndMembers
bm =
      if AccessRole -> Set AccessRole -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member AccessRole
NonTeamMemberAccessRole (ConversationAccessData -> Set AccessRole
cupAccessRoles ConversationAccessData
action)
        then BotsAndMembers -> Sem r BotsAndMembers
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BotsAndMembers
bm
        else case Conversation -> Maybe TeamId
convTeam Conversation
conv of
          Just TeamId
tid -> do
            [UserId]
onlyTeamUsers <- (UserId -> Sem r Bool) -> [UserId] -> Sem r [UserId]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Maybe TeamMember -> Bool)
-> Sem r (Maybe TeamMember) -> Sem r Bool
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe TeamMember -> Bool
forall a. Maybe a -> Bool
isJust (Sem r (Maybe TeamMember) -> Sem r Bool)
-> (UserId -> Sem r (Maybe TeamMember)) -> UserId -> Sem r Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid) (Set UserId -> [UserId]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (BotsAndMembers -> Set UserId
bmLocals BotsAndMembers
bm))
            BotsAndMembers -> Sem r BotsAndMembers
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers -> Sem r BotsAndMembers)
-> BotsAndMembers -> Sem r BotsAndMembers
forall a b. (a -> b) -> a -> b
$ BotsAndMembers
bm {bmLocals = Set.fromList onlyTeamUsers, bmRemotes = mempty}
          Maybe TeamId
Nothing -> BotsAndMembers -> Sem r BotsAndMembers
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BotsAndMembers
bm

    maybeRemoveTeamMembers :: (Member TeamStore r) => BotsAndMembers -> Sem r BotsAndMembers
    maybeRemoveTeamMembers :: forall (r :: EffectRow).
Member TeamStore r =>
BotsAndMembers -> Sem r BotsAndMembers
maybeRemoveTeamMembers BotsAndMembers
bm =
      if AccessRole -> Set AccessRole -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member AccessRole
TeamMemberAccessRole (ConversationAccessData -> Set AccessRole
cupAccessRoles ConversationAccessData
action)
        then BotsAndMembers -> Sem r BotsAndMembers
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BotsAndMembers
bm
        else case Conversation -> Maybe TeamId
convTeam Conversation
conv of
          Just TeamId
tid -> do
            [UserId]
noTeamMembers <- (UserId -> Sem r Bool) -> [UserId] -> Sem r [UserId]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Maybe TeamMember -> Bool)
-> Sem r (Maybe TeamMember) -> Sem r Bool
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe TeamMember -> Bool
forall a. Maybe a -> Bool
isNothing (Sem r (Maybe TeamMember) -> Sem r Bool)
-> (UserId -> Sem r (Maybe TeamMember)) -> UserId -> Sem r Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid) (Set UserId -> [UserId]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (BotsAndMembers -> Set UserId
bmLocals BotsAndMembers
bm))
            BotsAndMembers -> Sem r BotsAndMembers
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotsAndMembers -> Sem r BotsAndMembers)
-> BotsAndMembers -> Sem r BotsAndMembers
forall a b. (a -> b) -> a -> b
$ BotsAndMembers
bm {bmLocals = Set.fromList noTeamMembers}
          Maybe TeamId
Nothing -> BotsAndMembers -> Sem r BotsAndMembers
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BotsAndMembers
bm

data LocalConversationUpdate = LocalConversationUpdate
  { LocalConversationUpdate -> Event
lcuEvent :: Event,
    LocalConversationUpdate -> ConversationUpdate
lcuUpdate :: ConversationUpdate
  }
  deriving (Int -> LocalConversationUpdate -> ShowS
[LocalConversationUpdate] -> ShowS
LocalConversationUpdate -> String
(Int -> LocalConversationUpdate -> ShowS)
-> (LocalConversationUpdate -> String)
-> ([LocalConversationUpdate] -> ShowS)
-> Show LocalConversationUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocalConversationUpdate -> ShowS
showsPrec :: Int -> LocalConversationUpdate -> ShowS
$cshow :: LocalConversationUpdate -> String
show :: LocalConversationUpdate -> String
$cshowList :: [LocalConversationUpdate] -> ShowS
showList :: [LocalConversationUpdate] -> ShowS
Show)

updateLocalConversation ::
  forall tag r.
  ( 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 :: 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) =>
QualifiedWithTag 'QLocal ConvId
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversation QualifiedWithTag 'QLocal ConvId
lcnv Qualified UserId
qusr Maybe ConnId
con ConversationAction tag
action = do
  let tag :: Sing tag
tag = forall {k} (a :: k). SingI a => Sing a
forall (a :: ConversationActionTag). SingI a => Sing a
sing @tag

  -- retrieve conversation
  Conversation
conv <- QualifiedWithTag 'QLocal ConvId -> Sem r Conversation
forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r) =>
QualifiedWithTag 'QLocal ConvId -> Sem r Conversation
getConversationWithError QualifiedWithTag 'QLocal ConvId
lcnv

  -- check that the action does not bypass the underlying protocol
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Protocol -> ConversationActionTag -> Bool
protocolValidAction (Conversation -> Protocol
convProtocol Conversation
conv) (Sing tag -> Demote ConversationActionTag
forall k (a :: k). SingKind k => Sing a -> Demote k
forall (a :: ConversationActionTag).
Sing a -> Demote ConversationActionTag
fromSing Sing tag
tag)) (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

  -- perform all authorisation checks and, if successful, then update itself
  forall (tag :: ConversationActionTag) (r :: EffectRow).
(SingI tag, Member BackendNotificationQueueAccess r,
 Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 HasConversationActionEffects tag r) =>
Local Conversation
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversationUnchecked @tag (QualifiedWithTag 'QLocal ConvId
-> Conversation -> Local Conversation
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs QualifiedWithTag 'QLocal ConvId
lcnv Conversation
conv) Qualified UserId
qusr Maybe ConnId
con ConversationAction tag
action

-- | Similar to 'updateLocalConversationWithLocalUser', but takes a
-- 'Conversation' value directly, instead of a 'ConvId', and skips protocol
-- checks. All the other checks are still performed.
--
-- This is intended to be used by protocol-aware code, once all the
-- protocol-specific checks and updates have been performed, to finally apply
-- the changes to the conversation as seen by the backend.
updateLocalConversationUnchecked ::
  forall tag r.
  ( SingI tag,
    Member BackendNotificationQueueAccess r,
    Member (Error FederationError) r,
    Member (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    HasConversationActionEffects tag r
  ) =>
  Local Conversation ->
  Qualified UserId ->
  Maybe ConnId ->
  ConversationAction tag ->
  Sem r LocalConversationUpdate
updateLocalConversationUnchecked :: forall (tag :: ConversationActionTag) (r :: EffectRow).
(SingI tag, Member BackendNotificationQueueAccess r,
 Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 HasConversationActionEffects tag r) =>
Local Conversation
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversationUnchecked Local Conversation
lconv Qualified UserId
qusr Maybe ConnId
con ConversationAction tag
action = do
  let tag :: Sing tag
tag = forall {k} (a :: k). SingI a => Sing a
forall (a :: ConversationActionTag). SingI a => Sing a
sing @tag
      lcnv :: QualifiedWithTag 'QLocal ConvId
lcnv = (Conversation -> ConvId)
-> Local Conversation -> QualifiedWithTag 'QLocal ConvId
forall a b.
(a -> b)
-> QualifiedWithTag 'QLocal a -> QualifiedWithTag 'QLocal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.convId) Local Conversation
lconv
      conv :: Conversation
conv = Local Conversation -> Conversation
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local Conversation
lconv

  -- retrieve member
  Either LocalMember RemoteMember
self <- 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 (Either LocalMember RemoteMember)
 -> Sem r (Either LocalMember RemoteMember))
-> Maybe (Either LocalMember RemoteMember)
-> Sem r (Either LocalMember RemoteMember)
forall a b. (a -> b) -> a -> b
$ Local Conversation
-> Conversation
-> Qualified UserId
-> Maybe (Either LocalMember RemoteMember)
forall x.
Local x
-> Conversation
-> Qualified UserId
-> Maybe (Either LocalMember RemoteMember)
forall uid mem x.
IsConvMemberId uid mem =>
Local x -> Conversation -> uid -> Maybe mem
getConvMember Local Conversation
lconv Conversation
conv Qualified UserId
qusr

  -- perform checks
  Sing tag
-> QualifiedWithTag 'QLocal ConvId
-> ConversationAction tag
-> Conversation
-> Either LocalMember RemoteMember
-> Sem r ()
forall (tag :: ConversationActionTag) mem x (r :: EffectRow).
(IsConvMember mem, HasConversationActionEffects tag r,
 (Member
    (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
  Member (ErrorS 'InvalidOperation) r)) =>
Sing tag
-> Local x
-> ConversationAction tag
-> Conversation
-> mem
-> Sem r ()
ensureConversationActionAllowed (forall {k} (a :: k). SingI a => Sing a
forall (a :: ConversationActionTag). SingI a => Sing a
sing @tag) QualifiedWithTag 'QLocal ConvId
lcnv ConversationAction tag
action Conversation
conv Either LocalMember RemoteMember
self

  -- perform action
  (BotsAndMembers
extraTargets, ConversationAction tag
action') <- Sing tag
-> Qualified UserId
-> Local Conversation
-> ConversationAction tag
-> Sem r (BotsAndMembers, ConversationAction tag)
forall (tag :: ConversationActionTag) (r :: EffectRow).
(HasConversationActionEffects tag r,
 Member BackendNotificationQueueAccess r,
 Member (Error FederationError) r) =>
Sing tag
-> Qualified UserId
-> Local Conversation
-> ConversationAction tag
-> Sem r (BotsAndMembers, ConversationAction tag)
performAction Sing tag
tag Qualified UserId
qusr Local Conversation
lconv ConversationAction tag
action

  Sing tag
-> Qualified UserId
-> Bool
-> Maybe ConnId
-> Local Conversation
-> BotsAndMembers
-> ConversationAction tag
-> Sem 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 @tag)
    Qualified UserId
qusr
    Bool
False
    Maybe ConnId
con
    Local Conversation
lconv
    (Conversation -> BotsAndMembers
convBotsAndMembers Conversation
conv BotsAndMembers -> BotsAndMembers -> BotsAndMembers
forall a. Semigroup a => a -> a -> a
<> BotsAndMembers
extraTargets)
    ConversationAction tag
action'

-- --------------------------------------------------------------------------------
-- -- Utilities

ensureConversationActionAllowed ::
  forall tag mem x r.
  ( IsConvMember mem,
    HasConversationActionEffects tag r,
    ( Member (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
      Member (ErrorS 'InvalidOperation) r
    )
  ) =>
  Sing tag ->
  Local x ->
  ConversationAction (tag :: ConversationActionTag) ->
  Conversation ->
  mem ->
  Sem r ()
ensureConversationActionAllowed :: forall (tag :: ConversationActionTag) mem x (r :: EffectRow).
(IsConvMember mem, HasConversationActionEffects tag r,
 (Member
    (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
  Member (ErrorS 'InvalidOperation) r)) =>
Sing tag
-> Local x
-> ConversationAction tag
-> Conversation
-> mem
-> Sem r ()
ensureConversationActionAllowed Sing tag
tag Local x
loc ConversationAction tag
action Conversation
conv mem
self = do
  -- general action check
  Sing (ConversationActionPermission tag) -> mem -> Sem r ()
forall (action :: Action) mem (r :: EffectRow).
(IsConvMember mem, Member (ErrorS ('ActionDenied action)) r) =>
Sing action -> mem -> Sem r ()
ensureActionAllowed (Sing tag -> Sing (Apply ConversationActionPermissionSym0 tag)
forall (t :: ConversationActionTag).
Sing t -> Sing (Apply ConversationActionPermissionSym0 t)
sConversationActionPermission Sing tag
tag) mem
self

  -- check if it is a group conversation (except for rename actions)
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Sing tag -> Demote ConversationActionTag
forall k (a :: k). SingKind k => Sing a -> Demote k
forall (a :: ConversationActionTag).
Sing a -> Demote ConversationActionTag
fromSing Sing tag
tag ConversationActionTag -> ConversationActionTag -> Bool
forall a. Eq a => a -> a -> Bool
/= ConversationActionTag
ConversationRenameTag) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    Conversation -> Sem r ()
forall (r :: EffectRow).
Member (ErrorS 'InvalidOperation) r =>
Conversation -> Sem r ()
ensureGroupConversation Conversation
conv

  -- extra action-specific checks
  Sing tag
-> Local x
-> ConversationAction tag
-> Conversation
-> mem
-> Sem r ()
forall (tag :: ConversationActionTag) mem (r :: EffectRow) x.
(IsConvMember mem, HasConversationActionEffects tag r) =>
Sing tag
-> Local x
-> ConversationAction tag
-> Conversation
-> mem
-> Sem r ()
ensureAllowed Sing tag
tag Local x
loc ConversationAction tag
action Conversation
conv mem
self

-- | Add users to a conversation without performing any checks. Return extra
-- notification targets and the action performed.
addMembersToLocalConversation ::
  ( Member MemberStore r,
    Member (Error NoChanges) r
  ) =>
  Local ConvId ->
  UserList UserId ->
  RoleName ->
  Sem r (BotsAndMembers, ConversationJoin)
addMembersToLocalConversation :: forall (r :: EffectRow).
(Member MemberStore r, Member (Error NoChanges) r) =>
QualifiedWithTag 'QLocal ConvId
-> UserList UserId
-> RoleName
-> Sem r (BotsAndMembers, ConversationJoin)
addMembersToLocalConversation QualifiedWithTag 'QLocal ConvId
lcnv UserList UserId
users RoleName
role = do
  ([LocalMember]
lmems, [RemoteMember]
rmems) <- ConvId
-> UserList (UserId, RoleName)
-> Sem r ([LocalMember], [RemoteMember])
forall (r :: EffectRow) u.
(Member MemberStore r, ToUserRole u) =>
ConvId -> UserList u -> Sem r ([LocalMember], [RemoteMember])
E.createMembers (QualifiedWithTag 'QLocal ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified QualifiedWithTag 'QLocal ConvId
lcnv) ((UserId -> (UserId, RoleName))
-> UserList UserId -> UserList (UserId, RoleName)
forall a b. (a -> b) -> UserList a -> UserList b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,RoleName
role) UserList UserId
users)
  NonEmpty (Qualified UserId)
neUsers <- NoChanges
-> Maybe (NonEmpty (Qualified UserId))
-> Sem r (NonEmpty (Qualified UserId))
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note NoChanges
NoChanges (Maybe (NonEmpty (Qualified UserId))
 -> Sem r (NonEmpty (Qualified UserId)))
-> Maybe (NonEmpty (Qualified UserId))
-> Sem r (NonEmpty (Qualified UserId))
forall a b. (a -> b) -> a -> b
$ [Qualified UserId] -> Maybe (NonEmpty (Qualified UserId))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (QualifiedWithTag 'QLocal ConvId
-> UserList UserId -> [Qualified UserId]
forall x a. Local x -> UserList a -> [Qualified a]
ulAll QualifiedWithTag 'QLocal ConvId
lcnv UserList UserId
users)
  let action :: ConversationJoin
action = NonEmpty (Qualified UserId) -> RoleName -> ConversationJoin
ConversationJoin NonEmpty (Qualified UserId)
neUsers RoleName
role
  (BotsAndMembers, ConversationJoin)
-> Sem r (BotsAndMembers, ConversationJoin)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([LocalMember] -> [RemoteMember] -> BotsAndMembers
bmFromMembers [LocalMember]
lmems [RemoteMember]
rmems, ConversationJoin
action)

notifyConversationAction ::
  forall tag r.
  ( 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 :: ConversationActionTag) ->
  Sem r LocalConversationUpdate
notifyConversationAction :: 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 Sing tag
tag Qualified UserId
quid Bool
notifyOrigDomain Maybe ConnId
con Local Conversation
lconv BotsAndMembers
targets ConversationAction tag
action = do
  UTCTime
now <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  let lcnv :: QualifiedWithTag 'QLocal ConvId
lcnv = (Conversation -> ConvId)
-> Local Conversation -> QualifiedWithTag 'QLocal ConvId
forall a b.
(a -> b)
-> QualifiedWithTag 'QLocal a -> QualifiedWithTag 'QLocal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.convId) Local Conversation
lconv
      e :: Event
e = Sing tag
-> UTCTime
-> Qualified UserId
-> Qualified ConvId
-> Maybe SubConvId
-> ConversationAction tag
-> Event
forall (tag :: ConversationActionTag).
Sing tag
-> UTCTime
-> Qualified UserId
-> Qualified ConvId
-> Maybe SubConvId
-> ConversationAction tag
-> Event
conversationActionToEvent Sing tag
tag UTCTime
now Qualified UserId
quid (QualifiedWithTag 'QLocal ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged QualifiedWithTag 'QLocal ConvId
lcnv) Maybe SubConvId
forall a. Maybe a
Nothing ConversationAction tag
action
      mkUpdate :: [UserId] -> ConversationUpdate
mkUpdate [UserId]
uids =
        UTCTime
-> Qualified UserId
-> ConvId
-> [UserId]
-> SomeConversationAction
-> ConversationUpdate
ConversationUpdate
          UTCTime
now
          Qualified UserId
quid
          (QualifiedWithTag 'QLocal ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified QualifiedWithTag 'QLocal ConvId
lcnv)
          [UserId]
uids
          (Sing tag -> ConversationAction tag -> SomeConversationAction
forall (tag :: ConversationActionTag).
Sing tag -> ConversationAction tag -> SomeConversationAction
SomeConversationAction Sing tag
tag ConversationAction tag
action)
  ConversationUpdate
update <-
    ([QualifiedWithTag 'QRemote (Maybe ConversationUpdate)]
 -> ConversationUpdate)
-> Sem r [QualifiedWithTag 'QRemote (Maybe ConversationUpdate)]
-> Sem r ConversationUpdate
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ConversationUpdate
-> Maybe ConversationUpdate -> ConversationUpdate
forall a. a -> Maybe a -> a
fromMaybe ([UserId] -> ConversationUpdate
mkUpdate []) (Maybe ConversationUpdate -> ConversationUpdate)
-> ([QualifiedWithTag 'QRemote (Maybe ConversationUpdate)]
    -> Maybe ConversationUpdate)
-> [QualifiedWithTag 'QRemote (Maybe ConversationUpdate)]
-> ConversationUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe ConversationUpdate] -> Maybe ConversationUpdate
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe ConversationUpdate] -> Maybe ConversationUpdate)
-> ([QualifiedWithTag 'QRemote (Maybe ConversationUpdate)]
    -> [Maybe ConversationUpdate])
-> [QualifiedWithTag 'QRemote (Maybe ConversationUpdate)]
-> Maybe ConversationUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedWithTag 'QRemote (Maybe ConversationUpdate)
 -> Maybe ConversationUpdate)
-> [QualifiedWithTag 'QRemote (Maybe ConversationUpdate)]
-> [Maybe ConversationUpdate]
forall a b. (a -> b) -> [a] -> [b]
map QualifiedWithTag 'QRemote (Maybe ConversationUpdate)
-> Maybe ConversationUpdate
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified) (Sem r [QualifiedWithTag 'QRemote (Maybe ConversationUpdate)]
 -> Sem r ConversationUpdate)
-> Sem r [QualifiedWithTag 'QRemote (Maybe ConversationUpdate)]
-> Sem r ConversationUpdate
forall a b. (a -> b) -> a -> b
$
      DeliveryMode
-> [Remote UserId]
-> (Remote [UserId]
    -> FedQueueClient 'Galley (Maybe ConversationUpdate))
-> Sem r [QualifiedWithTag 'QRemote (Maybe ConversationUpdate)]
forall (c :: Component) (f :: * -> *) (r :: EffectRow) x a.
(KnownComponent c, Foldable f, Functor f,
 Member (Error FederationError) r,
 Member BackendNotificationQueueAccess r) =>
DeliveryMode
-> f (Remote x)
-> (Remote [x] -> FedQueueClient c a)
-> Sem r [Remote a]
enqueueNotificationsConcurrently DeliveryMode
Q.Persistent (Set (Remote UserId) -> [Remote UserId]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (BotsAndMembers -> Set (Remote UserId)
bmRemotes BotsAndMembers
targets)) ((Remote [UserId]
  -> FedQueueClient 'Galley (Maybe ConversationUpdate))
 -> Sem r [QualifiedWithTag 'QRemote (Maybe ConversationUpdate)])
-> (Remote [UserId]
    -> FedQueueClient 'Galley (Maybe ConversationUpdate))
-> Sem r [QualifiedWithTag 'QRemote (Maybe ConversationUpdate)]
forall a b. (a -> b) -> a -> b
$
        \Remote [UserId]
ruids -> do
          let update :: ConversationUpdate
update = [UserId] -> ConversationUpdate
mkUpdate (Remote [UserId] -> [UserId]
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Remote [UserId]
ruids)
          -- if notifyOrigDomain is false, filter out user from quid's domain,
          -- because quid's backend will update local state and notify its users
          -- itself using the ConversationUpdate returned by this function
          if Bool
notifyOrigDomain Bool -> Bool -> Bool
|| Remote [UserId] -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Remote [UserId]
ruids Domain -> Domain -> Bool
forall a. Eq a => a -> a -> Bool
/= Qualified UserId -> Domain
forall a. Qualified a -> Domain
qDomain Qualified UserId
quid
            then do
              ConversationUpdate
-> FedQueueClient 'Galley (PayloadBundle 'Galley)
makeConversationUpdateBundle ConversationUpdate
update FedQueueClient 'Galley (PayloadBundle 'Galley)
-> (PayloadBundle 'Galley -> FedQueueClient 'Galley ())
-> FedQueueClient 'Galley ()
forall a b.
FedQueueClient 'Galley a
-> (a -> FedQueueClient 'Galley b) -> FedQueueClient 'Galley b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PayloadBundle 'Galley -> FedQueueClient 'Galley ()
forall (c :: Component).
KnownComponent c =>
PayloadBundle c -> FedQueueClient c ()
sendBundle
              Maybe ConversationUpdate
-> FedQueueClient 'Galley (Maybe ConversationUpdate)
forall a. a -> FedQueueClient 'Galley a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ConversationUpdate
forall a. Maybe a
Nothing
            else Maybe ConversationUpdate
-> FedQueueClient 'Galley (Maybe ConversationUpdate)
forall a. a -> FedQueueClient 'Galley a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConversationUpdate -> Maybe ConversationUpdate
forall a. a -> Maybe a
Just ConversationUpdate
update)

  -- notify local participants and bots
  Maybe ConnId
-> Event -> Local (Set UserId) -> Set 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
con Event
e (QualifiedWithTag 'QLocal ConvId -> Set UserId -> Local (Set UserId)
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs QualifiedWithTag 'QLocal ConvId
lcnv (BotsAndMembers -> Set UserId
bmLocals BotsAndMembers
targets)) (BotsAndMembers -> Set BotMember
bmBots BotsAndMembers
targets)

  -- return both the event and the 'ConversationUpdate' structure corresponding
  -- to the originating domain (if it is remote)
  LocalConversationUpdate -> Sem r LocalConversationUpdate
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalConversationUpdate -> Sem r LocalConversationUpdate)
-> LocalConversationUpdate -> Sem r LocalConversationUpdate
forall a b. (a -> b) -> a -> b
$ Event -> ConversationUpdate -> LocalConversationUpdate
LocalConversationUpdate Event
e ConversationUpdate
update

-- | Update the local database with information on conversation members joining
-- or leaving. Finally, push out notifications to local users.
updateLocalStateOfRemoteConv ::
  ( Member BrigAccess r,
    Member NotificationSubsystem r,
    Member ExternalAccess r,
    Member (Input (Local ())) r,
    Member MemberStore r,
    Member P.TinyLog r
  ) =>
  Remote F.ConversationUpdate ->
  Maybe ConnId ->
  Sem r (Maybe Event)
updateLocalStateOfRemoteConv :: 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 ConversationUpdate
rcu Maybe ConnId
con = do
  Local ()
loc <- () -> Sem r (Local ())
forall (r :: EffectRow) a.
Member (Input (Local ())) r =>
a -> Sem r (Local a)
qualifyLocal ()
  let cu :: ConversationUpdate
cu = Remote ConversationUpdate -> ConversationUpdate
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Remote ConversationUpdate
rcu
      rconvId :: QualifiedWithTag 'QRemote ConvId
rconvId = (ConversationUpdate -> ConvId)
-> Remote ConversationUpdate -> QualifiedWithTag 'QRemote ConvId
forall a b.
(a -> b)
-> QualifiedWithTag 'QRemote a -> QualifiedWithTag 'QRemote b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.convId) Remote ConversationUpdate
rcu
      qconvId :: Qualified ConvId
qconvId = QualifiedWithTag 'QRemote ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged QualifiedWithTag 'QRemote ConvId
rconvId

  -- Note: we generally do not send notifications to users that are not part of
  -- the conversation (from our point of view), to prevent spam from the remote
  -- backend. See also the comment below.
  ([UserId]
presentUsers, Bool
allUsersArePresent) <-
    [UserId]
-> QualifiedWithTag 'QRemote ConvId -> Sem r ([UserId], Bool)
forall (r :: EffectRow).
Member MemberStore r =>
[UserId]
-> QualifiedWithTag 'QRemote ConvId -> Sem r ([UserId], Bool)
E.selectRemoteMembers ConversationUpdate
cu.alreadyPresentUsers QualifiedWithTag 'QRemote ConvId
rconvId

  -- Perform action, and determine extra notification targets.
  --
  -- When new users are being added to the conversation, we consider them as
  -- notification targets. Since we check connections before letting
  -- people being added, this is safe against spam. However, if users that
  -- are not in the conversations are being removed or have their membership state
  -- updated, we do **not** add them to the list of targets, because we have no
  -- way to make sure that they are actually supposed to receive that notification.

  (Maybe SomeConversationAction
mActualAction, [UserId]
extraTargets) <- case ConversationUpdate
cu.action of
    sca :: SomeConversationAction
sca@(SomeConversationAction Sing tag
singTag ConversationAction tag
action) -> case Sing tag
singTag of
      Sing tag
SConversationActionTag tag
SConversationJoinTag -> do
        let ConversationJoin NonEmpty (Qualified UserId)
toAdd RoleName
role = ConversationAction tag
action
        let ([UserId]
localUsers, [Remote UserId]
remoteUsers) = Local ()
-> NonEmpty (Qualified UserId) -> ([UserId], [Remote UserId])
forall (f :: * -> *) x a.
Foldable f =>
Local x -> f (Qualified a) -> ([a], [Remote a])
partitionQualified Local ()
loc NonEmpty (Qualified UserId)
toAdd
        [UserId]
addedLocalUsers <- Set UserId -> [UserId]
forall a. Set a -> [a]
Set.toList (Set UserId -> [UserId]) -> Sem r (Set UserId) -> Sem r [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualifiedWithTag 'QRemote ConvId
-> Qualified UserId -> [UserId] -> Sem r (Set UserId)
forall (r :: EffectRow).
(Member BrigAccess r, Member MemberStore r, Member TinyLog r) =>
QualifiedWithTag 'QRemote ConvId
-> Qualified UserId -> [UserId] -> Sem r (Set UserId)
addLocalUsersToRemoteConv QualifiedWithTag 'QRemote ConvId
rconvId ConversationUpdate
cu.origUserId [UserId]
localUsers
        let allAddedUsers :: [Qualified UserId]
allAddedUsers = (UserId -> Qualified UserId) -> [UserId] -> [Qualified UserId]
forall a b. (a -> b) -> [a] -> [b]
map (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 -> Local UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local ()
loc) [UserId]
addedLocalUsers [Qualified UserId] -> [Qualified UserId] -> [Qualified UserId]
forall a. Semigroup a => a -> a -> a
<> (Remote UserId -> Qualified UserId)
-> [Remote UserId] -> [Qualified UserId]
forall a b. (a -> b) -> [a] -> [b]
map Remote UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged [Remote UserId]
remoteUsers
        (Maybe SomeConversationAction, [UserId])
-> Sem r (Maybe SomeConversationAction, [UserId])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe SomeConversationAction, [UserId])
 -> Sem r (Maybe SomeConversationAction, [UserId]))
-> (Maybe SomeConversationAction, [UserId])
-> Sem r (Maybe SomeConversationAction, [UserId])
forall a b. (a -> b) -> a -> b
$
          ( (NonEmpty (Qualified UserId) -> SomeConversationAction)
-> Maybe (NonEmpty (Qualified UserId))
-> Maybe SomeConversationAction
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              (\NonEmpty (Qualified UserId)
users -> Sing 'ConversationJoinTag
-> ConversationAction 'ConversationJoinTag
-> SomeConversationAction
forall (tag :: ConversationActionTag).
Sing tag -> ConversationAction tag -> SomeConversationAction
SomeConversationAction Sing 'ConversationJoinTag
SConversationActionTag 'ConversationJoinTag
SConversationJoinTag (NonEmpty (Qualified UserId) -> RoleName -> ConversationJoin
ConversationJoin NonEmpty (Qualified UserId)
users RoleName
role))
              ([Qualified UserId] -> Maybe (NonEmpty (Qualified UserId))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Qualified UserId]
allAddedUsers),
            [UserId]
addedLocalUsers
          )
      Sing tag
SConversationActionTag tag
SConversationLeaveTag -> do
        let users :: [UserId]
users = Local ()
-> (Local UserId -> [UserId])
-> (Remote UserId -> [UserId])
-> Qualified UserId
-> [UserId]
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified Local ()
loc (UserId -> [UserId]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId -> [UserId])
-> (Local UserId -> UserId) -> Local UserId -> [UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified) ([UserId] -> Remote UserId -> [UserId]
forall a b. a -> b -> a
const []) ConversationUpdate
cu.origUserId
        QualifiedWithTag 'QRemote ConvId -> [UserId] -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
QualifiedWithTag 'QRemote ConvId -> [UserId] -> Sem r ()
E.deleteMembersInRemoteConversation QualifiedWithTag 'QRemote ConvId
rconvId [UserId]
users
        (Maybe SomeConversationAction, [UserId])
-> Sem r (Maybe SomeConversationAction, [UserId])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeConversationAction -> Maybe SomeConversationAction
forall a. a -> Maybe a
Just SomeConversationAction
sca, [])
      Sing tag
SConversationActionTag tag
SConversationRemoveMembersTag -> do
        let localUsers :: [UserId]
localUsers = Domain -> NonEmpty (Qualified UserId) -> [UserId]
getLocalUsers (Local () -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Local ()
loc) (NonEmpty (Qualified UserId) -> [UserId])
-> (ConversationAction tag -> NonEmpty (Qualified UserId))
-> ConversationAction tag
-> [UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConversationRemoveMembers -> NonEmpty (Qualified UserId)
ConversationAction tag -> NonEmpty (Qualified UserId)
crmTargets (ConversationAction tag -> [UserId])
-> ConversationAction tag -> [UserId]
forall a b. (a -> b) -> a -> b
$ ConversationAction tag
action
        QualifiedWithTag 'QRemote ConvId -> [UserId] -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
QualifiedWithTag 'QRemote ConvId -> [UserId] -> Sem r ()
E.deleteMembersInRemoteConversation QualifiedWithTag 'QRemote ConvId
rconvId [UserId]
localUsers
        (Maybe SomeConversationAction, [UserId])
-> Sem r (Maybe SomeConversationAction, [UserId])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeConversationAction -> Maybe SomeConversationAction
forall a. a -> Maybe a
Just SomeConversationAction
sca, [])
      Sing tag
SConversationActionTag tag
SConversationMemberUpdateTag ->
        (Maybe SomeConversationAction, [UserId])
-> Sem r (Maybe SomeConversationAction, [UserId])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeConversationAction -> Maybe SomeConversationAction
forall a. a -> Maybe a
Just SomeConversationAction
sca, [])
      Sing tag
SConversationActionTag tag
SConversationDeleteTag -> do
        QualifiedWithTag 'QRemote ConvId -> [UserId] -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
QualifiedWithTag 'QRemote ConvId -> [UserId] -> Sem r ()
E.deleteMembersInRemoteConversation QualifiedWithTag 'QRemote ConvId
rconvId [UserId]
presentUsers
        (Maybe SomeConversationAction, [UserId])
-> Sem r (Maybe SomeConversationAction, [UserId])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeConversationAction -> Maybe SomeConversationAction
forall a. a -> Maybe a
Just SomeConversationAction
sca, [])
      Sing tag
SConversationActionTag tag
SConversationRenameTag -> (Maybe SomeConversationAction, [UserId])
-> Sem r (Maybe SomeConversationAction, [UserId])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeConversationAction -> Maybe SomeConversationAction
forall a. a -> Maybe a
Just SomeConversationAction
sca, [])
      Sing tag
SConversationActionTag tag
SConversationMessageTimerUpdateTag -> (Maybe SomeConversationAction, [UserId])
-> Sem r (Maybe SomeConversationAction, [UserId])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeConversationAction -> Maybe SomeConversationAction
forall a. a -> Maybe a
Just SomeConversationAction
sca, [])
      Sing tag
SConversationActionTag tag
SConversationReceiptModeUpdateTag -> (Maybe SomeConversationAction, [UserId])
-> Sem r (Maybe SomeConversationAction, [UserId])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeConversationAction -> Maybe SomeConversationAction
forall a. a -> Maybe a
Just SomeConversationAction
sca, [])
      Sing tag
SConversationActionTag tag
SConversationAccessDataTag -> (Maybe SomeConversationAction, [UserId])
-> Sem r (Maybe SomeConversationAction, [UserId])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeConversationAction -> Maybe SomeConversationAction
forall a. a -> Maybe a
Just SomeConversationAction
sca, [])
      Sing tag
SConversationActionTag tag
SConversationUpdateProtocolTag -> (Maybe SomeConversationAction, [UserId])
-> Sem r (Maybe SomeConversationAction, [UserId])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeConversationAction -> Maybe SomeConversationAction
forall a. a -> Maybe a
Just SomeConversationAction
sca, [])

  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
allUsersArePresent (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.warn ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
      ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"conversation" (ConvId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' ConversationUpdate
cu.convId)
        (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"domain" (Domain -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' (Remote ConversationUpdate -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Remote ConversationUpdate
rcu))
        (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
Log.msg
          ( ByteString
"Attempt to send notification about conversation update \
            \to users not in the conversation" ::
              ByteString
          )

  -- Send notifications
  Maybe SomeConversationAction
-> (SomeConversationAction -> Sem r Event) -> Sem r (Maybe Event)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe SomeConversationAction
mActualAction ((SomeConversationAction -> Sem r Event) -> Sem r (Maybe Event))
-> (SomeConversationAction -> Sem r Event) -> Sem r (Maybe Event)
forall a b. (a -> b) -> a -> b
$ \(SomeConversationAction Sing tag
tag ConversationAction tag
action) -> do
    let event :: Event
event = Sing tag
-> UTCTime
-> Qualified UserId
-> Qualified ConvId
-> Maybe SubConvId
-> ConversationAction tag
-> Event
forall (tag :: ConversationActionTag).
Sing tag
-> UTCTime
-> Qualified UserId
-> Qualified ConvId
-> Maybe SubConvId
-> ConversationAction tag
-> Event
conversationActionToEvent Sing tag
tag ConversationUpdate
cu.time ConversationUpdate
cu.origUserId Qualified ConvId
qconvId Maybe SubConvId
forall a. Maybe a
Nothing ConversationAction tag
action
        targets :: [UserId]
targets = [UserId] -> [UserId]
forall a. Ord a => [a] -> [a]
nubOrd ([UserId] -> [UserId]) -> [UserId] -> [UserId]
forall a b. (a -> b) -> a -> b
$ [UserId]
presentUsers [UserId] -> [UserId] -> [UserId]
forall a. Semigroup a => a -> a -> a
<> [UserId]
extraTargets
    -- FUTUREWORK: support bots?
    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
con Event
event (Local () -> [UserId] -> Local [UserId]
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local ()
loc [UserId]
targets) [] Sem r () -> Event -> Sem r Event
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Event
event

addLocalUsersToRemoteConv ::
  ( Member BrigAccess r,
    Member MemberStore r,
    Member P.TinyLog r
  ) =>
  Remote ConvId ->
  Qualified UserId ->
  [UserId] ->
  Sem r (Set UserId)
addLocalUsersToRemoteConv :: forall (r :: EffectRow).
(Member BrigAccess r, Member MemberStore r, Member TinyLog r) =>
QualifiedWithTag 'QRemote ConvId
-> Qualified UserId -> [UserId] -> Sem r (Set UserId)
addLocalUsersToRemoteConv QualifiedWithTag 'QRemote ConvId
remoteConvId Qualified UserId
qAdder [UserId]
localUsers = do
  [ConnectionStatusV2]
connStatus <- [UserId]
-> Maybe [Qualified UserId]
-> Maybe Relation
-> Sem r [ConnectionStatusV2]
forall (r :: EffectRow).
Member BrigAccess r =>
[UserId]
-> Maybe [Qualified UserId]
-> Maybe Relation
-> Sem r [ConnectionStatusV2]
E.getConnections [UserId]
localUsers ([Qualified UserId] -> Maybe [Qualified UserId]
forall a. a -> Maybe a
Just [Qualified UserId
qAdder]) (Relation -> Maybe Relation
forall a. a -> Maybe a
Just Relation
Accepted)
  let localUserIdsSet :: Set UserId
localUserIdsSet = [UserId] -> Set UserId
forall a. Ord a => [a] -> Set a
Set.fromList [UserId]
localUsers
      adder :: UserId
adder = Qualified UserId -> UserId
forall a. Qualified a -> a
qUnqualified Qualified UserId
qAdder
      -- If alice@A creates a 1-1 conversation on B, it can appear as if alice is
      -- adding herself to a remote conversation. To make sure this is allowed, we
      -- always consider a user as connected to themself.
      connected :: Set UserId
connected =
        [UserId] -> Set UserId
forall a. Ord a => [a] -> Set a
Set.fromList ((ConnectionStatusV2 -> UserId) -> [ConnectionStatusV2] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConnectionStatusV2 -> UserId
csv2From [ConnectionStatusV2]
connStatus)
          Set UserId -> Set UserId -> Set UserId
forall a. Semigroup a => a -> a -> a
<> if UserId -> Set UserId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member UserId
adder Set UserId
localUserIdsSet
            then UserId -> Set UserId
forall a. a -> Set a
Set.singleton UserId
adder
            else Set UserId
forall a. Monoid a => a
mempty
      unconnected :: Set UserId
unconnected = Set UserId -> Set UserId -> Set UserId
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set UserId
localUserIdsSet Set UserId
connected
      connectedList :: [UserId]
connectedList = Set UserId -> [UserId]
forall a. Set a -> [a]
Set.toList Set UserId
connected

  -- FUTUREWORK: Consider handling the discrepancy between the views of the
  -- conversation-owning backend and the local backend
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set UserId -> Bool
forall a. Set a -> Bool
Set.null Set UserId
unconnected) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.warn ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
      Text -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
Log.msg (Text
"A remote user is trying to add unconnected local users to a remote conversation" :: Text)
        (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"remote_user" (Qualified UserId -> String
forall a. Show a => a -> String
show Qualified UserId
qAdder)
        (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"local_unconnected_users" (Set UserId -> String
forall a. Show a => a -> String
show Set UserId
unconnected)

  -- Update the local view of the remote conversation by adding only those local
  -- users that are connected to the adder
  QualifiedWithTag 'QRemote ConvId -> [UserId] -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
QualifiedWithTag 'QRemote ConvId -> [UserId] -> Sem r ()
E.createMembersInRemoteConversation QualifiedWithTag 'QRemote ConvId
remoteConvId [UserId]
connectedList
  Set UserId -> Sem r (Set UserId)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set UserId
connected

-- | Kick a user from a conversation and send notifications.
--
-- This function removes the given victim from the conversation by making them
-- leave, but then sends notifications as if the user was removed by someone
-- else.
kickMember ::
  ( Member BackendNotificationQueueAccess r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member ProposalStore r,
    Member (Input UTCTime) r,
    Member (Input Env) r,
    Member MemberStore r,
    Member SubConversationStore r,
    Member TinyLog r,
    Member Random r
  ) =>
  Qualified UserId ->
  Local Conversation ->
  BotsAndMembers ->
  Qualified UserId ->
  Sem r ()
kickMember :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member (Error FederationError) r, Member (Error InternalError) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member NotificationSubsystem r, Member ProposalStore r,
 Member (Input UTCTime) r, Member (Input Env) r,
 Member MemberStore r, Member SubConversationStore r,
 Member TinyLog r, Member Random r) =>
Qualified UserId
-> Local Conversation
-> BotsAndMembers
-> Qualified UserId
-> Sem r ()
kickMember Qualified UserId
qusr Local Conversation
lconv BotsAndMembers
targets Qualified UserId
victim = Sem r (Either NoChanges LocalConversationUpdate) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (Either NoChanges LocalConversationUpdate) -> Sem r ())
-> (Sem (Error NoChanges : r) LocalConversationUpdate
    -> Sem r (Either NoChanges LocalConversationUpdate))
-> Sem (Error NoChanges : r) LocalConversationUpdate
-> Sem r ()
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 ())
-> Sem (Error NoChanges : r) LocalConversationUpdate -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
  (BotsAndMembers
extraTargets, ConversationAction 'ConversationLeaveTag
_) <-
    Sing 'ConversationLeaveTag
-> Qualified UserId
-> Local Conversation
-> ConversationAction 'ConversationLeaveTag
-> Sem
     (Error NoChanges : r)
     (BotsAndMembers, ConversationAction 'ConversationLeaveTag)
forall (tag :: ConversationActionTag) (r :: EffectRow).
(HasConversationActionEffects tag r,
 Member BackendNotificationQueueAccess r,
 Member (Error FederationError) r) =>
Sing tag
-> Qualified UserId
-> Local Conversation
-> ConversationAction tag
-> Sem r (BotsAndMembers, ConversationAction tag)
performAction
      Sing 'ConversationLeaveTag
SConversationActionTag 'ConversationLeaveTag
SConversationLeaveTag
      Qualified UserId
victim
      Local Conversation
lconv
      ()
  Sing 'ConversationRemoveMembersTag
-> Qualified UserId
-> Bool
-> Maybe ConnId
-> Local Conversation
-> BotsAndMembers
-> ConversationAction 'ConversationRemoveMembersTag
-> 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 @'ConversationRemoveMembersTag)
    Qualified UserId
qusr
    Bool
True
    Maybe ConnId
forall a. Maybe a
Nothing
    Local Conversation
lconv
    (BotsAndMembers
targets BotsAndMembers -> BotsAndMembers -> BotsAndMembers
forall a. Semigroup a => a -> a -> a
<> BotsAndMembers
extraTargets)
    (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)

notifyTypingIndicator ::
  ( Member (Input UTCTime) r,
    Member (Input (Local ())) r,
    Member NotificationSubsystem r,
    Member FederatorAccess r
  ) =>
  Conversation ->
  Qualified UserId ->
  Maybe ConnId ->
  TypingStatus ->
  Sem r TypingDataUpdated
notifyTypingIndicator :: 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 Qualified UserId
qusr Maybe ConnId
mcon TypingStatus
ts = do
  let origDomain :: Domain
origDomain = Qualified UserId -> Domain
forall a. Qualified a -> Domain
qDomain Qualified UserId
qusr
  UTCTime
now <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  QualifiedWithTag 'QLocal ConvId
lconv <- ConvId -> Sem r (QualifiedWithTag 'QLocal ConvId)
forall (r :: EffectRow) a.
Member (Input (Local ())) r =>
a -> Sem r (Local a)
qualifyLocal (Conversation -> ConvId
Data.convId Conversation
conv)

  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
qusr UTCTime
now ((LocalMember -> UserId) -> [LocalMember] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalMember -> UserId
lmId (Conversation -> [LocalMember]
Data.convLocalMembers Conversation
conv)) Maybe ConnId
mcon (QualifiedWithTag 'QLocal ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged QualifiedWithTag 'QLocal ConvId
lconv) TypingStatus
ts

  let ([RemoteMember]
remoteMemsOrig, [RemoteMember]
remoteMemsOther) = (RemoteMember -> Bool)
-> [RemoteMember] -> ([RemoteMember], [RemoteMember])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition ((Domain
origDomain ==) (Domain -> Bool)
-> (RemoteMember -> Domain) -> RemoteMember -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Remote UserId -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain (Remote UserId -> Domain)
-> (RemoteMember -> Remote UserId) -> RemoteMember -> Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteMember -> Remote UserId
rmId) (Conversation -> [RemoteMember]
Data.convRemoteMembers Conversation
conv)
      tdu :: [UserId] -> TypingDataUpdated
tdu [UserId]
users =
        TypingDataUpdated
          { $sel:time:TypingDataUpdated :: UTCTime
time = UTCTime
now,
            $sel:origUserId:TypingDataUpdated :: Qualified UserId
origUserId = Qualified UserId
qusr,
            $sel:convId:TypingDataUpdated :: ConvId
convId = Conversation -> ConvId
Data.convId Conversation
conv,
            $sel:usersInConv:TypingDataUpdated :: [UserId]
usersInConv = [UserId]
users,
            $sel:typingStatus:TypingDataUpdated :: TypingStatus
typingStatus = TypingStatus
ts
          }

  Sem
  r
  [Either (Remote [UserId], FederationError) (Remote EmptyResponse)]
-> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem
   r
   [Either (Remote [UserId], FederationError) (Remote EmptyResponse)]
 -> Sem r ())
-> Sem
     r
     [Either (Remote [UserId], FederationError) (Remote EmptyResponse)]
-> Sem r ()
forall a b. (a -> b) -> a -> b
$ [Remote UserId]
-> (Remote [UserId] -> FederatorClient 'Galley EmptyResponse)
-> Sem
     r
     [Either (Remote [UserId], FederationError) (Remote EmptyResponse)]
forall (r :: EffectRow) (c :: Component) (f :: * -> *) x a.
(Member FederatorAccess r, KnownComponent c, Foldable f,
 Functor f) =>
f (Remote x)
-> (Remote [x] -> FederatorClient c a)
-> Sem r [Either (Remote [x], FederationError) (Remote a)]
E.runFederatedConcurrentlyEither ((RemoteMember -> Remote UserId)
-> [RemoteMember] -> [Remote UserId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RemoteMember -> Remote UserId
rmId [RemoteMember]
remoteMemsOther) ((Remote [UserId] -> FederatorClient 'Galley EmptyResponse)
 -> Sem
      r
      [Either (Remote [UserId], FederationError) (Remote EmptyResponse)])
-> (Remote [UserId] -> FederatorClient 'Galley EmptyResponse)
-> Sem
     r
     [Either (Remote [UserId], FederationError) (Remote EmptyResponse)]
forall a b. (a -> b) -> a -> b
$ \Remote [UserId]
rmems -> do
    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 @"on-typing-indicator-updated" ([UserId] -> TypingDataUpdated
tdu (Remote [UserId] -> [UserId]
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Remote [UserId]
rmems))

  TypingDataUpdated -> Sem r TypingDataUpdated
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([UserId] -> TypingDataUpdated
tdu ((RemoteMember -> UserId) -> [RemoteMember] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Remote UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified (Remote UserId -> UserId)
-> (RemoteMember -> Remote UserId) -> RemoteMember -> UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteMember -> Remote UserId
rmId) [RemoteMember]
remoteMemsOrig))

pushTypingIndicatorEvents ::
  (Member NotificationSubsystem r) =>
  Qualified UserId ->
  UTCTime ->
  [UserId] ->
  Maybe ConnId ->
  Qualified ConvId ->
  TypingStatus ->
  Sem r ()
pushTypingIndicatorEvents :: forall (r :: EffectRow).
Member NotificationSubsystem r =>
Qualified UserId
-> UTCTime
-> [UserId]
-> Maybe ConnId
-> Qualified ConvId
-> TypingStatus
-> Sem r ()
pushTypingIndicatorEvents Qualified UserId
qusr UTCTime
tEvent [UserId]
users Maybe ConnId
mcon Qualified ConvId
qcnv TypingStatus
ts = do
  let e :: Event
e = Qualified ConvId
-> Maybe SubConvId
-> Qualified UserId
-> UTCTime
-> EventData
-> Event
Event Qualified ConvId
qcnv Maybe SubConvId
forall a. Maybe a
Nothing Qualified UserId
qusr UTCTime
tEvent (TypingStatus -> EventData
EdTyping TypingStatus
ts)
  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 (Qualified UserId -> UserId
forall a. Qualified a -> a
qUnqualified Qualified UserId
qusr) (Event -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject Event
e) (UserId -> Recipient
userRecipient (UserId -> Recipient) -> [UserId] -> [Recipient]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId]
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
mcon
          Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Route -> Identity Route) -> Push -> Identity Push
Lens' Push Route
pushRoute ((Route -> Identity Route) -> Push -> Identity Push)
-> Route -> Push -> Push
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Route
PushV2.RouteDirect
          Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Push -> Identity Push
Lens' Push Bool
pushTransient ((Bool -> Identity Bool) -> Push -> Identity Push)
-> Bool -> Push -> Push
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
      ]