{-# LANGUAGE RecordWildCards #-}

-- 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.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