✨ Add internal helper for team duplication

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

@@ -35,6 +35,20 @@
    [promesa.core :as p]
    [promesa.exec :as px]))
 
+(defn- index-row
+  [index obj]
+  (assoc index (:id obj) (uuid/next)))
+
+(defn- lookup-index
+  [id index]
+  (get index id id))
+
+(defn- remap-id
+  [item index key]
+  (cond-> item
+    (contains? item key)
+    (update key lookup-index index)))
+
 ;; --- COMMAND: Duplicate File
 
 (declare duplicate-file)
@@ -51,14 +65,15 @@
   {::doc/added "1.16"
    ::webhooks/event? true
    ::sm/params schema:duplicate-file}
-  [cfg {:keys [::rpc/profile-id] :as params}]
+  [cfg {:keys [::rpc/profile-id file-id] :as params}]
-  (db/tx-run! cfg duplicate-file (assoc params :profile-id profile-id)))
+  (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
+                    (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
 
-(defn- remap-id
+                    (let [params (-> params
-  [item index key]
+                                     (assoc :index {file-id (uuid/next)})
-  (cond-> item
+                                     (assoc :profile-id profile-id)
-    (contains? item key)
+                                     (assoc ::reset-shared-flag? true))]
-    (assoc key (get index (get item key) (get item key)))))
+                      (duplicate-file cfg params)))))
 
 (defn- process-file
   [cfg index {:keys [id] :as file}]
@@ -109,7 +124,6 @@
           (process-file [{:keys [id] :as file}]
             (-> file
                 (update :data assoc :id id)
-                (update :data feat.fdata/process-pointers deref)
                 (pmg/migrate-file)
                 (update :data (fn [data]
                                 (-> data
@@ -118,10 +132,12 @@
                                     (update :media relink-media)
                                     (d/without-nils))))))]
 
-    (let [new-id (get index id)
+    (let [file (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
-          file   (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
+                 (-> file
-                   (-> (assoc file :id new-id)
+                     (update :id lookup-index index)
-                       (process-file)))
+                     (update :project-id lookup-index index)
+                     (update :data feat.fdata/process-pointers deref)
+                     (process-file)))
 
           file (if (contains? (:features file) "fdata/objects-map")
                  (feat.fdata/enable-objects-map file)
@@ -135,31 +151,34 @@
                  file)]
       file)))
 
