Merge remote-tracking branch 'origin/staging' into develop

backend/src/app/http.clj

@@ -114,7 +114,7 @@
               (partial not-found-handler request)))
 
           (on-error [cause request]
-            (let [{:keys [body] :as response} (errors/handle cause request)]
+            (let [{:keys [::rres/body] :as response} (errors/handle cause request)]
               (cond-> response
                 (map? body)
                 (-> (update ::rres/headers assoc "content-type" "application/transit+json")
@@ -150,10 +150,10 @@
    [["" {:middleware [[mw/server-timing]
                       [mw/params]
                       [mw/format-response]
+                      [mw/errors errors/handle]
                       [mw/parse-request]
                       [session/soft-auth cfg]
                       [actoken/soft-auth cfg]
-                      [mw/errors errors/handle]
                       [mw/restrict-methods]]}
 
      (::mtx/routes cfg)

backend/src/app/http/middleware.clj

@@ -10,16 +10,13 @@
    [app.common.logging :as l]
    [app.common.transit :as t]
    [app.config :as cf]
-   [app.util.json :as json]
+   [clojure.data.json :as json]
    [cuerdas.core :as str]
    [ring.request :as rreq]
    [ring.response :as rres]
    [yetti.adapter :as yt]
    [yetti.middleware :as ymw])
   (:import
-   com.fasterxml.jackson.core.JsonParseException
-   com.fasterxml.jackson.core.io.JsonEOFException
-   com.fasterxml.jackson.databind.exc.MismatchedInputException
    io.undertow.server.RequestTooBigException
    java.io.InputStream
    java.io.OutputStream))
@@ -34,11 +31,22 @@
   {:name ::params
    :compile (constantly ymw/wrap-params)})
 
-(def ^:private json-mapper
-  (json/mapper
-   {:encode-key-fn str/camel
-    :decode-key-fn (comp keyword str/kebab)
-    :pretty true}))
+(defn- get-reader
+  ^java.io.BufferedReader
+  [request]
+  (let [^InputStream body (rreq/body request)]
+    (java.io.BufferedReader.
+     (java.io.InputStreamReader. body))))
+
+(defn- read-json-key
+  [k]
+  (-> k str/kebab keyword))
+
+(defn- write-json-key
+  [k]
+  (if (or (keyword? k) (symbol? k))
+    (str/camel k)
+    (str k)))
 
 (defn wrap-parse-request
   [handler]
@@ -53,8 +61,8 @@
                         (update :params merge params))))
 
                 (str/starts-with? header "application/json")
-                (with-open [^InputStream is (rreq/body request)]
-                  (let [params (json/decode is json-mapper)]
+                (with-open [reader (get-reader request)]
+                  (let [params (json/read reader :key-fn read-json-key)]
                     (-> request
                         (assoc :body-params params)
                         (update :params merge params))))
@@ -74,9 +82,7 @@
                         :code :request-body-too-large
                         :hint (ex-message cause))
 
-              (or (instance? JsonEOFException cause)
-                  (instance? JsonParseException cause)
-                  (instance? MismatchedInputException cause))
+              (instance? java.io.EOFException cause)
               (ex/raise :type :validation
                         :code :malformed-json
                         :hint (ex-message cause)
@@ -128,7 +134,8 @@
               (-write-body-to-stream [_ _ output-stream]
                 (try
                   (with-open [^OutputStream bos (buffered-output-stream output-stream buffer-size)]
-                    (json/write! bos data json-mapper))
+                    (with-open [^java.io.OutputStreamWriter writer (java.io.OutputStreamWriter. bos)]
+                      (json/write data writer :key-fn write-json-key)))
 
                   (catch java.io.IOException _)
                   (catch Throwable cause

backend/src/app/loggers/audit.clj

@@ -140,6 +140,7 @@
                        (::rpc/profile-id params)
                        uuid/zero)
 
+        session-id (rreq/get-header request "x-external-session-id")
         props      (-> (or (::replace-props resultm)
                            (-> params
                                (merge (::props resultm))
@@ -150,6 +151,7 @@
 
         token-id  (::actoken/id request)
         context   (-> (::context resultm)
+                      (assoc :external-session-id session-id)
                       (assoc :access-token-id (some-> token-id str))
                       (d/without-nils))]
 

backend/src/app/util/objects_map.clj

@@ -19,7 +19,8 @@
    [app.common.fressian :as fres]
    [app.common.transit :as t]
    [app.common.uuid :as uuid]
-   [clojure.core :as c])
+   [clojure.core :as c]
+   [clojure.data.json :as json])
   (:import
    clojure.lang.Counted
    clojure.lang.IHashEq
@@ -83,6 +84,10 @@
                      ^:unsynchronized-mutable loaded?
                      ^:unsynchronized-mutable modified?]
 
+  json/JSONWriter
+  (-write [this writter options]
+    (json/-write (into {} this) writter options))
+
   IHashEq
   (hasheq [this]
     (when-not hash

backend/src/app/util/pointer_map.clj

@@ -40,7 +40,8 @@
    [app.common.transit :as t]
    [app.common.uuid :as uuid]
    [app.util.time :as dt]
-   [clojure.core :as c])
+   [clojure.core :as c]
+   [clojure.data.json :as json])
   (:import
    clojure.lang.Counted
    clojure.lang.IDeref
@@ -75,6 +76,14 @@
                      ^:unsynchronized-mutable modified?
                      ^:unsynchronized-mutable loaded?]
 
+  json/JSONWriter
+  (-write [this writter options]
+    (json/-write {:type "pointer"
+                  :id (get-id this)
+                  :meta (meta this)}
+                 writter
+                 options))
+
   IPointerMap
   (load! [_]
     (when-not *load-fn*

common/src/app/common/test_helpers/components.cljc

@@ -6,6 +6,7 @@
 
 (ns app.common.test-helpers.components
   (:require
+   [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.files.changes-builder :as pcb]
    [app.common.files.helpers :as cfh]
@@ -64,13 +65,12 @@
   [file id]
   (ctkl/get-component (:data file) id))
 
-(defn set-child-label
-  [file shape-label child-idx label]
-  (let [id (-> (ths/get-shape file shape-label)
-               :shapes
-               (nth child-idx))]
-    (when id
-      (thi/set-id! label id))))
+(defn- set-children-labels!
+  [file shape-label children-labels]
+  (doseq [[label id]
+          (d/zip children-labels (cfh/get-children-ids (-> (thf/current-page file) :objects)
+                                                       (thi/id shape-label)))]
+    (thi/set-id! label id)))
 
 (defn instantiate-component
   [file component-label copy-root-label & {:keys [parent-label library children-labels] :as params}]
@@ -103,6 +103,7 @@
 
                      (and (some? parent) (ctn/in-any-component? (:objects page) parent))
                      (dissoc :component-root))
+
         file'      (ctf/update-file-data
                     file
                     (fn [file-data]
@@ -128,14 +129,14 @@
                                                                      true)))
                                 $
                                 (remove #(= (:id %) (:id copy-root')) copy-shapes)))))]
+
     (when children-labels
-      (dotimes [idx (count children-labels)]
-        (set-child-label file' copy-root-label idx (nth children-labels idx))))
+      (set-children-labels! file' copy-root-label children-labels))
 
     file'))
 
 (defn component-swap
-  [file shape-label new-component-label new-shape-label & {:keys [library] :as params}]
+  [file shape-label new-component-label new-shape-label & {:keys [library children-labels] :as params}]
   (let [shape            (ths/get-shape file shape-label)
         library          (or library file)
         libraries        {(:id library) library}
@@ -147,10 +148,15 @@
         ;; Store the properties that need to be maintained when the component is swapped
         keep-props-values (select-keys shape ctk/swap-keep-attrs)
 
-
         [new_shape _ changes]
         (-> (pcb/empty-changes nil (:id page))
-            (cll/generate-component-swap objects shape (:data file) page libraries id-new-component 0 nil keep-props-values))]
+            (cll/generate-component-swap objects shape (:data file) page libraries id-new-component 0 nil keep-props-values))
+
+        file' (thf/apply-changes file changes)]
 
     (thi/set-id! new-shape-label (:id new_shape))
-    (thf/apply-changes file changes)))
+
+    (when children-labels
+      (set-children-labels! file' new-shape-label children-labels))
+
+    file'))

common/src/app/common/test_helpers/compositions.cljc

@@ -58,6 +58,28 @@
                                     :parent-label frame-label}
                                    child-params))))
 
+(defn add-minimal-component
+  [file component-label root-label
+   & {:keys [component-params root-params]}]
+  ;; Generated shape tree:
+  ;; {:root-label} [:name Frame1]    # [Component :component-label]
+  (-> file
+      (add-frame root-label root-params)
+      (thc/make-component component-label root-label component-params)))
+
+(defn add-minimal-component-with-copy
+  [file component-label main-root-label copy-root-label
+   & {:keys [component-params main-root-params copy-root-params]}]
+  ;; Generated shape tree:
+  ;; {:main-root-label} [:name Frame1]    # [Component :component-label]
+  ;; :copy-root-label [:name Frame1] #--> [Component :component-label] :main-root-label
+  (-> file
+      (add-minimal-component component-label
+                             main-root-label
+                             :component-params component-params
+                             :root-params main-root-params)
+      (thc/instantiate-component component-label copy-root-label copy-root-params)))
+
 (defn add-simple-component
   [file component-label root-label child-label
    & {:keys [component-params root-params child-params]}]

common/test/common_tests/logic/comp_detach_with_swap_test.cljc

@@ -0,0 +1,197 @@
+;; 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 common-tests.logic.comp-detach-with-swap-test
+  (:require
+   [app.common.files.changes-builder :as pcb]
+   [app.common.logic.libraries :as cll]
+   [app.common.test-helpers.components :as thc]
+   [app.common.test-helpers.compositions :as tho]
+   [app.common.test-helpers.files :as thf]
+   [app.common.test-helpers.ids-map :as thi]
+   [app.common.test-helpers.shapes :as ths]
+   [app.common.types.component :as ctk]
+   [clojure.test :as t]))
+
+(t/use-fixtures :each thi/test-fixture)
+
+;; Related .penpot file: common/test/cases/detach-with-swap.penpot
+(defn- setup-file
+  []
+  ;; {:r-ellipse} [:name Ellipse, :type :frame]                         # [Component :c-ellipse]
+  ;;     :ellipse [:name Ellipse, :type :circle] 
+  ;; {:r-rectangle} [:name Rectangle, :type :frame]                     # [Component :c-rectangle]
+  ;;     :rectangle [:name rectangle, :type :rect] 
+  ;; {:board-with-ellipse} [:name Board with ellipse, :type :frame]     # [Component :c-board-with-ellipse]
+  ;;     :nested-h-ellipse [:name Ellipse, :type :frame]                @--> :r-ellipse
+  ;;         :nested-ellipse [:name Ellipse, :type :circle]             ---> :ellipse
+  ;; {:board-with-rectangle} [:name Board with rectangle, :type :frame] # [Component :c-board-with-rectangle]
+  ;;     :nested-h-rectangle [:name Rectangle, :type :frame]            @--> :r-rectangle
+  ;;         :nested-rectangle [:name rectangle, :type :rect]           ---> :rectangle
+  ;; {:big-board} [:name Big Board, :type :frame]                       # [Component :c-big-board]
+  ;;     :h-board-with-ellipse [:name Board with ellipse, :type :frame] @--> :board-with-ellipse
+  ;;         :nested2-h-ellipse [:name Ellipse, :type :frame]           @--> :nested-h-ellipse
+  ;;             :nested2-ellipse [:name Ellipse, :type :circle]        ---> :nested-ellipse
+  (-> (thf/sample-file :file1)
+
+      (tho/add-simple-component :c-ellipse :r-ellipse :ellipse
+                                :root-params {:name "Ellipse"}
+                                :child-params {:name "Ellipse" :type :circle})
+
+      (tho/add-simple-component :c-rectangle :r-rectangle :rectangle
+                                :root-params {:name "Rectangle"}
+                                :child-params {:name "rectangle" :type :rect})
+
+      (tho/add-frame :board-with-ellipse :name "Board with ellipse")
+      (thc/instantiate-component :c-ellipse :nested-h-ellipse :parent-label :board-with-ellipse
+                                 :children-labels [:nested-ellipse])
+      (thc/make-component :c-board-with-ellipse :board-with-ellipse)
+
+      (tho/add-frame :board-with-rectangle :name "Board with rectangle")
+      (thc/instantiate-component :c-rectangle :nested-h-rectangle :parent-label :board-with-rectangle
+                                 :children-labels [:nested-rectangle])
+      (thc/make-component :c-board-with-rectangle :board-with-rectangle)
+
+      (tho/add-frame :big-board :name "Big Board")
+      (thc/instantiate-component :c-board-with-ellipse
+                                 :h-board-with-ellipse
+                                 :parent-label :big-board
+                                 :children-labels [:nested2-h-ellipse :nested2-ellipse])
+      (thc/make-component :c-big-board :big-board)))
+
+(t/deftest test-advance-when-not-swapped
+  (let [;; ==== Setup
+        file (-> (setup-file)
+                 (thc/instantiate-component :c-big-board
+                                            :copy-big-board
+                                            :children-labels [:copy-h-board-with-ellipse
+                                                              :copy-nested-h-ellipse
+                                                              :copy-nested-ellipse]))
+
+        page (thf/current-page file)
+
+        ;; ==== Action
+        changes (cll/generate-detach-instance (-> (pcb/empty-changes nil)
+                                                  (pcb/with-page page)
+                                                  (pcb/with-objects (:objects page)))
+                                              page
+                                              {(:id file) file}
+                                              (thi/id :copy-big-board))
+        file'   (thf/apply-changes file changes)
+
+        ;; ==== Get
+        copy-h-board-with-ellipse (ths/get-shape file' :copy-h-board-with-ellipse)
+        copy-nested-h-ellipse     (ths/get-shape file' :copy-nested-h-ellipse)
+        copy-nested-ellipse       (ths/get-shape file' :copy-nested-ellipse)]
+
+    ;; ==== Check
+
+    ;; In the normal case, children's ref (that pointed to the near main inside big-board)
+    ;; are advanced to point to the new near main inside board-with-ellipse.
+    (t/is (ctk/instance-root? copy-h-board-with-ellipse))
+    (t/is (= (:shape-ref copy-h-board-with-ellipse) (thi/id :board-with-ellipse)))
+    (t/is (nil? (ctk/get-swap-slot copy-h-board-with-ellipse)))
+
+    (t/is (ctk/instance-head? copy-nested-h-ellipse))
+    (t/is (= (:shape-ref copy-nested-h-ellipse) (thi/id :nested-h-ellipse)))
+    (t/is (nil? (ctk/get-swap-slot copy-nested-h-ellipse)))
+
+    (t/is (not (ctk/instance-head? copy-nested-ellipse)))
+    (t/is (= (:shape-ref copy-nested-ellipse) (thi/id :nested-ellipse)))
+    (t/is (nil? (ctk/get-swap-slot copy-nested-ellipse)))))
+
+(t/deftest test-dont-advance-when-swapped-copy
+  (let [;; ==== Setup
+        file (-> (setup-file)
+                 (thc/instantiate-component :c-big-board
+                                            :copy-big-board
+                                            :children-labels [:copy-h-board-with-ellipse
+                                                              :copy-nested-h-ellipse
+                                                              :copy-nested-ellipse])
+                 (thc/component-swap :copy-h-board-with-ellipse
+                                     :c-board-with-rectangle
+                                     :copy-h-board-with-rectangle
+                                     :children-labels [:copy-nested-h-rectangle
+                                                       :copy-nested-rectangle]))
+
+        page (thf/current-page file)
+
+        ;; ==== Action
+        changes (cll/generate-detach-instance (-> (pcb/empty-changes nil)
+                                                  (pcb/with-page page)
+                                                  (pcb/with-objects (:objects page)))
+                                              page
+                                              {(:id file) file}
+                                              (thi/id :copy-big-board))
+        file'   (thf/apply-changes file changes)
+
+        ;; ==== Get
+        copy-h-board-with-rectangle (ths/get-shape file' :copy-h-board-with-rectangle)
+        copy-nested-h-rectangle     (ths/get-shape file' :copy-nested-h-rectangle)
+        copy-nested-rectangle       (ths/get-shape file' :copy-nested-rectangle)]
+
+    ;; ==== Check
+
+    ;; If the nested copy was swapped, there is no need to advance shape-refs,
+    ;; as they already pointing to the near main inside board-with-rectangle.
+    (t/is (ctk/instance-root? copy-h-board-with-rectangle))
+    (t/is (= (:shape-ref copy-h-board-with-rectangle) (thi/id :board-with-rectangle)))
+    (t/is (nil? (ctk/get-swap-slot copy-h-board-with-rectangle)))
+
+    (t/is (ctk/instance-head? copy-nested-h-rectangle))
+    (t/is (= (:shape-ref copy-nested-h-rectangle) (thi/id :nested-h-rectangle)))
+    (t/is (nil? (ctk/get-swap-slot copy-nested-h-rectangle)))
+
+    (t/is (not (ctk/instance-head? copy-nested-rectangle)))
+    (t/is (= (:shape-ref copy-nested-rectangle) (thi/id :nested-rectangle)))
+    (t/is (nil? (ctk/get-swap-slot copy-nested-rectangle)))))
+
+(t/deftest test-propagate-slot-when-swapped-main
+  (let [;; ==== Setup
+        file (-> (setup-file)
+                 (thc/component-swap :nested2-h-ellipse
+                                     :c-rectangle
+                                     :nested2-h-rectangle
+                                     :children-labels [:nested2-rectangle])
+                 (thc/instantiate-component :c-big-board
+                                            :copy-big-board
+                                            :children-labels [:copy-h-board-with-ellipse
+                                                              :copy-nested-h-rectangle
+                                                              :copy-nested-rectangle]))
+
+        page (thf/current-page file)
+
+        ;; ==== Action
+        changes (cll/generate-detach-instance (-> (pcb/empty-changes nil)
+                                                  (pcb/with-page page)
+                                                  (pcb/with-objects (:objects page)))
+                                              page
+                                              {(:id file) file}
+                                              (thi/id :copy-big-board))
+        file'   (thf/apply-changes file changes)
+
+        ;; ==== Get
+        copy-h-board-with-ellipse (ths/get-shape file' :copy-h-board-with-ellipse)
+        copy-nested-h-rectangle   (ths/get-shape file' :copy-nested-h-rectangle)
+        copy-nested-rectangle     (ths/get-shape file' :copy-nested-rectangle)]
+
+    ;; ==== Check
+
+    ;; This one is advanced normally, as it has not been swapped.
+    (t/is (ctk/instance-root? copy-h-board-with-ellipse))
+    (t/is (= (:shape-ref copy-h-board-with-ellipse) (thi/id :board-with-ellipse)))
+    (t/is (nil? (ctk/get-swap-slot copy-h-board-with-ellipse)))
+
+    ;; If the nested copy has been swapped in the main, it does advance,
+    ;; but the swap slot of the near main is propagated to the copy.
+    (t/is (ctk/instance-head? copy-nested-h-rectangle))
+    (t/is (= (:shape-ref copy-nested-h-rectangle) (thi/id :r-rectangle)))
+    (t/is (= (ctk/get-swap-slot copy-nested-h-rectangle) (thi/id :nested-h-ellipse)))
+
+    (t/is (not (ctk/instance-head? copy-nested-rectangle)))
+    (t/is (= (:shape-ref copy-nested-rectangle) (thi/id :rectangle)))
+    (t/is (nil? (ctk/get-swap-slot copy-nested-rectangle)))))
+

common/test/common_tests/logic/comp_remove_swap_slots_test.cljc

@@ -758,7 +758,6 @@
     (t/is (some? blue-copy1'))
     (t/is (nil? (ctk/get-swap-slot blue-copy1')))))
 
-
 (t/deftest test-remove-swap-slot-detach
   (let [;; ==== Setup
         file                   (setup-file)

frontend/src/app/config.cljs

@@ -130,9 +130,16 @@
 (def worker-uri
   (obj/get global "penpotWorkerURI" "/js/worker.js"))
 
-(defn external-feature-flag [flag value]
-  (when-let [fn (obj/get global "externalFeatureFlag")]
-    (fn flag value)))
+(defn external-feature-flag
+  [flag value]
+  (let [f (obj/get global "externalFeatureFlag")]
+    (when (fn? f)
+      (f flag value))))
+
+(defn external-session-id
+  []
+  (let [f (obj/get global "externalSessionId")]
+    (when (fn? f) (f))))
 
 ;; --- Helper Functions
 

frontend/src/app/main/data/events.cljs

@@ -168,7 +168,7 @@
       ptk/EffectEvent
       (effect [_ _ stream]
         (let [session (atom nil)
-              stopper  (rx/filter (ptk/type? ::initialize) stream)
+              stopper (rx/filter (ptk/type? ::initialize) stream)
               buffer  (atom #queue [])
               profile (->> (rx/from-atom storage {:emit-current-value? true})
                            (rx/map :profile)
@@ -213,7 +213,9 @@
                          (let [session* (or @session (dt/now))
                                context  (-> @context
                                             (merge (:context event))
-                                            (assoc :session session*))]
+                                            (assoc :session session*)
+                                            (assoc :external-session-id (cf/external-session-id))
+                                            (d/without-nils))]
                            (reset! session session*)
                            (-> event
                                (assoc :timestamp (dt/now))

frontend/src/app/main/repo.cljs

@@ -97,7 +97,8 @@
         request   {:method method
                    :uri (u/join cf/public-uri "api/rpc/command/" nid)
                    :credentials "include"
-                   :headers {"accept" "application/transit+json,text/event-stream,*/*"}
+                   :headers {"accept" "application/transit+json,text/event-stream,*/*"
+                             "x-external-session-id" (cf/external-session-id)}
                    :body (when (= method :post)
                            (if form-data?
                              (http/form-data params)