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

-- | RPCs towards service providers.
module Brig.Provider.RPC
  ( -- * External RPC
    ServiceError (..),
    createBot,
    -- Internal RPC
    setServiceConn,
    removeServiceConn,
    addBotMember,
    removeBotMember,
  )
where

import Bilge
import Bilge.RPC
import Bilge.Retry (httpHandlers)
import Brig.App
import Brig.Provider.DB (ServiceConn (..))
import Brig.RPC
import Control.Error
import Control.Lens (set, (^.))
import Control.Monad.Catch
import Control.Retry (recovering)
import Data.Aeson
import Data.ByteString.Conversion
import Data.Id
import Data.List.NonEmpty qualified as NonEmpty
import Imports
import Network.HTTP.Client qualified as Http
import Network.HTTP.Types.Method
import Network.HTTP.Types.Status
import Network.Wai.Utilities.Exception
import Ssl.Util (withVerifiedSslConnection)
import System.Logger.Class (MonadLogger, field, msg, val, (~~))
import System.Logger.Class qualified as Log
import URI.ByteString
import Wire.API.Bot qualified as Galley
import Wire.API.Bot.Service (serviceEnabled)
import Wire.API.Bot.Service qualified as Galley
import Wire.API.Event.Conversation qualified as Conv
import Wire.API.Provider (httpsUrl)
import Wire.API.Provider.External
import Wire.API.Provider.Service qualified as Galley
import Wire.ParseException
import Wire.Rpc

--------------------------------------------------------------------------------
-- External RPC

data ServiceError
  = ServiceUnavailableWith String
  | ServiceBotConflict

-- | Request a new bot to be created by an external service.
--
-- If the external service is unavailable, returns a specific error
-- or the response body cannot be parsed, a 'ServiceError' is returned.
createBot :: ServiceConn -> NewBotRequest -> ExceptT ServiceError (AppT r) NewBotResponse
createBot scon new = do
  let fprs = toList (sconFingerprints scon)
  (man, verifyFingerprints) <- asks (.extGetManager)
  extHandleAll onExc $ do
    rs <- lift $
      wrapHttp $
        recovering x3 httpHandlers $
          const $
            liftIO $
              withVerifiedSslConnection (verifyFingerprints fprs) man reqBuilder $
                \req ->
                  Http.httpLbs req man
    case Bilge.statusCode rs of
      201 -> decodeBytes "External" (responseBody rs)
      409 -> throwE ServiceBotConflict
      _ -> lift (extLogError scon rs) >> throwE (ServiceUnavailableWith $ show rs)
  where
    -- we can't use 'responseJsonEither' instead, because we have a @Response ByteString@
    -- here, not a @Response (Maybe ByteString)@.
    decodeBytes ctx bs = case eitherDecode' bs of
      Left e -> throwM $ ParseException ctx e
      Right a -> pure a
    reqBuilder =
      extReq scon ["bots"]
        . method POST
        . Bilge.json new
    onExc ex = lift (extLogError scon ex) >> throwE (ServiceUnavailableWith $ displayExceptionNoBacktrace ex)

