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

-- | SCIM errors
module Web.Scim.Schema.Error
  ( -- * Types
    ScimErrorType (..),
    ScimError (..),
    Status (..),

    -- * Constructors
    notFound,
    badRequest,
    conflict,
    unauthorized,
    forbidden,
    serverError,

    -- * Servant/Wai interoperability
    scimToServerError,
    scimToWaiError,
  )
where

import Control.Exception
import Data.Aeson hiding (Error)
import Data.ByteString.UTF8 (fromString)
import Data.Text (Text, pack)
import qualified Data.Text.Lazy.Encoding as LText
import GHC.Generics (Generic)
import qualified Network.HTTP.Types.Header as HTTP
import qualified Network.HTTP.Types.Status as HTTP
import qualified Network.Wai.Utilities.Error as Wai
import Servant (ServerError (..))
import Web.Scim.Schema.Common
import Web.Scim.Schema.Schema

----------------------------------------------------------------------------
-- Types

-- | An ADT for error types in the SCIM specification. Not all possible SCIM
-- errors have a corresponding 'ScimErrorType' (for instance, authorization
-- is not covered by this type).
--
-- See <https://tools.ietf.org/html/rfc7644#page-69>
data ScimErrorType
  = InvalidFilter
  | TooMany
  | Uniqueness
  | Mutability
  | InvalidSyntax
  | InvalidPath
  | NoTarget
  | InvalidValue
  | InvalidVers
  | Sensitive
  deriving (Show, Eq, Generic)

instance ToJSON ScimErrorType where
  toJSON InvalidFilter = "invalidFilter"
  toJSON TooMany = "tooMany"
  toJSON Uniqueness = "uniqueness"
  toJSON Mutability = "mutability"
  toJSON InvalidSyntax = "invalidSyntax"
  toJSON InvalidPath = "invalidPath"
  toJSON NoTarget = "noTarget"
  toJSON InvalidValue = "invalidValue"
  toJSON InvalidVers = "invalidVers"
  toJSON Sensitive = "sensitive"

-- wrapped in a newtype because SCIM wants strings for status codes
newtype Status = Status {unStatus :: Int}
  deriving (Show, Eq, Generic)

instance ToJSON Status where
  toJSON (Status stat) = String . pack . show $ stat

data ScimError = ScimError
  { schemas :: [Schema],
    status :: Status,
    scimType :: Maybe ScimErrorType,
    detail :: Maybe Text
  }
  deriving (Show, Eq, Generic)

instance ToJSON ScimError where
  toJSON = genericToJSON serializeOptions

instance Exception ScimError

----------------------------------------------------------------------------
-- Constructors

badRequest ::
  -- | Error type
  ScimErrorType ->
  -- | Error details
  Maybe Text ->
  ScimError
badRequest typ mbDetail =
  ScimError
    { schemas = [Error20],
      status = Status 400,
      scimType = pure typ,
      detail = mbDetail
    }

unauthorized ::
  -- | Error details
  Text ->
  ScimError
unauthorized details =
  ScimError
    { schemas = [Error20],
      status = Status 401,
      scimType = Nothing,
      detail = pure $ "authorization failed: " <> details
    }

forbidden ::
  -- | Error details
  Text ->
  ScimError
forbidden details =
  ScimError
    { schemas = [Error20],
      status = Status 403,
      scimType = Nothing,
      detail = pure $ "forbidden: " <> details
    }

notFound ::
  -- | Resource type
  Text ->
  -- | Resource ID
  Text ->
  ScimError
notFound resourceType resourceId =
  ScimError
    { schemas = [Error20],
      status = Status 404,
      scimType = Nothing,
      detail = pure $ resourceType <> " " <> resourceId <> " not found"
    }

conflict :: ScimError
conflict =
  ScimError
    { schemas = [Error20],
      status = Status 409,
      scimType = Just Uniqueness,
      detail = Nothing
    }

serverError ::
  -- | Error details
  Text ->
  ScimError
serverError details =
  ScimError
    { schemas = [Error20],
      status = Status 500,
      scimType = Nothing,
      detail = pure details
    }

----------------------------------------------------------------------------
-- Servant

-- | Convert a SCIM 'Error' to a Servant one by encoding it with the
-- appropriate headers.
-- We would like to use Wire.Error.HttpError from wire-subsystems,
-- but hscim can't depend on that.
scimToWaiError :: ScimError -> (Wai.Error, [HTTP.Header])
scimToWaiError err = (Wai.mkError e "scim-error" (LText.decodeUtf8 $ encode err), hs)
  where
    e = HTTP.Status (unStatus (status err)) (fromString $ reasonPhrase (status err))
    hs = [("Content-Type", "application/scim+json;charset=utf-8")]

-- | Convert a SCIM 'Error' to a Servant one by encoding it with the
-- appropriate headers.
scimToServerError :: ScimError -> ServerError
scimToServerError err =
  ServerError
    { errHTTPCode = unStatus (status err),
      errReasonPhrase = reasonPhrase (status err),
      errBody = encode err,
      errHeaders = [("Content-Type", "application/scim+json;charset=utf-8")]
    }

-- | A mapping of error code "reason phrases" (e.g. "Method Not Allowed")
-- for all 4xx and 5xx errors.
reasonPhrase :: Status -> String
reasonPhrase = \case
  Status 400 -> "Bad Request"
  Status 401 -> "Unauthorized"
  Status 402 -> "Payment Required"
  Status 403 -> "Forbidden"
  Status 404 -> "Not Found"
  Status 405 -> "Method Not Allowed"
  Status 406 -> "Not Acceptable"
  Status 407 -> "Proxy Authentication Required"
  Status 408 -> "Request Time-out"
  Status 409 -> "Conflict"
  Status 410 -> "Gone"
  Status 411 -> "Length Required"
  Status 412 -> "Precondition Failed"
  Status 413 -> "Request Entity Too Large"
  Status 414 -> "Request-URI Too Large"
  Status 415 -> "Unsupported Media Type"
  Status 416 -> "Range Not Satisfiable"
  Status 417 -> "Expectation Failed"
  Status 422 -> "Unprocessable Entity"
  Status 500 -> "Internal Server Error"
  Status 501 -> "Not Implemented"
  Status 502 -> "Bad Gateway"
  Status 503 -> "Service Unavailable"
  Status 504 -> "Gateway Time-out"
  Status 505 -> "HTTP Version not supported"
  other -> show other
