-- 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 Brig.API.Connection.Remote
  ( performLocalAction,
    performRemoteAction,
    createConnectionToRemoteUser,
    updateConnectionToRemoteUser,
  )
where

import Brig.API.Connection.Util
import Brig.API.Types (ConnectionError (..))
import Brig.App
import Brig.Data.Connection qualified as Data
import Brig.IO.Intra qualified as Intra
import Brig.Options
import Control.Comonad
import Control.Error.Util ((??))
import Control.Monad.Trans.Except
import Data.Id as Id
import Data.Qualified
import Galley.Types.Conversations.One2One (one2OneConvId)
import Imports
import Polysemy
import System.Logger.Class qualified as Log
import Wire.API.Component
import Wire.API.Connection
import Wire.API.Federation.API
import Wire.API.Federation.API.Brig
import Wire.API.Routes.Internal.Galley.ConversationsIntra
import Wire.API.Routes.Public.Util (ResponseForExistedCreated (..))
import Wire.API.User
import Wire.API.UserEvent
import Wire.FederationAPIAccess
import Wire.FederationConfigStore
import Wire.GalleyAPIAccess
import Wire.NotificationSubsystem
import Wire.UserStore as UserStore
import Wire.UserSubsystem

data LocalConnectionAction
  = LocalConnect
  | LocalBlock
  | LocalIgnore
  | LocalRescind
  deriving (Eq)

data ConnectionAction
  = LCA LocalConnectionAction
  | RCA RemoteConnectionAction

-- | Connection state transition logic.
--
-- In the following, A is a local user, and B is a remote user.
--
-- LocalConnect: A communicates that they now want to connect. This
--   transitions Pending → Accepted, and every other state (but including Sent) to Sent.
-- LocalBlock: A communicates that they do not want to connect. This
--   transitions every state except Blocked to Blocked.
-- LocalIgnore: A ignores the connection. Pending → Ignored.
-- LocalRescind: A withdraws their intention to connect. Sent → Cancelled, Accepted → Pending.
-- RemoteConnect: B communicates that they now want to connect. Sent → Accepted, Cancelled → Pending, Accepted → Accepted.
-- RemoteRescind: B withdraws their intention to connect. Pending → Cancelled, Accepted → Sent.
--
-- Returns 'Nothing' if no transition is possible from the current state for
-- the given action. This results in an 'InvalidTransition' error if the
-- connection does not exist.
transition :: ConnectionAction -> Relation -> Maybe Relation
-- MissingLegalholdConsent is treated exactly like blocked
transition action MissingLegalholdConsent = transition action Blocked
transition (LCA LocalConnect) Pending = Just Accepted
transition (LCA LocalConnect) Accepted = Just Accepted
transition (LCA LocalConnect) _ = Just Sent
transition (LCA LocalBlock) Blocked = Nothing
transition (LCA LocalBlock) _ = Just Blocked
transition (LCA LocalIgnore) Pending = Just Ignored
transition (LCA LocalIgnore) _ = Nothing
transition (LCA LocalRescind) Sent = Just Cancelled
-- The following transition is to make sure we always end up in state P
-- when we start in S and receive the two actions RC and LR in an arbitrary
-- order.
transition (LCA LocalRescind) Accepted = Just Pending
transition (LCA LocalRescind) _ = Nothing
transition (RCA RemoteConnect) Sent = Just Accepted
transition (RCA RemoteConnect) Accepted = Just Accepted
transition (RCA RemoteConnect) Blocked = Nothing
transition (RCA RemoteConnect) _ = Just Pending
transition (RCA RemoteRescind) Pending = Just Cancelled
-- The following transition is to make sure we always end up in state S
-- when we start in P and receive the two actions LC and RR in an arbitrary
-- order.
transition (RCA RemoteRescind) Accepted = Just Sent
transition (RCA RemoteRescind) _ = Nothing

-- When user A has made a request -> Only user A's membership in conv is
-- affected -> User A wants to be in one2one conv with B, or User A doesn't want
-- to be in one2one conv with B
updateOne2OneConv ::
  Local UserId ->
  Maybe ConnId ->
  Remote UserId ->
  Qualified ConvId ->
  DesiredMembership ->
  Actor ->
  (AppT r) ()
updateOne2OneConv lUsr _mbConn remoteUser convId desiredMem actor = do
  let request =
        UpsertOne2OneConversationRequest
          { uooLocalUser = lUsr,
            uooRemoteUser = remoteUser,
            uooActor = actor,
            uooActorDesiredMembership = desiredMem,
            uooConvId = convId
          }
  void $ wrapHttp (Intra.upsertOne2OneConversation request)

desiredMembership :: Actor -> Relation -> DesiredMembership
desiredMembership a r =
  let isIncluded =
        a
          `elem` case r of
            Accepted -> [LocalActor, RemoteActor]
            Blocked -> []
            Pending -> [RemoteActor]
            Ignored -> [RemoteActor]
            Sent -> [LocalActor]
            Cancelled -> []
            MissingLegalholdConsent -> []
   in if isIncluded then Included else Excluded

