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

import Galley.API.MLS
import Galley.App
import Imports
import Wire.API.MakesFederatedCall
import Wire.API.Routes.API
import Wire.API.Routes.Public.Galley.MLS

mlsAPI :: API MLSAPI GalleyEffects
mlsAPI :: API MLSAPI GalleyEffects
mlsAPI =
  forall {k} (name :: k) (r0 :: EffectRow) api.
(HasServer api '[Domain],
 ServerEffects (DeclaredErrorEffects api) r0) =>
ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> API (Named name api) r0
forall (name :: Symbol) (r0 :: EffectRow) api.
(HasServer api '[Domain],
 ServerEffects (DeclaredErrorEffects api) r0) =>
ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> API (Named name api) r0
mkNamedAPI @"mls-message" (((HasAnnotation 'Remote "galley" "on-mls-message-sent",
  (HasAnnotation 'Remote "galley" "send-mls-message",
   (HasAnnotation 'Remote "galley" "on-conversation-updated",
    (HasAnnotation 'Remote "brig" "get-mls-clients",
     () :: Constraint)))) =>
 QualifiedWithTag 'QLocal UserId
 -> ClientId
 -> ConnId
 -> RawMLS Message
 -> Sem
      '[Error (Tagged 'ConvAccessDenied ()),
        Error (Tagged 'ConvMemberNotFound ()),
        Error (Tagged 'ConvNotFound ()),
        Error (Tagged 'LegalHoldNotEnabled ()),
        Error (Tagged 'MissingLegalholdConsent ()),
        Error (Tagged 'MLSClientMismatch ()),
        Error (Tagged 'MLSClientSenderUserMismatch ()),
        Error (Tagged 'MLSCommitMissingReferences ()),
        Error (Tagged 'MLSGroupConversationMismatch ()),
        Error (Tagged 'MLSInvalidLeafNodeIndex ()),
        Error (Tagged 'MLSNotEnabled ()),
        Error (Tagged 'MLSProposalNotFound ()), Error MLSProtocolError,
        Error (Tagged 'MLSSelfRemovalNotAllowed ()),
        Error (Tagged 'MLSStaleMessage ()),
        Error (Tagged 'MLSSubConvClientNotInParent ()),
        Error (Tagged 'MLSUnsupportedMessage ()),
        Error (Tagged 'MLSUnsupportedProposal ()),
        Error MLSProposalFailure, Error NonFederatingBackends,
        Error UnreachableBackends, BrigAccess, SparAccess,
        NotificationSubsystem, GundeckAPIAccess, Rpc, ExternalAccess,
        FederatorAccess, BackendNotificationQueueAccess, BotAccess,
        FireAndForget, ClientStore, CodeStore, ProposalStore,
        ConversationStore, SubConversationStore, Random,
        CustomBackendStore, TeamFeatureStore, LegalHoldStore, MemberStore,
        SearchVisibilityStore, ServiceStore, TeamNotificationStore,
        TeamStore, TeamMemberStore InternalPaging,
        TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
        ListItems CassandraPaging (Remote ConvId),
        ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
        ListItems InternalPaging TeamId, Input AllTeamFeatures,
        Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
        Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
        Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
        Error InvalidInput, Error InternalError, Error FederationError,
        Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
        Final IO]
      MLSMessageSendingStatus)
-> Dict (HasAnnotation 'Remote "galley" "on-mls-message-sent")
-> Dict (HasAnnotation 'Remote "galley" "send-mls-message")
-> Dict (HasAnnotation 'Remote "galley" "on-conversation-updated")
-> Dict (HasAnnotation 'Remote "brig" "get-mls-clients")
-> QualifiedWithTag 'QLocal UserId
-> ClientId
-> ConnId
-> RawMLS Message
-> Sem
     '[Error (Tagged 'ConvAccessDenied ()),
       Error (Tagged 'ConvMemberNotFound ()),
       Error (Tagged 'ConvNotFound ()),
       Error (Tagged 'LegalHoldNotEnabled ()),
       Error (Tagged 'MissingLegalholdConsent ()),
       Error (Tagged 'MLSClientMismatch ()),
       Error (Tagged 'MLSClientSenderUserMismatch ()),
       Error (Tagged 'MLSCommitMissingReferences ()),
       Error (Tagged 'MLSGroupConversationMismatch ()),
       Error (Tagged 'MLSInvalidLeafNodeIndex ()),
       Error (Tagged 'MLSNotEnabled ()),
       Error (Tagged 'MLSProposalNotFound ()), Error MLSProtocolError,
       Error (Tagged 'MLSSelfRemovalNotAllowed ()),
       Error (Tagged 'MLSStaleMessage ()),
       Error (Tagged 'MLSSubConvClientNotInParent ()),
       Error (Tagged 'MLSUnsupportedMessage ()),
       Error (Tagged 'MLSUnsupportedProposal ()),
       Error MLSProposalFailure, Error NonFederatingBackends,
       Error UnreachableBackends, BrigAccess, SparAccess,
       NotificationSubsystem, GundeckAPIAccess, Rpc, ExternalAccess,
       FederatorAccess, BackendNotificationQueueAccess, BotAccess,
       FireAndForget, ClientStore, CodeStore, ProposalStore,
       ConversationStore, SubConversationStore, Random,
       CustomBackendStore, TeamFeatureStore, LegalHoldStore, MemberStore,
       SearchVisibilityStore, ServiceStore, TeamNotificationStore,
       TeamStore, TeamMemberStore InternalPaging,
       TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
       ListItems CassandraPaging (Remote ConvId),
       ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
       ListItems InternalPaging TeamId, Input AllTeamFeatures,
       Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
       Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
       Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
       Error InvalidInput, Error InternalError, Error FederationError,
       Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
       Final IO]
     MLSMessageSendingStatus
forall (c :: Constraint) r a. SolveCallsFed c r a => (c => r) -> a
callsFed ((QualifiedWithTag 'QLocal UserId
 -> ClientId
 -> ConnId
 -> RawMLS Message
 -> Sem
      '[Error (Tagged 'ConvAccessDenied ()),
        Error (Tagged 'ConvMemberNotFound ()),
        Error (Tagged 'ConvNotFound ()),
        Error (Tagged 'LegalHoldNotEnabled ()),
        Error (Tagged 'MissingLegalholdConsent ()),
        Error (Tagged 'MLSClientMismatch ()),
        Error (Tagged 'MLSClientSenderUserMismatch ()),
        Error (Tagged 'MLSCommitMissingReferences ()),
        Error (Tagged 'MLSGroupConversationMismatch ()),
        Error (Tagged 'MLSInvalidLeafNodeIndex ()),
        Error (Tagged 'MLSNotEnabled ()),
        Error (Tagged 'MLSProposalNotFound ()), Error MLSProtocolError,
        Error (Tagged 'MLSSelfRemovalNotAllowed ()),
        Error (Tagged 'MLSStaleMessage ()),
        Error (Tagged 'MLSSubConvClientNotInParent ()),
        Error (Tagged 'MLSUnsupportedMessage ()),
        Error (Tagged 'MLSUnsupportedProposal ()),
        Error MLSProposalFailure, Error NonFederatingBackends,
        Error UnreachableBackends, BrigAccess, SparAccess,
        NotificationSubsystem, GundeckAPIAccess, Rpc, ExternalAccess,
        FederatorAccess, BackendNotificationQueueAccess, BotAccess,
        FireAndForget, ClientStore, CodeStore, ProposalStore,
        ConversationStore, SubConversationStore, Random,
        CustomBackendStore, TeamFeatureStore, LegalHoldStore, MemberStore,
        SearchVisibilityStore, ServiceStore, TeamNotificationStore,
        TeamStore, TeamMemberStore InternalPaging,
        TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
        ListItems CassandraPaging (Remote ConvId),
        ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
        ListItems InternalPaging TeamId, Input AllTeamFeatures,
        Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
        Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
        Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
        Error InvalidInput, Error InternalError, Error FederationError,
        Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
        Final IO]
      MLSMessageSendingStatus)
-> QualifiedWithTag 'QLocal UserId
-> ClientId
-> ConnId
-> RawMLS Message
-> Sem
     '[Error (Tagged 'ConvAccessDenied ()),
       Error (Tagged 'ConvMemberNotFound ()),
       Error (Tagged 'ConvNotFound ()),
       Error (Tagged 'LegalHoldNotEnabled ()),
       Error (Tagged 'MissingLegalholdConsent ()),
       Error (Tagged 'MLSClientMismatch ()),
       Error (Tagged 'MLSClientSenderUserMismatch ()),
       Error (Tagged 'MLSCommitMissingReferences ()),
       Error (Tagged 'MLSGroupConversationMismatch ()),
       Error (Tagged 'MLSInvalidLeafNodeIndex ()),
       Error (Tagged 'MLSNotEnabled ()),
       Error (Tagged 'MLSProposalNotFound ()), Error MLSProtocolError,
       Error (Tagged 'MLSSelfRemovalNotAllowed ()),
       Error (Tagged 'MLSStaleMessage ()),
       Error (Tagged 'MLSSubConvClientNotInParent ()),
       Error (Tagged 'MLSUnsupportedMessage ()),
       Error (Tagged 'MLSUnsupportedProposal ()),
       Error MLSProposalFailure, Error NonFederatingBackends,
       Error UnreachableBackends, BrigAccess, SparAccess,
       NotificationSubsystem, GundeckAPIAccess, Rpc, ExternalAccess,
       FederatorAccess, BackendNotificationQueueAccess, BotAccess,
       FireAndForget, ClientStore, CodeStore, ProposalStore,
       ConversationStore, SubConversationStore, Random,
       CustomBackendStore, TeamFeatureStore, LegalHoldStore, MemberStore,
       SearchVisibilityStore, ServiceStore, TeamNotificationStore,
       TeamStore, TeamMemberStore InternalPaging,
       TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
       ListItems CassandraPaging (Remote ConvId),
       ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
       ListItems InternalPaging TeamId, Input AllTeamFeatures,
       Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
       Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
       Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
       Error InvalidInput, Error InternalError, Error FederationError,
       Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
       Final IO]
     MLSMessageSendingStatus
forall x a. ToHasAnnotations x => a -> a
exposeAnnotations QualifiedWithTag 'QLocal UserId
-> ClientId
-> ConnId
-> RawMLS Message
-> Sem
     '[Error (Tagged 'ConvAccessDenied ()),
       Error (Tagged 'ConvMemberNotFound ()),
       Error (Tagged 'ConvNotFound ()),
       Error (Tagged 'LegalHoldNotEnabled ()),
       Error (Tagged 'MissingLegalholdConsent ()),
       Error (Tagged 'MLSClientMismatch ()),
       Error (Tagged 'MLSClientSenderUserMismatch ()),
       Error (Tagged 'MLSCommitMissingReferences ()),
       Error (Tagged 'MLSGroupConversationMismatch ()),
       Error (Tagged 'MLSInvalidLeafNodeIndex ()),
       Error (Tagged 'MLSNotEnabled ()),
       Error (Tagged 'MLSProposalNotFound ()), Error MLSProtocolError,
       Error (Tagged 'MLSSelfRemovalNotAllowed ()),
       Error (Tagged 'MLSStaleMessage ()),
       Error (Tagged 'MLSSubConvClientNotInParent ()),
       Error (Tagged 'MLSUnsupportedMessage ()),
       Error (Tagged 'MLSUnsupportedProposal ()),
       Error MLSProposalFailure, Error NonFederatingBackends,
       Error UnreachableBackends, BrigAccess, SparAccess,
       NotificationSubsystem, GundeckAPIAccess, Rpc, ExternalAccess,
       FederatorAccess, BackendNotificationQueueAccess, BotAccess,
       FireAndForget, ClientStore, CodeStore, ProposalStore,
       ConversationStore, SubConversationStore, Random,
       CustomBackendStore, TeamFeatureStore, LegalHoldStore, MemberStore,
       SearchVisibilityStore, ServiceStore, TeamNotificationStore,
       TeamStore, TeamMemberStore InternalPaging,
       TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
       ListItems CassandraPaging (Remote ConvId),
       ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
       ListItems InternalPaging TeamId, Input AllTeamFeatures,
       Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
       Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
       Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
       Error InvalidInput, Error InternalError, Error FederationError,
       Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
       Final IO]
     MLSMessageSendingStatus
forall (r :: EffectRow).
(HasProposalEffects r,
 Member (Error (Tagged 'ConvAccessDenied ())) r,
 Member (Error (Tagged 'ConvMemberNotFound ())) r,
 Member (Error (Tagged 'ConvNotFound ())) r,
 Member (Error (Tagged 'MissingLegalholdConsent ())) r,
 Member (Error (Tagged 'MLSClientSenderUserMismatch ())) r,
 Member (Error (Tagged 'MLSCommitMissingReferences ())) r,
 Member (Error (Tagged 'MLSGroupConversationMismatch ())) r,
 Member (Error (Tagged 'MLSNotEnabled ())) r,
 Member (Error (Tagged 'MLSProposalNotFound ())) r,
 Member (Error (Tagged 'MLSSelfRemovalNotAllowed ())) r,
 Member (Error (Tagged 'MLSStaleMessage ())) r,
 Member (Error (Tagged 'MLSUnsupportedMessage ())) r,
 Member (Error (Tagged 'MLSSubConvClientNotInParent ())) r,
 Member SubConversationStore r) =>
QualifiedWithTag 'QLocal UserId
-> ClientId
-> ConnId
-> RawMLS Message
-> Sem r MLSMessageSendingStatus
postMLSMessageFromLocalUser))
    API
  (Named
     "mls-message"
     ("mls"
      :> (Summary "Post an MLS message"
          :> (From 'V5
              :> (MakesFederatedCall 'Galley "on-mls-message-sent"
                  :> (MakesFederatedCall 'Galley "send-mls-message"
                      :> (MakesFederatedCall 'Galley "on-conversation-updated"
                          :> (MakesFederatedCall 'Brig "get-mls-clients"
                              :> (CanThrow 'ConvAccessDenied
                                  :> (CanThrow 'ConvMemberNotFound
                                      :> (CanThrow 'ConvNotFound
                                          :> (CanThrow 'LegalHoldNotEnabled
                                              :> (CanThrow 'MissingLegalholdConsent
                                                  :> (CanThrow 'MLSClientMismatch
                                                      :> (CanThrow 'MLSClientSenderUserMismatch
                                                          :> (CanThrow 'MLSCommitMissingReferences
                                                              :> (CanThrow
                                                                    'MLSGroupConversationMismatch
                                                                  :> (CanThrow
                                                                        'MLSInvalidLeafNodeIndex
                                                                      :> (CanThrow 'MLSNotEnabled
                                                                          :> (CanThrow
                                                                                'MLSProposalNotFound
                                                                              :> (CanThrow
                                                                                    'MLSProtocolErrorTag
                                                                                  :> (CanThrow
                                                                                        'MLSSelfRemovalNotAllowed
                                                                                      :> (CanThrow
                                                                                            'MLSStaleMessage
                                                                                          :> (CanThrow
                                                                                                'MLSSubConvClientNotInParent
                                                                                              :> (CanThrow
                                                                                                    'MLSUnsupportedMessage
                                                                                                  :> (CanThrow
                                                                                                        'MLSUnsupportedProposal
                                                                                                      :> (CanThrow
                                                                                                            MLSProposalFailure
                                                                                                          :> (CanThrow
                                                                                                                NonFederatingBackends
                                                                                                              :> (CanThrow
                                                                                                                    UnreachableBackends
                                                                                                                  :> ("messages"
                                                                                                                      :> (ZLocalUser
                                                                                                                          :> (ZClient
                                                                                                                              :> (ZConn
                                                                                                                                  :> (ReqBody
                                                                                                                                        '[MLS]
                                                                                                                                        (RawMLS
                                                                                                                                           Message)
                                                                                                                                      :> MultiVerb
                                                                                                                                           'POST
                                                                                                                                           '[JSON]
                                                                                                                                           '[Respond
                                                                                                                                               201
                                                                                                                                               "Message sent"
                                                                                                                                               MLSMessageSendingStatus]
                                                                                                                                           MLSMessageSendingStatus))))))))))))))))))))))))))))))))))
  '[BrigAccess, SparAccess, NotificationSubsystem, GundeckAPIAccess,
    Rpc, ExternalAccess, FederatorAccess,
    BackendNotificationQueueAccess, BotAccess, FireAndForget,
    ClientStore, CodeStore, ProposalStore, ConversationStore,
    SubConversationStore, Random, CustomBackendStore, TeamFeatureStore,
    LegalHoldStore, MemberStore, SearchVisibilityStore, ServiceStore,
    TeamNotificationStore, TeamStore, TeamMemberStore InternalPaging,
    TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
    ListItems CassandraPaging (Remote ConvId),
    ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
    ListItems InternalPaging TeamId, Input AllTeamFeatures,
    Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
    Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
    Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
    Error InvalidInput, Error InternalError, Error FederationError,
    Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
    Final IO]
-> API
     (Named
        "mls-commit-bundle"
        ("mls"
         :> (Summary "Post a MLS CommitBundle"
             :> (From 'V5
                 :> (MakesFederatedCall 'Galley "on-mls-message-sent"
                     :> (MakesFederatedCall 'Galley "mls-welcome"
                         :> (MakesFederatedCall 'Galley "send-mls-commit-bundle"
                             :> (MakesFederatedCall 'Galley "on-conversation-updated"
                                 :> (MakesFederatedCall 'Brig "get-mls-clients"
                                     :> (MakesFederatedCall 'Brig "get-users-by-ids"
                                         :> (MakesFederatedCall 'Brig "api-version"
                                             :> (CanThrow 'ConvAccessDenied
                                                 :> (CanThrow 'ConvMemberNotFound
                                                     :> (CanThrow 'ConvNotFound
                                                         :> (CanThrow 'LegalHoldNotEnabled
                                                             :> (CanThrow 'MissingLegalholdConsent
                                                                 :> (CanThrow 'MLSClientMismatch
                                                                     :> (CanThrow
                                                                           'MLSClientSenderUserMismatch
                                                                         :> (CanThrow
                                                                               'MLSCommitMissingReferences
                                                                             :> (CanThrow
                                                                                   'MLSGroupConversationMismatch
                                                                                 :> (CanThrow
                                                                                       'MLSInvalidLeafNodeIndex
                                                                                     :> (CanThrow
                                                                                           'MLSNotEnabled
                                                                                         :> (CanThrow
                                                                                               'MLSProposalNotFound
                                                                                             :> (CanThrow
                                                                                                   'MLSProtocolErrorTag
                                                                                                 :> (CanThrow
                                                                                                       'MLSSelfRemovalNotAllowed
                                                                                                     :> (CanThrow
                                                                                                           'MLSStaleMessage
                                                                                                         :> (CanThrow
                                                                                                               'MLSSubConvClientNotInParent
                                                                                                             :> (CanThrow
                                                                                                                   'MLSUnsupportedMessage
                                                                                                                 :> (CanThrow
                                                                                                                       'MLSUnsupportedProposal
                                                                                                                     :> (CanThrow
                                                                                                                           'MLSWelcomeMismatch
                                                                                                                         :> (CanThrow
                                                                                                                               'MLSLegalholdIncompatible
                                                                                                                             :> (CanThrow
                                                                                                                                   MLSProposalFailure
                                                                                                                                 :> (CanThrow
                                                                                                                                       NonFederatingBackends
                                                                                                                                     :> (CanThrow
                                                                                                                                           UnreachableBackends
                                                                                                                                         :> ("commit-bundles"
                                                                                                                                             :> (ZLocalUser
                                                                                                                                                 :> (ZClient
                                                                                                                                                     :> (ZConn
                                                                                                                                                         :> (ReqBody
                                                                                                                                                               '[MLS]
                                                                                                                                                               (RawMLS
                                                                                                                                                                  CommitBundle)
                                                                                                                                                             :> MultiVerb
                                                                                                                                                                  'POST
                                                                                                                                                                  '[JSON]
                                                                                                                                                                  '[Respond
                                                                                                                                                                      201
                                                                                                                                                                      "Commit accepted and forwarded"
                                                                                                                                                                      MLSMessageSendingStatus]
                                                                                                                                                                  MLSMessageSendingStatus))))))))))))))))))))))))))))))))))))))
      :<|> Named
             "mls-public-keys"
             ("mls"
              :> (Summary
                    "Get public keys used by the backend to sign external proposals"
                  :> (Description
                        "The format of the returned key is determined by the `format` query parameter:\n - raw (default): base64-encoded raw public keys\n - jwk: keys are nested objects in JWK format."
                      :> (From 'V5
                          :> (CanThrow 'MLSNotEnabled
                              :> ("public-keys"
                                  :> (ZLocalUser
                                      :> (QueryParam "format" MLSPublicKeyFormat
                                          :> MultiVerb
                                               'GET
                                               '[JSON]
                                               '[Respond
                                                   200
                                                   "Public keys"
                                                   (MLSKeysByPurpose (MLSKeys SomeKey))]
                                               (MLSKeysByPurpose (MLSKeys SomeKey)))))))))))
     '[BrigAccess, SparAccess, NotificationSubsystem, GundeckAPIAccess,
       Rpc, ExternalAccess, FederatorAccess,
       BackendNotificationQueueAccess, BotAccess, FireAndForget,
       ClientStore, CodeStore, ProposalStore, ConversationStore,
       SubConversationStore, Random, CustomBackendStore, TeamFeatureStore,
       LegalHoldStore, MemberStore, SearchVisibilityStore, ServiceStore,
       TeamNotificationStore, TeamStore, TeamMemberStore InternalPaging,
       TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
       ListItems CassandraPaging (Remote ConvId),
       ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
       ListItems InternalPaging TeamId, Input AllTeamFeatures,
       Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
       Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
       Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
       Error InvalidInput, Error InternalError, Error FederationError,
       Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
       Final IO]
-> API
     (Named
        "mls-message"
        ("mls"
         :> (Summary "Post an MLS message"
             :> (From 'V5
                 :> (MakesFederatedCall 'Galley "on-mls-message-sent"
                     :> (MakesFederatedCall 'Galley "send-mls-message"
                         :> (MakesFederatedCall 'Galley "on-conversation-updated"
                             :> (MakesFederatedCall 'Brig "get-mls-clients"
                                 :> (CanThrow 'ConvAccessDenied
                                     :> (CanThrow 'ConvMemberNotFound
                                         :> (CanThrow 'ConvNotFound
                                             :> (CanThrow 'LegalHoldNotEnabled
                                                 :> (CanThrow 'MissingLegalholdConsent
                                                     :> (CanThrow 'MLSClientMismatch
                                                         :> (CanThrow 'MLSClientSenderUserMismatch
                                                             :> (CanThrow
                                                                   'MLSCommitMissingReferences
                                                                 :> (CanThrow
                                                                       'MLSGroupConversationMismatch
                                                                     :> (CanThrow
                                                                           'MLSInvalidLeafNodeIndex
                                                                         :> (CanThrow 'MLSNotEnabled
                                                                             :> (CanThrow
                                                                                   'MLSProposalNotFound
                                                                                 :> (CanThrow
                                                                                       'MLSProtocolErrorTag
                                                                                     :> (CanThrow
                                                                                           'MLSSelfRemovalNotAllowed
                                                                                         :> (CanThrow
                                                                                               'MLSStaleMessage
                                                                                             :> (CanThrow
                                                                                                   'MLSSubConvClientNotInParent
                                                                                                 :> (CanThrow
                                                                                                       'MLSUnsupportedMessage
                                                                                                     :> (CanThrow
                                                                                                           'MLSUnsupportedProposal
                                                                                                         :> (CanThrow
                                                                                                               MLSProposalFailure
                                                                                                             :> (CanThrow
                                                                                                                   NonFederatingBackends
                                                                                                                 :> (CanThrow
                                                                                                                       UnreachableBackends
                                                                                                                     :> ("messages"
                                                                                                                         :> (ZLocalUser
                                                                                                                             :> (ZClient
                                                                                                                                 :> (ZConn
                                                                                                                                     :> (ReqBody
                                                                                                                                           '[MLS]
                                                                                                                                           (RawMLS
                                                                                                                                              Message)
                                                                                                                                         :> MultiVerb
                                                                                                                                              'POST
                                                                                                                                              '[JSON]
                                                                                                                                              '[Respond
                                                                                                                                                  201
                                                                                                                                                  "Message sent"
                                                                                                                                                  MLSMessageSendingStatus]
                                                                                                                                              MLSMessageSendingStatus)))))))))))))))))))))))))))))))))
      :<|> (Named
              "mls-commit-bundle"
              ("mls"
               :> (Summary "Post a MLS CommitBundle"
                   :> (From 'V5
                       :> (MakesFederatedCall 'Galley "on-mls-message-sent"
                           :> (MakesFederatedCall 'Galley "mls-welcome"
                               :> (MakesFederatedCall 'Galley "send-mls-commit-bundle"
                                   :> (MakesFederatedCall 'Galley "on-conversation-updated"
                                       :> (MakesFederatedCall 'Brig "get-mls-clients"
                                           :> (MakesFederatedCall 'Brig "get-users-by-ids"
                                               :> (MakesFederatedCall 'Brig "api-version"
                                                   :> (CanThrow 'ConvAccessDenied
                                                       :> (CanThrow 'ConvMemberNotFound
                                                           :> (CanThrow 'ConvNotFound
                                                               :> (CanThrow 'LegalHoldNotEnabled
                                                                   :> (CanThrow
                                                                         'MissingLegalholdConsent
                                                                       :> (CanThrow
                                                                             'MLSClientMismatch
                                                                           :> (CanThrow
                                                                                 'MLSClientSenderUserMismatch
                                                                               :> (CanThrow
                                                                                     'MLSCommitMissingReferences
                                                                                   :> (CanThrow
                                                                                         'MLSGroupConversationMismatch
                                                                                       :> (CanThrow
                                                                                             'MLSInvalidLeafNodeIndex
                                                                                           :> (CanThrow
                                                                                                 'MLSNotEnabled
                                                                                               :> (CanThrow
                                                                                                     'MLSProposalNotFound
                                                                                                   :> (CanThrow
                                                                                                         'MLSProtocolErrorTag
                                                                                                       :> (CanThrow
                                                                                                             'MLSSelfRemovalNotAllowed
                                                                                                           :> (CanThrow
                                                                                                                 'MLSStaleMessage
                                                                                                               :> (CanThrow
                                                                                                                     'MLSSubConvClientNotInParent
                                                                                                                   :> (CanThrow
                                                                                                                         'MLSUnsupportedMessage
                                                                                                                       :> (CanThrow
                                                                                                                             'MLSUnsupportedProposal
                                                                                                                           :> (CanThrow
                                                                                                                                 'MLSWelcomeMismatch
                                                                                                                               :> (CanThrow
                                                                                                                                     'MLSLegalholdIncompatible
                                                                                                                                   :> (CanThrow
                                                                                                                                         MLSProposalFailure
                                                                                                                                       :> (CanThrow
                                                                                                                                             NonFederatingBackends
                                                                                                                                           :> (CanThrow
                                                                                                                                                 UnreachableBackends
                                                                                                                                               :> ("commit-bundles"
                                                                                                                                                   :> (ZLocalUser
                                                                                                                                                       :> (ZClient
                                                                                                                                                           :> (ZConn
                                                                                                                                                               :> (ReqBody
                                                                                                                                                                     '[MLS]
                                                                                                                                                                     (RawMLS
                                                                                                                                                                        CommitBundle)
                                                                                                                                                                   :> MultiVerb
                                                                                                                                                                        'POST
                                                                                                                                                                        '[JSON]
                                                                                                                                                                        '[Respond
                                                                                                                                                                            201
                                                                                                                                                                            "Commit accepted and forwarded"
                                                                                                                                                                            MLSMessageSendingStatus]
                                                                                                                                                                        MLSMessageSendingStatus))))))))))))))))))))))))))))))))))))))
            :<|> Named
                   "mls-public-keys"
                   ("mls"
                    :> (Summary
                          "Get public keys used by the backend to sign external proposals"
                        :> (Description
                              "The format of the returned key is determined by the `format` query parameter:\n - raw (default): base64-encoded raw public keys\n - jwk: keys are nested objects in JWK format."
                            :> (From 'V5
                                :> (CanThrow 'MLSNotEnabled
                                    :> ("public-keys"
                                        :> (ZLocalUser
                                            :> (QueryParam "format" MLSPublicKeyFormat
                                                :> MultiVerb
                                                     'GET
                                                     '[JSON]
                                                     '[Respond
                                                         200
                                                         "Public keys"
                                                         (MLSKeysByPurpose (MLSKeys SomeKey))]
                                                     (MLSKeysByPurpose (MLSKeys SomeKey))))))))))))
     '[BrigAccess, SparAccess, NotificationSubsystem, GundeckAPIAccess,
       Rpc, ExternalAccess, FederatorAccess,
       BackendNotificationQueueAccess, BotAccess, FireAndForget,
       ClientStore, CodeStore, ProposalStore, ConversationStore,
       SubConversationStore, Random, CustomBackendStore, TeamFeatureStore,
       LegalHoldStore, MemberStore, SearchVisibilityStore, ServiceStore,
       TeamNotificationStore, TeamStore, TeamMemberStore InternalPaging,
       TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
       ListItems CassandraPaging (Remote ConvId),
       ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
       ListItems InternalPaging TeamId, Input AllTeamFeatures,
       Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
       Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
       Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
       Error InvalidInput, Error InternalError, Error FederationError,
       Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
       Final IO]
forall api1 (r :: EffectRow) api2.
API api1 r -> API api2 r -> API (api1 :<|> api2) r
<@> forall {k} (name :: k) (r0 :: EffectRow) api.
(HasServer api '[Domain],
 ServerEffects (DeclaredErrorEffects api) r0) =>
ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> API (Named name api) r0
forall (name :: Symbol) (r0 :: EffectRow) api.
(HasServer api '[Domain],
 ServerEffects (DeclaredErrorEffects api) r0) =>
ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> API (Named name api) r0
mkNamedAPI @"mls-commit-bundle" (((HasAnnotation 'Remote "galley" "on-mls-message-sent",
  (HasAnnotation 'Remote "galley" "mls-welcome",
   (HasAnnotation 'Remote "galley" "send-mls-commit-bundle",
    (HasAnnotation 'Remote "galley" "on-conversation-updated",
     (HasAnnotation 'Remote "brig" "get-mls-clients",
      (HasAnnotation 'Remote "brig" "get-users-by-ids",
       (HasAnnotation 'Remote "brig" "api-version",
        () :: Constraint))))))) =>
 QualifiedWithTag 'QLocal UserId
 -> ClientId
 -> ConnId
 -> RawMLS CommitBundle
 -> Sem
      '[Error (Tagged 'ConvAccessDenied ()),
        Error (Tagged 'ConvMemberNotFound ()),
        Error (Tagged 'ConvNotFound ()),
        Error (Tagged 'LegalHoldNotEnabled ()),
        Error (Tagged 'MissingLegalholdConsent ()),
        Error (Tagged 'MLSClientMismatch ()),
        Error (Tagged 'MLSClientSenderUserMismatch ()),
        Error (Tagged 'MLSCommitMissingReferences ()),
        Error (Tagged 'MLSGroupConversationMismatch ()),
        Error (Tagged 'MLSInvalidLeafNodeIndex ()),
        Error (Tagged 'MLSNotEnabled ()),
        Error (Tagged 'MLSProposalNotFound ()), Error MLSProtocolError,
        Error (Tagged 'MLSSelfRemovalNotAllowed ()),
        Error (Tagged 'MLSStaleMessage ()),
        Error (Tagged 'MLSSubConvClientNotInParent ()),
        Error (Tagged 'MLSUnsupportedMessage ()),
        Error (Tagged 'MLSUnsupportedProposal ()),
        Error (Tagged 'MLSWelcomeMismatch ()),
        Error (Tagged 'MLSLegalholdIncompatible ()),
        Error MLSProposalFailure, Error NonFederatingBackends,
        Error UnreachableBackends, BrigAccess, SparAccess,
        NotificationSubsystem, GundeckAPIAccess, Rpc, ExternalAccess,
        FederatorAccess, BackendNotificationQueueAccess, BotAccess,
        FireAndForget, ClientStore, CodeStore, ProposalStore,
        ConversationStore, SubConversationStore, Random,
        CustomBackendStore, TeamFeatureStore, LegalHoldStore, MemberStore,
        SearchVisibilityStore, ServiceStore, TeamNotificationStore,
        TeamStore, TeamMemberStore InternalPaging,
        TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
        ListItems CassandraPaging (Remote ConvId),
        ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
        ListItems InternalPaging TeamId, Input AllTeamFeatures,
        Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
        Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
        Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
        Error InvalidInput, Error InternalError, Error FederationError,
        Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
        Final IO]
      MLSMessageSendingStatus)
-> Dict (HasAnnotation 'Remote "galley" "on-mls-message-sent")
-> Dict (HasAnnotation 'Remote "galley" "mls-welcome")
-> Dict (HasAnnotation 'Remote "galley" "send-mls-commit-bundle")
-> Dict (HasAnnotation 'Remote "galley" "on-conversation-updated")
-> Dict (HasAnnotation 'Remote "brig" "get-mls-clients")
-> Dict (HasAnnotation 'Remote "brig" "get-users-by-ids")
-> Dict (HasAnnotation 'Remote "brig" "api-version")
-> QualifiedWithTag 'QLocal UserId
-> ClientId
-> ConnId
-> RawMLS CommitBundle
-> Sem
     '[Error (Tagged 'ConvAccessDenied ()),
       Error (Tagged 'ConvMemberNotFound ()),
       Error (Tagged 'ConvNotFound ()),
       Error (Tagged 'LegalHoldNotEnabled ()),
       Error (Tagged 'MissingLegalholdConsent ()),
       Error (Tagged 'MLSClientMismatch ()),
       Error (Tagged 'MLSClientSenderUserMismatch ()),
       Error (Tagged 'MLSCommitMissingReferences ()),
       Error (Tagged 'MLSGroupConversationMismatch ()),
       Error (Tagged 'MLSInvalidLeafNodeIndex ()),
       Error (Tagged 'MLSNotEnabled ()),
       Error (Tagged 'MLSProposalNotFound ()), Error MLSProtocolError,
       Error (Tagged 'MLSSelfRemovalNotAllowed ()),
       Error (Tagged 'MLSStaleMessage ()),
       Error (Tagged 'MLSSubConvClientNotInParent ()),
       Error (Tagged 'MLSUnsupportedMessage ()),
       Error (Tagged 'MLSUnsupportedProposal ()),
       Error (Tagged 'MLSWelcomeMismatch ()),
       Error (Tagged 'MLSLegalholdIncompatible ()),
       Error MLSProposalFailure, Error NonFederatingBackends,
       Error UnreachableBackends, BrigAccess, SparAccess,
       NotificationSubsystem, GundeckAPIAccess, Rpc, ExternalAccess,
       FederatorAccess, BackendNotificationQueueAccess, BotAccess,
       FireAndForget, ClientStore, CodeStore, ProposalStore,
       ConversationStore, SubConversationStore, Random,
       CustomBackendStore, TeamFeatureStore, LegalHoldStore, MemberStore,
       SearchVisibilityStore, ServiceStore, TeamNotificationStore,
       TeamStore, TeamMemberStore InternalPaging,
       TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
       ListItems CassandraPaging (Remote ConvId),
       ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
       ListItems InternalPaging TeamId, Input AllTeamFeatures,
       Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
       Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
       Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
       Error InvalidInput, Error InternalError, Error FederationError,
       Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
       Final IO]
     MLSMessageSendingStatus
forall (c :: Constraint) r a. SolveCallsFed c r a => (c => r) -> a
callsFed ((QualifiedWithTag 'QLocal UserId
 -> ClientId
 -> ConnId
 -> RawMLS CommitBundle
 -> Sem
      '[Error (Tagged 'ConvAccessDenied ()),
        Error (Tagged 'ConvMemberNotFound ()),
        Error (Tagged 'ConvNotFound ()),
        Error (Tagged 'LegalHoldNotEnabled ()),
        Error (Tagged 'MissingLegalholdConsent ()),
        Error (Tagged 'MLSClientMismatch ()),
        Error (Tagged 'MLSClientSenderUserMismatch ()),
        Error (Tagged 'MLSCommitMissingReferences ()),
        Error (Tagged 'MLSGroupConversationMismatch ()),
        Error (Tagged 'MLSInvalidLeafNodeIndex ()),
        Error (Tagged 'MLSNotEnabled ()),
        Error (Tagged 'MLSProposalNotFound ()), Error MLSProtocolError,
        Error (Tagged 'MLSSelfRemovalNotAllowed ()),
        Error (Tagged 'MLSStaleMessage ()),
        Error (Tagged 'MLSSubConvClientNotInParent ()),
        Error (Tagged 'MLSUnsupportedMessage ()),
        Error (Tagged 'MLSUnsupportedProposal ()),
        Error (Tagged 'MLSWelcomeMismatch ()),
        Error (Tagged 'MLSLegalholdIncompatible ()),
        Error MLSProposalFailure, Error NonFederatingBackends,
        Error UnreachableBackends, BrigAccess, SparAccess,
        NotificationSubsystem, GundeckAPIAccess, Rpc, ExternalAccess,
        FederatorAccess, BackendNotificationQueueAccess, BotAccess,
        FireAndForget, ClientStore, CodeStore, ProposalStore,
        ConversationStore, SubConversationStore, Random,
        CustomBackendStore, TeamFeatureStore, LegalHoldStore, MemberStore,
        SearchVisibilityStore, ServiceStore, TeamNotificationStore,
        TeamStore, TeamMemberStore InternalPaging,
        TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
        ListItems CassandraPaging (Remote ConvId),
        ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
        ListItems InternalPaging TeamId, Input AllTeamFeatures,
        Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
        Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
        Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
        Error InvalidInput, Error InternalError, Error FederationError,
        Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
        Final IO]
      MLSMessageSendingStatus)
-> QualifiedWithTag 'QLocal UserId
-> ClientId
-> ConnId
-> RawMLS CommitBundle
-> Sem
     '[Error (Tagged 'ConvAccessDenied ()),
       Error (Tagged 'ConvMemberNotFound ()),
       Error (Tagged 'ConvNotFound ()),
       Error (Tagged 'LegalHoldNotEnabled ()),
       Error (Tagged 'MissingLegalholdConsent ()),
       Error (Tagged 'MLSClientMismatch ()),
       Error (Tagged 'MLSClientSenderUserMismatch ()),
       Error (Tagged 'MLSCommitMissingReferences ()),
       Error (Tagged 'MLSGroupConversationMismatch ()),
       Error (Tagged 'MLSInvalidLeafNodeIndex ()),
       Error (Tagged 'MLSNotEnabled ()),
       Error (Tagged 'MLSProposalNotFound ()), Error MLSProtocolError,
       Error (Tagged 'MLSSelfRemovalNotAllowed ()),
       Error (Tagged 'MLSStaleMessage ()),
       Error (Tagged 'MLSSubConvClientNotInParent ()),
       Error (Tagged 'MLSUnsupportedMessage ()),
       Error (Tagged 'MLSUnsupportedProposal ()),
       Error (Tagged 'MLSWelcomeMismatch ()),
       Error (Tagged 'MLSLegalholdIncompatible ()),
       Error MLSProposalFailure, Error NonFederatingBackends,
       Error UnreachableBackends, BrigAccess, SparAccess,
       NotificationSubsystem, GundeckAPIAccess, Rpc, ExternalAccess,
       FederatorAccess, BackendNotificationQueueAccess, BotAccess,
       FireAndForget, ClientStore, CodeStore, ProposalStore,
       ConversationStore, SubConversationStore, Random,
       CustomBackendStore, TeamFeatureStore, LegalHoldStore, MemberStore,
       SearchVisibilityStore, ServiceStore, TeamNotificationStore,
       TeamStore, TeamMemberStore InternalPaging,
       TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
       ListItems CassandraPaging (Remote ConvId),
       ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
       ListItems InternalPaging TeamId, Input AllTeamFeatures,
       Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
       Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
       Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
       Error InvalidInput, Error InternalError, Error FederationError,
       Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
       Final IO]
     MLSMessageSendingStatus
forall x a. ToHasAnnotations x => a -> a
exposeAnnotations QualifiedWithTag 'QLocal UserId
-> ClientId
-> ConnId
-> RawMLS CommitBundle
-> Sem
     '[Error (Tagged 'ConvAccessDenied ()),
       Error (Tagged 'ConvMemberNotFound ()),
       Error (Tagged 'ConvNotFound ()),
       Error (Tagged 'LegalHoldNotEnabled ()),
       Error (Tagged 'MissingLegalholdConsent ()),
       Error (Tagged 'MLSClientMismatch ()),
       Error (Tagged 'MLSClientSenderUserMismatch ()),
       Error (Tagged 'MLSCommitMissingReferences ()),
       Error (Tagged 'MLSGroupConversationMismatch ()),
       Error (Tagged 'MLSInvalidLeafNodeIndex ()),
       Error (Tagged 'MLSNotEnabled ()),
       Error (Tagged 'MLSProposalNotFound ()), Error MLSProtocolError,
       Error (Tagged 'MLSSelfRemovalNotAllowed ()),
       Error (Tagged 'MLSStaleMessage ()),
       Error (Tagged 'MLSSubConvClientNotInParent ()),
       Error (Tagged 'MLSUnsupportedMessage ()),
       Error (Tagged 'MLSUnsupportedProposal ()),
       Error (Tagged 'MLSWelcomeMismatch ()),
       Error (Tagged 'MLSLegalholdIncompatible ()),
       Error MLSProposalFailure, Error NonFederatingBackends,
       Error UnreachableBackends, BrigAccess, SparAccess,
       NotificationSubsystem, GundeckAPIAccess, Rpc, ExternalAccess,
       FederatorAccess, BackendNotificationQueueAccess, BotAccess,
       FireAndForget, ClientStore, CodeStore, ProposalStore,
       ConversationStore, SubConversationStore, Random,
       CustomBackendStore, TeamFeatureStore, LegalHoldStore, MemberStore,
       SearchVisibilityStore, ServiceStore, TeamNotificationStore,
       TeamStore, TeamMemberStore InternalPaging,
       TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
       ListItems CassandraPaging (Remote ConvId),
       ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
       ListItems InternalPaging TeamId, Input AllTeamFeatures,
       Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
       Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
       Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
       Error InvalidInput, Error InternalError, Error FederationError,
       Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
       Final IO]
     MLSMessageSendingStatus
forall (r :: EffectRow).
(Member (Error (Tagged 'MLSLegalholdIncompatible ())) r,
 Member Random r, Member Resource r, Member SubConversationStore r,
 Members MLSBundleStaticErrors r, HasProposalEffects r) =>
QualifiedWithTag 'QLocal UserId
-> ClientId
-> ConnId
-> RawMLS CommitBundle
-> Sem r MLSMessageSendingStatus
postMLSCommitBundleFromLocalUser))
    API
  (Named
     "mls-commit-bundle"
     ("mls"
      :> (Summary "Post a MLS CommitBundle"
          :> (From 'V5
              :> (MakesFederatedCall 'Galley "on-mls-message-sent"
                  :> (MakesFederatedCall 'Galley "mls-welcome"
                      :> (MakesFederatedCall 'Galley "send-mls-commit-bundle"
                          :> (MakesFederatedCall 'Galley "on-conversation-updated"
                              :> (MakesFederatedCall 'Brig "get-mls-clients"
                                  :> (MakesFederatedCall 'Brig "get-users-by-ids"
                                      :> (MakesFederatedCall 'Brig "api-version"
                                          :> (CanThrow 'ConvAccessDenied
                                              :> (CanThrow 'ConvMemberNotFound
                                                  :> (CanThrow 'ConvNotFound
                                                      :> (CanThrow 'LegalHoldNotEnabled
                                                          :> (CanThrow 'MissingLegalholdConsent
                                                              :> (CanThrow 'MLSClientMismatch
                                                                  :> (CanThrow
                                                                        'MLSClientSenderUserMismatch
                                                                      :> (CanThrow
                                                                            'MLSCommitMissingReferences
                                                                          :> (CanThrow
                                                                                'MLSGroupConversationMismatch
                                                                              :> (CanThrow
                                                                                    'MLSInvalidLeafNodeIndex
                                                                                  :> (CanThrow
                                                                                        'MLSNotEnabled
                                                                                      :> (CanThrow
                                                                                            'MLSProposalNotFound
                                                                                          :> (CanThrow
                                                                                                'MLSProtocolErrorTag
                                                                                              :> (CanThrow
                                                                                                    'MLSSelfRemovalNotAllowed
                                                                                                  :> (CanThrow
                                                                                                        'MLSStaleMessage
                                                                                                      :> (CanThrow
                                                                                                            'MLSSubConvClientNotInParent
                                                                                                          :> (CanThrow
                                                                                                                'MLSUnsupportedMessage
                                                                                                              :> (CanThrow
                                                                                                                    'MLSUnsupportedProposal
                                                                                                                  :> (CanThrow
                                                                                                                        'MLSWelcomeMismatch
                                                                                                                      :> (CanThrow
                                                                                                                            'MLSLegalholdIncompatible
                                                                                                                          :> (CanThrow
                                                                                                                                MLSProposalFailure
                                                                                                                              :> (CanThrow
                                                                                                                                    NonFederatingBackends
                                                                                                                                  :> (CanThrow
                                                                                                                                        UnreachableBackends
                                                                                                                                      :> ("commit-bundles"
                                                                                                                                          :> (ZLocalUser
                                                                                                                                              :> (ZClient
                                                                                                                                                  :> (ZConn
                                                                                                                                                      :> (ReqBody
                                                                                                                                                            '[MLS]
                                                                                                                                                            (RawMLS
                                                                                                                                                               CommitBundle)
                                                                                                                                                          :> MultiVerb
                                                                                                                                                               'POST
                                                                                                                                                               '[JSON]
                                                                                                                                                               '[Respond
                                                                                                                                                                   201
                                                                                                                                                                   "Commit accepted and forwarded"
                                                                                                                                                                   MLSMessageSendingStatus]
                                                                                                                                                               MLSMessageSendingStatus)))))))))))))))))))))))))))))))))))))))
  '[BrigAccess, SparAccess, NotificationSubsystem, GundeckAPIAccess,
    Rpc, ExternalAccess, FederatorAccess,
    BackendNotificationQueueAccess, BotAccess, FireAndForget,
    ClientStore, CodeStore, ProposalStore, ConversationStore,
    SubConversationStore, Random, CustomBackendStore, TeamFeatureStore,
    LegalHoldStore, MemberStore, SearchVisibilityStore, ServiceStore,
    TeamNotificationStore, TeamStore, TeamMemberStore InternalPaging,
    TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
    ListItems CassandraPaging (Remote ConvId),
    ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
    ListItems InternalPaging TeamId, Input AllTeamFeatures,
    Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
    Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
    Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
    Error InvalidInput, Error InternalError, Error FederationError,
    Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
    Final IO]
-> API
     (Named
        "mls-public-keys"
        ("mls"
         :> (Summary
               "Get public keys used by the backend to sign external proposals"
             :> (Description
                   "The format of the returned key is determined by the `format` query parameter:\n - raw (default): base64-encoded raw public keys\n - jwk: keys are nested objects in JWK format."
                 :> (From 'V5
                     :> (CanThrow 'MLSNotEnabled
                         :> ("public-keys"
                             :> (ZLocalUser
                                 :> (QueryParam "format" MLSPublicKeyFormat
                                     :> MultiVerb
                                          'GET
                                          '[JSON]
                                          '[Respond
                                              200
                                              "Public keys"
                                              (MLSKeysByPurpose (MLSKeys SomeKey))]
                                          (MLSKeysByPurpose (MLSKeys SomeKey)))))))))))
     '[BrigAccess, SparAccess, NotificationSubsystem, GundeckAPIAccess,
       Rpc, ExternalAccess, FederatorAccess,
       BackendNotificationQueueAccess, BotAccess, FireAndForget,
       ClientStore, CodeStore, ProposalStore, ConversationStore,
       SubConversationStore, Random, CustomBackendStore, TeamFeatureStore,
       LegalHoldStore, MemberStore, SearchVisibilityStore, ServiceStore,
       TeamNotificationStore, TeamStore, TeamMemberStore InternalPaging,
       TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
       ListItems CassandraPaging (Remote ConvId),
       ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
       ListItems InternalPaging TeamId, Input AllTeamFeatures,
       Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
       Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
       Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
       Error InvalidInput, Error InternalError, Error FederationError,
       Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
       Final IO]
-> API
     (Named
        "mls-commit-bundle"
        ("mls"
         :> (Summary "Post a MLS CommitBundle"
             :> (From 'V5
                 :> (MakesFederatedCall 'Galley "on-mls-message-sent"
                     :> (MakesFederatedCall 'Galley "mls-welcome"
                         :> (MakesFederatedCall 'Galley "send-mls-commit-bundle"
                             :> (MakesFederatedCall 'Galley "on-conversation-updated"
                                 :> (MakesFederatedCall 'Brig "get-mls-clients"
                                     :> (MakesFederatedCall 'Brig "get-users-by-ids"
                                         :> (MakesFederatedCall 'Brig "api-version"
                                             :> (CanThrow 'ConvAccessDenied
                                                 :> (CanThrow 'ConvMemberNotFound
                                                     :> (CanThrow 'ConvNotFound
                                                         :> (CanThrow 'LegalHoldNotEnabled
                                                             :> (CanThrow 'MissingLegalholdConsent
                                                                 :> (CanThrow 'MLSClientMismatch
                                                                     :> (CanThrow
                                                                           'MLSClientSenderUserMismatch
                                                                         :> (CanThrow
                                                                               'MLSCommitMissingReferences
                                                                             :> (CanThrow
                                                                                   'MLSGroupConversationMismatch
                                                                                 :> (CanThrow
                                                                                       'MLSInvalidLeafNodeIndex
                                                                                     :> (CanThrow
                                                                                           'MLSNotEnabled
                                                                                         :> (CanThrow
                                                                                               'MLSProposalNotFound
                                                                                             :> (CanThrow
                                                                                                   'MLSProtocolErrorTag
                                                                                                 :> (CanThrow
                                                                                                       'MLSSelfRemovalNotAllowed
                                                                                                     :> (CanThrow
                                                                                                           'MLSStaleMessage
                                                                                                         :> (CanThrow
                                                                                                               'MLSSubConvClientNotInParent
                                                                                                             :> (CanThrow
                                                                                                                   'MLSUnsupportedMessage
                                                                                                                 :> (CanThrow
                                                                                                                       'MLSUnsupportedProposal
                                                                                                                     :> (CanThrow
                                                                                                                           'MLSWelcomeMismatch
                                                                                                                         :> (CanThrow
                                                                                                                               'MLSLegalholdIncompatible
                                                                                                                             :> (CanThrow
                                                                                                                                   MLSProposalFailure
                                                                                                                                 :> (CanThrow
                                                                                                                                       NonFederatingBackends
                                                                                                                                     :> (CanThrow
                                                                                                                                           UnreachableBackends
                                                                                                                                         :> ("commit-bundles"
                                                                                                                                             :> (ZLocalUser
                                                                                                                                                 :> (ZClient
                                                                                                                                                     :> (ZConn
                                                                                                                                                         :> (ReqBody
                                                                                                                                                               '[MLS]
                                                                                                                                                               (RawMLS
                                                                                                                                                                  CommitBundle)
                                                                                                                                                             :> MultiVerb
                                                                                                                                                                  'POST
                                                                                                                                                                  '[JSON]
                                                                                                                                                                  '[Respond
                                                                                                                                                                      201
                                                                                                                                                                      "Commit accepted and forwarded"
                                                                                                                                                                      MLSMessageSendingStatus]
                                                                                                                                                                  MLSMessageSendingStatus))))))))))))))))))))))))))))))))))))))
      :<|> Named
             "mls-public-keys"
             ("mls"
              :> (Summary
                    "Get public keys used by the backend to sign external proposals"
                  :> (Description
                        "The format of the returned key is determined by the `format` query parameter:\n - raw (default): base64-encoded raw public keys\n - jwk: keys are nested objects in JWK format."
                      :> (From 'V5
                          :> (CanThrow 'MLSNotEnabled
                              :> ("public-keys"
                                  :> (ZLocalUser
                                      :> (QueryParam "format" MLSPublicKeyFormat
                                          :> MultiVerb
                                               'GET
                                               '[JSON]
                                               '[Respond
                                                   200
                                                   "Public keys"
                                                   (MLSKeysByPurpose (MLSKeys SomeKey))]
                                               (MLSKeysByPurpose (MLSKeys SomeKey)))))))))))
     '[BrigAccess, SparAccess, NotificationSubsystem, GundeckAPIAccess,
       Rpc, ExternalAccess, FederatorAccess,
       BackendNotificationQueueAccess, BotAccess, FireAndForget,
       ClientStore, CodeStore, ProposalStore, ConversationStore,
       SubConversationStore, Random, CustomBackendStore, TeamFeatureStore,
       LegalHoldStore, MemberStore, SearchVisibilityStore, ServiceStore,
       TeamNotificationStore, TeamStore, TeamMemberStore InternalPaging,
       TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
       ListItems CassandraPaging (Remote ConvId),
       ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
       ListItems InternalPaging TeamId, Input AllTeamFeatures,
       Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
       Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
       Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
       Error InvalidInput, Error InternalError, Error FederationError,
       Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
       Final IO]
forall api1 (r :: EffectRow) api2.
API api1 r -> API api2 r -> API (api1 :<|> api2) r
<@> forall {k} (name :: k) (r0 :: EffectRow) api.
(HasServer api '[Domain],
 ServerEffects (DeclaredErrorEffects api) r0) =>
ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> API (Named name api) r0
forall (name :: Symbol) (r0 :: EffectRow) api.
(HasServer api '[Domain],
 ServerEffects (DeclaredErrorEffects api) r0) =>
ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> API (Named name api) r0
mkNamedAPI @"mls-public-keys" ((Maybe MLSPublicKeyFormat
 -> Sem
      '[Error (Tagged 'MLSNotEnabled ()), BrigAccess, SparAccess,
        NotificationSubsystem, GundeckAPIAccess, Rpc, ExternalAccess,
        FederatorAccess, BackendNotificationQueueAccess, BotAccess,
        FireAndForget, ClientStore, CodeStore, ProposalStore,
        ConversationStore, SubConversationStore, Random,
        CustomBackendStore, TeamFeatureStore, LegalHoldStore, MemberStore,
        SearchVisibilityStore, ServiceStore, TeamNotificationStore,
        TeamStore, TeamMemberStore InternalPaging,
        TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
        ListItems CassandraPaging (Remote ConvId),
        ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
        ListItems InternalPaging TeamId, Input AllTeamFeatures,
        Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
        Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
        Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
        Error InvalidInput, Error InternalError, Error FederationError,
        Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
        Final IO]
      (MLSKeysByPurpose (MLSKeys SomeKey)))
-> QualifiedWithTag 'QLocal UserId
-> Maybe MLSPublicKeyFormat
-> Sem
     '[Error (Tagged 'MLSNotEnabled ()), BrigAccess, SparAccess,
       NotificationSubsystem, GundeckAPIAccess, Rpc, ExternalAccess,
       FederatorAccess, BackendNotificationQueueAccess, BotAccess,
       FireAndForget, ClientStore, CodeStore, ProposalStore,
       ConversationStore, SubConversationStore, Random,
       CustomBackendStore, TeamFeatureStore, LegalHoldStore, MemberStore,
       SearchVisibilityStore, ServiceStore, TeamNotificationStore,
       TeamStore, TeamMemberStore InternalPaging,
       TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
       ListItems CassandraPaging (Remote ConvId),
       ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
       ListItems InternalPaging TeamId, Input AllTeamFeatures,
       Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
       Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
       Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
       Error InvalidInput, Error InternalError, Error FederationError,
       Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
       Final IO]
     (MLSKeysByPurpose (MLSKeys SomeKey))
forall a b. a -> b -> a
const Maybe MLSPublicKeyFormat
-> Sem
     '[Error (Tagged 'MLSNotEnabled ()), BrigAccess, SparAccess,
       NotificationSubsystem, GundeckAPIAccess, Rpc, ExternalAccess,
       FederatorAccess, BackendNotificationQueueAccess, BotAccess,
       FireAndForget, ClientStore, CodeStore, ProposalStore,
       ConversationStore, SubConversationStore, Random,
       CustomBackendStore, TeamFeatureStore, LegalHoldStore, MemberStore,
       SearchVisibilityStore, ServiceStore, TeamNotificationStore,
       TeamStore, TeamMemberStore InternalPaging,
       TeamMemberStore CassandraPaging, ListItems CassandraPaging ConvId,
       ListItems CassandraPaging (Remote ConvId),
       ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId,
       ListItems InternalPaging TeamId, Input AllTeamFeatures,
       Input (Maybe [TeamId], FeatureDefaults LegalholdConfig),
       Input (Local ()), Input Opts, Input UTCTime, Queue DeleteItem,
       Logger (Msg -> Msg), Error DynError, Input ClientState, Input Env,
       Error InvalidInput, Error InternalError, Error FederationError,
       Async, Delay, Fail, Embed IO, Error JSONResponse, Resource,
       Final IO]
     (MLSKeysByPurpose (MLSKeys SomeKey))
forall (r :: EffectRow).
(Member (Input Env) r, Member (Error (Tagged 'MLSNotEnabled ())) r,
 Member (Error InternalError) r) =>
Maybe MLSPublicKeyFormat
-> Sem r (MLSKeysByPurpose (MLSKeys SomeKey))
getMLSPublicKeys)