{-# LANGUAGE RecordWildCards #-}
module Galley.API.One2One
( one2OneConvId,
iUpsertOne2OneConversation,
)
where
import Data.Id
import Data.Qualified
import Galley.Data.Conversation
import Galley.Data.Conversation.Types
import Galley.Effects.ConversationStore
import Galley.Effects.MemberStore
import Galley.Types.Conversations.One2One (one2OneConvId)
import Galley.Types.ToUserRole
import Galley.Types.UserList
import Imports
import Polysemy
import Wire.API.Conversation hiding (Member)
import Wire.API.Routes.Internal.Galley.ConversationsIntra
import Wire.API.User
newConnectConversationWithRemote ::
Local UserId ->
UserList UserId ->
NewConversation
newConnectConversationWithRemote :: Local UserId -> UserList UserId -> NewConversation
newConnectConversationWithRemote Local UserId
creator UserList UserId
users =
NewConversation
{ $sel:ncMetadata:NewConversation :: ConversationMetadata
ncMetadata =
(Maybe UserId -> ConversationMetadata
defConversationMetadata (UserId -> Maybe UserId
forall a. a -> Maybe a
Just (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
creator)))
{ cnvmType = One2OneConv
},
$sel:ncUsers:NewConversation :: UserList (UserId, RoleName)
ncUsers = (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 UserId -> (UserId, RoleName)
forall a. ToUserRole a => a -> (UserId, RoleName)
toUserRole UserList UserId
users,
$sel:ncProtocol:NewConversation :: BaseProtocolTag
ncProtocol = BaseProtocolTag
BaseProtocolProteusTag
}
iUpsertOne2OneConversation ::
forall r.
( Member ConversationStore r,
Member MemberStore r
) =>
UpsertOne2OneConversationRequest ->
Sem r ()
iUpsertOne2OneConversation :: forall (r :: EffectRow).
(Member ConversationStore r, Member MemberStore r) =>
UpsertOne2OneConversationRequest -> Sem r ()
iUpsertOne2OneConversation UpsertOne2OneConversationRequest {Local UserId
Remote UserId
Qualified ConvId
Actor
DesiredMembership
uooLocalUser :: Local UserId
uooRemoteUser :: Remote UserId
uooActor :: Actor
uooActorDesiredMembership :: DesiredMembership
uooConvId :: Qualified ConvId
$sel:uooLocalUser:UpsertOne2OneConversationRequest :: UpsertOne2OneConversationRequest -> Local UserId
$sel:uooRemoteUser:UpsertOne2OneConversationRequest :: UpsertOne2OneConversationRequest -> Remote UserId
$sel:uooActor:UpsertOne2OneConversationRequest :: UpsertOne2OneConversationRequest -> Actor
$sel:uooActorDesiredMembership:UpsertOne2OneConversationRequest :: UpsertOne2OneConversationRequest -> DesiredMembership
$sel:uooConvId:UpsertOne2OneConversationRequest :: UpsertOne2OneConversationRequest -> Qualified ConvId
..} = do
let dolocal :: Local ConvId -> Sem r ()
dolocal :: Local ConvId -> Sem r ()
dolocal Local ConvId
lconvId = do
Maybe Conversation
mbConv <- ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
getConversation (Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvId
lconvId)
case Maybe Conversation
mbConv of
Maybe Conversation
Nothing -> do
let members :: UserList UserId
members =
case (Actor
uooActor, DesiredMembership
uooActorDesiredMembership) of
(Actor
LocalActor, DesiredMembership
Included) -> [UserId] -> UserList UserId
forall a. [a] -> UserList a
ulFromLocals [Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
uooLocalUser]
(Actor
LocalActor, DesiredMembership
Excluded) -> UserList UserId
forall a. Monoid a => a
mempty
(Actor
RemoteActor, DesiredMembership
Included) -> [Remote UserId] -> UserList UserId
forall a. [Remote a] -> UserList a
ulFromRemotes [Remote UserId
uooRemoteUser]
(Actor
RemoteActor, DesiredMembership
Excluded) -> UserList UserId
forall a. Monoid a => a
mempty
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (UserList UserId -> Bool
forall a. UserList a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null UserList UserId
members) (Sem r () -> Sem r ())
-> (Sem r Conversation -> Sem r ())
-> Sem r Conversation
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r Conversation -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Conversation -> Sem r ()) -> Sem r Conversation -> Sem r ()
forall a b. (a -> b) -> a -> b
$
Local ConvId -> NewConversation -> Sem r Conversation
forall (r :: EffectRow).
Member ConversationStore r =>
Local ConvId -> NewConversation -> Sem r Conversation
createConversation
Local ConvId
lconvId
(Local UserId -> UserList UserId -> NewConversation
newConnectConversationWithRemote Local UserId
uooLocalUser UserList UserId
members)
Just Conversation
conv -> do
case (Actor
uooActor, DesiredMembership
uooActorDesiredMembership) of
(Actor
LocalActor, DesiredMembership
Included) -> do
Sem r [LocalMember] -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r [LocalMember] -> Sem r ())
-> Sem r [LocalMember] -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Local ConvId -> Local UserId -> Sem r [LocalMember]
forall (r :: EffectRow).
Member MemberStore r =>
Local ConvId -> Local UserId -> Sem r [LocalMember]
createMember Local ConvId
lconvId Local UserId
uooLocalUser
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([RemoteMember] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Conversation -> [RemoteMember]
convRemoteMembers Conversation
conv)) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
ConvId -> Sem r ()
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r ()
acceptConnectConversation (Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvId
lconvId)
(Actor
LocalActor, DesiredMembership
Excluded) -> do
ConvId -> UserList UserId -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
ConvId -> UserList UserId -> Sem r ()
deleteMembers
(Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvId
lconvId)
([UserId] -> [Remote UserId] -> UserList UserId
forall a. [a] -> [Remote a] -> UserList a
UserList [Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
uooLocalUser] [])
(Actor
RemoteActor, DesiredMembership
Included) -> do
Sem r ([LocalMember], [RemoteMember]) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r ([LocalMember], [RemoteMember]) -> Sem r ())
-> Sem r ([LocalMember], [RemoteMember]) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ ConvId -> UserList UserId -> Sem r ([LocalMember], [RemoteMember])
forall (r :: EffectRow) u.
(Member MemberStore r, ToUserRole u) =>
ConvId -> UserList u -> Sem r ([LocalMember], [RemoteMember])
createMembers (Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvId
lconvId) ([UserId] -> [Remote UserId] -> UserList UserId
forall a. [a] -> [Remote a] -> UserList a
UserList [] [Remote UserId
uooRemoteUser])
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LocalMember] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Conversation -> [LocalMember]
convLocalMembers Conversation
conv)) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
ConvId -> Sem r ()
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r ()
acceptConnectConversation (Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvId
lconvId)
(Actor
RemoteActor, DesiredMembership
Excluded) ->
ConvId -> UserList UserId -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
ConvId -> UserList UserId -> Sem r ()
deleteMembers
(Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvId
lconvId)
([UserId] -> [Remote UserId] -> UserList UserId
forall a. [a] -> [Remote a] -> UserList a
UserList [] [Remote UserId
uooRemoteUser])
doremote :: Remote ConvId -> Sem r ()
doremote :: Remote ConvId -> Sem r ()
doremote Remote ConvId
rconvId =
case (Actor
uooActor, DesiredMembership
uooActorDesiredMembership) of
(Actor
LocalActor, DesiredMembership
Included) -> do
Remote ConvId -> [UserId] -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
Remote ConvId -> [UserId] -> Sem r ()
createMembersInRemoteConversation Remote ConvId
rconvId [Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
uooLocalUser]
(Actor
LocalActor, DesiredMembership
Excluded) -> do
Remote ConvId -> [UserId] -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
Remote ConvId -> [UserId] -> Sem r ()
deleteMembersInRemoteConversation Remote ConvId
rconvId [Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
uooLocalUser]
(Actor
RemoteActor, DesiredMembership
_) -> () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Local UserId
-> (Local ConvId -> Sem r ())
-> (Remote ConvId -> Sem r ())
-> Qualified ConvId
-> Sem r ()
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified Local UserId
uooLocalUser Local ConvId -> Sem r ()
dolocal Remote ConvId -> Sem r ()
doremote Qualified ConvId
uooConvId