-- 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.MLS.GroupInfo where

import Data.Id as Id
import Data.Json.Util
import Data.Qualified
import Galley.API.MLS.Enabled
import Galley.API.MLS.Util
import Galley.API.Util
import Galley.Effects
import Galley.Effects.ConversationStore qualified as E
import Galley.Effects.FederatorAccess qualified as E
import Galley.Env
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Federation.API
import Wire.API.Federation.API.Galley
import Wire.API.Federation.Error
import Wire.API.MLS.GroupInfo
import Wire.API.MLS.SubConversation

type MLSGroupInfoStaticErrors =
  '[ ErrorS 'ConvNotFound,
     ErrorS 'MLSMissingGroupInfo,
     ErrorS 'MLSNotEnabled
   ]

getGroupInfo ::
  ( Member ConversationStore r,
    Member (Error FederationError) r,
    Member FederatorAccess r,
    Member (Input Env) r,
    Member MemberStore r
  ) =>
  (Members MLSGroupInfoStaticErrors r) =>
  Local UserId ->
  Qualified ConvId ->
  Sem r GroupInfoData
getGroupInfo :: forall (r :: EffectRow).
(Member ConversationStore r, Member (Error FederationError) r,
 Member FederatorAccess r, Member (Input Env) r,
 Member MemberStore r, Members MLSGroupInfoStaticErrors r) =>
Local UserId -> Qualified ConvId -> Sem r GroupInfoData
getGroupInfo Local UserId
lusr Qualified ConvId
qcnvId = do
  Sem r ()
