;; 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.transit :as t] [app.common.uuid :as uuid] [clojure.pprint :as ppr] [app.config :as cf] [app.db :as db] [app.util.template :as tmpl] [clojure.java.io :as io] [app.rpc.queries.profile :as profile] [app.util.blob :as blob] [app.util.json :as json] [clojure.spec.alpha :as s] [cuerdas.core :as str] [integrant.core :as ig])) (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 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 prepare-response [body] (when-not body (ex/raise :type :not-found :code :enpty-data :hint "empty response")) {:status 200 :headers {"content-type" "application/transit+json"} :body body}) (defn retrieve-file-data [{:keys [pool]} request] (when-not (authorized? pool request) (ex/raise :type :authentication :code :only-admins-allowed)) (let [id (some-> (get-in request [:path-params :id]) uuid/uuid) revn (some-> (get-in request [:params :revn]) d/parse-integer)] (when-not id (ex/raise :type :validation :code :missing-arguments)) (if (integer? revn) (let [fchange (db/exec-one! pool [sql:retrieve-single-change id revn])] (prepare-response (some-> fchange :data blob/decode))) (let [file (db/get-by-id pool :file id)] (prepare-response (some-> file :data blob/decode)))))) (defn retrieve-file-changes [{:keys [pool]} {:keys [params path-params profile-id] :as request}] (when-not (authorized? pool request) (ex/raise :type :authentication :code :only-admins-allowed)) (let [id (some-> (get-in request [:path-params :id]) uuid/uuid) revn (get-in request [:params :revn] "latest")] (when (or (not 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 id (d/parse-integer revn)])] (prepare-response (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 id start end])] (prepare-response (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-prob :spec-problems) params {:context (with-out-str (ppr/pprint context)) :data (:data report) :trace (or (:cause report) (:trace report) (some-> report :error :trace)) :params (:params report)}] (-> (io/resource "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"})))) ;; TODO: error list table (defmethod ig/init-key ::handlers [_ {:keys [pool] :as cfg}] {:retrieve-file-data (partial retrieve-file-data cfg) :retrieve-file-changes (partial retrieve-file-changes cfg) :retrieve-error (partial retrieve-error cfg)})