-- | Perform a state transition on a connection, handle conversation updates and
-- push events.
--
-- NOTE: This function does not check whether the max connection limit has been
-- reached, the consumers must ensure of this.
--
-- Returns the connection, and whether it was updated or not.
transitionTo ::
  (Member GalleyAPIAccess r, Member NotificationSubsystem r) =>
  Local UserId ->
  Maybe ConnId ->
  Remote UserId ->
  Maybe UserConnection ->
  Maybe Relation ->
  Actor ->
  (ConnectionM r) (ResponseForExistedCreated UserConnection, Bool)
transitionTo self _ _ Nothing Nothing _ =
  -- This can only happen if someone tries to ignore as a first action on a
  -- connection. This shouldn't be possible.
  throwE (InvalidTransition (tUnqualified self))
transitionTo self mzcon other Nothing (Just rel) actor = lift $ do
  -- Create 1-1 proteus conversation.
  --
  -- We do nothing here for MLS as haveing no pre-existing connection implies
  -- there was no conversation. Creating an MLS converstaion is special due to
  -- key packages, etc. so the clients have to make another call for this.
  let proteusConv = one2OneConvId BaseProtocolProteusTag (tUntagged self) (tUntagged other)
  updateOne2OneConv self mzcon other proteusConv (desiredMembership actor rel) actor

  -- create connection
  connection <-
    wrapClient $
      Data.insertConnection
        self
        (tUntagged other)
        (relationWithHistory rel)
        proteusConv

  -- send event
  pushEvent self mzcon connection
  pure (Created connection, True)