forall (r :: EffectRow).
(Member (Input Env) r, Member (ErrorS 'MLSNotEnabled) r) =>
Sem r ()
assertMLSEnabled
  Local UserId
-> (Local ConvId -> Sem r GroupInfoData)
-> (Remote ConvId -> Sem r GroupInfoData)
-> Qualified ConvId
-> Sem r GroupInfoData
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
    Local UserId
lusr
    (Qualified UserId -> Local ConvId -> Sem r GroupInfoData
forall (r :: EffectRow).
(Member ConversationStore r, Member MemberStore r,
 Members MLSGroupInfoStaticErrors r) =>
Qualified UserId -> Local ConvId -> Sem r GroupInfoData
getGroupInfoFromLocalConv (Qualified UserId -> Local ConvId -> Sem r GroupInfoData)
-> (Local UserId -> Qualified UserId)
-> Local UserId
-> Local ConvId
-> Sem r GroupInfoData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (Local UserId -> Local ConvId -> Sem r GroupInfoData)
-> Local UserId -> Local ConvId -> Sem r GroupInfoData
forall a b. (a -> b) -> a -> b
$ Local UserId
lusr)
    (Local UserId -> Remote ConvOrSubConvId -> Sem r GroupInfoData
forall (r :: EffectRow).
(Member (Error FederationError) r, Member FederatorAccess r,
 Members MLSGroupInfoStaticErrors r) =>
Local UserId -> Remote ConvOrSubConvId -> Sem r GroupInfoData
getGroupInfoFromRemoteConv Local UserId
lusr (Remote ConvOrSubConvId -> Sem r GroupInfoData)
-> (Remote ConvId -> Remote ConvOrSubConvId)
-> Remote ConvId
-> Sem r GroupInfoData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConvId -> ConvOrSubConvId)
-> Remote ConvId -> Remote ConvOrSubConvId
forall a b.
(a -> b)
-> QualifiedWithTag 'QRemote a -> QualifiedWithTag 'QRemote b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConvId -> ConvOrSubConvId
forall c s. c -> ConvOrSubChoice c s
Conv)
    Qualified ConvId
qcnvId

getGroupInfoFromLocalConv ::
  ( Member ConversationStore r,
    Member MemberStore r
  ) =>
  (Members MLSGroupInfoStaticErrors r) =>
  Qualified UserId ->
  Local ConvId ->
  Sem r GroupInfoData
getGroupInfoFromLocalConv :: forall (r :: EffectRow).
(Member ConversationStore r, Member MemberStore r,
 Members MLSGroupInfoStaticErrors r) =>
Qualified UserId -> Local ConvId -> Sem r GroupInfoData
getGroupInfoFromLocalConv Qualified UserId
qusr Local ConvId
lcnvId = do
  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
$ Qualified UserId -> Local ConvId -> Sem r Conversation
forall (r :: EffectRow).
(Member (Error (Tagged 'ConvNotFound ())) r,
 Member ConversationStore r, Member MemberStore r) =>
Qualified UserId -> Local ConvId -> Sem r Conversation
getLocalConvForUser Qualified UserId
qusr Local ConvId
lcnvId
  ConvId -> Sem r (Maybe GroupInfoData)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe GroupInfoData)
E.getGroupInfo (Local ConvId -> ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvId
lcnvId)
    Sem r (Maybe GroupInfoData)
-> (Maybe GroupInfoData -> Sem r GroupInfoData)
-> Sem r GroupInfoData
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'MLSMissingGroupInfo

getGroupInfoFromRemoteConv ::
  ( Member (Error FederationError) r,
    Member FederatorAccess r
  ) =>
  (Members MLSGroupInfoStaticErrors r) =>
  Local UserId ->
  Remote ConvOrSubConvId ->
  Sem r GroupInfoData
getGroupInfoFromRemoteConv :: forall (r :: EffectRow).
(Member (Error FederationError) r, Member FederatorAccess r,
 Members MLSGroupInfoStaticErrors r) =>
Local UserId -> Remote ConvOrSubConvId -> Sem r GroupInfoData
getGroupInfoFromRemoteConv Local UserId
lusr Remote ConvOrSubConvId
rcnv = do
  let getRequest :: GetGroupInfoRequest
getRequest =
        GetGroupInfoRequest
          { $sel:sender:GetGroupInfoRequest :: UserId
sender = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr,
            $sel:conv:GetGroupInfoRequest :: ConvOrSubConvId
conv = Remote ConvOrSubConvId -> ConvOrSubConvId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Remote ConvOrSubConvId
rcnv
          }
  GetGroupInfoResponse
response <- Remote ConvOrSubConvId
-> FederatorClient 'Galley GetGroupInfoResponse
-> Sem r GetGroupInfoResponse
forall (r :: EffectRow) (c :: Component) x a.
(Member FederatorAccess r, KnownComponent c) =>
Remote x -> FederatorClient c a -> Sem r a
E.runFederated Remote ConvOrSubConvId
rcnv (forall {k} (comp :: Component) (name :: k)
       (fedM :: Component -> * -> *) (showcomp :: Symbol) api x.
(AddAnnotation 'Remote showcomp (FedPath name) x,
 showcomp ~ ShowComponent comp, HasFedEndpoint comp api name,
 HasClient (fedM comp) api, KnownComponent comp, IsNamed name,
 FederationMonad fedM, Typeable (Client (fedM comp) api)) =>
Client (fedM comp) api
forall (comp :: Component) (name :: Symbol)
       (fedM :: Component -> * -> *) (showcomp :: Symbol) api x.
(AddAnnotation 'Remote showcomp (FedPath name) x,
 showcomp ~ ShowComponent comp, HasFedEndpoint comp api name,
 HasClient (fedM comp) api, KnownComponent comp, IsNamed name,
 FederationMonad fedM, Typeable (Client (fedM comp) api)) =>
Client (fedM comp) api
fedClient @'Galley @"query-group-info" GetGroupInfoRequest
getRequest)
  case GetGroupInfoResponse
response of
    GetGroupInfoResponseError GalleyError
e -> forall (effs :: EffectRow) (r :: EffectRow) a.
RethrowErrors effs r =>
GalleyError -> Sem r a
rethrowErrors @MLSGroupInfoStaticErrors GalleyError
e
    GetGroupInfoResponseState Base64ByteString
s ->
      GroupInfoData -> Sem r GroupInfoData
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (GroupInfoData -> Sem r GroupInfoData)
-> (Base64ByteString -> GroupInfoData)
-> Base64ByteString
-> Sem r GroupInfoData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> GroupInfoData
GroupInfoData
        (ByteString -> GroupInfoData)
-> (Base64ByteString -> ByteString)
-> Base64ByteString
-> GroupInfoData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64ByteString -> ByteString
fromBase64ByteString
        (Base64ByteString -> Sem r GroupInfoData)
-> Base64ByteString -> Sem r GroupInfoData
forall a b. (a -> b) -> a -> b
$ Base64ByteString
s