{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2026 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 Wire.ConversationSubsystem.Federation where

import Control.Error hiding (note)
import Control.Lens
import Data.Bifunctor
import Data.ByteString.Conversion (toByteString')
import Data.Default
import Data.Domain (Domain)
import Data.Id
import Data.Json.Util
import Data.Map qualified as Map
import Data.Map.Lens (toMapOf)
import Data.Qualified
import Data.Range (Range (fromRange))
import Data.Set qualified as Set
import Data.Singletons (SingI (..), demote, sing)
import Data.Tagged
import Data.Text.Lazy qualified as LT
import Galley.Types.Conversations.One2One
import Galley.Types.Error
import Imports
import Network.Wai.Utilities.Exception
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Polysemy.Internal.Kind (Append)
import Polysemy.Resource
import Polysemy.TinyLog
import Polysemy.TinyLog qualified as P
import System.Logger.Class qualified as Log
import Wire.API.Conversation hiding (Member)
import Wire.API.Conversation qualified as Public
import Wire.API.Conversation.Action
import Wire.API.Conversation.Config (ConversationSubsystemConfig)
import Wire.API.Conversation.Role
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Event.Conversation
import Wire.API.Federation.API.Common (EmptyResponse (..))
import Wire.API.Federation.API.Galley hiding (id)
import Wire.API.Federation.Client (FederatorClient)
import Wire.API.Federation.Error
import Wire.API.MLS.Credential
import Wire.API.MLS.GroupInfo
import Wire.API.MLS.Keys
import Wire.API.MLS.Serialisation
import Wire.API.MLS.SubConversation
import Wire.API.Message
import Wire.API.Push.V2 (RecipientClients (..))
import Wire.API.Routes.Public.Galley.MLS
import Wire.API.ServantProto
import Wire.API.Team.FeatureFlags (FeatureFlags)
import Wire.API.User (BaseProtocolTag (..))
import Wire.BackendNotificationQueueAccess
import Wire.BrigAPIAccess (BrigAPIAccess)
import Wire.CodeStore
import Wire.ConversationStore qualified as E
import Wire.ConversationSubsystem.Action
import Wire.ConversationSubsystem.MLS.Enabled
import Wire.ConversationSubsystem.MLS.GroupInfo
import Wire.ConversationSubsystem.MLS.GroupInfoCheck (GroupInfoCheckEnabled)
import Wire.ConversationSubsystem.MLS.IncomingMessage
import Wire.ConversationSubsystem.MLS.Message
import Wire.ConversationSubsystem.MLS.One2One
import Wire.ConversationSubsystem.MLS.Removal
import Wire.ConversationSubsystem.MLS.SubConversation hiding (leaveSubConversation)
import Wire.ConversationSubsystem.MLS.Util
import Wire.ConversationSubsystem.MLS.Welcome
import Wire.ConversationSubsystem.Message
import Wire.ConversationSubsystem.Util
import Wire.ExternalAccess (ExternalAccess)
import Wire.FeaturesConfigSubsystem
import Wire.FederationAPIAccess (FederationAPIAccess)
import Wire.FederationSubsystem (FederationSubsystem)
import Wire.FireAndForget qualified as E
import Wire.LegalHoldStore (LegalHoldStore)
import Wire.MeetingNotifier
import Wire.NotificationSubsystem
import Wire.ProposalStore (ProposalStore)
import Wire.Sem.Now (Now)
import Wire.Sem.Now qualified as Now
import Wire.Sem.Random (Random)
import Wire.StoredConversation
import Wire.StoredConversation qualified as Data
import Wire.TeamCollaboratorsSubsystem
import Wire.TeamStore
import Wire.TeamSubsystem (TeamSubsystem)
import Wire.UserClientIndexStore (UserClientIndexStore)
import Wire.UserList (UserList (UserList))
import Wire.Util

onClientRemoved ::
  ( Member BackendNotificationQueueAccess r,
    Member E.ConversationStore r,
    Member ExternalAccess r,
    Member (Error FederationError) r,
    Member NotificationSubsystem r,
    Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
    Member (Input (Local ())) r,
    Member Now r,
    Member ProposalStore r,
    Member Random r,
    Member TinyLog r,
    Member (Input ConversationSubsystemConfig) r
  ) =>
  Domain ->
  ClientRemovedRequest ->
  Sem r EmptyResponse
onClientRemoved domain req = do
  let qusr = Qualified req.user domain
  whenM isMLSEnabled $ do
    for_ req.convs $ \convId -> do
      mConv <- E.getConversation convId
      for mConv $ \conv -> do
        lconv <- qualifyLocal conv
        removeClient lconv qusr (req.client)
  pure EmptyResponse

onConversationCreated ::
  ( Member BrigAPIAccess r,
    Member NotificationSubsystem r,
    Member ExternalAccess r,
    Member (Input (Local ())) r,
    Member E.ConversationStore r,
    Member P.TinyLog r
  ) =>
  Domain ->
  ConversationCreated ConvId ->
  Sem r EmptyResponse
onConversationCreated domain rc = do
  let qrc = fmap (toRemoteUnsafe domain) rc
  loc <- qualifyLocal ()
  let (localUserIds, _) = partitionQualified loc (map omQualifiedId (toList (nonCreatorMembers rc)))

  addedUserIds <-
    addLocalUsersToRemoteConv
      (cnvId qrc)
      (tUntagged (ccRemoteOrigUserId qrc))
      localUserIds

  let connectedMembers =
        Set.filter
          ( foldQualified
              loc
              (flip Set.member addedUserIds . tUnqualified)
              (const True)
              . omQualifiedId
          )
          (nonCreatorMembers rc)
  -- Make sure to notify only about local users connected to the adder
  let qrcConnected = qrc {nonCreatorMembers = connectedMembers}

  for_ (fromConversationCreated loc qrcConnected) $ \(mem, c) -> do
    let evtData = createConversationEventData c
        event =
          Event
            (tUntagged (cnvId qrcConnected))
            Nothing
            (EventFromUser (tUntagged (ccRemoteOrigUserId qrcConnected)))
            qrcConnected.time
            Nothing
            evtData
    pushConversationEvent Nothing () event (qualifyAs loc [qUnqualified . Public.memId $ mem]) []
  pure EmptyResponse

getConversations ::
  ( Member E.ConversationStore r,
    Member (Input (Local ())) r
  ) =>
  Domain ->
  GetConversationsRequest ->
  Sem r GetRemoteConversationViewsResponse
getConversations domain (GetConversationsRequest uid cids) = do
  let ruid = toRemoteUnsafe domain uid
  loc <- qualifyLocal ()
  GetRemoteConversationViewsResponse
    . mapMaybe (conversationToRemote (tDomain loc) ruid)
    <$> E.getConversations cids

-- | Update the local database with information on conversation members joining
-- or leaving. Finally, push out notifications to local users.
onConversationUpdated ::
  ( Member BrigAPIAccess r,
    Member NotificationSubsystem r,
    Member ExternalAccess r,
    Member (Input (Local ())) r,
    Member E.ConversationStore r,
    Member P.TinyLog r
  ) =>
  Domain ->
  ConversationUpdate ->
  Sem r EmptyResponse
onConversationUpdated requestingDomain cu = do
  let rcu = toRemoteUnsafe requestingDomain cu
  void $ updateLocalStateOfRemoteConv rcu Nothing
  pure EmptyResponse

-- as of now this will not generate the necessary events on the leaver's domain
leaveConversation ::
  ( Member BackendNotificationQueueAccess r,
    Member E.ConversationStore r,
    Member (Error InternalError) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input (Local ())) r,
    Member Now r,
    Member ProposalStore r,
    Member Random r,
    Member TinyLog r,
    Member TeamSubsystem r,
    Member (Input ConversationSubsystemConfig) r
  ) =>
  Domain ->
  LeaveConversationRequest ->
  Sem r LeaveConversationResponse
leaveConversation requestingDomain lc = do
  let leaver = Qualified lc.leaver requestingDomain
  lcnv <- qualifyLocal lc.convId

  res <-
    runError
      . mapToRuntimeError @'ConvNotFound RemoveFromConversationErrorNotFound
      . mapToRuntimeError @('ActionDenied 'LeaveConversation) RemoveFromConversationErrorRemovalNotAllowed
      . mapToRuntimeError @'InvalidOperation RemoveFromConversationErrorRemovalNotAllowed
      . mapError @NoChanges (const RemoveFromConversationErrorUnchanged)
      $ do
        conv <- maskConvAccessDenied $ getConversationAsMember leaver lcnv
        outcome <-
          runError @FederationError $
            lcuUpdate
              <$> updateLocalConversationLeave
                lcnv
                leaver
                Nothing
        case outcome of
          Left e -> do
            logFederationError lcnv e
            throw . internalErr $ e
          Right _ -> pure conv

  case res of
    Left e -> pure $ LeaveConversationResponse (Left e)
    Right conv -> do
      let remotes = filter ((== qDomain leaver) . tDomain) ((.id_) <$> conv.remoteMembers)
      let botsAndMembers = BotsAndMembers mempty (Set.fromList remotes) mempty
      do
        outcome <-
          runError @FederationError $
            sendConversationActionNotifications
              SConversationLeaveTag
              leaver
              False
              Nothing
              (qualifyAs lcnv conv)
              botsAndMembers
              ()
              def
        case outcome of
          Left e -> do
            logFederationError lcnv e
            throw . internalErr $ e
          Right _ -> pure ()

      pure $ LeaveConversationResponse (Right ())
  where
    internalErr = InternalErrorWithDescription . LT.pack . displayExceptionNoBacktrace

-- FUTUREWORK: report errors to the originating backend
-- FUTUREWORK: error handling for missing / mismatched clients
-- FUTUREWORK: support bots
onMessageSent ::
  ( Member NotificationSubsystem r,
    Member ExternalAccess r,
    Member E.ConversationStore r,
    Member (Input (Local ())) r,
    Member P.TinyLog r
  ) =>
  Domain ->
  RemoteMessage ConvId ->
  Sem r EmptyResponse
onMessageSent domain rmUnqualified = do
  let rm = fmap (toRemoteUnsafe domain) rmUnqualified
      convId = tUntagged rm.conversation
      msgMetadata =
        MessageMetadata
          { mmNativePush = rm.push,
            mmTransient = rm.transient,
            mmNativePriority = rm.priority,
            mmData = _data rm
          }
      recipientMap = userClientMap rm.recipients
      msgs = toMapOf (itraversed <.> itraversed) recipientMap
  (members, allMembers) <-
    first Set.fromList
      <$> E.selectRemoteMembers (Map.keys recipientMap) rm.conversation
  unless allMembers $
    P.warn $
      Log.field "conversation" (toByteString' (qUnqualified convId))
        Log.~~ Log.field "domain" (toByteString' (qDomain convId))
        Log.~~ Log.msg
          ( "Attempt to send remote message to local\
            \ users not in the conversation" ::
              ByteString
          )
  loc <- qualifyLocal ()
  void $
    sendLocalMessages
      loc
      rm.time
      rm.sender
      rm.senderClient
      Nothing
      (Just convId)
      mempty
      msgMetadata
      (Map.filterWithKey (\(uid, _) _ -> Set.member uid members) msgs)
  pure EmptyResponse

sendMessage ::
  ( Member BrigAPIAccess r,
    Member UserClientIndexStore r,
    Member (Input IntraListing) r,
    Member (Input FeatureFlags) r,
    Member E.ConversationStore r,
    Member (Error InvalidInput) r,
    Member (FederationAPIAccess FederatorClient) r,
    Member BackendNotificationQueueAccess r,
    Member NotificationSubsystem r,
    Member (Input (Local ())) r,
    Member Now r,
    Member ExternalAccess r,
    Member TeamSubsystem r,
    Member P.TinyLog r
  ) =>
  Domain ->
  ProteusMessageSendRequest ->
  Sem r MessageSendResponse
sendMessage originDomain msr = do
  let sender = Qualified msr.sender originDomain
  msg <- either throwErr pure (fromProto (fromBase64ByteString msr.rawMessage))
  lcnv <- qualifyLocal msr.convId
  MessageSendResponse <$> postQualifiedOtrMessage User sender Nothing lcnv msg
  where
    throwErr = throw . InvalidPayload . LT.pack

onUserDeleted ::
  ( Member BackendNotificationQueueAccess r,
    Member E.ConversationStore r,
    Member E.FireAndForget r,
    Member (Error FederationError) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input (Local ())) r,
    Member Now r,
    Member ProposalStore r,
    Member Random r,
    Member TinyLog r,
    Member (Input ConversationSubsystemConfig) r
  ) =>
  Domain ->
  UserDeletedConversationsNotification ->
  Sem r EmptyResponse
onUserDeleted origDomain udcn = do
  let deletedUser = toRemoteUnsafe origDomain udcn.user
      untaggedDeletedUser = tUntagged deletedUser
      convIds = conversations udcn

  E.spawnMany $
    fromRange convIds <&> \c -> do
      lc <- qualifyLocal c
      mconv <- E.getConversation c
      E.deleteMembers c (UserList [] [deletedUser])
      for_ mconv $ \conv -> do
        when (isRemoteMember deletedUser (conv.remoteMembers)) $
          case Data.convType conv of
            -- No need for a notification on One2One conv as the user is being
            -- deleted and that notification should suffice.
            Public.One2OneConv -> pure ()
            -- No need for a notification on Connect Conv as there should be no
            -- other user in the conv.
            Public.ConnectConv -> pure ()
            -- The self conv cannot be on a remote backend.
            Public.SelfConv -> pure ()
            Public.RegularConv -> do
              let botsAndMembers = convBotsAndMembers conv
              removeUser (qualifyAs lc conv) RemoveUserIncludeMain (tUntagged deletedUser)
              outcome <-
                runError @FederationError $
                  sendConversationActionNotifications
                    (sing @'ConversationLeaveTag)
                    untaggedDeletedUser
                    False
                    Nothing
                    (qualifyAs lc conv)
                    botsAndMembers
                    ()
                    def
              case outcome of
                Left e -> logFederationError lc e
                Right _ -> pure ()
  pure EmptyResponse

updateConversation ::
  forall r.
  ( Member BackendNotificationQueueAccess r,
    Member BrigAPIAccess r,
    Member CodeStore r,
    Member E.FireAndForget r,
    Member (Error FederationError) r,
    Member (Error InvalidInput) r,
    Member ExternalAccess r,
    Member (FederationAPIAccess FederatorClient) r,
    Member NotificationSubsystem r,
    Member Now r,
    Member LegalHoldStore r,
    Member ProposalStore r,
    Member TeamSubsystem r,
    Member TinyLog r,
    Member Resource r,
    Member E.ConversationStore r,
    Member Random r,
    Member FederationSubsystem r,
    Member (Input (Local ())) r,
    Member TeamCollaboratorsSubsystem r,
    Member E.MLSCommitLockStore r,
    Member TeamStore r,
    Member (Input ConversationSubsystemConfig) r,
    Member FeaturesConfigSubsystem r
  ) =>
  Domain ->
  ConversationUpdateRequest ->
  Sem r ConversationUpdateResponse
updateConversation origDomain updateRequest = do
  loc <- qualifyLocal ()
  let rusr = toRemoteUnsafe origDomain updateRequest.user
      lcnv = qualifyAs loc updateRequest.convId

  mkResponse $ case updateRequest.action of
    SomeConversationAction tag action -> case tag of
      SConversationJoinTag ->
        mapToGalleyError @(HasConversationActionGalleyErrors 'ConversationJoinTag)
          . fmap lcuUpdate
          $ updateLocalConversationJoin lcnv (tUntagged rusr) Nothing action
      SConversationLeaveTag ->
        mapToGalleyError
          @(HasConversationActionGalleyErrors 'ConversationLeaveTag)
          . fmap lcuUpdate
          $ updateLocalConversationLeave lcnv (tUntagged rusr) Nothing
      SConversationRemoveMembersTag ->
        mapToGalleyError
          @(HasConversationActionGalleyErrors 'ConversationRemoveMembersTag)
          . fmap lcuUpdate
          $ updateLocalConversationRemoveMembers lcnv (tUntagged rusr) Nothing action
      SConversationMemberUpdateTag ->
        mapToGalleyError
          @(HasConversationActionGalleyErrors 'ConversationMemberUpdateTag)
          . fmap lcuUpdate
          $ updateLocalConversationMemberUpdate lcnv (tUntagged rusr) Nothing action
      SConversationDeleteTag ->
        mapToGalleyError
          @(HasConversationActionGalleyErrors 'ConversationDeleteTag)
          . fmap lcuUpdate
          $ updateLocalConversationDelete lcnv (tUntagged rusr) Nothing
      SConversationRenameTag ->
        mapToGalleyError
          @(HasConversationActionGalleyErrors 'ConversationRenameTag)
          . fmap lcuUpdate
          $ updateLocalConversationRename lcnv (tUntagged rusr) Nothing action
      SConversationMessageTimerUpdateTag ->
        mapToGalleyError
          @(HasConversationActionGalleyErrors 'ConversationMessageTimerUpdateTag)
          . fmap lcuUpdate
          $ updateLocalConversationMessageTimerUpdate lcnv (tUntagged rusr) Nothing action
      SConversationReceiptModeUpdateTag ->
        mapToGalleyError @(HasConversationActionGalleyErrors 'ConversationReceiptModeUpdateTag)
          . fmap lcuUpdate
          $ updateLocalConversationReceiptModeUpdate lcnv (tUntagged rusr) Nothing action
      SConversationAccessDataTag ->
        mapToGalleyError
          @(HasConversationActionGalleyErrors 'ConversationAccessDataTag)
          . fmap lcuUpdate
          $ updateLocalConversationAccessData lcnv (tUntagged rusr) Nothing action
      SConversationUpdateProtocolTag ->
        mapToGalleyError
          @(HasConversationActionGalleyErrors 'ConversationUpdateProtocolTag)
          . fmap lcuUpdate
          $ updateLocalConversationUpdateProtocol lcnv (tUntagged rusr) Nothing action
      SConversationUpdateAddPermissionTag ->
        mapToGalleyError
          @(HasConversationActionGalleyErrors 'ConversationUpdateAddPermissionTag)
          . fmap lcuUpdate
          $ updateLocalConversationUpdateAddPermission lcnv (tUntagged rusr) Nothing action
      SConversationResetTag ->
        mapToGalleyError
          @(HasConversationActionGalleyErrors 'ConversationResetTag)
          . fmap lcuUpdate
          $ updateLocalConversationReset lcnv (tUntagged rusr) Nothing action
      SConversationHistoryUpdateTag ->
        mapToGalleyError
          @(HasConversationActionGalleyErrors 'ConversationHistoryUpdateTag)
          . fmap lcuUpdate
          $ updateLocalConversationHistoryUpdate lcnv (tUntagged rusr) Nothing action
  where
    mkResponse =
      fmap (either ConversationUpdateResponseError Imports.id)
        . runError @GalleyError
        . fmap (fromRight ConversationUpdateResponseNoChanges)
        . runError @NoChanges
        . fmap (either ConversationUpdateResponseNonFederatingBackends Imports.id)
        . runError @NonFederatingBackends
        . fmap (either ConversationUpdateResponseUnreachableBackends Imports.id)
        . runError @UnreachableBackends
        . fmap ConversationUpdateResponseUpdate

type MLSBundleStaticErrors =
  Append
    MLSMessageStaticErrors
    '[ ErrorS 'MLSWelcomeMismatch,
       ErrorS 'MLSIdentityMismatch,
       ErrorS 'GroupIdVersionNotSupported,
       ErrorS 'MLSInvalidLeafNodeSignature,
       ErrorS 'MLSGroupConversationMismatch
     ]

handleMLSMessageErrors ::
  ( r1
      ~ Append
          MLSBundleStaticErrors
          ( Error MLSOutOfSyncError
              ': Error GroupInfoDiagnostics
              ': Error UnreachableBackends
              ': Error NonFederatingBackends
              ': Error MLSProposalFailure
              ': Error GalleyError
              ': Error MLSProtocolError
              ': r
          )
  ) =>
  Sem r1 MLSMessageResponse ->
  Sem r MLSMessageResponse
handleMLSMessageErrors =
  fmap (either (MLSMessageResponseProtocolError . unTagged) Imports.id)
    . runError @MLSProtocolError
    . fmap (either MLSMessageResponseError Imports.id)
    . runError
    . fmap (either (MLSMessageResponseProposalFailure . pfInner) Imports.id)
    . runError
    . fmap (either MLSMessageResponseNonFederatingBackends Imports.id)
    . runError
    . fmap (either (MLSMessageResponseUnreachableBackends . Set.fromList . (.backends)) Imports.id)
    . runError @UnreachableBackends
    . fmap (either MLSMessageResponseGroupInfoDiagnostics Imports.id)
    . runError @GroupInfoDiagnostics
    . fmap (either MLSMessageResponseOutOfSyncError Imports.id)
    . runError @MLSOutOfSyncError
    . mapToGalleyError @MLSBundleStaticErrors

sendMLSCommitBundle ::
  ( Member MeetingNotifier r,
    Member BackendNotificationQueueAccess r,
    Member BrigAPIAccess r,
    Member E.ConversationStore r,
    Member ExternalAccess r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS 'MLSClientMismatch) r,
    Member (ErrorS 'MLSInvalidLeafNodeIndex) r,
    Member (ErrorS 'MLSUnsupportedProposal) r,
    Member (FederationAPIAccess FederatorClient) r,
    Member NotificationSubsystem r,
    Member (Input (Local ())) r,
    Member (Input (Maybe GroupInfoCheckEnabled)) r,
    Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
    Member Now r,
    Member LegalHoldStore r,
    Member Resource r,
    Member TeamStore r,
    Member FederationSubsystem r,
    Member TeamSubsystem r,
    Member P.TinyLog r,
    Member Random r,
    Member ProposalStore r,
    Member TeamCollaboratorsSubsystem r,
    Member E.MLSCommitLockStore r,
    Member FeaturesConfigSubsystem r,
    Member (Input ConversationSubsystemConfig) r
  ) =>
  Domain ->
  MLSMessageSendRequest ->
  Sem r MLSMessageResponse
sendMLSCommitBundle remoteDomain msr = handleMLSMessageErrors $ do
  assertMLSEnabled
  loc <- qualifyLocal ()
  let sender = toRemoteUnsafe remoteDomain msr.sender
  bundle <-
    either (throw . mlsProtocolError) pure $
      decodeMLS' (fromBase64ByteString msr.rawMessage)

  ibundle <- noteS @'MLSUnsupportedMessage $ mkIncomingBundle bundle
  (ctype, qConvOrSub) <- getConvFromGroupId ibundle.groupId
  when (qUnqualified qConvOrSub /= msr.convOrSubId) $ throwS @'MLSGroupConversationMismatch

  -- this cannot throw the error since we always pass the sender which is qualified to be remote
  MLSMessageResponseUpdates
    . fmap lcuUpdate
    <$> mapToRuntimeError @MLSLegalholdIncompatible
      (InternalErrorWithDescription "expected group conversation while handling policy conflicts")
      ( postMLSCommitBundle
          loc
          -- Type application to prevent future changes from introducing errors.
          -- It is only safe to assume that we can discard the error when the sender
          -- is actually remote.
          -- Since `tUntagged` works on local and remote, a future changed may
          -- go unchecked without this.
          (tUntagged @QRemote sender)
          msr.senderClient
          ctype
          qConvOrSub
          Nothing
          (fromMaybe def msr.enableOutOfSyncCheck)
          ibundle
      )

sendMLSMessage ::
  ( Member BackendNotificationQueueAccess r,
    Member BrigAPIAccess r,
    Member E.ConversationStore r,
    Member ExternalAccess r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (FederationAPIAccess FederatorClient) r,
    Member (ErrorS 'MLSClientMismatch) r,
    Member (ErrorS 'MLSInvalidLeafNodeIndex) r,
    Member (ErrorS 'MLSUnsupportedProposal) r,
    Member NotificationSubsystem r,
    Member (Input (Local ())) r,
    Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
    Member Now r,
    Member LegalHoldStore r,
    Member P.TinyLog r,
    Member ProposalStore r,
    Member TeamCollaboratorsSubsystem r,
    Member TeamStore r
  ) =>
  Domain ->
  MLSMessageSendRequest ->
  Sem r MLSMessageResponse
sendMLSMessage remoteDomain msr = handleMLSMessageErrors $ do
  assertMLSEnabled
  loc <- qualifyLocal ()
  let sender = toRemoteUnsafe remoteDomain msr.sender
  raw <- either (throw . mlsProtocolError) pure $ decodeMLS' (fromBase64ByteString msr.rawMessage)
  msg <- noteS @'MLSUnsupportedMessage $ mkIncomingMessage raw
  (ctype, qConvOrSub) <- getConvFromGroupId msg.groupId
  when (qUnqualified qConvOrSub /= msr.convOrSubId) $ throwS @'MLSGroupConversationMismatch
  MLSMessageResponseUpdates . map lcuUpdate
    <$> postMLSMessage
      loc
      (tUntagged sender)
      msr.senderClient
      ctype
      qConvOrSub
      Nothing
      (fromMaybe def msr.enableOutOfSyncCheck)
      msg

getSubConversationForRemoteUser ::
  ( Member E.ConversationStore r,
    Member (Input (Local ())) r,
    Member TeamSubsystem r
  ) =>
  Domain ->
  GetSubConversationsRequest ->
  Sem r GetSubConversationsResponse
getSubConversationForRemoteUser domain GetSubConversationsRequest {..} =
  fmap (either GetSubConversationsResponseError GetSubConversationsResponseSuccess)
    . runError @GalleyError
    . mapToGalleyError @MLSGetSubConvStaticErrors
    $ do
      let qusr = Qualified gsreqUser domain
      lconv <- qualifyLocal gsreqConv
      getLocalSubConversation qusr lconv gsreqSubConv

leaveSubConversation ::
  ( HasLeaveSubConversationEffects r,
    Member (Error FederationError) r,
    Member (Input (Local ())) r,
    Member Resource r,
    Member TeamSubsystem r,
    Member E.MLSCommitLockStore r,
    Member (Input ConversationSubsystemConfig) r
  ) =>
  Domain ->
  LeaveSubConversationRequest ->
  Sem r LeaveSubConversationResponse
leaveSubConversation domain lscr = do
  let rusr = toRemoteUnsafe domain (lscrUser lscr)
      cid = mkClientIdentity (tUntagged rusr) (lscrClient lscr)
  lcnv <- qualifyLocal (lscrConv lscr)
  fmap (either (LeaveSubConversationResponseProtocolError . unTagged) Imports.id)
    . runError @MLSProtocolError
    . fmap (either LeaveSubConversationResponseError Imports.id)
    . runError @GalleyError
    . mapToGalleyError @LeaveSubConversationStaticErrors
    $ leaveLocalSubConversation cid lcnv (lscrSubConv lscr)
      $> LeaveSubConversationResponseOk

deleteSubConversationForRemoteUser ::
  ( Member E.ConversationStore r,
    Member (Input (Local ())) r,
    Member Resource r,
    Member TeamSubsystem r,
    Member E.MLSCommitLockStore r,
    Member TinyLog r
  ) =>
  Domain ->
  DeleteSubConversationFedRequest ->
  Sem r DeleteSubConversationResponse
deleteSubConversationForRemoteUser domain DeleteSubConversationFedRequest {..} =
  fmap
    ( either
        DeleteSubConversationResponseError
        (\() -> DeleteSubConversationResponseSuccess)
    )
    . runError @GalleyError
    . mapToGalleyError @MLSDeleteSubConvStaticErrors
    $ do
      let qusr = Qualified dscreqUser domain
          dsc = MLSReset dscreqGroupId dscreqEpoch
      lconv <- qualifyLocal dscreqConv
      resetLocalSubConversation qusr lconv dscreqSubConv dsc

getLegacyOne2OneConversation ::
  ( Member (Input (Local ())) r,
    Member BrigAPIAccess r,
    Member (Error InvalidInput) r
  ) =>
  Domain ->
  GetOne2OneConversationRequest ->
  Sem r GetOne2OneConversationResponse
getLegacyOne2OneConversation domain (GetOne2OneConversationRequest self other) =
  fmap (Imports.fromRight GetOne2OneConversationNotConnected)
    . runError @(Tagged 'NotConnected ())
    $ do
      lother <- qualifyLocal other
      let rself = toRemoteUnsafe domain self
      ensureConnectedToRemotes lother [rself]
      foldQualified
        lother
        (const . throw $ FederationFunctionNotSupported "Getting 1:1 conversations is not supported over federation API < V2.")
        (const (pure GetOne2OneConversationBackendMismatch))
        (one2OneConvId BaseProtocolMLSTag (tUntagged lother) (tUntagged rself))

getOne2OneConversation ::
  ( Member E.ConversationStore r,
    Member (Input (Local ())) r,
    Member (Error InternalError) r,
    Member BrigAPIAccess r,
    Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r
  ) =>
  Domain ->
  GetOne2OneConversationRequest ->
  Sem r GetOne2OneConversationResponseV2
getOne2OneConversation domain (GetOne2OneConversationRequest self other) =
  fmap (Imports.fromRight GetOne2OneConversationV2MLSNotEnabled)
    . runError @(Tagged 'MLSNotEnabled ())
    . fmap (Imports.fromRight GetOne2OneConversationV2NotConnected)
    . runError @(Tagged 'NotConnected ())
    $ do
      lother <- qualifyLocal other
      let rself = toRemoteUnsafe domain self
      let getLocal lconv = do
            mconv <- E.getConversation (tUnqualified lconv)
            mlsPublicKeys <- mlsKeysToPublic <$$> getMLSPrivateKeys
            conv <- case mconv of
              Nothing -> pure (localMLSOne2OneConversationAsRemote lconv)
              Just conv ->
                note
                  (InternalErrorWithDescription "Unexpected member list in 1-1 conversation")
                  (conversationToRemote (tDomain lother) rself conv)
            pure . GetOne2OneConversationV2Ok $ RemoteMLSOne2OneConversation conv mlsPublicKeys

      ensureConnectedToRemotes lother [rself]

      foldQualified
        lother
        getLocal
        (const (pure GetOne2OneConversationV2BackendMismatch))
        (one2OneConvId BaseProtocolMLSTag (tUntagged lother) (tUntagged rself))

--------------------------------------------------------------------------------
-- Error handling machinery

class ToGalleyRuntimeError (effs :: EffectRow) r where
  mapToGalleyError ::
    (Member (Error GalleyError) r) =>
    Sem (Append effs r) a ->
    Sem r a

instance ToGalleyRuntimeError '[] r where
  mapToGalleyError = Imports.id

instance
  forall (err :: GalleyError) effs r.
  ( ToGalleyRuntimeError effs r,
    SingI err,
    Member (Error GalleyError) (Append effs r)
  ) =>
  ToGalleyRuntimeError (ErrorS err ': effs) r
  where
  mapToGalleyError act =
    mapToGalleyError @effs @r $
      runError act >>= \case
        Left _ -> throw (demote @err)
        Right res -> pure res

onMLSMessageSent ::
  ( Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input (Local ())) r,
    Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
    Member E.ConversationStore r,
    Member P.TinyLog r
  ) =>
  Domain ->
  RemoteMLSMessage ->
  Sem r EmptyResponse
onMLSMessageSent domain rmm =
  (EmptyResponse <$)
    . (logError =<<)
    . runError @(Tagged 'MLSNotEnabled ())
    $ do
      assertMLSEnabled
      loc <- qualifyLocal ()
      let rcnv = toRemoteUnsafe domain rmm.conversation
      let users = Map.keys rmm.recipients
      (members, allMembers) <-
        first Set.fromList
          <$> E.selectRemoteMembers (toList users) rcnv
      unless allMembers $
        P.warn $
          Log.field "conversation" (toByteString' (tUnqualified rcnv))
            Log.~~ Log.field "domain" (toByteString' (tDomain rcnv))
            Log.~~ Log.msg
              ( "Attempt to send remote message to local\
                \ users not in the conversation" ::
                  ByteString
              )
      let recipients =
            filter (\r -> Set.member (recipientUserId r) members)
              . map (\(u, clts) -> Recipient u (RecipientClientsSome clts))
              . Map.assocs
              $ rmm.recipients
      -- FUTUREWORK: support local bots
      let e =
            Event (tUntagged rcnv) rmm.subConversation (EventFromUser rmm.sender) rmm.time Nothing $
              EdMLSMessage (fromBase64ByteString rmm.message)

      runMessagePush loc (Just (tUntagged rcnv)) $
        newMessagePush mempty Nothing rmm.metadata recipients e
  where
    logError :: (Member P.TinyLog r) => Either (Tagged 'MLSNotEnabled ()) () -> Sem r ()
    logError (Left _) =
      P.warn $
        Log.field "conversation" (toByteString' rmm.conversation)
          Log.~~ Log.field "domain" (toByteString' domain)
          Log.~~ Log.msg
            ("Cannot process remote MLS message because MLS is disabled on this backend" :: ByteString)
    logError _ = pure ()

mlsSendWelcome ::
  ( Member (Error InternalError) r,
    Member NotificationSubsystem r,
    Member ExternalAccess r,
    Member P.TinyLog r,
    Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
    Member (Input (Local ())) r,
    Member Now r
  ) =>
  Domain ->
  MLSWelcomeRequest ->
  Sem r MLSWelcomeResponse
mlsSendWelcome origDomain req = do
  fmap (either (const MLSWelcomeMLSNotEnabled) (const MLSWelcomeSent))
    . runError @(Tagged 'MLSNotEnabled ())
    $ do
      assertMLSEnabled
      loc <- qualifyLocal ()
      now <- Now.get
      welcome <-
        either (throw . InternalErrorWithDescription . LT.fromStrict) pure $
          decodeMLS' (fromBase64ByteString req.welcomeMessage)
      sendLocalWelcomes req.qualifiedConvId (Qualified req.originatingUser origDomain) Nothing now welcome (qualifyAs loc req.recipients)

queryGroupInfo ::
  ( Member E.ConversationStore r,
    Member (Input (Local ())) r,
    Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r
  ) =>
  Domain ->
  GetGroupInfoRequest ->
  Sem r GetGroupInfoResponse
queryGroupInfo origDomain req =
  fmap (either GetGroupInfoResponseError GetGroupInfoResponseState)
    . runError @GalleyError
    . mapToGalleyError @MLSGroupInfoStaticErrors
    $ do
      assertMLSEnabled
      let sender = toRemoteUnsafe origDomain . (.sender) $ req
      state <- case req.conv of
        Conv convId -> do
          lconvId <- qualifyLocal convId
          getGroupInfoFromLocalConv (tUntagged sender) lconvId
        SubConv convId subConvId -> do
          lconvId <- qualifyLocal convId
          getSubConversationGroupInfoFromLocalConv (tUntagged sender) subConvId lconvId
      pure
        . Base64ByteString
        . unGroupInfoData
        $ state

updateTypingIndicator ::
  ( Member NotificationSubsystem r,
    Member (FederationAPIAccess FederatorClient) r,
    Member E.ConversationStore r,
    Member Now r,
    Member (Input (Local ())) r,
    Member TeamSubsystem r
  ) =>
  Domain ->
  TypingDataUpdateRequest ->
  Sem r TypingDataUpdateResponse
updateTypingIndicator origDomain TypingDataUpdateRequest {..} = do
  let qusr = Qualified userId origDomain
  lcnv <- qualifyLocal convId

  ret <- runError
    . mapToRuntimeError @'ConvNotFound ConvNotFound
    $ do
      conv <- maskConvAccessDenied $ getConversationAsMember qusr lcnv
      notifyTypingIndicator conv qusr Nothing typingStatus

  pure (either TypingDataUpdateError TypingDataUpdateSuccess ret)

onTypingIndicatorUpdated ::
  (Member NotificationSubsystem r) =>
  Domain ->
  TypingDataUpdated ->
  Sem r EmptyResponse
onTypingIndicatorUpdated origDomain TypingDataUpdated {..} = do
  let qcnv = Qualified convId origDomain
  pushTypingIndicatorEvents origUserId time usersInConv Nothing qcnv typingStatus
  pure EmptyResponse

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

-- | Log a federation error that is impossible in processing a remote request
-- for a local conversation.
logFederationError ::
  (Member P.TinyLog r) =>
  Local ConvId ->
  FederationError ->
  Sem r ()
logFederationError lc e =
  P.warn $
    Log.field "conversation" (toByteString' (tUnqualified lc))
      Log.~~ Log.field "domain" (toByteString' (tDomain lc))
      Log.~~ Log.msg
        ( "An impossible federation error occurred when deleting\
          \ a user from a local conversation: "
            <> displayException e
        )