transitionTo _self _zcon _other (Just connection) Nothing _actor = pure (Existed connection, False)
transitionTo self mzcon other (Just connection) (Just rel) actor = do
  -- update 1-1 conversation
  let proteusConvId =
        fromMaybe
          (one2OneConvId BaseProtocolProteusTag (tUntagged self) (tUntagged other))
          $ ucConvId connection
      desiredMem = desiredMembership actor rel
  lift $ updateOne2OneConv self Nothing other proteusConvId desiredMem actor
  mlsEnabled <- asks (.settings.enableMLS)
  when (fromMaybe False mlsEnabled) $ do
    let mlsConvId = one2OneConvId BaseProtocolMLSTag (tUntagged self) (tUntagged other)
    isEstablished <- lift . liftSem $ isMLSOne2OneEstablished self (tUntagged other)
    lift
      . when
        ( isEstablished == Established
            || (isEstablished == NotAMember && ucStatus connection == Blocked && rel == Accepted)
        )
      $ updateOne2OneConv self Nothing other mlsConvId desiredMem actor

  -- update connection
  connection' <- lift $ wrapClient $ Data.updateConnection connection (relationWithHistory rel)

  -- send event
  lift $ pushEvent self mzcon connection'
  pure (Existed connection', True)

-- | Send an event to the local user when the state of a connection changes.
pushEvent ::
  (Member NotificationSubsystem r) =>
  Local UserId ->
  Maybe ConnId ->
  UserConnection ->
  AppT r ()
pushEvent self mzcon connection = do
  let event = ConnectionUpdated connection Nothing
  liftSem $ Intra.onConnectionEvent (tUnqualified self) mzcon event

performLocalAction ::
  ( Member GalleyAPIAccess r,
    Member NotificationSubsystem r,
    Member UserStore r,
    HasBrigFederationAccess m r
  ) =>
  Local UserId ->
  Maybe ConnId ->
  Remote UserId ->
  Maybe UserConnection ->
  LocalConnectionAction ->
  (ConnectionM r) (ResponseForExistedCreated UserConnection, Bool)
performLocalAction luid mzcon other mconnection action = do
  let rel0 = maybe Cancelled ucStatus mconnection
  checkLimitForLocalAction luid rel0 action
  mrel2 <- for (transition (LCA action) rel0) $ \rel1 -> do
    mreaction <- fmap join . for (remoteAction action) $ \ra -> do
      let uid = tUnqualified luid
      mSelfTeam <- lift $ liftSem $ UserStore.getUserTeam uid
      Log.info $ Log.msg @Text "Brig-federation: sending connection action to remote backend"
      let req = NewConnectionRequest uid mSelfTeam (qUnqualified $ tUntagged other) ra
      response <- lift $ liftSem $ runFederatedEither other $ fedClient @'Brig @"send-connection-action" req
      case response of
        Right (NewConnectionResponseOk reaction) -> pure reaction
        Right NewConnectionResponseNotFederating -> throwE ConnectTeamFederationError
        Right NewConnectionResponseUserNotActivated -> throwE (InvalidUser (tUntagged other))
        Left e -> throwE $ ConnectFederationError e
    pure $
      fromMaybe rel1 $ do
        reactionAction <- (mreaction :: Maybe RemoteConnectionAction)
        transition (RCA reactionAction) rel1
  transitionTo luid mzcon other mconnection mrel2 LocalActor
  where
    remoteAction :: LocalConnectionAction -> Maybe RemoteConnectionAction
    remoteAction LocalConnect = Just RemoteConnect
    remoteAction LocalRescind = Just RemoteRescind
    remoteAction _ = Nothing

-- | The 'RemoteConnectionAction' "reaction" that may be returned is processed
-- by the remote caller. This extra action allows to automatically resolve some
-- inconsistent states, for example:
--
-- Without any reaction
-- @
--              A         B
-- A connects:  Sent      Pending
-- B ignores:   Sent      Ignore
-- B connects:  Accepted  Sent
-- @
--
-- Using the reaction returned by A
--
-- @
--                         A         B
-- A connects:             Sent      Pending
-- B ignores:              Sent      Ignore
-- B connects & A reacts:  Accepted  Accepted
-- @
performRemoteAction ::
  (Member GalleyAPIAccess r, Member NotificationSubsystem r) =>
  Local UserId ->
  Remote UserId ->
  Maybe UserConnection ->
  RemoteConnectionAction ->
  (AppT r) (Maybe RemoteConnectionAction)
performRemoteAction self other mconnection action = do
  let rel0 = maybe Cancelled ucStatus mconnection
  let rel1 = transition (RCA action) rel0
  result <- runExceptT . void $ transitionTo self Nothing other mconnection rel1 RemoteActor
  pure $ either (const (Just RemoteRescind)) (const (reaction rel1)) result
  where
    reaction :: Maybe Relation -> Maybe RemoteConnectionAction
    reaction (Just Accepted) = Just RemoteConnect
    reaction (Just Sent) = Just RemoteConnect
    reaction _ = Nothing

createConnectionToRemoteUser ::
  ( Member GalleyAPIAccess r,
    Member FederationConfigStore r,
    Member UserStore r,
    Member UserSubsystem r,
    Member NotificationSubsystem r,
    HasBrigFederationAccess m r
  ) =>
  Local UserId ->
  ConnId ->
  Remote UserId ->
  ConnectionM r (ResponseForExistedCreated UserConnection)
createConnectionToRemoteUser self zcon other = do
  ensureNotSameAndActivated self (tUntagged other)
  mbOtherProfile <- ensureFederatesWith other
  let selfInfo, otherInfo :: [Qualified (Either UserId UserProfile)]
      selfInfo = [tUntagged $ Left <$> self]
      otherInfo = [tUntagged $ qualifyAs other (Right op) | op <- maybeToList mbOtherProfile]
  ensureNoApps self $ selfInfo <> otherInfo
  mconnection <- lift . wrapClient $ Data.lookupConnection self (tUntagged other)
  fst <$> performLocalAction self (Just zcon) other mconnection LocalConnect

updateConnectionToRemoteUser ::
  ( Member GalleyAPIAccess r,
    Member NotificationSubsystem r,
    Member FederationConfigStore r,
    Member UserStore r,
    HasBrigFederationAccess m r
  ) =>
  Local UserId ->
  Remote UserId ->
  Relation ->
  Maybe ConnId ->
  (ConnectionM r) (Maybe UserConnection)
updateConnectionToRemoteUser self other rel1 zcon = do
  void $ ensureFederatesWith other
  mconnection <- lift . wrapClient $ Data.lookupConnection self (tUntagged other)
  action <-
    actionForTransition rel1
      ?? InvalidTransition (tUnqualified self)
  (conn, wasUpdated) <- performLocalAction self zcon other mconnection action
  pure $ guard wasUpdated $> extract conn
  where
    actionForTransition Cancelled = Just LocalRescind
    actionForTransition Sent = Just LocalConnect
    actionForTransition Accepted = Just LocalConnect
    actionForTransition Blocked = Just LocalBlock
    actionForTransition Ignored = Just LocalIgnore
    actionForTransition Pending = Nothing
    actionForTransition MissingLegalholdConsent = Nothing

checkLimitForLocalAction :: Local UserId -> Relation -> LocalConnectionAction -> (ConnectionM r) ()
checkLimitForLocalAction u oldRel action =
  when (oldRel `notElem` [Accepted, Sent] && (action == LocalConnect)) $
    checkLimit u

-- | Check if the local backend federates with the remote user's
-- team. Throw an exception if it does not federate.  Return the
-- profile of the remote user because we sometimes need it again, and
-- don't want to fetch it twice.
ensureFederatesWith ::
  ( Member FederationConfigStore r,
    HasBrigFederationAccess m r
  ) =>
  Remote UserId ->
  ConnectionM r (Maybe UserProfile)
ensureFederatesWith remote = do
  lift $ Log.info $ Log.msg ("Brig-federation: get users by ids on remote backends" :: ByteString)
  profiles <-
    either (throwE . ConnectFederationError) pure
      =<< lift (liftSem $ runFederatedEither remote $ fedClient @'Brig @"get-users-by-ids" [tUnqualified remote])
  let rTeam = qualifyAs remote $ profileTeam =<< listToMaybe profiles
  unlessM (lift . liftSem . backendFederatesWith $ rTeam) $
    throwE ConnectTeamFederationError
  pure (listToMaybe profiles)
