-- 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.Mapping
  ( conversationView,
    conversationViewWithCachedOthers,
    remoteConversationView,
    conversationToRemote,
    localMemberToSelf,
  )
where

import Data.Domain (Domain)
import Data.Id (UserId, idToText)
import Data.Qualified
import Galley.API.Error
import Galley.Data.Conversation qualified as Data
import Galley.Types.Conversations.Members
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.TinyLog qualified as P
import System.Logger.Message (msg, val, (+++))
import Wire.API.Conversation hiding (Member)
import Wire.API.Conversation qualified as Conversation
import Wire.API.Federation.API.Galley

-- | View for a given user of a stored conversation.
--
-- Throws @BadMemberState@ when the user is not part of the conversation.
conversationView ::
  ( Member (Error InternalError) r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  Data.Conversation ->
  Sem r Conversation
conversationView :: forall (r :: EffectRow).
(Member (Error InternalError) r, Member TinyLog r) =>
Local UserId -> Conversation -> Sem r Conversation
conversationView Local UserId
luid Conversation
conv = do
  let remoteOthers :: [OtherMember]
remoteOthers = (RemoteMember -> OtherMember) -> [RemoteMember] -> [OtherMember]
forall a b. (a -> b) -> [a] -> [b]
map RemoteMember -> OtherMember
remoteMemberToOther ([RemoteMember] -> [OtherMember])
-> [RemoteMember] -> [OtherMember]
forall a b. (a -> b) -> a -> b
$ Conversation -> [RemoteMember]
Data.convRemoteMembers Conversation
conv
      localOthers :: [OtherMember]
localOthers = (LocalMember -> OtherMember) -> [LocalMember] -> [OtherMember]
forall a b. (a -> b) -> [a] -> [b]
map (Domain -> LocalMember -> OtherMember
localMemberToOther (Local UserId -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Local UserId
luid)) ([LocalMember] -> [OtherMember]) -> [LocalMember] -> [OtherMember]
forall a b. (a -> b) -> a -> b
$ Conversation -> [LocalMember]
Data.convLocalMembers Conversation
conv
  [OtherMember]
-> [OtherMember]
-> Conversation
-> Local UserId
-> Sem r Conversation
forall (r :: EffectRow).
(Member (Error InternalError) r, Member TinyLog r) =>
[OtherMember]
-> [OtherMember]
-> Conversation
-> Local UserId
-> Sem r Conversation
conversationViewWithCachedOthers [OtherMember]
remoteOthers [OtherMember]
localOthers Conversation
conv Local UserId
luid

-- | Like 'conversationView' but optimized for situations which could benefit
-- from pre-computing the list of @OtherMember@s in the conversation. For
-- instance, creating @ConvesationView@ for more than 1 member of the same conversation.
conversationViewWithCachedOthers ::
  ( Member (Error InternalError) r,
    Member P.TinyLog r
  ) =>
  [OtherMember] ->
  [OtherMember] ->
  Data.Conversation ->
  Local UserId ->
  Sem r Conversation
conversationViewWithCachedOthers :: forall (r :: EffectRow).
(Member (Error InternalError) r, Member TinyLog r) =>
[OtherMember]
-> [OtherMember]
-> Conversation
-> Local UserId
-> Sem r Conversation
conversationViewWithCachedOthers [OtherMember]
remoteOthers [OtherMember]
localOthers Conversation
conv Local UserId
luid = do
  let mbConv :: Maybe Conversation
mbConv = Local UserId
-> [OtherMember]
-> [OtherMember]
-> Conversation
-> Maybe Conversation
conversationViewMaybe Local UserId
luid [OtherMember]
remoteOthers [OtherMember]
localOthers Conversation
conv
  Sem r Conversation
-> (Conversation -> Sem r Conversation)
-> Maybe Conversation
-> Sem r Conversation
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Sem r Conversation
memberNotFound Conversation -> Sem r Conversation
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Conversation
mbConv
  where
    memberNotFound :: Sem r Conversation
memberNotFound = do
      (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.err ((Msg -> Msg) -> Sem r ())
-> (Builder -> Msg -> Msg) -> Builder -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
msg (Builder -> Sem r ()) -> Builder -> Sem r ()
forall a b. (a -> b) -> a -> b
$
        ByteString -> Builder
val ByteString
"User "
          Builder -> Builder -> Builder
forall a b. (ToBytes a, ToBytes b) => a -> b -> Builder
+++ UserId -> Text
forall {k} (a :: k). Id a -> Text
idToText (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid)
          Text -> Builder -> Builder
forall a b. (ToBytes a, ToBytes b) => a -> b -> Builder
+++ ByteString -> Builder
val ByteString
" is not a member of conv "
          Builder -> Text -> Builder
forall a b. (ToBytes a, ToBytes b) => a -> b -> Builder
+++ ConvId -> Text
forall {k} (a :: k). Id a -> Text
idToText (Conversation -> ConvId
Data.convId Conversation
conv)
      InternalError -> Sem r Conversation
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw InternalError
BadMemberState

-- | View for a given user of a stored conversation.
--
-- Returns 'Nothing' if the user is not part of the conversation.
conversationViewMaybe :: Local UserId -> [OtherMember] -> [OtherMember] -> Data.Conversation -> Maybe Conversation
conversationViewMaybe :: Local UserId
-> [OtherMember]
-> [OtherMember]
-> Conversation
-> Maybe Conversation
conversationViewMaybe Local UserId
luid [OtherMember]
remoteOthers [OtherMember]
localOthers Conversation
conv = do
  let selfs :: [LocalMember]
selfs = (LocalMember -> Bool) -> [LocalMember] -> [LocalMember]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid ==) (UserId -> Bool) -> (LocalMember -> UserId) -> LocalMember -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalMember -> UserId
lmId) (Conversation -> [LocalMember]
Data.convLocalMembers Conversation
conv)
  Member
