;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL

(ns app.http.errors
  "A errors handling for the http server."
  (:require
   [app.common.exceptions :as ex]
   [app.common.logging :as l]
   [app.common.schema :as-alias sm]
   [app.config :as cf]
   [app.http :as-alias http]
   [app.http.access-token :as-alias actoken]
   [app.http.auth :as-alias auth]
   [app.http.session :as-alias session]
   [app.util.inet :as inet]
   [clojure.spec.alpha :as s]
   [cuerdas.core :as str]
   [yetti.request :as yreq]
   [yetti.response :as yres]))

(defn request->context
  "Extracts error report relevant context data from request."
  [request]
  (let [{:keys [claims] :as auth} (get request ::http/auth-data)]
    (-> (cf/logging-context)
        (assoc :request/path (:path request))
        (assoc :request/method (:method request))
        (assoc :request/params (:params request))
        (assoc :request/user-agent (yreq/get-header request "user-agent"))
        (assoc :request/ip-addr (inet/parse-request request))
        (assoc :request/profile-id (get claims :uid))
        (assoc :request/auth-data (dissoc auth :token))
        (assoc :frontend/version (or (yreq/get-header request "x-frontend-version") "unknown")))))

(defn- strip-internal-fields
  "Remove fields that leak internal implementation details from error
  response data. Full context is preserved in server-side logs."
  [data]
  (dissoc data :state :path :context))

(defmulti handle-error
  (fn [cause _ _]
    (-> cause ex-data :type)))

(defmulti handle-exception
  (fn [cause _ _]
    (class cause)))

(defmethod handle-error :authentication
  [err _ _]
  {::yres/status 401
   ::yres/body (ex-data err)})

(defmethod handle-error :authorization
  [err _ _]
  {::yres/status 403
   ::yres/body (ex-data err)})