extReq :: ServiceConn -> [ByteString] -> Request -> Request
extReq scon ps =
  maybe id host (extHost url)
    . port (fromMaybe 443 (extPort url))
    . header "Authorization" ("Bearer " <> toByteString' tok)
    . paths (url ^. pathL : ps)
    . secure
  where
    url = httpsUrl (sconBaseUrl scon)
    tok = NonEmpty.head (sconAuthTokens scon)

extHandleAll :: (MonadCatch m) => (SomeException -> m a) -> m a -> m a
extHandleAll f ma =
  catches
    ma
    [ Handler $ \(ex :: SomeAsyncException) -> throwM ex,
      Handler $ \(ex :: SomeException) -> f ex
    ]

-- nb. We log these errors on 'Info' level since we're usually not
-- able to do anything about them and don't want to distract from
-- other important errors.
extLogError :: (MonadLogger m, Show e) => ServiceConn -> e -> m ()
extLogError scon e =
  Log.info $
    field "provider" (toByteString pid)
      ~~ field "service" (toByteString sid)
      ~~ field "error" (show e)
      ~~ msg (val "External service error")
  where
    pid = sconProvider scon
    sid = sconService scon

--------------------------------------------------------------------------------
-- Internal RPC

-- | Set service connection information in galley.
setServiceConn :: ServiceConn -> AppT r ()
setServiceConn scon = do
  Log.debug $
    remote "galley"
      . field "provider" (toByteString pid)
      . field "service" (toByteString sid)
      . msg (val "Setting service connection")
  void $ wrapHttp $ galleyRequest POST req
  where
    pid = sconProvider scon
    sid = sconService scon
    ref = Galley.newServiceRef sid pid
    url = sconBaseUrl scon
    tok = NonEmpty.head (sconAuthTokens scon)
    fps = toList (sconFingerprints scon)
    req =
      path "/i/services"
        . contentJson
        . lbytes (encode svc)
        . expect2xx
    svc =
      Galley.newService ref url tok fps
        & set serviceEnabled (sconEnabled scon)

-- | Remove service connection information from galley.
removeServiceConn ::
  ( MonadReader Env m,
    MonadUnliftIO m,
    MonadMask m,
    MonadHttp m,
    HasRequestId m,
    MonadLogger m
  ) =>
  ProviderId ->
  ServiceId ->
  m ()
removeServiceConn pid sid = do
  Log.debug $
    remote "galley"
      . field "provider" (toByteString pid)
      . field "service" (toByteString sid)
      . msg (val "Removing service connection")
  void $ galleyRequest DELETE req
  where
    req =
      path "/i/services"
        . contentJson
        . lbytes (encode (Galley.newServiceRef sid pid))
        . expect2xx

-- | Tell galley to add a service bot as a member to a conversation.
addBotMember ::
  UserId ->
  ConnId ->
  ConvId ->
  BotId ->
  ClientId ->
  ProviderId ->
  ServiceId ->
  (AppT r) Conv.Event
addBotMember zusr zcon conv bot clt pid sid = do
  Log.debug $
    remote "galley"
      . field "provider" (toByteString pid)
      . field "service" (toByteString sid)
      . field "conv" (toByteString conv)
      . field "user" (toByteString zusr)
      . field "bot" (toByteString bot)
      . msg (val "Adding bot member")
  decodeBody "galley" =<< wrapHttp (galleyRequest POST req)
  where
    req =
      path "/i/bots"
        . header "Z-User" (toByteString' zusr)
        . header "Z-Connection" (toByteString' zcon)
        . contentJson
        . lbytes (encode (Galley.addBot (Galley.newServiceRef sid pid) conv bot clt))
        . expect2xx

-- | Tell galley to remove a service bot from a conversation.
removeBotMember ::
  ( MonadHttp m,
    MonadReader Env m,
    MonadUnliftIO m,
    MonadMask m,
    HasRequestId m,
    MonadLogger m
  ) =>
  UserId ->
  Maybe ConnId ->
  ConvId ->
  BotId ->
  m (Maybe Conv.Event)
removeBotMember zusr zcon conv bot = do
  Log.debug $
    remote "galley"
      . field "user" (toByteString zusr)
      . field "conv" (toByteString conv)
      . field "bot" (toByteString bot)
      . msg (val "Removing bot member")
  rs <- galleyRequest DELETE req
  if isJust (responseBody rs) && Bilge.statusCode rs == 200
    then Just <$> decodeBody "galley" rs
    else pure Nothing
  where
    req =
      path "/i/bots"
        . header "Z-User" (toByteString' zusr)
        . maybe id (header "Z-Connection" . toByteString') zcon
        . contentJson
        . lbytes (encode (Galley.removeBot conv bot))
        . expect [status200, status404] -- 404 is allowed: a given conversation may no longer exist
