{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module ServerErrors where

import Control.Exception (Exception)
import Control.Monad.Logger (MonadLogger, logError, logWarn)
import Data.ByteString.Lazy qualified as Bytes.Lazy
import Data.Error.Tree
import Network.HTTP.Types qualified as Http
import PossehlAnalyticsPrelude

data ServerError = ServerError
  { status :: Http.Status,
    errBody :: Bytes.Lazy.ByteString
  }
  deriving stock (Show)
  deriving anyclass (Exception)

emptyServerError :: Http.Status -> ServerError
emptyServerError status = ServerError {status, errBody = ""}

-- | Throw a user error.
--
-- “User” here is a client using our API, not a human user.
-- So we throw a `HTTP 400` error, which means the API was used incorrectly.
--
-- We also log the error as a warning, because it probably signifies a programming bug in our client.
--
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
throwUserError ::
  (MonadLogger m, MonadThrow m) =>
  -- | The error to log & throw to the user
  Error ->
  m b
throwUserError err = do
  -- TODO: should we make this into a macro to keep the line numbers?
  $logWarn (err & errorContext "There was a “user holding it wrong” error, check the client code" & prettyError)
  throwM
    ServerError
      { status = Http.badRequest400,
        errBody = err & prettyError & textToBytesUtf8 & toLazyBytes
      }

-- | Throw a user error.
--
-- “User” here is a client using our API, not a human user.
-- So we throw a `HTTP 400` error, which means the API was used incorrectly.
--
-- We also log the error as a warning, because it probably signifies a programming bug in our client.
--
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
throwUserErrorTree ::
  (MonadLogger m, MonadThrow m) =>
  -- | The error to log & throw to the user
  ErrorTree ->
  m b
throwUserErrorTree err = do
  -- TODO: should we make this into a macro to keep the line numbers?
  $logWarn (err & nestedError "There was a “user holding it wrong” error, check the client code" & prettyErrorTree)
  throwM
    ServerError
      { status = Http.badRequest400,
        errBody = err & prettyErrorTree & textToBytesUtf8 & toLazyBytes
      }

-- | Unwrap the `Either` and if `Left` throw a user error.
--
-- Intended to use in a pipeline, e.g.:
--
-- @@
-- doSomething
--   >>= orUserError "Oh no something did not work"
--   >>= doSomethingElse
-- @@
--
-- “User” here is a client using our API, not a human user.
-- So we throw a `HTTP 400` error, which means the API was used incorrectly.
--
-- We also log the error as a warning, because it probably signifies a programming bug in our client.
--
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
orUserError ::
  (MonadThrow m, MonadLogger m) =>
  -- | The message to add as a context to the error being thrown
  Text ->
  -- | Result to unwrap and potentially throw
  Either Error a ->
  m a
orUserError outerMsg eErrA =
  orUserErrorTree outerMsg (first singleError eErrA)

-- | Unwrap the `Either` and if `Left` throw a user error. Will pretty-print the 'ErrorTree'
--
-- Intended to use in a pipeline, e.g.:
--
-- @@
-- doSomething
--   >>= orUserErrorTree "Oh no something did not work"
--   >>= doSomethingElse
-- @@
--
-- “User” here is a client using our API, not a human user.
-- So we throw a `HTTP 400` error, which means the API was used incorrectly.
--
-- We also log the error as a warning, because it probably signifies a programming bug in our client.
--
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
orUserErrorTree ::
  (MonadThrow m, MonadLogger m) =>
  -- | The message to add as a context to the 'ErrorTree' being thrown
  Text ->
  -- | Result to unwrap and potentially throw
  Either ErrorTree a ->
  m a
orUserErrorTree outerMsg = \case
  Right a -> pure a
  Left err -> do
    -- TODO: this outer message should probably be added as a separate root instead of adding to the root error?
    let tree = errorTreeContext outerMsg err
    -- TODO: should we make this into a macro to keep the line numbers?
    $logWarn (errorTreeContext "There was a “user holding it wrong” error, check the client code" tree & prettyErrorTree)
    throwM
      ServerError
        { status = Http.badRequest400,
          errBody = tree & prettyErrorTree & textToBytesUtf8 & toLazyBytes
        }

-- | Throw an internal error.
--
-- “Internal” here means some assertion that we depend on failed,
-- e.g. some database request returned a wrong result/number of results
-- or some invariant that we expect to hold failed.
--
-- This prints the full error to the log,
-- and returns a “HTTP 500” error without the message.
--
-- If you want to signify a mishandling of the API (e.g. a wrong request), throw a `userError`.
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
throwInternalError ::
  (MonadLogger m, MonadThrow m) =>
  -- | The error to log internally
  Error ->
  m b
throwInternalError err = do
  -- TODO: should we make this into a macro to keep the line numbers?
  $logError
    (err & prettyError)
  throwM $ emptyServerError Http.internalServerError500

-- | Throw an internal error.
--
-- “Internal” here means some assertion that we depend on failed,
-- e.g. some database request returned a wrong result/number of results
-- or some invariant that we expect to hold failed.
--
-- This prints the full error to the log,
-- and returns a “HTTP 500” error without the message.
--
-- If you want to signify a mishandling of the API (e.g. a wrong request), throw a `userError`.
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
throwInternalErrorTree ::
  (MonadLogger m, MonadThrow m) =>
  -- | The error to log internally
  ErrorTree ->
  m b
throwInternalErrorTree err = do
  -- TODO: should we make this into a macro to keep the line numbers?
  $logError
    (err & prettyErrorTree)
  throwM $ emptyServerError   Http.internalServerError500

-- | Unwrap the `Either` and if `Left` throw an internal error.
--
-- Intended to use in a pipeline, e.g.:
--
-- @@
-- doSomething
--   >>= orInternalError "Oh no something did not work"
--   >>= doSomethingElse
-- @@
--
-- “Internal” here means some assertion that we depend on failed,
-- e.g. some database request returned a wrong result/number of results
-- or some invariant that we expect to hold failed.
--
-- This prints the full error to the log,
-- and returns a “HTTP 500” error without the message.
--
-- If you want to signify a mishandling of the API (e.g. a wrong request), throw a `userError`.
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
orInternalError ::
  (MonadThrow m, MonadLogger m) =>
  -- | The message to add as a context to the error being thrown
  Text ->
  -- | Result to unwrap and potentially throw
  Either Error a ->
  m a
orInternalError outerMsg eErrA = orInternalErrorTree outerMsg (first singleError eErrA)

-- | Unwrap the `Either` and if `Left` throw an internal error. Will pretty-print the 'ErrorTree'.
--
-- Intended to use in a pipeline, e.g.:
--
-- @@
-- doSomething
--   >>= orInternalErrorTree "Oh no something did not work"
--   >>= doSomethingElse
-- @@
--
-- “Internal” here means some assertion that we depend on failed,
-- e.g. some database request returned a wrong result/number of results
-- or some invariant that we expect to hold failed.
--
-- This prints the full error to the log,
-- and returns a “HTTP 500” error without the message.
--
-- If you want to signify a mishandling of the API (e.g. a wrong request), throw a `userError`.
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
orInternalErrorTree ::
  (MonadThrow m, MonadLogger m) =>
  -- | The message to add as a context to the 'ErrorTree' being thrown
  Text ->
  -- | Result to unwrap and potentially throw
  Either ErrorTree a ->
  m a
orInternalErrorTree outerMsg = \case
  Right a -> pure a
  Left err -> do
    -- TODO: this outer message should probably be added as a separate root instead of adding to the root error?
    let tree = errorTreeContext outerMsg err
    -- TODO: should we make this into a macro to keep the line numbers?
    $logError (tree & prettyErrorTree)
    throwM $ emptyServerError   Http.internalServerError500