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

import Data.Id
import Data.Qualified
import Galley.API.Query qualified as Query
import Galley.API.Teams.Features qualified as Features
import Galley.API.Update
import Galley.App
import Galley.Effects
import Galley.Effects qualified as E
import Galley.Options
import Polysemy
import Polysemy.Input
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Event.Team qualified as Public ()
import Wire.API.Federation.API
import Wire.API.Provider.Bot
import Wire.API.Routes.API
import Wire.API.Routes.Public.Galley.Bot

botAPI :: API BotAPI GalleyEffects
botAPI :: API BotAPI GalleyEffects
botAPI =
  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 @"post-bot-message-unqualified" (((HasAnnotation 'Remote "galley" "on-message-sent",
  (HasAnnotation 'Remote "brig" "get-user-clients",
   () :: Constraint)) =>
 BotId
 -> ConvId
 -> Maybe IgnoreMissing
 -> Maybe ReportMissing
 -> NewOtrMessage
 -> Sem
      '[Error (Tagged 'ConvNotFound ()), 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]
      (PostOtrResponse ClientMismatch))
-> Dict (HasAnnotation 'Remote "galley" "on-message-sent")
-> Dict (HasAnnotation 'Remote "brig" "get-user-clients")
-> BotId
-> ConvId
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> NewOtrMessage
-> Sem
     '[Error (Tagged 'ConvNotFound ()), 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]
     (PostOtrResponse ClientMismatch)
forall (c :: Constraint) r a. SolveCallsFed c r a => (c => r) -> a
callsFed ((BotId
 -> ConvId
 -> Maybe IgnoreMissing
 -> Maybe ReportMissing
 -> NewOtrMessage
 -> Sem
      '[Error (Tagged 'ConvNotFound ()), 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]
      (PostOtrResponse ClientMismatch))
-> BotId
-> ConvId
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> NewOtrMessage
-> Sem
     '[Error (Tagged 'ConvNotFound ()), 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]
     (PostOtrResponse ClientMismatch)
forall x a. ToHasAnnotations x => a -> a
exposeAnnotations BotId
-> ConvId
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> NewOtrMessage
-> Sem
     '[Error (Tagged 'ConvNotFound ()), 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]
     (PostOtrResponse ClientMismatch)
forall (r :: EffectRow).
(Member BrigAccess r, Member ClientStore r,
 Member ConversationStore r, Member ExternalAccess r,
 Member FederatorAccess r, Member BackendNotificationQueueAccess r,
 Member NotificationSubsystem r, Member (Input (Local ())) r,
 Member (Input Opts) r, Member TeamStore r,
 Member (Logger (Msg -> Msg)) r, Member (Input UTCTime) r) =>
