Merge remote-tracking branch 'origin/staging'

CHANGES.md

@@ -1,5 +1,13 @@
 # CHANGELOG
 
+## 2.0.2
+
+### :sparkles: Enhancements
+
+- Fix locking contention on cron subsystem (causes backend start blocking)
+- Fix locking contention on file object thumbails backend RPC calls
+
+
 ## 2.0.1
 
 ### :bug: Bugs fixed

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

@@ -228,51 +228,52 @@
 ;; MUTATION COMMANDS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;; MUTATION COMMAND: create-file-object-thumbnail
+(def sql:get-file-object-thumbnail
+  "SELECT * FROM file_tagged_object_thumbnail
+    WHERE file_id = ? AND object_id = ? AND tag = ?
+      FOR UPDATE")
 
-(defn- create-file-object-thumbnail!
+(def sql:create-file-object-thumbnail
-  [{:keys [::db/conn ::sto/storage]} file-id object-id media tag]
+  "INSERT INTO file_tagged_object_thumbnail (file_id, object_id, tag, media_id)
+   VALUES (?, ?, ?, ?)
+       ON CONFLICT (file_id, object_id, tag)
+       DO UPDATE SET updated_at=?, media_id=?, deleted_at=null
+   RETURNING *")
 
-  (let [thumb (db/get* conn :file-tagged-object-thumbnail
+(defn- persist-thumbnail!
-                       {:file-id file-id
+  [storage media created-at]
-                        :object-id object-id
+  (let [path  (:path media)
-                        :tag tag}
-                       {::db/remove-deleted false
-                        ::sql/for-update true})
-
-        path  (:path media)
         mtype (:mtype media)
         hash  (sto/calculate-hash path)
         data  (-> (sto/content path)
-                  (sto/wrap-with-hash hash))
+                  (sto/wrap-with-hash hash))]
-        tnow  (dt/now)
 
-        media (sto/put-object! storage
+    (sto/put-object! storage
-                               {::sto/content data
+                     {::sto/content data
-                                ::sto/deduplicate? true
+                      ::sto/deduplicate? true
-                                ::sto/touched-at tnow
+                      ::sto/touched-at created-at
-                                :content-type mtype
+                      :content-type mtype
-                                :bucket "file-object-thumbnail"})]
+                      :bucket "file-object-thumbnail"})))
 
-    (if (some? thumb)
+
-      (do
+
-        ;; We mark the old media id as touched if it does not matches
+(defn- create-file-object-thumbnail!
-        (when (not= (:id media) (:media-id thumb))
+  [{:keys [::sto/storage] :as cfg} file-id object-id media tag]
-          (sto/touch-object! storage (:media-id thumb)))
+  (let [tsnow     (dt/now)
-        (db/update! conn :file-tagged-object-thumbnail
+        media     (persist-thumbnail! storage media tsnow)
-                    {:media-id (:id media)
+        [th1 th2] (db/tx-run! cfg (fn [{:keys [::db/conn]}]
-                     :deleted-at nil
+                                    (let [th1 (db/exec-one! conn [sql:get-file-object-thumbnail file-id object-id tag])
-                     :updated-at tnow}
+                                          th2 (db/exec-one! conn [sql:create-file-object-thumbnail
-                    {:file-id file-id
+                                                                  file-id object-id tag (:id media)
-                     :object-id object-id
+                                                                  tsnow (:id media)])]
-                     :tag tag}))
+                                      [th1 th2])))]
-      (db/insert! conn :file-tagged-object-thumbnail
+
-                  {:file-id file-id
+    (when (and (some? th1)
-                   :object-id object-id
+               (not= (:media-id th1)
-                   :created-at tnow
+                     (:media-id th2)))
-                   :updated-at tnow
+      (sto/touch-object! storage (:media-id th1)))
-                   :tag tag
+
-                   :media-id (:id media)}))))
+    th2))
 
 (def ^:private
   schema:create-file-object-thumbnail
@@ -296,16 +297,10 @@
   (media/validate-media-type! media)
   (media/validate-media-size! media)
 
-  (db/tx-run! cfg
+  (db/run! cfg files/check-edition-permissions! profile-id file-id)
-              (fn [{:keys [::db/conn] :as cfg}]
+
-                (files/check-edition-permissions! conn profile-id file-id)
+  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
-                (when-not (db/read-only? conn)
+    (create-file-object-thumbnail! cfg file-id object-id media (or tag "frame"))))
-                  (let [cfg (-> cfg
-                                (update ::sto/storage media/configure-assets-storage)
-                                (assoc ::rtry/when rtry/conflict-exception?)
-                                (assoc ::rtry/max-retries 5)
-                                (assoc ::rtry/label "create-file-object-thumbnail"))]
-                    (create-file-object-thumbnail! cfg file-id object-id media (or tag "frame")))))))
 
 ;; --- MUTATION COMMAND: delete-file-object-thumbnail
 

