Merge pull request #3051 from penpot/niwinz-experiments-2

🐛 Fix many issues related to the concurrency refactor PR

backend/scripts/repl

@@ -5,6 +5,8 @@ export PENPOT_TENANT=dev
 export PENPOT_FLAGS="\
        $PENPOT_FLAGS \
        enable-backend-asserts \
+       enable-fdata-storage-pointer-map \
+       enable-fdata-storage-objets-map \
        enable-audit-log \
        enable-transit-readable-response \
        enable-demo-users \

backend/scripts/start-dev

@@ -2,7 +2,20 @@
 
 export PENPOT_HOST=devenv
 export PENPOT_TENANT=dev
-export PENPOT_FLAGS="$PENPOT_FLAGS enable-backend-asserts enable-audit-log enable-transit-readable-response enable-demo-users disable-secure-session-cookies enable-smtp enable-webhooks"
+export PENPOT_FLAGS="\
+       $PENPOT_FLAGS \
+       enable-prepl-server \
+       enable-urepl-server \
+       enable-webhooks \
+       enable-backend-asserts \
+       enable-audit-log \
+       enable-transit-readable-response \
+       enable-demo-users \
+       enable-fdata-storage-pointer-map \
+       enable-fdata-storage-objets-map \
+       disable-secure-session-cookies \
+       enable-smtp \
+       enable-webhooks";
 
 set -ex
 

backend/src/app/http/errors.clj

@@ -112,7 +112,7 @@
     (l/error :hint "Internal error" :message (ex-message error) :cause error)
     {::yrs/status 500
      ::yrs/body {:type :server-error
-                 :code :unhandloed
+                 :code :unhandled
                  :hint (ex-message error)
                  :data (ex-data error)}}))
 

backend/src/app/http/middleware.clj

@@ -158,8 +158,13 @@
                       (assoc ::yrs/body (transit-streamable-body body opts))))
                 response)))
 
+          (format-from-params [{:keys [query-params] :as request}]
+            (and (= "json" (get query-params :_fmt))
+                 "application/json"))
+
           (format-response [response request]
-            (let [accept (yrq/get-header request "accept")]
+            (let [accept (or (format-from-params request)
+                             (yrq/get-header request "accept"))]
               (cond
                 (or (= accept "application/transit+json")
                     (str/includes? accept "application/transit+json"))

backend/src/app/rpc/climit.clj

@@ -168,7 +168,7 @@
 
 (defn submit!
   [{:keys [::id ::cache ::wrk/executor ::mtx/metrics]} f]
-  (let [f (partial px/submit! executor f)]
+  (let [f (partial px/submit! executor (px/wrap-bindings f))]
     (if (and cache id)
       (p/await! (invoke! cache metrics id nil f))
       (p/await! (f)))))

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

@@ -670,12 +670,30 @@
 
 ;; --- COMMAND QUERY: get-file-data-for-thumbnail
 
+;; FIXME: performance issue
+;;
+;; We need to improve how we set frame for thumbnail in order to avoid
+;; loading all pages into memory for find the frame set for thumbnail.
+
 (defn get-file-data-for-thumbnail
   [conn {:keys [data id] :as file}]
   (letfn [;; function responsible on finding the frame marked to be
           ;; used as thumbnail; the returned frame always have
           ;; the :page-id set to the page that it belongs.
+
           (get-thumbnail-frame [data]
+            ;; NOTE: this is a hack for avoid perform blocking
+            ;; operation inside the for loop, clojure lazy-seq uses
+            ;; synchronized blocks that does not plays well with
+            ;; virtual threads, so we need to perform the load
+            ;; operation first. This operation forces all pointer maps
+            ;; load into the memory.
+            (->> (-> data :pages-index vals)
+                 (filter pmap/pointer-map?)
+                 (run! pmap/load!))
+
+            ;; Then proceed to find the frame set for thumbnail
+
             (d/seek :use-for-thumbnail?
                     (for [page  (-> data :pages-index vals)
                           frame (-> page :objects ctt/get-frames)]

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

@@ -33,22 +33,26 @@
          (db/insert! conn :file-profile-rel))))
 
 (defn create-file
-  [conn {:keys [id name project-id is-shared data revn
+  [conn {:keys [id name project-id is-shared revn
                 modified-at deleted-at create-page
                 ignore-sync-until features]
          :or {is-shared false revn 0 create-page true}
          :as params}]
-  (let [id       (or id (:id data) (uuid/next))
+
+  (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED;"])
+  (let [id       (or id (uuid/next))
         features (-> (into files/default-features features)
                      (files/check-features-compatibility!))
 
-        data     (or data
+        data     (binding [pmap/*tracked* (atom {})
-                     (binding [ffeat/*current* features
+                           ffeat/*current* features
-                               ffeat/*wrap-with-objects-map-fn* (if (features "storate/objects-map") omap/wrap identity)
+                           ffeat/*wrap-with-objects-map-fn* (if (features "storate/objects-map") omap/wrap identity)
-                               ffeat/*wrap-with-pointer-map-fn* (if (features "storage/pointer-map") pmap/wrap identity)]
+                           ffeat/*wrap-with-pointer-map-fn* (if (features "storage/pointer-map") pmap/wrap identity)]
-                       (if create-page
+                   (let [data (if create-page
-                         (ctf/make-file-data id)
+                                (ctf/make-file-data id)
-                         (ctf/make-file-data id nil))))
+                                (ctf/make-file-data id nil))]
+                     (files/persist-pointers! conn id)
+                     data))
 
         features (db/create-array conn "text" features)
         file     (db/insert! conn :file

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

@@ -48,25 +48,24 @@
 (defn- validate-webhook!
   [cfg whook params]
   (when (not= (:uri whook) (:uri params))
-    (try
+    (let [response (ex/try!
-      (let [response (http/req! cfg
+                    (http/req! cfg
-                                {:method :head
+                               {:method :head
-                                 :uri (str (:uri params))
+                                :uri (str (:uri params))
-                                 :timeout (dt/duration "3s")}
+                                :timeout (dt/duration "3s")}
-                                {:sync? true})]
+                               {:sync? true}))]
-        (when-let [hint (webhooks/interpret-response response)]
+      (if (ex/exception? response)
-          (ex/raise :type :validation
+        (if-let [hint (webhooks/interpret-exception response)]
-                    :code :webhook-validation
-                    :hint hint)))
-
-      (catch Throwable cause
-        (if-let [hint (webhooks/interpret-exception cause)]
           (ex/raise :type :validation
                     :code :webhook-validation
                     :hint hint)
           (ex/raise :type :internal
                     :code :webhook-validation
-                    :cause cause))))))
+                    :cause response))
+        (when-let [hint (webhooks/interpret-response response)]
+          (ex/raise :type :validation
+                    :code :webhook-validation
+                    :hint hint))))))
 
 (defn- validate-quotes!
   [{:keys [::db/pool]} {:keys [team-id]}]

backend/src/app/util/time.clj

@@ -128,7 +128,8 @@
 
 (extend-protocol fez/IEdn
   Duration
-  (-edn [o] (pr-str o)))
+  (-edn [o]
+    (tagged-literal 'app/duration (str o))))
 
 (defn format-duration
   [o]
@@ -218,7 +219,7 @@
 
 (extend-protocol fez/IEdn
   Instant
-  (-edn [o] (pr-str o)))
+  (-edn [o] (tagged-literal 'app/instant (format-instant o))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Cron Expression