;; 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 INC

(ns app.http.debug
  (:refer-clojure :exclude [error-handler])
  (:require
   [app.common.exceptions :as ex]
   [app.common.logging :as l]
   [app.common.pprint :as pp]
   [app.common.uuid :as uuid]
   [app.config :as cf]
   [app.db :as db]
   [app.http.middleware :as mw]
   [app.http.session :as session]
   [app.rpc.commands.binfile :as binf]
   [app.rpc.commands.files-create :refer [create-file]]
   [app.rpc.commands.profile :as profile]
   [app.storage :as-alias sto]
   [app.util.blob :as blob]
   [app.util.template :as tmpl]
   [app.util.time :as dt]
   [app.worker :as wrk]
   [clojure.spec.alpha :as s]
   [cuerdas.core :as str]
   [datoteka.io :as io]
   [emoji.core :as emj]
   [integrant.core :as ig]
   [markdown.core :as md]
   [markdown.transformers :as mdt]
   [yetti.request :as yrq]
   [yetti.response :as yrs]))

;; (selmer.parser/cache-off!)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn authorized?
  [pool {:keys [::session/profile-id]}]
  (or (= "devenv" (cf/get :host))
      (let [profile (ex/ignoring (profile/get-profile pool profile-id))
            admins  (or (cf/get :admins) #{})]
        (contains? admins (:email profile)))))

(defn prepare-response
  [body]
  (let [headers {"content-type" "application/transit+json"}]
    (yrs/response :status 200 :body body :headers headers)))

(defn prepare-download-response
  [body filename]
  (let [headers {"content-disposition" (str "attachment; filename=" filename)
                 "content-type" "application/octet-stream"}]
    (yrs/response :status 200 :body body :headers headers)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; INDEX
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn index-handler
  [{:keys [::db/pool]} request]
  (when-not (authorized? pool request)
    (ex/raise :type :authentication
              :code :only-admins-allowed))
  (yrs/response :status  200
                :headers {"content-type" "text/html"}
                :body    (-> (io/resource "app/templates/debug.tmpl")
                             (tmpl/render {}))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FILE CHANGES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def sql:retrieve-range-of-changes
  "select revn, changes from file_change where file_id=? and revn >= ? and revn <= ? order by revn")

(def sql:retrieve-single-change
  "select revn, changes, data from file_change where file_id=? and revn = ?")

(defn- retrieve-file-data
  [{:keys [::db/pool]} {:keys [params ::session/profile-id] :as request}]
  (when-not (authorized? pool request)
    (ex/raise :type :authentication
              :code :only-admins-allowed))

  (let [file-id  (some-> params :file-id parse-uuid)
        revn     (some-> params :revn parse-long)
        filename (str file-id)]

    (when-not file-id
      (ex/raise :type :validation
                :code :missing-arguments))

    (let [data (if (integer? revn)
                 (some-> (db/exec-one! pool [sql:retrieve-single-change file-id revn]) :data)
                 (some-> (db/get-by-id pool :file file-id) :data))]

      (when-not data
        (ex/raise :type :not-found
                  :code :enpty-data
                  :hint "empty response"))
      (cond
        (contains? params :download)
        (prepare-download-response data filename)

        (contains? params :clone)
        (let [profile    (profile/get-profile pool profile-id)
              project-id (:default-project-id profile)
              data       (blob/decode data)]
          (create-file pool {:id (uuid/next)
                             :name (str "Cloned file: " filename)
                             :project-id project-id
                             :profile-id profile-id
                             :data data})
          (yrs/response 201 "OK CREATED"))

        :else
        (prepare-response (blob/decode data))))))

(defn- is-file-exists?
  [pool id]
  (let [sql "select exists (select 1 from file where id=?) as exists;"]
    (-> (db/exec-one! pool [sql id]) :exists)))

(defn- upload-file-data
  [{:keys [::db/pool]} {:keys [::session/profile-id params] :as request}]
  (let [profile    (profile/get-profile pool profile-id)
        project-id (:default-project-id profile)
        data       (some-> params :file :path io/read-as-bytes blob/decode)]

    (if (and data project-id)
      (let [fname      (str "Imported file *: " (dt/now))
            overwrite? (contains? params :overwrite?)
            file-id    (or (and overwrite? (ex/ignoring (-> params :file :filename parse-uuid)))
                           (uuid/next))]

        (if (and overwrite? file-id
                 (is-file-exists? pool file-id))
          (do
            (db/update! pool :file
                        {:data (blob/encode data)}
                        {:id file-id})
            (yrs/response 200 "OK UPDATED"))

          (do
            (create-file pool {:id file-id
                               :name fname
                               :project-id project-id
                               :profile-id profile-id
                               :data data})
            (yrs/response 201 "OK CREATED"))))

      (yrs/response 500 "ERROR"))))

(defn file-data-handler
  [cfg request]
  (case (yrq/method request)
    :get (retrieve-file-data cfg request)
    :post (upload-file-data cfg request)
    (ex/raise :type :http
              :code :method-not-found)))

(defn file-changes-handler
  [{:keys [::db/pool]} {:keys [params] :as request}]
  (when-not (authorized? pool request)
    (ex/raise :type :authentication
              :code :only-admins-allowed))

  (letfn [(retrieve-changes [file-id revn]
            (if (str/includes? revn ":")
              (let [[start end] (->> (str/split revn #":")
                                     (map str/trim)
                                     (map parse-long))]
                (some->> (db/exec! pool [sql:retrieve-range-of-changes file-id start end])
                         (map :changes)
                         (map blob/decode)
                         (mapcat identity)
                         (vec)))

              (if-let [revn (parse-long revn)]
                (let [item (db/exec-one! pool [sql:retrieve-single-change file-id revn])]
                  (some-> item :changes blob/decode vec))
                (ex/raise :type :validation :code :invalid-arguments))))]

    (let [file-id  (some-> params :id parse-uuid)
          revn     (or (some-> params :revn parse-long) "latest")
          filename (str file-id)]

      (when (or (not file-id) (not revn))
        (ex/raise :type :validation
                  :code :invalid-arguments
                  :hint "missing arguments"))

      (let [data (retrieve-changes file-id revn)]
        (if (contains? params :download)
          (prepare-download-response data filename)
          (prepare-response data))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ERROR BROWSER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn error-handler
  [{:keys [::db/pool]} request]
  (letfn [(get-report [{:keys [path-params]}]
            (ex/ignoring
             (let [report-id (some-> path-params :id parse-uuid)]
               (some-> (db/get-by-id pool :server-error-report report-id)
                       (update :content db/decode-transit-pgobject)))))

          (render-template-v1 [{:keys [content]}]
            (let [context (dissoc content
                                  :trace :cause :params :data :spec-problems :message
                                  :spec-explain :spec-value :error :explain :hint)
                  params  {:context       (pp/pprint-str context :width 200)
                           :hint          (:hint content)
                           :spec-explain  (:spec-explain content)
                           :spec-problems (:spec-problems content)
                           :spec-value    (:spec-value content)
                           :data          (:data content)
                           :trace         (or (:trace content)
                                              (some-> content :error :trace))
                           :params        (:params content)}]
              (-> (io/resource "app/templates/error-report.tmpl")
                  (tmpl/render params))))

          (render-template-v2 [{report :content}]
            (-> (io/resource "app/templates/error-report.v2.tmpl")
                (tmpl/render report)))

          ]

    (when-not (authorized? pool request)
      (ex/raise :type :authentication
                :code :only-admins-allowed))

    (if-let [report (get-report request)]
      (let [result (if (= 1 (:version report))
                     (render-template-v1 report)
                     (render-template-v2 report))]
        (yrs/response :status 200
                      :body result
                      :headers {"content-type" "text/html; charset=utf-8"
                                "x-robots-tag" "noindex"}))
      (yrs/response 404 "not found"))))

(def sql:error-reports
  "SELECT id, created_at,
          content->>'~:hint' AS hint
     FROM server_error_report
    ORDER BY created_at DESC
    LIMIT 100")

(defn error-list-handler
  [{:keys [::db/pool]} request]
  (when-not (authorized? pool request)
    (ex/raise :type :authentication
              :code :only-admins-allowed))
  (let [items (->> (db/exec! pool [sql:error-reports])
                   (map #(update % :created-at dt/format-instant :rfc1123)))]
    (yrs/response :status 200
                  :body (-> (io/resource "app/templates/error-list.tmpl")
                            (tmpl/render {:items items}))
                  :headers {"content-type" "text/html; charset=utf-8"
                            "x-robots-tag" "noindex"})))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; EXPORT/IMPORT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn export-handler
  [{:keys [::db/pool] :as cfg} {:keys [params ::session/profile-id] :as request}]

  (let [file-ids (->> (:file-ids params)
                      (remove empty?)
                      (mapv parse-uuid))
        libs?    (contains? params :includelibs)
        clone?   (contains? params :clone)
        embed?   (contains? params :embedassets)]

    (when-not (seq file-ids)
      (ex/raise :type :validation
                :code :missing-arguments))

    (let [path (-> cfg
                   (assoc ::binf/file-ids file-ids)
                   (assoc ::binf/embed-assets? embed?)
                   (assoc ::binf/include-libraries? libs?)
                   (binf/export-to-tmpfile!))]
      (if clone?
        (let [profile    (profile/get-profile pool profile-id)
              project-id (:default-project-id profile)]
          (binf/import!
           (assoc cfg
                  ::binf/input path
                  ::binf/overwrite? false
                  ::binf/ignore-index-errors? true
                  ::binf/profile-id profile-id
                  ::binf/project-id project-id))

          (yrs/response
           :status  200
           :headers {"content-type" "text/plain"}
           :body    "OK CLONED"))

        (yrs/response
         :status  200
         :headers {"content-type" "application/octet-stream"
                   "content-disposition" (str "attachmen; filename=" (first file-ids) ".penpot")}
         :body    (io/input-stream path))))))


(defn import-handler
  [{:keys [::db/pool] :as cfg} {:keys [params ::session/profile-id] :as request}]
  (when-not (contains? params :file)
    (ex/raise :type :validation
              :code :missing-upload-file
              :hint "missing upload file"))

  (let [profile    (profile/get-profile pool profile-id)
        project-id (:default-project-id profile)
        overwrite? (contains? params :overwrite)
        migrate?   (contains? params :migrate)
        ignore-index-errors? (contains? params :ignore-index-errors)]

    (when-not project-id
      (ex/raise :type :validation
                :code :missing-project
                :hint "project not found"))

    (binf/import!
     (assoc cfg
            ::binf/input (-> params :file :path)
            ::binf/overwrite? overwrite?
            ::binf/migrate? migrate?
            ::binf/ignore-index-errors? ignore-index-errors?
            ::binf/profile-id profile-id
            ::binf/project-id project-id))

    (yrs/response
     :status  200
     :headers {"content-type" "text/plain"}
     :body    "OK")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; OTHER SMALL VIEWS/HANDLERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn health-handler
  "Mainly a task that performs a health check."
  [{:keys [::db/pool]} _]
  (try
    (db/exec-one! pool ["select count(*) as count from server_prop;"])
    (yrs/response 200 "OK")
    (catch Throwable cause
      (l/warn :hint "unable to execute query on health handler"
              :cause cause)
      (yrs/response 503 "KO"))))

(defn changelog-handler
  [_ _]
  (letfn [(transform-emoji [text state]
            [(emj/emojify text) state])
          (md->html [text]
            (md/md-to-html-string text :replacement-transformers (into [transform-emoji] mdt/transformer-vector)))]
    (if-let [clog (io/resource "changelog.md")]
      (yrs/response :status 200
                    :headers {"content-type" "text/html; charset=utf-8"}
                    :body (-> clog slurp md->html))
      (yrs/response :status 404 :body "NOT FOUND"))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; INIT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def with-authorization
  {:compile
   (fn [& _]
     (fn [handler pool]
       (fn [request respond raise]
         (if (authorized? pool request)
           (handler request respond raise)
           (raise (ex/error :type :authentication
                            :code :only-admins-allowed))))))})

(defmethod ig/pre-init-spec ::routes [_]
  (s/keys :req [::db/pool
                ::wrk/executor
                ::sto/storage
                ::session/manager]))

(defmethod ig/init-key ::routes
  [_ {:keys [::db/pool ::wrk/executor] :as cfg}]
  [["/readyz" {:middleware [[mw/with-dispatch executor]
                            [mw/with-config cfg]]
               :handler health-handler}]
   ["/dbg" {:middleware [[session/authz cfg]
                         [with-authorization pool]
                         [mw/with-dispatch executor]
                         [mw/with-config cfg]]}
    ["" {:handler index-handler}]
    ["/health" {:handler health-handler}]
    ["/changelog" {:handler changelog-handler}]
    ;; ["/error-by-id/:id" {:handler error-handler}]
    ["/error/:id" {:handler error-handler}]
    ["/error" {:handler error-list-handler}]
    ["/file/export" {:handler export-handler}]
    ["/file/import" {:handler import-handler}]
    ["/file/data" {:handler file-data-handler}]
    ["/file/changes" {:handler file-changes-handler}]]])