self <- Local UserId -> LocalMember -> Member
forall x. Local x -> LocalMember -> Member
localMemberToSelf Local UserId
luid (LocalMember -> Member) -> Maybe LocalMember -> Maybe Member
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocalMember] -> Maybe LocalMember
forall a. [a] -> Maybe a
listToMaybe [LocalMember]
selfs
  let others :: [OtherMember]
others = (OtherMember -> Bool) -> [OtherMember] -> [OtherMember]
forall a. (a -> Bool) -> [a] -> [a]
filter (\OtherMember
oth -> Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
luid Qualified UserId -> Qualified UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= OtherMember -> Qualified UserId
omQualifiedId OtherMember
oth) [OtherMember]
localOthers [OtherMember] -> [OtherMember] -> [OtherMember]
forall a. Semigroup a => a -> a -> a
<> [OtherMember]
remoteOthers
  Conversation -> Maybe Conversation
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Conversation -> Maybe Conversation)
-> Conversation -> Maybe Conversation
forall a b. (a -> b) -> a -> b
$
    Qualified ConvId
-> ConversationMetadata -> ConvMembers -> Protocol -> Conversation
Conversation
      (QualifiedWithTag 'QLocal ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (QualifiedWithTag 'QLocal ConvId -> Qualified ConvId)
-> (Conversation -> QualifiedWithTag 'QLocal ConvId)
-> Conversation
-> Qualified ConvId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local UserId -> ConvId -> QualifiedWithTag 'QLocal ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
luid (ConvId -> QualifiedWithTag 'QLocal ConvId)
-> (Conversation -> ConvId)
-> Conversation
-> QualifiedWithTag 'QLocal ConvId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConvId
Data.convId (Conversation -> Qualified ConvId)
-> Conversation -> Qualified ConvId
forall a b. (a -> b) -> a -> b
$ Conversation
conv)
      (Conversation -> ConversationMetadata
Data.convMetadata Conversation
conv)
      (Member -> [OtherMember] -> ConvMembers
ConvMembers Member
self [OtherMember]
others)
      (Conversation -> Protocol
Data.convProtocol Conversation
conv)

-- | View for a local user of a remote conversation.
remoteConversationView ::
  Local UserId ->
  MemberStatus ->
  Remote RemoteConversationV2 ->
  Conversation
remoteConversationView :: Local UserId
-> MemberStatus -> Remote RemoteConversationV2 -> Conversation
remoteConversationView Local UserId
uid MemberStatus
status (Remote RemoteConversationV2 -> Qualified RemoteConversationV2
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged -> Qualified RemoteConversationV2
rconv Domain
rDomain) =
  let mems :: RemoteConvMembers
mems = RemoteConversationV2
rconv.members
      others :: [OtherMember]
others = RemoteConvMembers
mems.others
      self :: Member
self =
        Local UserId -> LocalMember -> Member
forall x. Local x -> LocalMember -> Member
localMemberToSelf
          Local UserId
uid
          LocalMember
            { $sel:lmId:LocalMember :: UserId
lmId = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
uid,
              $sel:lmService:LocalMember :: Maybe ServiceRef
lmService = Maybe ServiceRef
forall a. Maybe a
Nothing,
              $sel:lmStatus:LocalMember :: MemberStatus
lmStatus = MemberStatus
status,
              $sel:lmConvRoleName:LocalMember :: RoleName
lmConvRoleName = RemoteConvMembers
mems.selfRole
            }
   in Qualified ConvId
-> ConversationMetadata -> ConvMembers -> Protocol -> Conversation
Conversation
        (ConvId -> Domain -> Qualified ConvId
forall a. a -> Domain -> Qualified a
Qualified RemoteConversationV2
rconv.id Domain
rDomain)
        RemoteConversationV2
rconv.metadata
        (Member -> [OtherMember] -> ConvMembers
ConvMembers Member
self [OtherMember]
others)
        RemoteConversationV2
rconv.protocol

-- | Convert a local conversation to a structure to be returned to a remote
-- backend.
--
-- This returns 'Nothing' if the given remote user is not part of the conversation.
conversationToRemote ::
  Domain ->
  Remote UserId ->
  Data.Conversation ->
  Maybe RemoteConversationV2
conversationToRemote :: Domain
-> Remote UserId -> Conversation -> Maybe RemoteConversationV2
conversationToRemote Domain
localDomain Remote UserId
ruid Conversation
conv = do
  let ([RemoteMember]
selfs, [RemoteMember]
rothers) = (RemoteMember -> Bool)
-> [RemoteMember] -> ([RemoteMember], [RemoteMember])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Remote UserId -> Remote UserId -> Bool
forall a. Eq a => a -> a -> Bool
== Remote UserId
ruid) (Remote UserId -> Bool)
-> (RemoteMember -> Remote UserId) -> RemoteMember -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteMember -> Remote UserId
rmId) (Conversation -> [RemoteMember]
Data.convRemoteMembers Conversation
conv)
      lothers :: [LocalMember]