-(def sql:get-used-libraries
+(defn duplicate-file
-  "select flr.*
+  [{:keys [::db/conn] :as cfg} {:keys [profile-id index file-id name ::reset-shared-flag?]}]
-     from file_library_rel as flr
+  (let [;; We don't touch the original file on duplication
-    inner join file as l on (flr.library_file_id = l.id)
+        file     (files/get-file cfg file-id :migrate? false)
-    where flr.file_id = ?
-      and l.deleted_at is null")
 
-(def sql:get-used-media-objects
+        ;; We only check permissions if profile-id is present; it can
-  "select fmo.*
+        ;; be omited when this function is called from SREPL helpers
-     from file_media_object as fmo
+        _        (when (uuid? profile-id)
-    inner join storage_object as so on (fmo.media_id = so.id)
+                   (proj/check-edition-permissions! conn profile-id (:project-id file)))
-    where fmo.file_id = ?
-      and so.deleted_at is null")
 
-(defn duplicate-file*
+        flibs    (let [sql (str "SELECT flr.* "
-  [{:keys [::db/conn] :as cfg} {:keys [profile-id file index project-id name flibs fmeds]} {:keys [reset-shared-flag]}]
+                                "  FROM file_library_rel AS flr "
-  (let [flibs    (or flibs (db/exec! conn [sql:get-used-libraries (:id file)]))
+                                "  JOIN file AS l ON (flr.library_file_id = l.id) "
-        fmeds    (or fmeds (db/exec! conn [sql:get-used-media-objects (:id file)]))
+                                " WHERE flr.file_id = ? AND l.deleted_at is null")]
+                   (db/exec! conn [sql file-id]))
+
+        fmeds    (let [sql (str "SELECT fmo.* "
+                                "  FROM file_media_object AS fmo "
+                                "  JOIN storage_object AS so ON (fmo.media_id = so.id) "
+                                " WHERE fmo.file_id = ? AND so.deleted_at is null")]
+                   (db/exec! conn [sql file-id]))
 
         ;; memo uniform creation/modification date
         now      (dt/now)
         ignore   (dt/plus now (dt/duration {:seconds 5}))
 
         ;; add to the index all file media objects.
-        index    (reduce #(assoc %1 (:id %2) (uuid/next)) index fmeds)
+        index    (reduce index-row index fmeds)
 
         flibs-xf (comp
                   (map #(remap-id % index :file-id))
@@ -179,13 +198,10 @@
         fmeds   (sequence fmeds-xf fmeds)
 
         file    (cond-> file
-                  (some? project-id)
+                  (string? name)
-                  (assoc :project-id project-id)
-
-                  (some? name)
                   (assoc :name name)
 
-                  (true? reset-shared-flag)
+                  (true? reset-shared-flag?)
                   (assoc :is-shared false))
 
         file    (-> file
@@ -201,13 +217,18 @@
                     (update :data blob/encode))
                 {::db/return-keys? false})
 
-    (db/insert! conn :file-profile-rel
+    ;; The file profile creation is optional, so when no profile is
-                {:file-id (:id file)
+    ;; present (when this function is called from profile less
-                 :profile-id profile-id
+    ;; environment: SREPL) we just omit the creation of the relation
-                 :is-owner true
+
-                 :is-admin true
+    (when (uuid? profile-id)
-                 :can-edit true}
+      (db/insert! conn :file-profile-rel
-                {::db/return-keys? false})
+                  {:file-id (:id file)
+                   :profile-id profile-id
+                   :is-owner true
+                   :is-admin true
+                   :can-edit true}
+                  {::db/return-keys? false}))
 
     (doseq [params flibs]
       (db/insert! conn :file-library-rel params ::db/return-keys? false))
@@ -217,16 +238,6 @@
 
     file))
 
-(defn duplicate-file
-  [{:keys [::db/conn] :as cfg} {:keys [profile-id file-id] :as params}]
-  (let [;; We don't touch the original file on duplication
-        file   (files/get-file cfg file-id :migrate? false)
-        index  {file-id (uuid/next)}
-        params (assoc params :index index :file file)]
-    (proj/check-edition-permissions! conn profile-id (:project-id file))
-    (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
-    (duplicate-file* cfg params {:reset-shared-flag true})))
-
 ;; --- COMMAND: Duplicate Project
 
 (declare duplicate-project)
@@ -244,28 +255,29 @@
    ::webhooks/event? true
    ::sm/params schema:duplicate-project}
   [cfg {:keys [::rpc/profile-id] :as params}]
-  (db/tx-run! cfg duplicate-project (assoc params :profile-id profile-id)))
+  (db/tx-run! cfg (fn [cfg]
+                      ;; Defer all constraints
+                    (db/exec-one! cfg ["SET CONSTRAINTS ALL DEFERRED"])
+                    (duplicate-project cfg (assoc params :profile-id profile-id)))))
 
 (defn duplicate-project
   [{:keys [::db/conn] :as cfg} {:keys [profile-id project-id name] :as params}]
-
-  ;; Defer all constraints
-  (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
-
   (let [project (-> (db/get-by-id conn :project project-id)
                     (assoc :is-pinned false))
 
         files   (db/query conn :file
-                          {:project-id (:id project)
+                          {:project-id project-id
                            :deleted-at nil}
                           {:columns [:id]})
 
+        index  (reduce index-row {project-id (uuid/next)} files)
+
         project (cond-> project
                   (string? name)
                   (assoc :name name)
 
                   :always
-                  (assoc :id (uuid/next)))]
+                  (update :id lookup-index index))]
 
     ;; Check if the source team-id allow creating new project for current user
     (teams/check-edition-permissions! conn profile-id (:team-id project))
@@ -273,23 +285,119 @@
     ;; create the duplicated project and assign the current profile as
     ;; a project owner
     (teams/create-project conn project)
-    (teams/create-project-role conn profile-id (:id project) :owner)
 
-    ;; duplicate all files
+    ;; The project profile creation is optional, so when no profile is
-    (let [index  (reduce #(assoc %1 (:id %2) (uuid/next)) {} files)
+    ;; present (when this function is called from profile less
-          params (-> params
+    ;; environment: SREPL) we just omit the creation of the relation
-                     (dissoc :name)
+    (when (uuid? profile-id)
-                     (assoc :project-id (:id project))
+      (teams/create-project-role conn profile-id (:id project) :owner))
-                     (assoc :index index))]
+
-      (doseq [{:keys [id]} files]
+    (doseq [{:keys [id] :as file} files]
-        (let [file   (files/get-file cfg id :migrate? false)
+      (let [params (-> params
-              params (assoc params :file file)
+                       (dissoc :name)
-              opts   {:reset-shared-flag false}]
+                       (assoc :file-id id)
-          (duplicate-file* cfg params opts))))
+                       (assoc :index index)
+                       (assoc ::reset-shared-flag? false))]
+        (duplicate-file cfg params)))
 
-    ;; return the created project
     project))
 
+(defn duplicate-team
+  [{:keys [::db/conn] :as cfg} & {:keys [profile-id team-id name] :as params}]
+
+  ;; Check if the source team-id allowed to be read by the user if
+  ;; profile-id is present; it can be ommited if this function is
+  ;; called from SREPL helpers where no profile is available
+  (when (uuid? profile-id)
+    (teams/check-read-permissions! conn profile-id team-id))
+
+  (let [projs (db/query conn :project
+                           {:team-id team-id})
+
+        files (let [sql (str "SELECT f.id "
+                             "  FROM file AS f "
+                             "  JOIN project AS p ON (p.id = f.project_id) "
+                             " WHERE p.team_id = ? "
+                             "   AND p.deleted_at IS NULL "
+                             "   AND f.deleted_at IS NULL")]
+                (db/exec! conn [sql team-id]))
+
+        trels (db/query conn :team-profile-rel
+                        {:team-id team-id})
+
+        prels (let [sql (str "SELECT r.* FROM project_profile_rel AS r "
+                             "  JOIN project AS p ON (r.project_id = p.id) "
+                             " WHERE p.team_id = ?")]
+                (db/exec! conn [sql team-id]))
+
+
+        fonts (db/query conn :team-font-variant
+                        {:team-id team-id})
+
+        index (as-> {team-id (uuid/next)} index
+                (reduce index-row index projs)
+                (reduce index-row index files)
+                (reduce index-row index fonts))
+
+        team  (db/get-by-id conn :team team-id)
+        team  (cond-> team
+                (string? name)
+                (assoc :name name)
+
+                :always
+                (update :id lookup-index index))]
+
+    ;; FIXME: disallow clone default team
+
+    ;; Create the new team in the database
+    (db/insert! conn :team team)
+
+    ;; Duplicate team <-> profile relations
+    (doseq [params trels]
+      (let [params (-> params
+                       (assoc :id (uuid/next))
+                       (update :team-id lookup-index index))]
+        (db/insert! conn :team-profile-rel params
+                    {::db/return-keys? false})))
+
+    ;; Duplucate team fonts
+    (doseq [font fonts]
+      (let [params (-> font
+                       (update :id lookup-index index)
+                       (update :team-id lookup-index index))]
+        (db/insert! conn :team-font-variant params
+                    {::db/return-keys? false})))
+
+    ;; Create all the projects in the database
+    (doseq [project projs]
+      (let [project (-> project
+                        (update :id lookup-index index)
+                        (update :team-id lookup-index index))]
+        (teams/create-project conn project)
+
+        ;; The project profile creation is optional, so when no profile is
+        ;; present (when this function is called from profile less
+        ;; environment: SREPL) we just omit the creation of the relation
+        (when (uuid? profile-id)
+          (teams/create-project-role conn profile-id (:id project) :owner))))
+
+    ;; Duplicate project <-> profile relations
+    (doseq [params prels]
+      (let [params (-> params
+                       (assoc :id (uuid/next))
+                       (update :project-id lookup-index index))]
+        (db/insert! conn :project-profile-rel params)))
+
+    (doseq [file-id (map :id files)]
+      (let [params (-> params
+                       (dissoc :name)
+                       (assoc :index index)
+                       (assoc :file-id file-id)
+                       (assoc ::reset-shared-flag? false))]
+        (duplicate-file cfg params)))
+
+    team))
+
 ;; --- COMMAND: Move file
 
 (def sql:get-files

backend/src/app/srepl/main.clj

@@ -23,6 +23,7 @@
    [app.msgbus :as mbus]
    [app.rpc.commands.auth :as auth]
    [app.rpc.commands.files-snapshot :as fsnap]
+   [app.rpc.commands.management :as mgmt]
    [app.rpc.commands.profile :as profile]
    [app.srepl.cli :as cli]
    [app.srepl.helpers :as h]
@@ -332,3 +333,13 @@
          (filter some?)
          (into #{})
          (run! send))))
+
+
+(defn duplicate-team
+  [system team-id & {:keys [name]}]
+  (let [team-id (if (string? team-id) (parse-uuid team-id) team-id)
+        name    (or name (fn [prev-name]
+                           (str/ffmt "Cloned: % (%)" prev-name (dt/format-instant (dt/now)))))]
+    (db/tx-run! system (fn [cfg]
+                         (db/exec-one! cfg ["SET CONSTRAINTS ALL DEFERRED"])
+                         (mgmt/duplicate-team cfg :team-id team-id :name name)))))

backend/src/app/util/time.clj

@@ -209,9 +209,16 @@
   ([v] (.format DateTimeFormatter/ISO_INSTANT ^Instant v))
   ([v fmt]
    (case fmt
-     :iso (.format DateTimeFormatter/ISO_INSTANT ^Instant v)
+     :iso
-     :rfc1123 (.format DateTimeFormatter/RFC_1123_DATE_TIME
+     (.format DateTimeFormatter/ISO_INSTANT ^Instant v)
-                       ^ZonedDateTime (instant->zoned-date-time v)))))
+
+     :iso-local-time
+     (.format DateTimeFormatter/ISO_LOCAL_TIME
+              ^ZonedDateTime (instant->zoned-date-time v))
+
+     :rfc1123
+     (.format DateTimeFormatter/RFC_1123_DATE_TIME
+              ^ZonedDateTime (instant->zoned-date-time v)))))
 
 (defmethod print-method Instant
   [mv ^java.io.Writer writer]