Encrypt profiles and don't store passwords

alexander-yakushev · alexander-yakushev · commit 6b30f6623ab4 · 2024-11-11T19:22:30.000+02:00
diff --git a/res/migrations/20241111-03-dontstorereadpassword.up.sql b/res/migrations/20241111-03-dontstorereadpassword.up.sql
@@ -0,0 +1,12 @@
+ALTER TABLE profile
+DROP COLUMN read_password;
+
+--;;
+
+ALTER TABLE profile
+ADD COLUMN edit_token TEXT;
+
+--;;
+
+ALTER TABLE profile
+ADD COLUMN is_public INTEGER;
diff --git a/src/flamebin/config.clj b/src/flamebin/config.clj
@@ -84,6 +84,8 @@
 (mount/defstate config
   :start (do (init-config) (fn config-getter [& path] (apply cfg/get path))))
 
+#_(mount/start #'config)
+
 ;;;; Misc initialization
 
 (malli.registry/set-default-registry!
diff --git a/src/flamebin/core.clj b/src/flamebin/core.clj
@@ -13,33 +13,36 @@
                  (@rl/global-saved-kbytes-limiter length-kb))
     (raise 429 "Upload saved bytes limit reached.")))
 
-(defn save-profile [stream ip {:keys [profile-format type private?]
+(defn save-profile [stream ip {:keys [profile-format type public?]
                                :as _upload-request}]
   (let [profile (case profile-format
                   :collapsed (proc/collapsed-stacks-stream->dense-profile stream)
                   :dense-edn (proc/dense-edn-stream->dense-profile stream))
-        dpf-array (proc/freeze profile)
+        edit-token (secret-token)
+        read-token (when-not public? (secret-token))
+        dpf-array (proc/freeze profile read-token)
         dpf-kb (quot (alength ^bytes dpf-array) 1024)
         id (db/new-unused-id)
         filename (format "%s.dpf" id)]
     (ensure-saved-limits ip dpf-kb)
     (storage/save-file dpf-array filename)
-    (db/insert-profile
-     ;; TODO: replace IP with proper owner at some point
-     (dto/->Profile id filename type (:total-samples profile) ip
-                    (when private? (secret-token)) (Instant/now)))))
+    ;; TODO: replace IP with proper owner at some point
+    (-> (dto/->Profile id filename type (:total-samples profile) ip
+                       edit-token public? (Instant/now))
+        db/insert-profile
+        ;; Attach read-token to the response here — it's not in the scheme
+        ;; because we don't store it in the DB.
+        (assoc :read-token read-token))))
 
-(defn render-profile [profile-id provided-read-password]
-  (let [{:keys [read_password file_path] :as profile} (db/get-profile profile-id)]
+(defn render-profile [profile-id read-token]
+  (let [{:keys [is_public file_path] :as profile} (db/get-profile profile-id)]
     ;; Authorization
-    (when read_password
-      (when (nil? provided-read-password)
-        (raise 403 "Required read-password to access this resource."))
-      (when (not= read_password provided-read-password)
-        (raise 403 "Incorrect read-password.")))
+    (when-not is_public
+      (when (nil? read-token)
+        (raise 403 "Required read-token to access this resource.")))
 
     (-> (storage/get-file file_path)
-        proc/read-compressed-profile
+        (proc/read-compressed-profile read-token)
         (render/render-html-flamegraph {}))))
 
 (defn list-public-profiles []
@@ -48,4 +51,4 @@
 (comment
   (save-profile
    (clojure.java.io/input-stream (clojure.java.io/file "test/res/normal.txt"))
-   "me" (dto/->UploadProfileRequest :collapsed :flamegraph "alloc" true)))
+   "me" (dto/->UploadProfileRequest :collapsed :flamegraph "alloc" false)))
diff --git a/src/flamebin/db.clj b/src/flamebin/db.clj
@@ -53,7 +53,7 @@
 (defn insert-profile [profile]
   (m/assert Profile profile)
   (let [{:keys [id file_path profile_type sample_count owner upload_ts
-                read_password]} profile]
+                edit_token is_public]} profile]
     (log/infof "Inserting profile %s from %s" id owner)
     (with-locking db-lock
       (sql-helpers/insert! (db-options) :profile
@@ -62,29 +62,34 @@
                             :profile_type  (name profile_type)
                             :upload_ts     (str upload_ts)
                             :sample_count  sample_count
-                            :read_password read_password
+                            :is_public     is_public
+                            :edit_token    edit_token
                             :owner         owner}))
     profile))
 
