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
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
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
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)
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
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
}
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