(defmethod handle-error :restriction
  [err request _]
  (let [data    (ex-data err)
        code    (get data :code)
        explain (ex/explain data)
        data    (-> data
                    (dissoc ::sm/explain)
                    (cond-> explain (assoc :explain explain)))]

    (if (= code :method-not-allowed)
      {::yres/status 405
       ::yres/body data}

      (binding [l/*context* (request->context request)]
        {::yres/status 400
         ::yres/body data}))))

(defmethod handle-error :rate-limit
  [err _ _]
  (let [data    (ex-data err)
        headers (cond-> (::http/headers data)
                  (some? (:ttl data))
                  (assoc "retry-after" (str (:ttl data))))]
    {::yres/status  429
     ::yres/headers headers
     ::yres/body    {:type :rate-limit
                     :code (:code data)
                     :hint (:hint data)
                     :ttl  (:ttl data)}}))

(defmethod handle-error :concurrency-limit
  [err _ _]
  (let [headers (-> err ex-data ::http/headers)]
    {::yres/status 429
     ::yres/headers headers}))

(defmethod handle-error :validation
  [err request parent-cause]
  (let [{:keys [code] :as data} (ex-data err)]
    (cond
      (or (= code :spec-validation)
          (= code :params-validation)
          (= code :schema-validation)
          (= code :data-validation))
      (let [explain (ex/explain data)]
        {::yres/status 400
         ::yres/body   (-> data
                           (dissoc ::s/problems ::s/value ::s/spec ::sm/explain)
                           (cond-> explain (assoc :explain explain)))})

      (= code :vern-conflict)
      {::yres/status 409 ;; 409 - Conflict
       ::yres/body data}

      (= code :request-body-too-large)
      {::yres/status 413 ::yres/body data}

      (= code :invalid-image)
      (binding [l/*context* (request->context request)]
        (let [cause (or parent-cause err)]
          (l/warn :hint "image process error" :cause cause)
          {::yres/status 400 ::yres/body data}))

      :else
      (let [explain (ex/explain data)]
        {::yres/status 400
         ::yres/body   (-> data
                           (dissoc ::sm/explain)
                           (cond-> explain (assoc :explain explain)))}))))

(defmethod handle-error :assertion
  [error request parent-cause]
  (binding [l/*context* (request->context request)]
    (let [{:keys [code] :as data} (ex-data error)
          cause (or parent-cause error)]
      (cond
        (= code :data-validation)
        (let [explain (ex/explain data)]
          (l/error :hint "data assertion error" :cause cause)
          {::yres/status 500
           ::yres/body   (-> data
                             (dissoc ::sm/explain)
                             (cond-> explain (assoc :explain explain))
                             (assoc :type :server-error)
                             (assoc :code :assertion))})

        (= code :spec-validation)
        (let [explain (ex/explain data)]
          (l/error :hint "spec assertion error" :cause cause)
          {::yres/status 500
           ::yres/body   (-> data
                             (dissoc ::s/problems ::s/value ::s/spec)
                             (cond-> explain (assoc :explain explain))
                             (assoc :type :server-error)
                             (assoc :code :assertion))})

        :else
        (do
          (l/error :hint "assertion error" :cause cause)
          {::yres/status 500
           ::yres/body   (-> data
                             (strip-internal-fields)
                             (assoc :type :server-error)
                             (assoc :code :assertion))})))))

(defmethod handle-error :not-found
  [err _ _]
  {::yres/status 404
   ::yres/body (ex-data err)})

(defmethod handle-error :conflict
  [err _ _]
  {::yres/status 409
   ::yres/body (ex-data err)})

(defmethod handle-error :nitrate-unavailable
  [err request _]
  (binding [l/*context* (request->context request)]
    (l/warn :hint "nitrate is unreachable; blocking request" :cause err)
    ;; Do not leak Nitrate's internal URL/status to the client; the
    ;; full context is already logged above for operators.
    {::yres/status 503
     ::yres/body {:type :nitrate-unavailable}}))

(defmethod handle-error :nitrate-not-configured
  [err request _]
  (binding [l/*context* (request->context request)]
    (l/warn :hint "nitrate is not configured; blocking request" :cause err)
    {::yres/status 503
     ::yres/body {:type :nitrate-not-configured}}))

(defmethod handle-error :internal
  [error request parent-cause]
  (binding [l/*context* (request->context request)]
    (let [cause (or parent-cause error)
          data  (ex-data error)]
      (l/error :hint "internal error" :cause cause)
      {::yres/status 500
       ::yres/body (-> data
                       (strip-internal-fields)
                       (assoc :type :server-error)
                       (update :code #(or % :unhandled)))})))

(defmethod handle-error :default
  [error request parent-cause]
  (let [edata (ex-data error)]
    ;; This is a special case for the idle-in-transaction error;
    ;; when it happens, the connection is automatically closed and
    ;; next-jdbc combines the two errors in a single ex-info. We
    ;; only need the :handling error, because the :rollback error
    ;; will be always "connection closed".
    (if (and (ex/exception? (:rollback edata))
             (ex/exception? (:handling edata)))
      (handle-exception (:handling edata) request error)
      (handle-exception error request parent-cause))))

(defn- pgsql-state->message
  "Map PostgreSQL SQLSTATE codes to safe, client-facing messages.
  Returns a user-friendly string that conveys the nature of the error
  without exposing table names, constraint names, or other internals."
  [state]
  (case state
    "23505" "A conflicting entry already exists"
    "23503" "The referenced item does not exist"
    "23502" "A required field is missing"
    "23514" "The value violates a data integrity constraint"
    "57014" "The operation took too long and was cancelled"
    "25P03" "The transaction was idle too long and was cancelled"
    "A database error occurred"))

(defn- transient-sql-state?
  "True for SQLSTATE codes of failures that pass on their own: lost or
  refused connections, lack of resources, a server shutting down, and
  serialization failures or deadlocks of concurrent transactions."
  [state]
  (and (string? state)
       (or (str/starts-with? state "08")
           (str/starts-with? state "53")
           (contains? #{"57P01" "57P02" "57P03" "40001" "40P01"} state))))

(defn- unavailable
  "Response for a failure that passes on its own: the request can be sent
  again."
  [code hint]
  {::yres/status 503
   ::yres/body {:type :server-error
                :code code
                :hint hint}})

(defmethod handle-exception org.postgresql.util.PSQLException
  [error request parent-cause]
  (let [state (.getSQLState ^java.sql.SQLException error)
        cause (or parent-cause error)]
    (binding [l/*context* (request->context request)]
      (l/error :hint "postgresql error"
               :cause cause)
      (cond
        (transient-sql-state? state)
        (unavailable :database-unavailable "The database is not available right now")

        (= state "57014")
        {::yres/status 504
         ::yres/body {:type :server-error
                      :code :statement-timeout
                      :hint (pgsql-state->message state)}}

        (= state "25P03")
        {::yres/status 504
         ::yres/body {:type :server-error
                      :code :idle-in-transaction-timeout
                      :hint (pgsql-state->message state)}}

        :else
        {::yres/status 500
         ::yres/body {:type :server-error
                      :code :database-error
                      :hint (pgsql-state->message state)}}))))

(defmethod handle-exception :default
  [error request parent-cause]
  (let [edata (ex-data error)
        cause (or parent-cause error)]
    (cond
      ;; This means that exception is not a controlled exception.
      (nil? edata)
      (binding [l/*context* (request->context request)]
        (l/error :hint "unexpected error" :cause cause)
        {::yres/status 500
         ::yres/body {:type :server-error
                      :code :unexpected}})

      :else
      (binding [l/*context* (request->context request)]
        (l/error :hint "unhandled error" :cause cause)
        {::yres/status 500
         ::yres/body (-> edata
                         (strip-internal-fields)
                         (assoc :type :server-error)
                         (update :code #(or % :unhandled)))}))))

(defmethod handle-exception java.sql.SQLTransientException
  [cause request _]
  (binding [l/*context* (request->context request)]
    (l/wrn :hint "transient database error" :cause cause)
    (unavailable :database-unavailable "The database is not available right now")))

(defn- transient-io-exception?
  "True for I/O failures that pass on their own: a lost, refused or timed
  out connection, or a host name that did not resolve. A parse error or
  data that cannot be read fails again on every attempt."
  [cause]
  (or (instance? java.net.SocketException cause)
      (instance? java.io.InterruptedIOException cause)
      (instance? java.net.UnknownHostException cause)
      (instance? java.net.http.HttpTimeoutException cause)))

(defmethod handle-exception java.io.IOException
  [cause request _]
  (binding [l/*context* (request->context request)]
    (l/wrn :hint "io exception" :cause cause)
    (if (transient-io-exception? cause)
      (unavailable :io-exception "An input/output operation failed")
      {::yres/status 500
       ::yres/body {:type :server-error
                    :code :io-exception}})))

(defmethod handle-exception InterruptedException
  [cause request _]
  (binding [l/*context* (request->context request)]
    (l/wrn :hint "interrupted request" :cause cause)
    (unavailable :interrupted "The request was interrupted")))

(defmethod handle-exception java.util.concurrent.CompletionException
  [cause request _]
  (let [cause' (ex-cause cause)]
    (if (ex/error? cause')
      (handle-error cause' request cause)
      (handle-exception cause' request cause))))

(defmethod handle-exception java.util.concurrent.ExecutionException
  [cause request _]
  (let [cause' (ex-cause cause)]
    (if (ex/error? cause')
      (handle-error cause' request cause)
      (handle-exception cause' request cause))))

(defn handle
  [cause request]
  (if (ex/error? cause)
    (handle-error cause request nil)
    (handle-exception cause request nil)))

(defn handle'
  [cause request]
  (::yres/body (handle cause request)))