+#_(jdbc/execute! (db-options) ["SELECT * FROM profile"])
+
+(defn- unqualify-keys [m] (update-keys m (comp keyword name)))
+
 (defn list-profiles []
   (with-locking db-lock
-    (->> (jdbc/execute! (db-options) ["SELECT id, file_path, profile_type, sample_count, owner, upload_ts FROM profile"])
-         (mapv #(-> (update-keys % (comp keyword name))
-                    (assoc :read_password nil)
+    (->> (jdbc/execute! (db-options) ["SELECT id, file_path, profile_type, sample_count, owner, upload_ts, is_public FROM profile"])
+         (mapv #(-> (unqualify-keys %)
+                    (assoc :edit_token nil)
                     (coerce Profile))))))
 
 (defn list-public-profiles [n]
   (with-locking db-lock
-    (->> (jdbc/execute! (db-options) ["SELECT id, file_path, profile_type, sample_count, owner, upload_ts, read_password FROM profile
-WHERE read_password IS NULL ORDER BY upload_ts DESC LIMIT ?" n])
-         (mapv #(-> (update-keys % (comp keyword name))
+    (->> (jdbc/execute! (db-options) ["SELECT id, file_path, profile_type, sample_count, owner, upload_ts, is_public, edit_token FROM profile
+WHERE is_public = 1 ORDER BY upload_ts DESC LIMIT ?" n])
+         (mapv #(-> (unqualify-keys %)
                     (coerce Profile))))))
 
 (defn get-profile [profile-id]
   (with-locking db-lock
-    (let [q ["SELECT id, file_path, profile_type, sample_count, owner, upload_ts, read_password FROM profile WHERE id = ?" profile-id]
+    (let [q ["SELECT id, file_path, profile_type, sample_count, owner, upload_ts, edit_token, is_public FROM profile WHERE id = ?" profile-id]
           row (some-> (jdbc/execute-one! (db-options) q)
-                      (update-keys (comp keyword name))
+                      unqualify-keys
                       (coerce Profile))]
       (or row
           (let [msg (format "Profile with ID '%s' not found." profile-id)]
@@ -98,7 +103,9 @@ WHERE read_password IS NULL ORDER BY upload_ts DESC LIMIT ?" n])
 
 (comment
   (clear-db)
-  (insert-profile {:id (new-id) :file_path "no.txt" :profile_type :alloc :sample_count 100 :owner "me"}  )
+  (insert-profile {:id (new-id) :file_path "no.txt" :profile_type :alloc
+                   :sample_count 100 :owner "me" :upload_ts (java.time.Instant/now)
+                   :is_public true, :edit_token "sadhjflkaj"})
   (insert-profile {:id (new-id) :file_path "nilsamples" :profile_type "noexist" :sample_count nil :owner "me"})
   (find-ppf-file "xDRA4dpWFM")
   (let [p (malli.generator/generate Profile)]
diff --git a/src/flamebin/dto.clj b/src/flamebin/dto.clj
@@ -4,61 +4,70 @@
             [malli.core :as m]
             [malli.experimental.lite :as mlite]
             [malli.experimental.time.transform]
-            [malli.transform :as mt])
+            [malli.transform :as mt]
+            [malli.util :as mu])
   (:import java.time.Instant))
 
 config ;; Don't remove.
 
+(def ^:private int-to-boolean
+  {:decoders
+   {:boolean #(cond (= % 1) true
+                    (= % 0) false
+                    :else %)}})
+
 (def global-transformer
   (mt/transformer
    mt/string-transformer
+   int-to-boolean
    malli.experimental.time.transform/time-transformer))
 
 (defn coerce [value schema]
   (m/coerce schema value global-transformer))
 
+(defmacro ^:private defschema-and-constructor [schema-name schema-val]
+  (assert (= (first schema-val) '->))
+  (assert (map? (second schema-val)))
+  (let [ks (keys (second schema-val))]
+    `(let [sch# ~schema-val]
+       (def ~schema-name ~schema-val)
+       (defn ~(symbol (str "->" schema-name)) ~(mapv symbol ks)
+         (coerce ~(into {} (map #(vector % (symbol %)) ks)) ~schema-name)))))
+
 ;;;; Profile
 
-(def Profile
-  (mlite/schema
-   {:id :nano-id
-    :file_path [:and {:gen/fmap #(str % ".dpf")} :string]
-    :profile_type :keyword
-    :sample_count [:maybe nat-int?]
-    :owner [:maybe :string]
-    :read_password [:maybe :string]
-    :upload_ts [:and {:gen/gen (gen/fmap Instant/ofEpochSecond
-                                         (gen/choose 1500000000 1700000000))}
-                :time/instant]}))
+(defschema-and-constructor Profile
+  (-> {:id :nano-id
+       :file_path [:and {:gen/fmap #(str % ".dpf")} :string]
+       :profile_type :keyword
+       :sample_count [:maybe nat-int?]
+       :owner [:maybe :string]
+       :edit_token [:maybe :string]
+       :is_public :boolean
+       :upload_ts [:and {:gen/gen (gen/fmap Instant/ofEpochSecond
+                                            (gen/choose 1500000000 1700000000))}
+                   :time/instant]}
+      mlite/schema))
 
-(defn ->Profile
-  [id file_path profile_type sample_count owner read_password upload_ts]
-  (-> {:id id, :file_path file_path, :profile_type profile_type,
-       :upload_ts upload_ts, :sample_count sample_count, :owner owner
-       :read_password read_password}
-      (coerce Profile)))
+#_((requiring-resolve 'malli.generator/sample) Profile)
 
 ;;;; DenseProfile
 
-(def DenseProfile
-  (m/schema [:map {:closed true}
-             [:stacks [:vector [:tuple [:vector pos-int?] pos-int?]]]
-             [:id->frame [:vector string?]]
-             [:total-samples {:optional true} pos-int?]]))
-
-#_((requiring-resolve 'malli.generator/sample) Profile)
+(defschema-and-constructor DenseProfile
+  (-> {:stacks [:vector [:tuple [:vector pos-int?] pos-int?]]
+       :id->frame [:vector string?]
+       :total-samples pos-int?}
+      mlite/schema
+      (mu/optional-keys [:total-samples])
+      mu/closed-schema))
 
 ;;;; UploadProfileRequest
 
-(def UploadProfileRequest
-  (mlite/schema
-   {:profile-format [:enum :collapsed :dense-edn]
-    :kind [:enum :flamegraph :diffgraph]
-    :type [:re #"[\w\.]+"]
-    :private? :boolean}))
-
-(defn ->UploadProfileRequest [profile-format kind type private?]
-  (-> {:profile-format profile-format, :kind kind, :type type, :private? private?}
-      (coerce UploadProfileRequest)))
+(defschema-and-constructor UploadProfileRequest
+  (-> {:profile-format [:enum :collapsed :dense-edn]
+       :kind [:enum :flamegraph :diffgraph]
+       :type [:re #"[\w\.]+"]
+       :public? :boolean}
+      mlite/schema))
 
 #_(->UploadProfileRequest "collapsed" "diffgraph" "cpu" true)
diff --git a/src/flamebin/processing.clj b/src/flamebin/processing.clj
@@ -1,19 +1,14 @@
 (ns flamebin.processing
-  (:require [clj-async-profiler.post-processing :as pp]
+  (:require [clojure.edn :as edn]
             [clojure.java.io :as io]
             [clojure.string :as str]
-            [taoensso.nippy :as nippy]
             [flamebin.dto :refer [DenseProfile]]
             [flamebin.util :refer [raise]]
             [malli.core :as m]
-            [jsonista.core :as json]
-            [flamebin.util :refer [raise]]
-            [clojure.edn :as edn])
+            [taoensso.nippy :as nippy])
   (:import clj_async_profiler.Helpers
-           (java.io BufferedReader InputStream)
-           (java.util HashMap HashMap$Node Map$Entry)
-           (java.util.function Consumer Function)
-           java.io.PushbackReader))
+           (java.io BufferedReader InputStream PushbackReader)
+           (java.util HashMap Map$Entry)))
 
 ;; Collapsed stacks:
 ;;    a;b;c 10
@@ -88,16 +83,15 @@
               .stream
               (.sorted (Map$Entry/comparingByKey))
               (.forEach
-               (reify Consumer
-                 (accept [_ entry]
-                   (let [stack (split-by-semicolon-and-transform-to-indices
-                                (.getKey ^Map$Entry entry) frame->id-map)
-                         value (.getValue ^Map$Entry entry)
-                         same (count-same stack (aget last-stack 0))
-                         dense-stack (into [same] (drop same stack))]
-                     (.add acc [dense-stack value])
-                     (aset last-stack 0 stack)
-                     (aset total-samples 0 (+ (aget total-samples 0) ^long value)))))))
+               (fn [^Map$Entry entry]
+                 (let [stack (split-by-semicolon-and-transform-to-indices
+                              (.getKey entry) frame->id-map)
+                       value (.getValue entry)
+                       same (count-same stack (aget last-stack 0))
+                       dense-stack (into [same] (drop same stack))]
+                   (.add acc [dense-stack value])
+                   (aset last-stack 0 stack)
+                   (aset total-samples 0 (+ (aget total-samples 0) ^long value))))))
         id->frame-arr (object-array (.size frame->id-map))]
     (run! (fn [[k v]] (aset id->frame-arr v k)) frame->id-map)
     {:stacks (vec acc)
@@ -106,8 +100,9 @@
 
 (def ^:private nippy-compressor nippy/zstd-compressor)
 
-(defn freeze [object]
-  (nippy/freeze object {:compressor nippy-compressor}))
+(defn freeze [object read-token]
+  (nippy/freeze object {:compressor nippy-compressor
+                        :password (when read-token [:salted read-token])}))
 
 (defn collapsed-stacks-stream->dense-profile [input-stream]
   (-> input-stream
@@ -122,8 +117,13 @@
       (update profile :total-samples
               #(or % (transduce (map second) + 0 (:stacks profile)))))))
 
-(defn read-compressed-profile [source-file]
-  (nippy/thaw-from-file source-file))
+(defn read-compressed-profile [source-file read-token]
+  (try (nippy/thaw-from-file source-file {:password (when read-token
+                                                      [:salted read-token])})
+       (catch clojure.lang.ExceptionInfo ex
+         (if (str/includes? (ex-message ex) "decryption")
+           (raise 403 "Failed to decrypt flamegraph, incorrect read-token.")
+           (throw ex)))))
 
 (comment
   (defn file-as-gzip-input-stream [file]
@@ -134,10 +134,13 @@
           (io/copy (io/file file) s))
         (.toByteArray baos)))))
 
-  (freeze
-   (intermediate-profile->dense-profile
-    (collapsed-stacks-stream->intermediate-profile
-     (file-as-gzip-input-stream "test/res/huge.txt"))))
+  (nippy/thaw
+   (freeze
+    (intermediate-profile->dense-profile
+     (collapsed-stacks-stream->intermediate-profile
+      (file-as-gzip-input-stream "test/res/normal.txt")))
+    "key1")
+   {:password  [:salted "key2"]})
 
   (with-open [w (io/writer (io/file "test/res/huge.edn"))]
     (binding [*out* w]
diff --git a/src/flamebin/web.clj b/src/flamebin/web.clj
@@ -106,29 +106,29 @@
                  (@rl/global-processed-kbytes-limiter length-kb))
     (raise 429 "Upload processed bytes limit reached.")))
 
-(defn- profile-url [router profile-id read-password]
+(defn- profile-url [router profile-id read-token]
   (format "https://%s%s%s"
           (@config :server :host)
           (-> (r/match-by-name router ::profile-page {:profile-id profile-id})
               r/match->path)
-          (if read-password
-            (str "?read_password=" read-password)
+          (if read-token
+            (str "?read-token=" read-token)
             "")))
 
 (defn $upload-profile [{:keys [remote-addr body query-params], router ::r/router
                         :as req}]
   (let [length-kb (quot (ensure-content-length req) 1024)]
     (ensure-processed-limits remote-addr length-kb)
     ;; TODO: probably better validate in routes coercion.
-    (let [{:strs [kind type private], pformat "format"} query-params
+    (let [{:strs [kind type public], pformat "format"} query-params
           req' (->UploadProfileRequest pformat (or kind :flamegraph) type
-                                       (= private "true"))
+                                       (= public "true"))
 
-          {:keys [id read_password] :as profile} (core/save-profile body remote-addr req')]
+          {:keys [id read-token] :as profile} (core/save-profile body remote-addr req')]
       {:status 201
-       :headers (cond-> {"Location" (profile-url router id read_password)
+       :headers (cond-> {"Location" (profile-url router id read-token)
                          "X-Created-ID" (str id)}
-                    read_password (assoc "X-Read-Password" read_password))
+                    read-token (assoc "X-Read-Token" read-token))
        :body profile})))
 
 ;; Endpoints: web pages
@@ -140,13 +140,13 @@
   (resp (pages/index-page)))
 
 (defn $render-profile [{:keys [path-params query-params] :as req}]
-  ;; TODO: define read_password in routes.
+  ;; TODO: define read_token in routes.
   (let [{:keys [profile-id]} path-params]
     (when-not (valid-id? profile-id)
       (raise 404 (str "Invalid profile ID: " profile-id)))
     {:status 200
      :headers {"content-type" "text/html"}
-     :body (core/render-profile profile-id (query-params "read_password"))}))
+     :body (core/render-profile profile-id (query-params "read-token"))}))
 
 (defn $public-resource [req]
   (ring.middleware.resource/resource-request req ""))
diff --git a/test/flamebin/db_test.clj b/test/flamebin/db_test.clj