BotId
-> ConvId
-> Maybe IgnoreMissing
-> Maybe ReportMissing
-> NewOtrMessage
-> Sem r (PostOtrResponse ClientMismatch)
postBotMessageUnqualified))
    API
  (Named
     "post-bot-message-unqualified"
     (MakesFederatedCall 'Galley "on-message-sent"
      :> (MakesFederatedCall 'Brig "get-user-clients"
          :> (ZBot
              :> (ZConversation
                  :> (CanThrow 'ConvNotFound
                      :> ("bot"
                          :> ("messages"
                              :> (QueryParam "ignore_missing" IgnoreMissing
                                  :> (QueryParam "report_missing" ReportMissing
                                      :> (ReqBody '[JSON] NewOtrMessage
                                          :> MultiVerb
                                               'POST
                                               '[JSON]
                                               '[ErrorResponse 'ConvNotFound,
                                                 ErrorResponse 'UnknownClient,
                                                 ErrorResponse 'MissingLegalholdConsentOldClients,
                                                 ErrorResponse 'MissingLegalholdConsent,
                                                 Respond 412 "Missing clients" ClientMismatch,
                                                 Respond 201 "Message sent" ClientMismatch]
                                               (PostOtrResponse ClientMismatch))))))))))))
  '[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
        "get-bot-conversation"
        (CanThrow 'AccessDenied
         :> (CanThrow 'ConvNotFound
             :> (CanThrow OperationDenied
                 :> (CanThrow 'NotATeamMember
                     :> (CanThrow 'TeamNotFound
                         :> ("bot"
                             :> ("conversation"
                                 :> (ZBot :> (ZConversation :> Get '[JSON] BotConvView))))))))))
     '[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
        "post-bot-message-unqualified"
        (MakesFederatedCall 'Galley "on-message-sent"
         :> (MakesFederatedCall 'Brig "get-user-clients"
             :> (ZBot
                 :> (ZConversation
                     :> (CanThrow 'ConvNotFound
                         :> ("bot"
                             :> ("messages"
                                 :> (QueryParam "ignore_missing" IgnoreMissing
                                     :> (QueryParam "report_missing" ReportMissing
                                         :> (ReqBody '[JSON] NewOtrMessage
                                             :> MultiVerb
                                                  'POST
                                                  '[JSON]
                                                  '[ErrorResponse 'ConvNotFound,
                                                    ErrorResponse 'UnknownClient,
                                                    ErrorResponse
                                                      'MissingLegalholdConsentOldClients,
                                                    ErrorResponse 'MissingLegalholdConsent,
                                                    Respond 412 "Missing clients" ClientMismatch,
                                                    Respond 201 "Message sent" ClientMismatch]
                                                  (PostOtrResponse ClientMismatch)))))))))))
      :<|> Named
             "get-bot-conversation"
             (CanThrow 'AccessDenied
              :> (CanThrow 'ConvNotFound
                  :> (CanThrow OperationDenied
                      :> (CanThrow 'NotATeamMember
                          :> (CanThrow 'TeamNotFound
                              :> ("bot"
                                  :> ("conversation"
                                      :> (ZBot
                                          :> (ZConversation :> Get '[JSON] BotConvView))))))))))
     '[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 @"get-bot-conversation" ServerT
  (CanThrow 'AccessDenied
   :> (CanThrow 'ConvNotFound
       :> (CanThrow OperationDenied
           :> (CanThrow 'NotATeamMember
               :> (CanThrow 'TeamNotFound
                   :> ("bot"
                       :> ("conversation"
                           :> (ZBot :> (ZConversation :> Get '[JSON] BotConvView)))))))))
  (Sem
     (Append
        (DeclaredErrorEffects
           (CanThrow 'AccessDenied
            :> (CanThrow 'ConvNotFound
                :> (CanThrow OperationDenied
                    :> (CanThrow 'NotATeamMember
                        :> (CanThrow 'TeamNotFound
                            :> ("bot"
                                :> ("conversation"
                                    :> (ZBot :> (ZConversation :> Get '[JSON] BotConvView))))))))))
        '[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]))
BotId
-> ConvId
-> Sem
     '[Error (Tagged 'AccessDenied ()), Error (Tagged 'ConvNotFound ()),
       Error (Tagged OperationDenied ()),
       Error (Tagged 'NotATeamMember ()), Error (Tagged 'TeamNotFound ()),
       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]
     BotConvView
forall (r :: EffectRow).
(Member ConversationStore r, Member (Input (Local ())) r,
 Member (Input Opts) r, Member TeamFeatureStore r,
 Member (Error (Tagged 'AccessDenied ())) r,
 Member (Error (Tagged 'ConvNotFound ())) r, Member TeamStore r) =>
BotId -> ConvId -> Sem r BotConvView
getBotConversation

getBotConversation ::
  forall r.
  ( Member E.ConversationStore r,
    Member (Input (Local ())) r,
    Member (Input Opts) r,
    Member TeamFeatureStore r,
    Member (ErrorS 'AccessDenied) r,
    Member (ErrorS 'ConvNotFound) r,
    Member TeamStore r
  ) =>
  BotId ->
  ConvId ->
  Sem r BotConvView
getBotConversation :: forall (r :: EffectRow).
(Member ConversationStore r, Member (Input (Local ())) r,
 Member (Input Opts) r, Member TeamFeatureStore r,
 Member (Error (Tagged 'AccessDenied ())) r,
 Member (Error (Tagged 'ConvNotFound ())) r, Member TeamStore r) =>
BotId -> ConvId -> Sem r BotConvView
getBotConversation BotId
bid ConvId
cnv = do
  UserId -> ConvId -> Sem r ()
forall (r :: EffectRow).
(Member TeamFeatureStore r, Member (Input Opts) r,
 Member (Error (Tagged 'AccessDenied ())) r, Member TeamStore r,
 Member ConversationStore r) =>
UserId -> ConvId -> Sem r ()
Features.guardSecondFactorDisabled (BotId -> UserId
botUserId BotId
bid) ConvId
cnv
  BotId -> ConvId -> Sem r BotConvView
forall (r :: EffectRow).
(Member ConversationStore r,
 Member (Error (Tagged 'ConvNotFound ())) r,
 Member (Input (Local ())) r) =>
BotId -> ConvId -> Sem r BotConvView
Query.getBotConversation BotId
bid ConvId
cnv