Merge pull request #7747 from penpot/niwinz-develop-storage-changes

✨ Make the binfile exportation process more reliable

CHANGES.md

@@ -60,8 +60,10 @@ penpot on-premise you will need to apply the same changes on your own
 
 ### :sparkles: New features & Enhancements
 
-- Select boards to export as PDF [Taiga #12320](https://tree.taiga.io/project/penpot/issue/12320)
+- Add the ability to select boards to export as PDF [Taiga #12320](https://tree.taiga.io/project/penpot/issue/12320)
-- Toggle for switching boolean property values [Taiga #12341](https://tree.taiga.io/project/penpot/us/12341)
+- Add toggle for switching boolean property values [Taiga #12341](https://tree.taiga.io/project/penpot/us/12341)
+- Make the file export process more reliable [Taiga #12555](https://tree.taiga.io/project/penpot/us/12555)
+- Add auth flow changes [Taiga #12333](https://tree.taiga.io/project/penpot/us/12333)
 
 ### :bug: Bugs fixed
 

backend/src/app/binfile/v3.clj

@@ -255,6 +255,8 @@
 
         (write-entry! output path params)
 
+        (events/tap :progress {:section :storage-object :id id})
+
         (with-open [input (sto/get-object-data storage sobject)]
           (.putNextEntry ^ZipOutputStream output (ZipEntry. (str "objects/" id ext)))
           (io/copy input output :size (:size sobject))
@@ -279,6 +281,8 @@
 
         thumbnails   (bfc/get-file-object-thumbnails cfg file-id)]
 
+    (events/tap :progress {:section :file :id file-id})
+
     (vswap! bfc/*state* update :files assoc file-id
             {:id file-id
              :name (:name file)

backend/src/app/rpc/commands/binfile.clj

@@ -11,9 +11,9 @@
    [app.binfile.v1 :as bf.v1]
    [app.binfile.v3 :as bf.v3]
    [app.common.features :as cfeat]
-   [app.common.logging :as l]
    [app.common.schema :as sm]
    [app.common.time :as ct]
+   [app.common.uri :as u]
    [app.config :as cf]
    [app.db :as db]
    [app.http.sse :as sse]
@@ -25,10 +25,12 @@
    [app.rpc.commands.projects :as projects]
    [app.rpc.commands.teams :as teams]
    [app.rpc.doc :as-alias doc]
-   [app.rpc.helpers :as rph]
+   [app.storage :as sto]
+   [app.storage.tmp :as tmp]
    [app.tasks.file-gc]
    [app.util.services :as sv]
-   [app.worker :as-alias wrk]))
+   [app.worker :as-alias wrk]
+   [datoteka.fs :as fs]))
 
 (set! *warn-on-reflection* true)
 
@@ -38,52 +40,42 @@
   schema:export-binfile
   [:map {:title "export-binfile"}
    [:file-id ::sm/uuid]
-   [:version {:optional true} ::sm/int]
    [:include-libraries ::sm/boolean]
    [:embed-assets ::sm/boolean]])
 
-(defn stream-export-v1
+(defn- export-binfile
-  [cfg {:keys [file-id include-libraries embed-assets] :as params}]
+  [{:keys [::sto/storage] :as cfg} {:keys [file-id include-libraries embed-assets]}]
-  (rph/stream
+  (let [output  (tmp/tempfile*)]
-   (fn [_ output-stream]
+    (try
-     (try
+      (-> cfg
-       (-> cfg
+          (assoc ::bfc/ids #{file-id})
-           (assoc ::bfc/ids #{file-id})
+          (assoc ::bfc/embed-assets embed-assets)
-           (assoc ::bfc/embed-assets embed-assets)
+          (assoc ::bfc/include-libraries include-libraries)
-           (assoc ::bfc/include-libraries include-libraries)
+          (bf.v3/export-files! output))
-           (bf.v1/export-files! output-stream))
-       (catch Throwable cause
-         (l/err :hint "exception on exporting file"
-                :file-id (str file-id)
-                :cause cause))))))
 
-(defn stream-export-v3
+      (let [data   (sto/content output)
-  [cfg {:keys [file-id include-libraries embed-assets] :as params}]
+            object (sto/put-object! storage
-  (rph/stream
+                                    {::sto/content data
-   (fn [_ output-stream]
+                                     ::sto/touched-at (ct/in-future {:minutes 60})
-     (try
+                                     :content-type "application/zip"
-       (-> cfg
+                                     :bucket "tempfile"})]
-           (assoc ::bfc/ids #{file-id})
+
-           (assoc ::bfc/embed-assets embed-assets)
+        (-> (cf/get :public-uri)
-           (assoc ::bfc/include-libraries include-libraries)
+            (u/join "/assets/by-id/")
-           (bf.v3/export-files! output-stream))
+            (u/join (str (:id object)))))
-       (catch Throwable cause
+
-         (l/err :hint "exception on exporting file"
+      (finally
-                :file-id (str file-id)
+        (fs/delete output)))))
-                :cause cause))))))
 
 (sv/defmethod ::export-binfile
   "Export a penpot file in a binary format."
   {::doc/added "1.15"
+   ::doc/changes [["2.12" "Remove version parameter, only one version is supported"]]
    ::webhooks/event? true
    ::sm/params schema:export-binfile}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id version file-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (files/check-read-permissions! pool profile-id file-id)
-  (let [version (or version 1)]
+  (sse/response (partial export-binfile cfg params)))
-    (case (int version)
-      1 (stream-export-v1 cfg params)
-      2 (throw (ex-info "not-implemented" {}))
-      3 (stream-export-v3 cfg params))))
 
 ;; --- Command: import-binfile
 

backend/src/app/storage.clj

@@ -41,6 +41,7 @@
     "file-object-thumbnail"
     "file-thumbnail"
     "profile"
+    "tempfile"
     "file-data"
     "file-data-fragment"
     "file-change"})
@@ -163,9 +164,6 @@
      backend
      (:metadata result))))
 
-(def ^:private sql:retrieve-storage-object
-  "select * from storage_object where id = ? and (deleted_at is null or deleted_at > now())")
-
 (defn row->storage-object [res]
   (let [mdata (or (some-> (:metadata res) (db/decode-transit-pgobject)) {})]
     (impl/storage-object
@@ -177,9 +175,15 @@
      (keyword (:backend res))
      mdata)))
 
-(defn- retrieve-database-object
+(def ^:private sql:get-storage-object
+  "SELECT *
+     FROM storage_object
+    WHERE id = ?
+      AND (deleted_at IS NULL)")
+
+(defn- get-database-object
   [conn id]
-  (some-> (db/exec-one! conn [sql:retrieve-storage-object id])
+  (some-> (db/exec-one! conn [sql:get-storage-object id])
           (row->storage-object)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -202,7 +206,7 @@
 (defn get-object
   [{:keys [::db/connectable] :as storage}  id]
   (assert (valid-storage? storage))
-  (retrieve-database-object connectable id))
+  (get-database-object connectable id))
 
 (defn put-object!
   "Creates a new object with the provided content."

backend/src/app/storage/gc_deleted.clj

@@ -37,7 +37,6 @@
          (into #{} (map :id))
          (not-empty))))
 
-
 (def ^:private sql:delete-sobjects
   "DELETE FROM storage_object
     WHERE id = ANY(?::uuid[])")
@@ -77,47 +76,37 @@
   (d/group-by (comp keyword :backend) :id #{} items))
 
 (def ^:private sql:get-deleted-sobjects
-  "SELECT s.* FROM storage_object AS s
+  "SELECT s.*
+     FROM storage_object AS s
     WHERE s.deleted_at IS NOT NULL
-      AND s.deleted_at < now() - ?::interval
+      AND s.deleted_at <= ?
     ORDER BY s.deleted_at ASC")
 
 (defn- get-buckets
-  [conn min-age]
+  [conn]
-  (let [age (db/interval min-age)]
+  (let [now (ct/now)]
     (sequence
      (comp (partition-all 25)
            (mapcat group-by-backend))
-     (db/cursor conn [sql:get-deleted-sobjects age]))))
+     (db/cursor conn [sql:get-deleted-sobjects now]))))
-
 
 (defn- clean-deleted!
-  [{:keys [::db/conn ::min-age] :as cfg}]
+  [{:keys [::db/conn] :as cfg}]
   (reduce (fn [total [backend-id ids]]
             (let [deleted (delete-in-bulk! cfg backend-id ids)]
               (+ total (or deleted 0))))
           0
-          (get-buckets conn min-age)))
+          (get-buckets conn)))
 
 (defmethod ig/assert-key ::handler
   [_ params]
   (assert (sto/valid-storage? (::sto/storage params)) "expect valid storage")
   (assert (db/pool? (::db/pool params)) "expect valid storage"))
 
-(defmethod ig/expand-key ::handler
-  [k v]
-  {k (assoc v ::min-age (ct/duration {:hours 2}))})
-
 (defmethod ig/init-key ::handler
-  [_ {:keys [::min-age] :as cfg}]
+  [_ cfg]
-  (fn [{:keys [props] :as task}]
+  (fn [_]
-    (let [min-age (ct/duration (or (:min-age props) min-age))]
+    (db/tx-run! cfg (fn [cfg]
-      (db/tx-run! cfg (fn [cfg]
+                      (let [total (clean-deleted! cfg)]
-                        (let [cfg   (assoc cfg ::min-age min-age)
+                        (l/inf :hint "task finished" :total total)
-                              total (clean-deleted! cfg)]
+                        {:deleted total})))))
-
-                          (l/inf :hint "task finished"
-                                 :min-age (ct/format-duration min-age)
-                                 :total total)
-
-                          {:deleted total}))))))

backend/src/app/storage/gc_touched.clj

@@ -22,6 +22,8 @@
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
+   [app.common.time :as ct]
+   [app.config :as cf]
    [app.db :as db]
    [app.storage :as-alias sto]
    [app.storage.impl :as impl]
@@ -101,14 +103,15 @@
 
 (def ^:private sql:mark-delete-in-bulk
   "UPDATE storage_object
-      SET deleted_at = now(),
+      SET deleted_at = ?,
           touched_at = NULL
     WHERE id = ANY(?::uuid[])")
 
 (defn- mark-delete-in-bulk!
-  [conn ids]
+  [conn deletion-delay ids]
-  (let [ids (db/create-array conn "uuid" ids)]
+  (let [ids (db/create-array conn "uuid" ids)
-    (db/exec-one! conn [sql:mark-delete-in-bulk ids])))
+        now (ct/plus (ct/now) deletion-delay)]
+    (db/exec-one! conn [sql:mark-delete-in-bulk now ids])))
 
 ;; NOTE: A getter that retrieves the key which will be used for group
 ;; ids; previously we have no value, then we introduced the
@@ -137,18 +140,20 @@
     (if-let [{:keys [id] :as object} (first objects)]
       (if (has-refs? conn object)
         (do
-          (l/debug :id (str id)
+          (l/dbg :id (str id)
-                   :status "freeze"
+                 :status "freeze"
-                   :bucket bucket)
+                 :bucket bucket)
           (recur (conj to-freeze id) to-delete (rest objects)))
         (do
-          (l/debug :id (str id)
+          (l/dbg :id (str id)
-                   :status "delete"
+                 :status "delete"
-                   :bucket bucket)
+                 :bucket bucket)
           (recur to-freeze (conj to-delete id) (rest objects))))
-      (do
+      (let [deletion-delay (if (= bucket "tempfile")
+                             (ct/duration {:hours 2})
+                             (cf/get-deletion-delay))]
         (some->> (seq to-freeze) (mark-freeze-in-bulk! conn))
-        (some->> (seq to-delete) (mark-delete-in-bulk! conn))
+        (some->> (seq to-delete) (mark-delete-in-bulk! conn deletion-delay))
         [(count to-freeze) (count to-delete)]))))
 
 (defn- process-bucket!
@@ -160,6 +165,7 @@
     "file-thumbnail"        (process-objects! conn has-file-thumbnails-refs? bucket objects)
     "profile"               (process-objects! conn has-profile-refs? bucket objects)
     "file-data"             (process-objects! conn has-file-data-refs? bucket objects)
+    "tempfile"              (process-objects! conn (constantly false) bucket objects)
     (ex/raise :type :internal
               :code :unexpected-unknown-reference
               :hint (dm/fmt "unknown reference '%'" bucket))))
@@ -173,27 +179,27 @@
              [0 0]
              (d/group-by lookup-bucket identity #{} chunk)))
 
-(def ^:private
+(def ^:private sql:get-touched-storage-objects
-  sql:get-touched-storage-objects
   "SELECT so.*
      FROM storage_object AS so
     WHERE so.touched_at IS NOT NULL
+      AND so.touched_at <= ?
     ORDER BY touched_at ASC
       FOR UPDATE
      SKIP LOCKED
     LIMIT 10")
 
 (defn get-chunk
-  [conn]
+  [conn timestamp]
-  (->> (db/exec! conn [sql:get-touched-storage-objects])
+  (->> (db/exec! conn [sql:get-touched-storage-objects timestamp])
        (map impl/decode-row)
        (not-empty)))
 
 (defn- process-touched!
-  [{:keys [::db/pool] :as cfg}]
+  [{:keys [::db/pool ::timestamp] :as cfg}]
   (loop [freezed 0
          deleted 0]
-    (if-let [chunk (get-chunk pool)]
+    (if-let [chunk (get-chunk pool timestamp)]
       (let [[nfo ndo] (db/tx-run! cfg process-chunk! chunk)]
         (recur (long (+ freezed nfo))
                (long (+ deleted ndo))))
@@ -209,5 +215,6 @@
 
 (defmethod ig/init-key ::handler
   [_ cfg]
-  (fn [_] (process-touched! cfg)))
+  (fn [_]
+    (process-touched! (assoc cfg ::timestamp (ct/now)))))
 

backend/src/app/storage/tmp.clj

@@ -79,14 +79,17 @@
 ;; API
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn tempfile
+(defn tempfile*
-  [& {:keys [suffix prefix min-age]
+  [& {:keys [suffix prefix]
       :or {prefix "penpot."
            suffix ".tmp"}}]
   (let [attrs (fs/make-permissions "rw-r--r--")
-        path  (fs/join default-tmp-dir (str prefix (uuid/next) suffix))
+        path  (fs/join default-tmp-dir (str prefix (uuid/next) suffix))]
-        path  (Files/createFile path attrs)]
+    (Files/createFile path attrs)))
-    (fs/delete-on-exit! path)
+
+(defn tempfile
+  [& {:keys [min-age] :as opts}]
+  (let [path (tempfile* opts)]
     (sp/offer! queue [path (some-> min-age ct/duration)])
     path))
 

backend/src/app/tasks/objects_gc.clj

@@ -18,15 +18,15 @@
 (def ^:private sql:get-profiles
   "SELECT id, photo_id FROM profile
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() + ?::interval
+      AND deleted_at <= ?
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-profiles!
-  [{:keys [::db/conn ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
+  [{:keys [::db/conn ::timestamp ::chunk-size ::sto/storage] :as cfg}]
-  (->> (db/plan conn [sql:get-profiles deletion-threshold chunk-size] {:fetch-size 5})
+  (->> (db/plan conn [sql:get-profiles timestamp chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [id photo-id]}]
                  (l/trc :obj "profile" :id (str id))
 
@@ -41,15 +41,15 @@
 (def ^:private sql:get-teams
   "SELECT deleted_at, id, photo_id FROM team
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() + ?::interval
+      AND deleted_at <= ?
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-teams!
-  [{:keys [::db/conn ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
+  [{:keys [::db/conn ::timestamp ::chunk-size ::sto/storage] :as cfg}]
-  (->> (db/plan conn [sql:get-teams deletion-threshold chunk-size] {:fetch-size 5})
+  (->> (db/plan conn [sql:get-teams timestamp chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [id photo-id deleted-at]}]
                  (l/trc :obj "team"
                         :id (str id)
@@ -68,15 +68,15 @@
   "SELECT id, team_id, deleted_at, woff1_file_id, woff2_file_id, otf_file_id, ttf_file_id
      FROM team_font_variant
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() + ?::interval
+      AND deleted_at <= ?
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-fonts!
-  [{:keys [::db/conn ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
+  [{:keys [::db/conn ::timestamp ::chunk-size ::sto/storage] :as cfg}]
-  (->> (db/plan conn [sql:get-fonts deletion-threshold chunk-size] {:fetch-size 5})
+  (->> (db/plan conn [sql:get-fonts timestamp chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [id team-id deleted-at] :as font}]
                  (l/trc :obj "font-variant"
                         :id (str id)
@@ -98,15 +98,15 @@
   "SELECT id, deleted_at, team_id
      FROM project
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() + ?::interval
+      AND deleted_at <= ?
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-projects!
-  [{:keys [::db/conn ::deletion-threshold ::chunk-size] :as cfg}]
+  [{:keys [::db/conn ::timestamp ::chunk-size] :as cfg}]
-  (->> (db/plan conn [sql:get-projects deletion-threshold chunk-size] {:fetch-size 5})
+  (->> (db/plan conn [sql:get-projects timestamp chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [id team-id deleted-at]}]
                  (l/trc :obj "project"
                         :id (str id)
@@ -124,15 +124,15 @@
           f.project_id
      FROM file AS f
     WHERE f.deleted_at IS NOT NULL
-      AND f.deleted_at < now() + ?::interval
+      AND f.deleted_at <= ?
     ORDER BY f.deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-files!
-  [{:keys [::db/conn ::deletion-threshold ::chunk-size] :as cfg}]
+  [{:keys [::db/conn ::timestamp ::chunk-size] :as cfg}]
-  (->> (db/plan conn [sql:get-files deletion-threshold chunk-size] {:fetch-size 5})
+  (->> (db/plan conn [sql:get-files timestamp chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [id deleted-at project-id] :as file}]
                  (l/trc :obj "file"
                         :id (str id)
@@ -148,15 +148,15 @@
   "SELECT file_id, revn, media_id, deleted_at
      FROM file_thumbnail
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() + ?::interval
+      AND deleted_at <= ?
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn delete-file-thumbnails!
-  [{:keys [::db/conn ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
+  [{:keys [::db/conn ::timestamp ::chunk-size ::sto/storage] :as cfg}]
-  (->> (db/plan conn [sql:get-file-thumbnails deletion-threshold chunk-size] {:fetch-size 5})
+  (->> (db/plan conn [sql:get-file-thumbnails timestamp chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [file-id revn media-id deleted-at]}]
                  (l/trc :obj "file-thumbnail"
                         :file-id (str file-id)
@@ -175,15 +175,15 @@
   "SELECT file_id, object_id, media_id, deleted_at
      FROM file_tagged_object_thumbnail
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() + ?::interval
+      AND deleted_at <= ?
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn delete-file-object-thumbnails!
-  [{:keys [::db/conn ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
+  [{:keys [::db/conn ::timestamp ::chunk-size ::sto/storage] :as cfg}]
-  (->> (db/plan conn [sql:get-file-object-thumbnails deletion-threshold chunk-size] {:fetch-size 5})
+  (->> (db/plan conn [sql:get-file-object-thumbnails timestamp chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [file-id object-id media-id deleted-at]}]
                  (l/trc :obj "file-object-thumbnail"
                         :file-id (str file-id)
@@ -203,15 +203,15 @@
   "SELECT id, file_id, media_id, thumbnail_id, deleted_at
      FROM file_media_object
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() + ?::interval
+      AND deleted_at <= ?
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-file-media-objects!
-  [{:keys [::db/conn ::deletion-threshold ::chunk-size ::sto/storage] :as cfg}]
+  [{:keys [::db/conn ::timestamp ::chunk-size ::sto/storage] :as cfg}]
-  (->> (db/plan conn [sql:get-file-media-objects deletion-threshold chunk-size] {:fetch-size 5})
+  (->> (db/plan conn [sql:get-file-media-objects timestamp chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [id file-id deleted-at] :as fmo}]
                  (l/trc :obj "file-media-object"
                         :id (str id)
@@ -231,16 +231,15 @@
   "SELECT file_id, id, type, deleted_at, metadata, backend
      FROM file_data
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() + ?::interval
+      AND deleted_at <= ?
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-file-data!
-  [{:keys [::db/conn ::deletion-threshold ::chunk-size] :as cfg}]
+  [{:keys [::db/conn ::timestamp ::chunk-size] :as cfg}]
-
+  (->> (db/plan conn [sql:get-file-data timestamp chunk-size] {:fetch-size 5})
-  (->> (db/plan conn [sql:get-file-data deletion-threshold chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [file-id id type deleted-at metadata backend]}]
 
                  (some->> metadata
@@ -266,15 +265,15 @@
   "SELECT id, file_id, deleted_at
      FROM file_change
     WHERE deleted_at IS NOT NULL
-      AND deleted_at < now() + ?::interval
+      AND deleted_at <= ?
     ORDER BY deleted_at ASC
     LIMIT ?
       FOR UPDATE
      SKIP LOCKED")
 
 (defn- delete-file-changes!
-  [{:keys [::db/conn ::deletion-threshold ::chunk-size] :as cfg}]
+  [{:keys [::db/conn ::timestamp ::chunk-size] :as cfg}]
-  (->> (db/plan conn [sql:get-file-change deletion-threshold chunk-size] {:fetch-size 5})
+  (->> (db/plan conn [sql:get-file-change timestamp chunk-size] {:fetch-size 5})
        (reduce (fn [total {:keys [id file-id deleted-at] :as xlog}]
                  (l/trc :obj "file-change"
                         :id (str id)
@@ -322,9 +321,8 @@
 
 (defmethod ig/init-key ::handler
   [_ cfg]
-  (fn [{:keys [props] :as task}]
+  (fn [_]
-    (let [threshold (ct/duration (get props :deletion-threshold 0))
+    (let [cfg (assoc cfg ::timestamp (ct/now))]
-          cfg       (assoc cfg ::deletion-threshold (db/interval threshold))]
       (loop [procs (map deref deletion-proc-vars)
              total 0]
         (if-let [proc-fn (first procs)]

backend/src/app/util/services.clj

@@ -27,7 +27,7 @@
       (throw (IllegalArgumentException. "Missing arguments on `defmethod` macro.")))
 
     (let [mdata (assoc mdata
-                       ::docstring (some-> docs str/<<-)
+                       ::docstring (some-> docs str/unindent)
                        ::spec sname
                        ::name (name sname))
 

backend/test/backend_tests/rpc_file_snapshot_test.clj

@@ -9,6 +9,7 @@
    [app.common.features :as cfeat]
    [app.common.pprint :as pp]
    [app.common.thumbnails :as thc]
+   [app.common.time :as ct]
    [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]
    [app.config :as cf]
@@ -16,6 +17,7 @@
    [app.db.sql :as sql]
    [app.http :as http]
    [app.rpc :as-alias rpc]
+   [app.setup.clock :as clock]
    [app.storage :as sto]
    [backend-tests.helpers :as th]
    [clojure.test :as t]
@@ -132,9 +134,10 @@
         ;; this will run pending task triggered by deleting user snapshot
         (th/run-pending-tasks!)
 
-        (let [res (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
+        (binding [ct/*clock* (clock/fixed (ct/in-future {:days 8}))]
-          ;; delete 2 snapshots and 2 file data entries
+          (let [res (th/run-task! :objects-gc {})]
-          (t/is (= 4 (:processed res))))))))
+            ;; delete 2 snapshots and 2 file data entries
+            (t/is (= 4 (:processed res)))))))))
 
 (t/deftest snapshots-locking
   (let [profile-1 (th/create-profile* 1 {:is-active true})

backend/test/backend_tests/rpc_file_test.clj

@@ -313,7 +313,7 @@
       ;; freeze because of the deduplication (we have uploaded 2 times
       ;; the same files).
 
-      (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+      (let [res (th/run-task! :storage-gc-touched {})]
         (t/is (= 2 (:freeze res)))
         (t/is (= 0 (:delete res))))
 
@@ -372,14 +372,14 @@
       (th/db-exec! ["update file_change set deleted_at = now() where file_id = ? and label is not null" (:id file)])
       (th/db-exec! ["update file set has_media_trimmed = false where id = ?" (:id file)])
 
-      (let [res (th/run-task! :objects-gc {:deletion-threshold 0})]
+      (let [res (th/run-task! :objects-gc {})]
         ;; this will remove the file change and file data entries for two snapshots
         (t/is (= 4 (:processed res))))
 
       ;; Rerun the file-gc and objects-gc
       (t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
 
-      (let [res (th/run-task! :objects-gc {:deletion-threshold 0})]
+      (let [res (th/run-task! :objects-gc {})]
         ;; this will remove the file media objects marked as deleted
         ;; on prev file-gc
         (t/is (= 2 (:processed res))))
@@ -387,7 +387,7 @@
       ;; Now that file-gc have deleted the file-media-object usage,
       ;; lets execute the touched-gc task, we should see that two of
       ;; them are marked to be deleted
-      (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+      (let [res (th/run-task! :storage-gc-touched {})]
         (t/is (= 0 (:freeze res)))
         (t/is (= 2 (:delete res))))
 
@@ -572,7 +572,7 @@
       ;; Now that file-gc have deleted the file-media-object usage,
       ;; lets execute the touched-gc task, we should see that two of
       ;; them are marked to be deleted.
-      (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+      (let [res (th/run-task! :storage-gc-touched {})]
         (t/is (= 0 (:freeze res)))
         (t/is (= 2 (:delete res))))
 
@@ -665,7 +665,7 @@
       ;; because of the deduplication (we have uploaded 2 times the
       ;; same files).
 
-      (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+      (let [res (th/run-task! :storage-gc-touched {})]
         (t/is (= 1 (:freeze res)))
         (t/is (= 0 (:delete res))))
 
@@ -715,7 +715,7 @@
 
       ;; Now that objects-gc have deleted the object thumbnail lets
       ;; execute the touched-gc task
-      (let [res (th/run-task! "storage-gc-touched" {:min-age 0})]
+      (let [res (th/run-task! "storage-gc-touched" {})]
         (t/is (= 1 (:freeze res))))
 
       ;; check file media objects
@@ -750,7 +750,7 @@
 
       ;; Now that file-gc have deleted the object thumbnail lets
       ;; execute the touched-gc task
-      (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+      (let [res (th/run-task! :storage-gc-touched {})]
         (t/is (= 1 (:delete res))))
 
       ;; check file media objects
@@ -922,8 +922,9 @@
       (t/is (= 0 (:processed result))))
 
     ;; run permanent deletion
-    (let [result (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
+    (binding [ct/*clock* (clock/fixed (ct/in-future {:days 8}))]
-      (t/is (= 3 (:processed result))))
+      (let [result (th/run-task! :objects-gc {})]
+        (t/is (= 3 (:processed result)))))
 
     ;; query the list of file libraries of a after hard deletion
     (let [data {::th/type :get-file-libraries
@@ -1134,7 +1135,7 @@
       (th/sleep 300)
 
       ;; run the task
-      (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file)})))
+      (t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
 
       ;; check that object thumbnails are still here
       (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
@@ -1163,7 +1164,7 @@
         (t/is (= 2 (count rows))))
 
       ;; run the task again
-      (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file)})))
+      (t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
 
       ;; check that we have all object thumbnails
       (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
@@ -1226,7 +1227,7 @@
         (t/is (= 2 (count rows)))))
 
     (t/testing "gc task"
-      (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file)})))
+      (t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
 
       (let [rows (th/db-query :file-thumbnail {:file-id (:id file)})]
         (t/is (= 2 (count rows)))
@@ -1273,7 +1274,7 @@
     ;; The FileGC task will schedule an inner taskq
     (th/run-pending-tasks!)
 
-    (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+    (let [res (th/run-task! :storage-gc-touched {})]
       (t/is (= 2 (:freeze res)))
       (t/is (= 0 (:delete res))))
 
@@ -1367,7 +1368,7 @@
 
     ;; we ensure that once object-gc is passed and marked two storage
     ;; objects to delete
-    (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+    (let [res (th/run-task! :storage-gc-touched {})]
       (t/is (= 0 (:freeze res)))
       (t/is (= 2 (:delete res))))
 
@@ -1489,7 +1490,7 @@
         (t/is (some? (not-empty (:objects component))))))
 
     ;; Re-run the file-gc task
-    (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file)})))
+    (t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
     (let [row (th/db-get :file {:id (:id file)})]
       (t/is (true? (:has-media-trimmed row))))
 
@@ -1519,7 +1520,7 @@
 
     ;; Now, we have deleted the usage of component if we pass file-gc,
     ;; that component should be deleted
-    (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file)})))
+    (t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
 
     ;; Check that component is properly removed
     (let [data {::th/type :get-file
@@ -1610,8 +1611,8 @@
               :component-id c-id})}])
 
     ;; Run the file-gc on file and library
-    (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file-1)})))
+    (t/is (true? (th/run-task! :file-gc {:file-id (:id file-1)})))
-    (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file-2)})))
+    (t/is (true? (th/run-task! :file-gc {:file-id (:id file-2)})))
 
     ;; Check that component exists
     (let [data {::th/type :get-file
@@ -1684,7 +1685,7 @@
 
     ;; Now, we have deleted the usage of component if we pass file-gc,
     ;; that component should be deleted
-    (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file-1)})))
+    (t/is (true? (th/run-task! :file-gc {:file-id (:id file-1)})))
 
     ;; Check that component is properly removed
     (let [data {::th/type :get-file
@@ -1833,8 +1834,8 @@
         (t/is (not= (:id fill) (:id fmedia)))))
 
     ;; Run the file-gc on file and library
-    (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file-1)})))
+    (t/is (true? (th/run-task! :file-gc {:file-id (:id file-1)})))
-    (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file-2)})))
+    (t/is (true? (th/run-task! :file-gc {:file-id (:id file-2)})))
 
     ;; Now proceed to delete file and absorb it
     (let [data {::th/type :delete-file

backend/test/backend_tests/rpc_file_thumbnails_test.clj

@@ -8,12 +8,14 @@
   (:require
    [app.common.pprint :as pp]
    [app.common.thumbnails :as thc]
+   [app.common.time :as ct]
    [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.auth :as cauth]
+   [app.setup.clock :as clock]
    [app.storage :as sto]
    [app.tokens :as tokens]
    [backend-tests.helpers :as th]
@@ -83,7 +85,8 @@
       (t/is (map? (:result out))))
 
     ;; run the task again
-    (let [res (th/run-task! "storage-gc-touched" {:min-age 0})]
+    (let [res (binding [ct/*clock* (clock/fixed (ct/in-future {:minutes 31}))]
+                (th/run-task! "storage-gc-touched" {}))]
       (t/is (= 2 (:freeze res))))
 
     (let [[row1 row2 :as rows] (th/db-query :file-tagged-object-thumbnail
@@ -114,9 +117,9 @@
 
       ;; Run the File GC task that should remove unused file object
       ;; thumbnails
-      (th/run-task! :file-gc {:min-age 0 :file-id (:id file)})
+      (th/run-task! :file-gc {:file-id (:id file)})
 
-      (let [result (th/run-task! :objects-gc {:min-age 0})]
+      (let [result (th/run-task! :objects-gc {})]
         (t/is (= 3 (:processed result))))
 
       ;; check if row2 related thumbnail row still exists
@@ -133,7 +136,8 @@
       (t/is (some? (sto/get-object storage (:media-id row2))))
 
       ;; run the task again
-      (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+      (let [res (binding [ct/*clock* (clock/fixed (ct/in-future {:minutes 31}))]
+                  (th/run-task! :storage-gc-touched {}))]
         (t/is (= 1 (:delete res)))
         (t/is (= 0 (:freeze res))))
 
@@ -143,8 +147,9 @@
 
       ;; Run the storage gc deleted task, it should permanently delete
       ;; all storage objects related to the deleted thumbnails
-      (let [result (th/run-task! :storage-gc-deleted {:min-age 0})]
+      (binding [ct/*clock* (clock/fixed (ct/in-future {:days 8}))]
-        (t/is (= 1 (:deleted result))))
+        (let [res (th/run-task! :storage-gc-deleted {})]
+          (t/is (= 1 (:deleted res)))))
 
       (t/is (nil? (sto/get-object storage (:media-id row1))))
       (t/is (some? (sto/get-object storage (:media-id row2))))
@@ -216,9 +221,9 @@
 
       ;; Run the File GC task that should remove unused file object
       ;; thumbnails
-      (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file)})))
+      (t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
 
-      (let [result (th/run-task! :objects-gc {:min-age 0})]
+      (let [result (th/run-task! :objects-gc {})]
         (t/is (= 2 (:processed result))))
 
       ;; check if row1 related thumbnail row still exists
@@ -230,7 +235,7 @@
         (t/is (= (:object-id data1) (:object-id row)))
         (t/is (uuid? (:media-id row1))))
 
-      (let [result (th/run-task! :storage-gc-touched {:min-age 0})]
+      (let [result (th/run-task! :storage-gc-touched {})]
         (t/is (= 1 (:delete result))))
 
       ;; Check if storage objects still exists after file-gc
@@ -242,8 +247,9 @@
 
       ;; Run the storage gc deleted task, it should permanently delete
       ;; all storage objects related to the deleted thumbnails
-      (let [result (th/run-task! :storage-gc-deleted {:min-age 0})]
+      (binding [ct/*clock* (clock/fixed (ct/in-future {:days 8}))]
-        (t/is (= 1 (:deleted result))))
+        (let [result (th/run-task! :storage-gc-deleted {})]
+          (t/is (= 1 (:deleted result)))))
 
       (t/is (some? (sto/get-object storage (:media-id row2)))))))
 

backend/test/backend_tests/rpc_font_test.clj

@@ -6,11 +6,13 @@
 
 (ns backend-tests.rpc-font-test
   (:require
+   [app.common.time :as ct]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
    [app.http :as http]
    [app.rpc :as-alias rpc]
+   [app.setup.clock :as clock]
    [app.storage :as sto]
    [backend-tests.helpers :as th]
    [clojure.test :as t]
@@ -129,7 +131,7 @@
       ;; (th/print-result! out)
       (t/is (nil? (:error out))))
 
-    (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+    (let [res (th/run-task! :storage-gc-touched {})]
       (t/is (= 6 (:freeze res))))
 
     (let [params {::th/type :delete-font
@@ -141,16 +143,17 @@
       (t/is (nil? (:error out)))
       (t/is (nil? (:result out))))
 
-    (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+    (let [res (th/run-task! :storage-gc-touched {})]
       (t/is (= 0 (:freeze res)))
       (t/is (= 0 (:delete res))))
 
-    (let [res (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
+    (binding [ct/*clock* (clock/fixed (ct/in-future {:days 8}))]
-      (t/is (= 2 (:processed res))))
+      (let [res (th/run-task! :objects-gc {})]
+        (t/is (= 2 (:processed res))))
 
-    (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+      (let [res (th/run-task! :storage-gc-touched {})]
-      (t/is (= 0 (:freeze res)))
+        (t/is (= 0 (:freeze res)))
-      (t/is (= 6 (:delete res))))))
+        (t/is (= 6 (:delete res)))))))
 
 (t/deftest font-deletion-2
   (let [prof    (th/create-profile* 1 {:is-active true})
@@ -189,7 +192,7 @@
       ;; (th/print-result! out)
       (t/is (nil? (:error out))))
 
-    (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+    (let [res (th/run-task! :storage-gc-touched {})]
       (t/is (= 6 (:freeze res))))
 
     (let [params {::th/type :delete-font
@@ -201,16 +204,17 @@
       (t/is (nil? (:error out)))
       (t/is (nil? (:result out))))
 
-    (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+    (let [res (th/run-task! :storage-gc-touched {})]
       (t/is (= 0 (:freeze res)))
       (t/is (= 0 (:delete res))))
 
-    (let [res (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
+    (binding [ct/*clock* (clock/fixed (ct/in-future {:days 8}))]
-      (t/is (= 1 (:processed res))))
+      (let [res (th/run-task! :objects-gc {})]
+        (t/is (= 1 (:processed res))))
 
-    (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+      (let [res (th/run-task! :storage-gc-touched {})]
-      (t/is (= 0 (:freeze res)))
+        (t/is (= 0 (:freeze res)))
-      (t/is (= 3 (:delete res))))))
+        (t/is (= 3 (:delete res)))))))
 
 (t/deftest font-deletion-3
   (let [prof    (th/create-profile* 1 {:is-active true})
@@ -248,7 +252,7 @@
     (t/is (nil? (:error out1)))
     (t/is (nil? (:error out2)))
 
-    (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+    (let [res (th/run-task! :storage-gc-touched {})]
       (t/is (= 6 (:freeze res))))
 
     (let [params {::th/type :delete-font-variant
@@ -260,13 +264,14 @@
       (t/is (nil? (:error out)))
       (t/is (nil? (:result out))))
 
-    (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+    (let [res (th/run-task! :storage-gc-touched {})]
       (t/is (= 0 (:freeze res)))
       (t/is (= 0 (:delete res))))
 
-    (let [res (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
+    (binding [ct/*clock* (clock/fixed (ct/in-future {:days 8}))]
-      (t/is (= 1 (:processed res))))
+      (let [res (th/run-task! :objects-gc {})]
+        (t/is (= 1 (:processed res))))
 
-    (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
+      (let [res (th/run-task! :storage-gc-touched {})]
-      (t/is (= 0 (:freeze res)))
+        (t/is (= 0 (:freeze res)))
-      (t/is (= 3 (:delete res))))))
+        (t/is (= 3 (:delete res)))))))

backend/test/backend_tests/rpc_project_test.clj

@@ -6,11 +6,13 @@
 
 (ns backend-tests.rpc-project-test
   (:require
+   [app.common.time :as ct]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
    [app.http :as http]
    [app.rpc :as-alias rpc]
+   [app.setup.clock :as clock]
    [backend-tests.helpers :as th]
    [clojure.test :as t]))
 
@@ -226,8 +228,9 @@
         (t/is (= 0 (count result)))))
 
     ;; run permanent deletion
-    (let [result (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
+    (binding [ct/*clock* (clock/fixed (ct/in-future {:days 8}))]
-      (t/is (= 1 (:processed result))))
+      (let [result (th/run-task! :objects-gc {})]
+        (t/is (= 1 (:processed result)))))
 
     ;; query the list of files of a after hard deletion
     (let [data {::th/type :get-project-files

backend/test/backend_tests/rpc_team_test.clj

@@ -13,6 +13,7 @@
    [app.db :as db]
    [app.http :as http]
    [app.rpc :as-alias rpc]
+   [app.setup.clock :as clock]
    [app.storage :as sto]
    [app.tokens :as tokens]
    [backend-tests.helpers :as th]
@@ -525,8 +526,9 @@
         (t/is (= :not-found (:type edata)))))
 
     ;; run permanent deletion
-    (let [result (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
+    (binding [ct/*clock* (clock/fixed (ct/in-future {:days 8}))]
-      (t/is (= 2 (:processed result))))
+      (let [result (th/run-task! :objects-gc {})]
+        (t/is (= 2 (:processed result)))))
 
     ;; query the list of projects of a after hard deletion
     (let [data {::th/type :get-projects
@@ -581,8 +583,9 @@
       (t/is (= 1 (count rows)))
       (t/is (ct/inst? (:deleted-at (first rows)))))
 
-    (let [result (th/run-task! :objects-gc {:deletion-threshold (cf/get-deletion-delay)})]
+    (binding [ct/*clock* (clock/fixed (ct/in-future {:days 8}))]
-      (t/is (= 7 (:processed result))))))
+      (let [result (th/run-task! :objects-gc {})]
+        (t/is (= 7 (:processed result)))))))
 
 (t/deftest create-team-access-request
   (with-mocks [mock {:target 'app.email/send! :return nil}]

backend/test/backend_tests/storage_test.clj

@@ -11,6 +11,7 @@
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.rpc :as-alias rpc]
+   [app.setup.clock :as clock]
    [app.storage :as sto]
    [backend-tests.helpers :as th]
    [clojure.test :as t]
@@ -53,19 +54,13 @@
                     (configure-storage-backend))
         content (sto/content "content")
         object  (sto/put-object! storage {::sto/content content
-                                          ::sto/expired-at (ct/in-future {:seconds 1})
+                                          ::sto/expired-at (ct/in-future {:hours 1})
                                           :content-type "text/plain"})]
 
     (t/is (sto/object? object))
     (t/is (ct/inst? (:expired-at object)))
     (t/is (ct/is-after? (:expired-at object) (ct/now)))
-    (t/is (= object (sto/get-object storage (:id object))))
+    (t/is (nil? (sto/get-object storage (:id object))))))
-
-    (th/sleep 1000)
-    (t/is (nil? (sto/get-object storage (:id object))))
-    (t/is (nil? (sto/get-object-data storage object)))
-    (t/is (nil? (sto/get-object-url storage object)))
-    (t/is (nil? (sto/get-object-path storage object)))))
 
 (t/deftest put-and-delete-object
   (let [storage (-> (:app.storage/storage th/*system*)
@@ -98,20 +93,25 @@
                                            ::sto/expired-at (ct/now)
                                            :content-type "text/plain"})
         object2  (sto/put-object! storage {::sto/content content2
-                                           ::sto/expired-at (ct/in-past {:hours 2})
+                                           ::sto/expired-at (ct/in-future {:hours 2})
                                            :content-type "text/plain"})
         object3  (sto/put-object! storage {::sto/content content3
-                                           ::sto/expired-at (ct/in-past {:hours 1})
+                                           ::sto/expired-at (ct/in-future {:hours 1})
                                            :content-type "text/plain"})]
 
-
+    (binding [ct/*clock* (clock/fixed (ct/in-future {:minutes 0}))]
-    (th/sleep 200)
+      (let [res (th/run-task! :storage-gc-deleted {})]
-
+        (t/is (= 1 (:deleted res)))))
-    (let [res (th/run-task! :storage-gc-deleted {})]
-      (t/is (= 1 (:deleted res))))
 
     (let [res (th/db-exec-one! ["select count(*) from storage_object;"])]
-      (t/is (= 2 (:count res))))))
+      (t/is (= 2 (:count res))))
+
+    (binding [ct/*clock* (clock/fixed (ct/in-future {:minutes 61}))]
+      (let [res (th/run-task! :storage-gc-deleted {})]
+        (t/is (= 1 (:deleted res)))))
+
+    (let [res (th/db-exec-one! ["select count(*) from storage_object;"])]
+      (t/is (= 1 (:count res))))))
 
 (t/deftest touched-gc-task-1
   (let [storage (-> (:app.storage/storage th/*system*)
@@ -158,7 +158,7 @@
                      {:id (:id result-1)})
 
       ;; run the objects gc task for permanent deletion
-      (let [res (th/run-task! :objects-gc {:min-age 0})]
+      (let [res (th/run-task! :objects-gc {})]
         (t/is (= 1 (:processed res))))
 
       ;; check that we still have all the storage objects
@@ -182,7 +182,6 @@
       (let [res (th/db-exec-one! ["select count(*) from storage_object where deleted_at is not null"])]
         (t/is (= 0 (:count res)))))))
 
-
 (t/deftest touched-gc-task-2
   (let [storage (-> (:app.storage/storage th/*system*)
                     (configure-storage-backend))
@@ -243,11 +242,12 @@
                        {:id (:id result-2)})
 
         ;; run the objects gc task for permanent deletion
-        (let [res (th/run-task! :objects-gc {:min-age 0})]
+        (let [res (th/run-task! :objects-gc {})]
           (t/is (= 1 (:processed res))))
 
         ;; revert touched state to all storage objects
-        (th/db-exec-one! ["update storage_object set touched_at=now()"])
+
+        (th/db-exec-one! ["update storage_object set touched_at=?" (ct/now)])
 
         ;; Run the task again
         (let [res (th/run-task! :storage-gc-touched {})]
@@ -293,10 +293,10 @@
           result-2 (:result out2)]
 
       ;; now we proceed to manually mark all storage objects touched
-      (th/db-exec! ["update storage_object set touched_at=now()"])
+      (th/db-exec! ["update storage_object set touched_at=?" (ct/now)])
 
       ;; run the touched gc task
-      (let [res (th/run-task! "storage-gc-touched" {:min-age 0})]
+      (let [res (th/run-task! :storage-gc-touched {})]
         (t/is (= 2 (:freeze res)))
         (t/is (= 0 (:delete res))))
 
@@ -305,13 +305,13 @@
         (t/is (= 2 (count rows)))))
 
     ;; now we proceed to manually delete all file_media_object
-    (th/db-exec! ["update file_media_object set deleted_at = now()"])
+    (th/db-exec! ["update file_media_object set deleted_at = ?" (ct/now)])
 
-    (let [res (th/run-task! "objects-gc" {:min-age 0})]
+    (let [res (th/run-task! :objects-gc {})]
       (t/is (= 2 (:processed res))))
 
     ;; run the touched gc task
-    (let [res (th/run-task! "storage-gc-touched" {:min-age 0})]
+    (let [res (th/run-task! :storage-gc-touched {})]
       (t/is (= 0 (:freeze res)))
       (t/is (= 2 (:delete res))))
 

common/src/app/common/flags.cljc

@@ -132,7 +132,6 @@
     :v2-migration
     :webhooks
     ;; TODO: deprecate this flag and consolidate the code
-    :export-file-v3
     :render-wasm-dpr
     :hide-release-modal
     :subscriptions

common/src/app/common/types/file.cljc

@@ -1082,33 +1082,35 @@
 
         detach-shape
         (fn [objects shape]
-          (l/debug :hint "detach-shape"
+          (let [shape' (cond-> shape
-                   :file-id file-id
+                         (not= file-id (:fill-color-ref-file shape))
-                   :component-ref-file (get-component-ref-file objects shape)
+                         (dissoc :fill-color-ref-id :fill-color-ref-file)
-                   ::l/sync? true)
-          (cond-> shape
-            (not= file-id (:fill-color-ref-file shape))
-            (dissoc :fill-color-ref-id :fill-color-ref-file)
 
-            (not= file-id (:stroke-color-ref-file shape))
+                         (not= file-id (:stroke-color-ref-file shape))
-            (dissoc :stroke-color-ref-id :stroke-color-ref-file)
+                         (dissoc :stroke-color-ref-id :stroke-color-ref-file)
 
-            (not= file-id (get-component-ref-file objects shape))
+                         (not= file-id (get-component-ref-file objects shape))
-            (dissoc :component-id :component-file :shape-ref :component-root)
+                         (dissoc :component-id :component-file :shape-ref :component-root)
 
-            (= :text (:type shape))
+                         (= :text (:type shape))
-            (update :content detach-text)))
+                         (update :content detach-text))]
+
+            (when (not= shape shape')
+              (l/dbg :hint "detach shape"
+                     :file-id (str file-id)
+                     :shape-id (str (:id shape))))
+
+            shape'))
 
         detach-objects
         (fn [objects]
-          (update-vals objects #(detach-shape objects %)))
+          (d/update-vals objects #(detach-shape objects %)))
 
         detach-pages
         (fn [pages-index]
-          (update-vals pages-index #(update % :objects detach-objects)))]
+          (d/update-vals pages-index #(update % :objects detach-objects)))]
 
-    (-> file
+    (update-in file [:data :pages-index] detach-pages)))
-        (update-in [:data :pages-index] detach-pages))))
 
 ;; Base font size
 

frontend/src/app/main/data/exports/files.cljs

@@ -12,6 +12,7 @@
    [app.main.data.event :as ev]
    [app.main.data.modal :as modal]
    [app.main.repo :as rp]
+   [app.util.sse :as sse]
    [beicon.v2.core :as rx]
    [potok.v2.core :as ptk]))
 
@@ -32,25 +33,18 @@
 (def check-export-files
   (sm/check-fn schema:export-files))
 
-(defn export-files
+(defn open-export-dialog
-  [files format]
+  [files]
-  (assert (contains? valid-formats format)
-          "expected valid export format")
-
   (let [files (check-export-files files)]
-
     (ptk/reify ::export-files
       ptk/WatchEvent
       (watch [_ state _]
-        (let [team-id  (get state :current-team-id)
+        (let [team-id (get state :current-team-id)]
-              evname   (if (= format :legacy-zip)
-                         "export-standard-files"
-                         "export-binary-files")]
           (rx/merge
-           (rx/of (ptk/event ::ev/event {::ev/name evname
+           (rx/of (ev/event {::ev/name "export-binary-files"
-                                         ::ev/origin "dashboard"
+                             ::ev/origin "dashboard"
-                                         :format format
+                             :format "binfile-v3"
-                                         :num-files (count files)}))
+                             :num-files (count files)}))
            (->> (rx/from files)
                 (rx/mapcat
                  (fn [file]
@@ -58,11 +52,29 @@
                         (rx/map #(assoc file :has-libraries %)))))
                 (rx/reduce conj [])
                 (rx/map (fn [files]
-                          (modal/show
+                          (modal/show {:type ::export-files
-                           {:type ::export-files
+                                       :team-id team-id
-                            :team-id team-id
+                                       :files files}))))))))))
-                            :files files
+
-                            :format format}))))))))))
+(defn export-files
+  [& {:keys [type files]}]
+  (->> (rx/from files)
+       (rx/mapcat
+        (fn [file]
+          (->> (rp/cmd! ::sse/export-binfile {:file-id (:id file)
+                                              :version 3
+                                              :include-libraries (= type :all)
+                                              :embed-assets (= type :merge)})
+               (rx/filter sse/end-of-stream?)
+               (rx/map sse/get-payload)
+               (rx/map (fn [uri]
+                         {:file-id (:id file)
+                          :uri uri
+                          :filename (:name file)}))
+               (rx/catch (fn [cause]
+                           (let [error (ex-data cause)]
+                             (rx/of {:file-id (:id file)
+                                     :error error})))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;
 ;; Team Request

frontend/src/app/main/repo.cljs

@@ -77,6 +77,9 @@
    {:query-params [:file-id :revn]
     :form-data? true}
 
+   ::sse/export-binfile
+   {:stream? true}
+
    ::sse/clone-template
    {:stream? true}
 

frontend/src/app/main/ui/dashboard/file_menu.cljs

@@ -6,7 +6,6 @@
 
 (ns app.main.ui.dashboard.file-menu
   (:require
-   [app.config :as cf]
    [app.main.data.common :as dcm]
    [app.main.data.dashboard :as dd]
    [app.main.data.event :as-alias ev]
@@ -185,19 +184,10 @@
                       :on-accept del-shared
                       :count-libraries file-count})))
 
-        on-export-files
-        (fn [format]
-          (st/emit! (with-meta (fexp/export-files files format)
-                      {::ev/origin "dashboard"})))
-
         on-export-binary-files
-        (partial on-export-files :binfile-v1)
+        (fn []
-
+          (st/emit! (-> (fexp/open-export-dialog files)
-        on-export-binary-files-v3
+                        (with-meta {::ev/origin "dashboard"}))))]
-        (partial on-export-files :binfile-v3)
-
-        on-export-standard-files
-        (partial on-export-files :legacy-zip)]
 
     (mf/with-effect []
       (->> (rp/cmd! :get-all-projects)
@@ -248,20 +238,9 @@
                 :id      "file-move-multi"
                 :options    sub-options})
 
-             (when-not (contains? cf/flags :export-file-v3)
+             {:name    (tr "dashboard.export-binary-multi" file-count)
-               {:name    (tr "dashboard.export-binary-multi" file-count)
+              :id      "file-binary-export-multi"
-                :id      "file-binary-export-multi"
+              :handler on-export-binary-files}
-                :handler on-export-binary-files})
-
-             (when (contains? cf/flags :export-file-v3)
-               {:name    (tr "dashboard.export-binary-multi" file-count)
-                :id      "file-binary-export-multi"
-                :handler on-export-binary-files-v3})
-
-             (when-not (contains? cf/flags :export-file-v3)
-               {:name    (tr "dashboard.export-standard-multi" file-count)
-                :id      "file-standard-export-multi"
-                :handler on-export-standard-files})
 
              (when (and (:is-shared file) can-edit)
                {:name    (tr "labels.unpublish-multi-files" file-count)
@@ -307,20 +286,9 @@
 
              {:name   :separator}
 
-             (when-not (contains? cf/flags :export-file-v3)
+             {:name    (tr "dashboard.download-binary-file")
-               {:name    (tr "dashboard.download-binary-file")
+              :id      "download-binary-file"
-                :id      "download-binary-file"
+              :handler on-export-binary-files}
-                :handler on-export-binary-files})
-
-             (when (contains? cf/flags :export-file-v3)
-               {:name    (tr "dashboard.download-binary-file")
-                :id      "download-binary-file"
-                :handler on-export-binary-files-v3})
-
-             (when-not (contains? cf/flags :export-file-v3)
-               {:name    (tr "dashboard.download-standard-file")
-                :id      "download-standard-file"
-                :handler on-export-standard-files})
 
              (when (and (not is-lib-page?) (not is-search-page?) can-edit)
                {:name   :separator})

frontend/src/app/main/ui/exports/files.cljs

@@ -10,13 +10,11 @@
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
-   [app.config :as cf]
    [app.main.data.exports.files :as fexp]
    [app.main.data.modal :as modal]
    [app.main.store :as st]
    [app.main.ui.ds.product.loader :refer [loader*]]
    [app.main.ui.icons :as deprecated-icon]
-   [app.main.worker :as mw]
    [app.util.dom :as dom]
    [app.util.i18n :as i18n :refer  [tr]]
    [beicon.v2.core :as rx]
@@ -71,7 +69,7 @@
   {::mf/register modal/components
    ::mf/register-as ::fexp/export-files
    ::mf/props :obj}
-  [{:keys [team-id files format]}]
+  [{:keys [team-id files]}]
   (let [state*       (mf/use-state (partial initialize-state files))
         has-libs?    (some :has-libraries files)
 
@@ -79,40 +77,19 @@
         selected     (:selected state)
         status       (:status state)
 
-        binary?      (not= format :legacy-zip)
-
-        ;; We've deprecated the merge option on non-binary files
-        ;; because it wasn't working and we're planning to remove this
-        ;; export in future releases.
-        export-types (if binary? fexp/valid-types [:all :detach])
-
         start-export
         (mf/use-fn
          (mf/deps team-id selected files)
          (fn []
            (swap! state* assoc :status :exporting)
-           (->> (mw/ask-many!
+           (->> (fexp/export-files :files files :type type)
-                 {:cmd :export-files
-                  :format format
-                  :team-id team-id
-                  :type selected
-                  :files files})
-                (rx/mapcat #(->> (rx/of %)
-                                 (rx/delay 1000)))
                 (rx/subs!
-                 (fn [msg]
+                 (fn [{:keys [file-id error filename uri] :as result}]
-                   (cond
+                   (if error
-                     (= :error (:type msg))
+                     (swap! state* update :files mark-file-error file-id)
-                     (swap! state* update :files mark-file-error (:file-id msg))
+                     (do
-
+                       (swap! state* update :files mark-file-success file-id)
-                     (= :finish (:type msg))
+                       (dom/trigger-download-uri filename "application/penpot" uri))))))))
-                     (let [mtype (if (contains? cf/flags :export-file-v3)
-                                   "application/penpot"
-                                   (:mtype msg))
-                           fname (:filename msg)
-                           uri   (:uri msg)]
-                       (swap! state* update :files mark-file-success (:file-id msg))
-                       (dom/trigger-download-uri fname mtype uri))))))))
 
         on-cancel
         (mf/use-fn
@@ -155,7 +132,7 @@
           [:p {:class (stl/css :modal-msg)} (tr "dashboard.export.explain")]
           [:p {:class (stl/css :modal-scd-msg)} (tr "dashboard.export.detail")]
 
-          (for [type export-types]
+          (for [type fexp/valid-types]
             [:div {:class (stl/css :export-option true)
                    :key (name type)}
              [:label {:for (str "export-" type)

frontend/src/app/main/ui/workspace/main_menu.cljs

@@ -602,12 +602,9 @@
         on-export-file
         (mf/use-fn
          (mf/deps file)
-         (fn [event]
+         (fn [_]
-           (let [target  (dom/get-current-target event)
+           (st/emit! (-> (fexp/open-export-dialog [file])
-                 format  (-> (dom/get-data target "format")
+                         (with-meta {::ev/origin "workspace"})))))
-                             (keyword))]
-             (st/emit! (st/emit! (with-meta (fexp/export-files [file] format)
-                                   {::ev/origin "workspace"}))))))
 
         on-export-file-key-down
         (mf/use-fn
@@ -684,32 +681,13 @@
        (for [sc (scd/split-sc (sc/get-tooltip :export-shapes))]
          [:span {:class (stl/css :shortcut-key) :key sc} sc])]]
 
-     (when-not (contains? cf/flags :export-file-v3)
+     [:> dropdown-menu-item* {:class (stl/css :submenu-item)
-       [:> dropdown-menu-item* {:class (stl/css :submenu-item)
+                              :on-click    on-export-file
-                                :on-click    on-export-file
+                              :on-key-down on-export-file-key-down
-                                :on-key-down on-export-file-key-down
+                              :data-format "binfile-v3"
-                                :data-format "binfile-v1"
+                              :id          "file-menu-binary-file"}
-                                :id          "file-menu-binary-file"}
+      [:span {:class (stl/css :item-name)}
-        [:span {:class (stl/css :item-name)}
+       (tr "dashboard.download-binary-file")]]
-         (tr "dashboard.download-binary-file")]])
-
-     (when (contains? cf/flags :export-file-v3)
-       [:> dropdown-menu-item* {:class (stl/css :submenu-item)
-                                :on-click    on-export-file
-                                :on-key-down on-export-file-key-down
-                                :data-format "binfile-v3"
-                                :id          "file-menu-binary-file"}
-        [:span {:class (stl/css :item-name)}
-         (tr "dashboard.download-binary-file")]])
-
-     (when-not (contains? cf/flags :export-file-v3)
-       [:> dropdown-menu-item* {:class (stl/css :submenu-item)
-                                :on-click    on-export-file
-                                :on-key-down on-export-file-key-down
-                                :data-format "legacy-zip"
-                                :id          "file-menu-standard-file"}
-        [:span {:class (stl/css :item-name)}
-         (tr "dashboard.download-standard-file")]])
 
      (when (seq frames)
        [:> dropdown-menu-item* {:class (stl/css :submenu-item)

frontend/src/app/worker.cljs

@@ -11,7 +11,6 @@
    [app.common.schema :as sm]
    [app.common.types.objects-map]
    [app.util.object :as obj]
-   [app.worker.export]
    [app.worker.impl :as impl]
    [app.worker.import]
    [app.worker.index]
@@ -32,7 +31,7 @@
      [:cmd :keyword]]]
    [:buffer? {:optional true} :boolean]])
 
-(def ^:private check-message!
+(def ^:private check-message
   (sm/check-fn schema:message))
 
 (def buffer (rx/subject))
@@ -41,9 +40,7 @@
   "Process the message and returns to the client"
   [{:keys [sender-id payload transfer] :as message}]
 
-  (dm/assert!
+  (assert (check-message message))
-   "expected valid message"
-   (check-message! message))
 
   (letfn [(post [msg]
             (let [msg (-> msg (assoc :reply-to sender-id) (wm/encode))]

frontend/src/app/worker/export.cljs

@@ -1,44 +0,0 @@
-;; 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.worker.export
-  (:require
-   [app.common.exceptions :as ex]
-   [app.main.repo :as rp]
-   [app.util.webapi :as wapi]
-   [app.worker.impl :as impl]
-   [beicon.v2.core :as rx]))
-
-(defmethod impl/handler :export-files
-  [{:keys [files type format] :as message}]
-  (assert (or (= format :binfile-v1)
-              (= format :binfile-v3))
-          "expected valid format")
-
-  (->> (rx/from files)
-       (rx/mapcat
-        (fn [file]
-          (->> (rp/cmd! :export-binfile {:file-id (:id file)
-                                         :version (if (= format :binfile-v3) 3 1)
-                                         :include-libraries (= type :all)
-                                         :embed-assets (= type :merge)})
-               (rx/map wapi/create-blob)
-               (rx/map wapi/create-uri)
-               (rx/map (fn [uri]
-                         {:type :finish
-                          :file-id (:id file)
-                          :filename (:name file)
-                          :mtype (if (= format :binfile-v3)
-                                   "application/zip"
-                                   "application/penpot")
-                          :uri uri}))
-               (rx/catch
-                (fn [cause]
-                  (rx/of (ex/raise :type :internal
-                                   :code :export-error
-                                   :hint "unexpected error on exporting file"
-                                   :file-id (:id file)
-                                   :cause cause)))))))))