lothers = Conversation -> [LocalMember]
Data.convLocalMembers Conversation
conv
  RoleName
selfRole' <- RemoteMember -> RoleName
rmConvRoleName (RemoteMember -> RoleName) -> Maybe RemoteMember -> Maybe RoleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RemoteMember] -> Maybe RemoteMember
forall a. [a] -> Maybe a
listToMaybe [RemoteMember]
selfs
  let others' :: [OtherMember]
others' =
        (LocalMember -> OtherMember) -> [LocalMember] -> [OtherMember]
forall a b. (a -> b) -> [a] -> [b]
map (Domain -> LocalMember -> OtherMember
localMemberToOther Domain
localDomain) [LocalMember]
lothers
          [OtherMember] -> [OtherMember] -> [OtherMember]
forall a. Semigroup a => a -> a -> a
<> (RemoteMember -> OtherMember) -> [RemoteMember] -> [OtherMember]
forall a b. (a -> b) -> [a] -> [b]
map RemoteMember -> OtherMember
remoteMemberToOther [RemoteMember]
rothers
  RemoteConversationV2 -> Maybe RemoteConversationV2
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteConversationV2 -> Maybe RemoteConversationV2)
-> RemoteConversationV2 -> Maybe RemoteConversationV2
forall a b. (a -> b) -> a -> b
$
    RemoteConversationV2
      { $sel:id:RemoteConversationV2 :: ConvId
id = Conversation -> ConvId
Data.convId Conversation
conv,
        $sel:metadata:RemoteConversationV2 :: ConversationMetadata
metadata = Conversation -> ConversationMetadata
Data.convMetadata Conversation
conv,
        $sel:members:RemoteConversationV2 :: RemoteConvMembers
members =
          RemoteConvMembers
            { $sel:selfRole:RemoteConvMembers :: RoleName
selfRole = RoleName
selfRole',
              $sel:others:RemoteConvMembers :: [OtherMember]
others = [OtherMember]
others'
            },
        $sel:protocol:RemoteConversationV2 :: Protocol
protocol = Conversation -> Protocol
Data.convProtocol Conversation
conv
      }

-- | Convert a local conversation member (as stored in the DB) to a publicly
-- facing 'Member' structure.
localMemberToSelf :: Local x -> LocalMember -> Conversation.Member
localMemberToSelf :: forall x. Local x -> LocalMember -> Member
localMemberToSelf Local x
loc LocalMember
lm =
  Conversation.Member
    { $sel:memId:Member :: Qualified UserId
memId = Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (Local UserId -> Qualified UserId)
-> (LocalMember -> Local UserId) -> LocalMember -> Qualified UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local x -> UserId -> Local UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local x
loc (UserId -> Local UserId)
-> (LocalMember -> UserId) -> LocalMember -> Local UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalMember -> UserId
lmId (LocalMember -> Qualified UserId)
-> LocalMember -> Qualified UserId
forall a b. (a -> b) -> a -> b
$ LocalMember
lm,
      $sel:memService:Member :: Maybe ServiceRef
memService = LocalMember -> Maybe ServiceRef
lmService LocalMember
lm,
      $sel:memOtrMutedStatus:Member :: Maybe MutedStatus
memOtrMutedStatus = MemberStatus -> Maybe MutedStatus
msOtrMutedStatus MemberStatus
st,
      $sel:memOtrMutedRef:Member :: Maybe Text
memOtrMutedRef = MemberStatus -> Maybe Text
msOtrMutedRef MemberStatus
st,
      $sel:memOtrArchived:Member :: Bool
memOtrArchived = MemberStatus -> Bool
msOtrArchived MemberStatus
st,
      $sel:memOtrArchivedRef:Member :: Maybe Text
memOtrArchivedRef = MemberStatus -> Maybe Text
msOtrArchivedRef MemberStatus
st,
      $sel:memHidden:Member :: Bool
memHidden = MemberStatus -> Bool
msHidden MemberStatus
st,
      $sel:memHiddenRef:Member :: Maybe Text
memHiddenRef = MemberStatus -> Maybe Text
msHiddenRef MemberStatus
st,
      $sel:memConvRoleName:Member :: RoleName
memConvRoleName = LocalMember -> RoleName
lmConvRoleName LocalMember
lm
    }
  where
    st :: MemberStatus
st = LocalMember -> MemberStatus
lmStatus LocalMember
lm