backend/src/app/worker/cron.clj

@@ -27,14 +27,15 @@
   "insert into scheduled_task (id, cron_expr)
    values (?, ?)
        on conflict (id)
-       do update set cron_expr=?")
+       do nothing")
 
 (defn- synchronize-cron-entries!
-  [{:keys [::db/pool ::entries]}]
+  [{:keys [::db/conn ::entries]}]
-  (db/with-atomic [conn pool]
+  (doseq [{:keys [id cron]} entries]
-    (doseq [{:keys [id cron]} entries]
+    (let [result   (db/exec-one! conn [sql:upsert-cron-task id (str cron)])
-      (l/trc :hint "register cron task" :id id :cron (str cron))
+          updated? (pos? (db/get-update-count result))]
-      (db/exec-one! conn [sql:upsert-cron-task id (str cron) (str cron)]))))
+      (l/dbg :hint "register task" :id id :cron (str cron)
+             :status (if updated? "created" "exists")))))
 
 (defn- lock-scheduled-task!
   [conn id]
@@ -45,7 +46,7 @@
 (declare ^:private schedule-cron-task)
 
 (defn- execute-cron-task
-  [cfg {:keys [id] :as task}]
+  [cfg {:keys [id cron] :as task}]
   (px/thread
     {:name (str "penpot/cron-task/" id)}
     (let [tpoint (dt/tpoint)]
@@ -54,20 +55,25 @@
                           (db/exec-one! conn ["SET LOCAL statement_timeout=0;"])
                           (db/exec-one! conn ["SET LOCAL idle_in_transaction_session_timeout=0;"])
                           (when (lock-scheduled-task! conn id)
-                            (l/dbg :hint "start task" :task-id id)
+                            (db/update! conn :scheduled-task
+                                        {:cron-expr (str cron)
+                                         :modified-at (dt/now)}
+                                        {:id id}
+                                        {::db/return-keys false})
+                            (l/dbg :hint "start" :id id)
                             ((:fn task) task)
                             (let [elapsed (dt/format-duration (tpoint))]
-                              (l/dbg :hint "end task" :task-id id :elapsed elapsed)))))
+                              (l/dbg :hint "end" :id id :elapsed elapsed)))))
 
         (catch InterruptedException _
           (let [elapsed (dt/format-duration (tpoint))]
-            (l/debug :hint "task interrupted" :task-id id :elapsed elapsed)))
+            (l/debug :hint "task interrupted" :id id :elapsed elapsed)))
 
         (catch Throwable cause
           (let [elapsed (dt/format-duration (tpoint))]
             (binding [l/*context* (get-error-context cause task)]
               (l/err :hint "unhandled exception on running task"
-                     :task-id id
+                     :id id
                      :elapsed elapsed
                      :cause cause))))
         (finally
@@ -86,7 +92,7 @@
   (let [ts (ms-until-valid cron)
         ft (px/schedule! ts (partial execute-cron-task cfg task))]
 
-    (l/dbg :hint "schedule task" :task-id id
+    (l/dbg :hint "schedule task" :id id
            :ts (dt/format-duration ts)
            :at (dt/format-instant (dt/in-future ts)))
 
@@ -135,7 +141,8 @@
           cfg     (assoc cfg ::entries entries ::running running)]
 
       (l/inf :hint "started" :tasks (count entries))
-      (synchronize-cron-entries! cfg)
+
+      (db/tx-run! cfg synchronize-cron-entries!)
 
       (->> (filter some? entries)
            (run! (partial schedule-cron-task cfg)))

backend/test/backend_tests/rpc_file_test.clj

@@ -1158,7 +1158,7 @@
       ;; check that the unknown frame thumbnail is deleted
       (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
         (t/is (= 2 (count rows)))
-        (t/is (= 1 (count (remove (comp some? :deleted-at) rows)))))
+        (t/is (= 1 (count (remove :deleted-at rows)))))
 
       (let [res (th/run-task! :objects-gc {:min-age 0})]
         (t/is (= 3 (:processed res))))

frontend/src/app/libs/file_builder.cljs

@@ -253,7 +253,7 @@
 
   (export [_]
     (->> (export-file file)
-         (rx/subs
+         (rx/subs!
           (fn [value]
             (when  (not (contains? value :type))
               (let [[file export-blob] value]