;; 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) UXBOX Labs SL (ns app.http.debug (:require [app.common.data :as d] [app.common.exceptions :as ex] [app.common.spec :as us] [app.common.uuid :as uuid] [app.config :as cf] [app.db :as db] [app.rpc.mutations.files :as m.files] [app.rpc.queries.profile :as profile] [app.util.blob :as blob] [app.util.template :as tmpl] [app.util.time :as dt] [clojure.java.io :as io] [clojure.pprint :as ppr] [cuerdas.core :as str] [datoteka.core :as fs] [integrant.core :as ig])) ;; (selmer.parser/cache-off!) (defn authorized? [pool {:keys [profile-id]}] (or (= "devenv" (cf/get :host)) (let [profile (ex/ignoring (profile/retrieve-profile-data pool profile-id)) admins (or (cf/get :admins) #{})] (contains? admins (:email profile))))) (defn index [{:keys [pool]} request] (when-not (authorized? pool request) (ex/raise :type :authentication :code :only-admins-allowed)) {:status 200 :headers {"content-type" "text/html"} :body (-> (io/resource "templates/debug.tmpl") (tmpl/render {}))}) (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 prepare-response [{:keys [params] :as request} body] (when-not body (ex/raise :type :not-found :code :enpty-data :hint "empty response")) (cond-> {:status 200 :headers {"content-type" "application/transit+json"} :body body} (contains? params :download) (update :headers assoc "content-disposition" "attachment"))) (defn retrieve-file-data [{:keys [pool]} {:keys [params] :as request}] (when-not (authorized? pool request) (ex/raise :type :authentication :code :only-admins-allowed)) (let [file-id (some-> (get-in request [:params :file-id]) uuid/uuid) revn (some-> (get-in request [:params :revn]) d/parse-integer)] (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))] (if (contains? params :download) (-> (prepare-response request data) (update :headers assoc "content-type" "application/octet-stream")) (prepare-response request (some-> data blob/decode)))))) (defn upload-file-data [{:keys [pool]} {:keys [profile-id params] :as request}] (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id) data (some-> params :file :tempfile fs/slurp-bytes blob/decode)] (if (and data project-id) (let [fname (str "imported-file-" (dt/now))] (m.files/create-file pool {:id (uuid/next) :name fname :project-id project-id :profile-id profile-id :data data}) {:status 200 :body "OK"}) {:status 500 :body "error"}))) (defn retrieve-file-changes [{:keys [pool]} request] (when-not (authorized? pool request) (ex/raise :type :authentication :code :only-admins-allowed)) (let [file-id (some-> (get-in request [:params :id]) uuid/uuid) revn (or (get-in request [:params :revn]) "latest")] (when (or (not file-id) (not revn)) (ex/raise :type :validation :code :invalid-arguments :hint "missing arguments")) (cond (d/num-string? revn) (let [item (db/exec-one! pool [sql:retrieve-single-change file-id (d/parse-integer revn)])] (prepare-response request (some-> item :changes blob/decode vec))) (str/includes? revn ":") (let [[start end] (->> (str/split revn #":") (map str/trim) (map d/parse-integer)) items (db/exec! pool [sql:retrieve-range-of-changes file-id start end])] (prepare-response request (some->> items (map :changes) (map blob/decode) (mapcat identity) (vec)))) :else (ex/raise :type :validation :code :invalid-arguments)))) (defn retrieve-error [{:keys [pool]} request] (letfn [(parse-id [request] (let [id (get-in request [:path-params :id]) id (us/uuid-conformer id)] (when (uuid? id) id))) (retrieve-report [id] (ex/ignoring (some-> (db/get-by-id pool :server-error-report id) :content db/decode-transit-pgobject))) (render-template [report] (binding [ppr/*print-right-margin* 300] (let [context (dissoc report :trace :cause :params :data :spec-problems :spec-value :error :explain :hint) params {:context (with-out-str (ppr/pprint context)) :hint (:hint report) :spec-problems (:spec-problems report) :spec-value (:spec-value report) :data (:data report) :trace (or (:cause report) (:trace report) (some-> report :error :trace)) :params (:params report)}] (-> (io/resource "templates/error-report.tmpl") (tmpl/render params))))) ] (when-not (authorized? pool request) (ex/raise :type :authentication :code :only-admins-allowed)) (let [result (some-> (parse-id request) (retrieve-report) (render-template))] (if result {:status 200 :headers {"content-type" "text/html; charset=utf-8" "x-robots-tag" "noindex"} :body result} {:status 404 :body "not found"})))) (def sql:error-reports "select id, created_at from server_error_report order by created_at desc limit 100") (defn retrieve-error-list [{:keys [pool]} request] (when-not (authorized? pool request) (ex/raise :type :authentication :code :only-admins-allowed)) (let [items (db/exec! pool [sql:error-reports]) items (map #(update % :created-at dt/format-instant :rfc1123) items)] {:status 200 :headers {"content-type" "text/html; charset=utf-8" "x-robots-tag" "noindex"} :body (-> (io/resource "templates/error-list.tmpl") (tmpl/render {:items items}))})) (defmethod ig/init-key ::handlers [_ cfg] {:index (partial index cfg) :retrieve-file-data (partial retrieve-file-data cfg) :retrieve-file-changes (partial retrieve-file-changes cfg) :retrieve-error (partial retrieve-error cfg) :retrieve-error-list (partial retrieve-error-list cfg) :upload-file-data (partial upload-file-data cfg)})