-- 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.Handler
  ( -- * Handler Monad
    Handler,
    toServantHandler,

    -- * Utilities
    checkAllowlist,
    checkAllowlistWithError,
    isAllowlisted,
    UserNotAllowedToJoinTeam (..),
  )
where

import Bilge (RequestId (..))
import Brig.API.Error
import Brig.AWS qualified as AWS
import Brig.App
import Brig.CanonicalInterpreter (BrigCanonicalEffects, runBrigToIO)
import Brig.Options (allowlistEmailDomains)
import Control.Error
import Control.Exception (throwIO)
import Control.Monad.Catch (catches, throwM)
import Control.Monad.Catch qualified as Catch
import Control.Monad.Except (MonadError, throwError)
import Data.Aeson qualified as Aeson
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.ZAuth.Validation qualified as ZV
import Imports
import Network.HTTP.Types (Status (statusCode, statusMessage))
import Network.Wai.Utilities.Error qualified as WaiError
import Network.Wai.Utilities.Server qualified as Server
import Servant qualified
import System.Logger qualified as Log
import System.Logger.Class (Logger)
import Wire.API.Allowlists qualified as Allowlists
import Wire.API.Error
import Wire.API.Error.Brig
import Wire.API.User
import Wire.AuthenticationSubsystem.Error (zauthError)
import Wire.Error

-------------------------------------------------------------------------------
-- HTTP Handler Monad

type Handler r = ExceptT HttpError (AppT r)

toServantHandler :: Env -> (Handler BrigCanonicalEffects) a -> Servant.Handler a
toServantHandler env action = do
  let logger = env.appLogger
      reqId = unRequestId $ env.requestId
  a <-
    liftIO $
      (runBrigToIO env (runExceptT action))
        `catches` brigErrorHandlers logger reqId
  case a of
    Left werr -> handleWaiErrors logger reqId werr
    Right x -> pure x
  where
    mkCode = statusCode . WaiError.code
    mkPhrase = Text.unpack . Text.decodeUtf8 . statusMessage

    handleWaiErrors logger reqId =
      \case
        -- throw in IO so that the `catchErrors` middleware can turn this error
        -- into a response and log accordingly
        StdError werr -> do
          Server.logError' logger (Just reqId) werr
          liftIO $ throwIO werr
        richErr@(RichError werr _ headers) -> do
          when (statusCode (WaiError.code werr) < 500) $
            -- 5xx are logged by the middleware, so we only log errors < 500 to avoid duplicated entries
            Server.logError' logger (Just reqId) werr
          Servant.throwError $
            Servant.ServerError (mkCode werr) (mkPhrase (WaiError.code werr)) (Aeson.encode richErr) headers

newtype UserNotAllowedToJoinTeam = UserNotAllowedToJoinTeam WaiError.Error
  deriving (Show)

instance Exception UserNotAllowedToJoinTeam

brigErrorHandlers :: Logger -> ByteString -> [Catch.Handler IO (Either HttpError a)]
brigErrorHandlers logger reqId =
  [ Catch.Handler $ \(ex :: ZV.Failure) ->
      pure (Left (StdError (zauthError ex))),
    Catch.Handler $ \(ex :: AWS.Error) ->
      case ex of
        AWS.SESInvalidDomain ->
          pure (Left (StdError (errorToWai @'InvalidEmail)))
        _ -> throwM ex,
    Catch.Handler $ \(e :: HttpError) -> pure $ Left e,
    Catch.Handler $ \(UserNotAllowedToJoinTeam e) -> pure (Left $ StdError e),
    Catch.Handler $ \(e :: SomeException) -> do
      Log.err logger $
        Log.msg ("IO Exception occurred" :: ByteString)
          . Log.field "message" (displayException e)
          . Log.field "request" reqId
      throwIO e
  ]

-------------------------------------------------------------------------------
-- Utilities

-- | If an Allowlist is configured, consult it, otherwise a no-op. {#RefActivationAllowlist}
checkAllowlist :: EmailAddress -> Handler r ()
checkAllowlist = wrapHttpClientE . checkAllowlistWithError (StdError allowlistError)

checkAllowlistWithError :: (MonadReader Env m, MonadError e m) => e -> EmailAddress -> m ()
checkAllowlistWithError e key = do
  ok <- isAllowlisted key
  unless ok (throwError e)

isAllowlisted :: (MonadReader Env m) => EmailAddress -> m Bool
isAllowlisted key = do
  env <- asks (.settings)
  pure $ Allowlists.verify env.allowlistEmailDomains key
