✨ Read files info from manifest

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

@@ -11,6 +11,7 @@
    [app.common.pages.migrations :as pmg]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
+
    [app.db :as db]
    [app.rpc.permissions :as perms]
    [app.rpc.queries.files :as files]
@@ -18,6 +19,7 @@
    [app.util.blob :as blob]
    [app.util.services :as sv]
    [app.util.time :as dt]
+
    [clojure.spec.alpha :as s]))
 
 ;; --- Helpers & Specs
@@ -43,6 +45,7 @@
     (proj/check-edition-permissions! conn profile-id project-id)
     (create-file conn params)))
 
+
 (defn create-file-role
   [conn {:keys [file-id profile-id role]}]
   (let [params {:file-id file-id
@@ -51,8 +54,9 @@
          (db/insert! conn :file-profile-rel))))
 
 (defn create-file
-  [conn {:keys [id name project-id is-shared data]
+  [conn {:keys [id name project-id is-shared data deleted-at]
-         :or {is-shared false}
+         :or {is-shared false
+              deleted-at nil}
          :as params}]
   (let [id   (or id (:id data) (uuid/next))
         data (or data (cp/make-file-data id))
@@ -61,7 +65,8 @@
                           :project-id project-id
                           :name name
                           :is-shared is-shared
-                          :data (blob/encode data)})]
+                          :data (blob/encode data)
+                          :deleted-at deleted-at})]
     (->> (assoc params :file-id id :role :owner)
          (create-file-role conn))
     (assoc file :data data)))
@@ -118,6 +123,7 @@
   [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id id)
+
     (mark-file-deleted conn params)))
 
 (defn mark-file-deleted
@@ -268,7 +274,8 @@
   [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (db/xact-lock! conn id)
-    (let [{:keys [id] :as file} (db/get-by-id conn :file id {:for-key-share true})]
+    (let [{:keys [id] :as file} (db/get-by-id conn :file id {:for-key-share true
+                                                             :uncheked true})]
       (files/check-edition-permissions! conn profile-id id)
       (update-file (assoc cfg :conn  conn)
                    (assoc params :file file)))))
@@ -381,3 +388,24 @@
   [conn project-id]
   (:team-id (db/get-by-id conn :project project-id {:columns [:team-id]})))
 
+
+;; TEMPORARY FILE CREATION
+
+(s/def ::create-temp-file ::create-file)
+
+(sv/defmethod ::create-temp-file
+  [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
+  (db/with-atomic [conn pool]
+    (proj/check-edition-permissions! conn profile-id project-id)
+    (create-file conn (assoc params :deleted-at (dt/in-future {:days 1})))))
+
+(s/def ::make-permanent
+  (s/keys :req-un [::id ::profile-id]))
+
+(sv/defmethod ::make-permanent
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  (db/with-atomic [conn pool]
+    (files/check-edition-permissions! conn profile-id id)
+    (db/update! conn :file
+                {:deleted-at nil}
+                {:id id})))

frontend/src/app/util/zip.cljs

@@ -10,7 +10,8 @@
    ["jszip" :as zip]
    [app.common.data :as d]
    [beicon.core :as rx]
-   [promesa.core :as p]))
+   [promesa.core :as p]
+   [app.util.http :as http]))
 
 (defn compress-files
   [files]
@@ -21,32 +22,44 @@
       (->> (.generateAsync zobj #js {:type "blob"})
            (rx/from)))))
 
+(defn load-from-url
+  "Loads the data from a blob url"
+  [url]
+  (->> (http/send!
+        {:uri url
+         :response-type :blob
+         :method :get})
+       (rx/map :body)
+       (rx/flat-map zip/loadAsync)))
+
+(defn- process-file [entry path]
+  (cond
+    (nil? entry)
+    (p/rejected "No file found")
+
+    (.-dir entry)
+    (p/resolved {:dir path})
+
+    :else
+    (-> (.async entry "text")
+        (p/then #(hash-map :path path :content %)))))
+
+(defn get-file
+  "Gets a single file from the zip archive"
+  [zip path]
+  (-> (.file zip path)
+      (process-file path)
+      (rx/from)))
+
 (defn extract-files
   "Creates a stream that will emit values for every file in the zip"
-  [file]
+  [zip]
-  (rx/create
+  (let [promises (atom [])
-   (fn [subs]
+        get-file
-     (let [process-entry
+        (fn [path entry]
-           (fn [path entry]
+          (let [current (process-file entry path)]
-             (if (.-dir entry)
+            (swap! promises conj current)))]
-               (rx/push! subs {:dir path})
+    (.forEach zip get-file)
-               (p/then
-                (.async entry "text")
-                (fn [content]
-                  (rx/push! subs
-                            {:path path
-                             :content content})))))]
 
-       (p/let [response (js/fetch file)
+    (->> (rx/from (p/all @promises))
-               data     (.blob response)
+         (rx/flat-map identity))))
-               content  (zip/loadAsync data)]
-
-         (let [promises (atom [])]
-           (.forEach content
-                     (fn [path entry]
-                       (let [current (process-entry path entry)]
-                         (swap! promises conj current))))
-
-           (p/then (p/all @promises)
-                   #(rx/end! subs))))
-       nil))))

frontend/src/app/worker/export.cljs

@@ -10,16 +10,39 @@
    [app.main.repo :as rp]
    [app.util.dom :as dom]
    [app.util.zip :as uz]
+   [app.util.json :as json]
    [app.worker.impl :as impl]
    [beicon.core :as rx]))
 
+(defn create-manifest
+  "Creates a manifest entry for the given files"
+  [team-id files]
+  (letfn [(format-page [manifest page]
+            (-> manifest
+                (assoc (str (:id page))
+                       {:name (:name page)})))
+
+          (format-file [manifest file]
+            (let [name  (:name file)
+                  pages (->> (get-in file [:data :pages]) (mapv str))
+                  index (->> (get-in file [:data :pages-index]) (vals)
+                             (reduce format-page {}))]
+              (-> manifest
+                  (assoc (str (:id file))
+                         {:name       name
+                          :pages      pages
+                          :pagesIndex index}))))]
+    (let [manifest {:teamId (str team-id)
+                    :files (->> (vals files) (reduce format-file {}))}]
+      (json/encode manifest))))
+
 (defn get-page-data
-  [{file-name :file-name {:keys [id name] :as data} :data}]
+  [{file-id :file-id {:keys [id name] :as data} :data}]
   (->> (r/render-page data)
        (rx/map (fn [markup]
                  {:id id
                   :name name
-                  :file-name file-name
+                  :file-id file-id
                   :markup markup}))))
 
 (defn process-pages [file]
@@ -27,30 +50,48 @@
         pages-index (get-in file [:data :pages-index])]
     (->> pages
          (map #(hash-map
-                :file-name (:name file)
+                :file-id (:id file)
                 :data (get pages-index %))))))
 
 (defn collect-page
-  [coll {:keys [id file-name name markup] :as page}]
+  [{:keys [id file-id markup] :as page}]
-  (conj coll [(str file-name "/" name ".svg") markup]))
+  [(str file-id "/" id ".svg") markup])
 
 (defmethod impl/handler :export-file
-  [{:keys [team-id files] :as message}]
+  [{:keys [team-id project-id files] :as message}]
 
-  (let [render-stream
+  (let [files-ids (->> files (mapv :id))
-        (->> (rx/from (->> files (mapv :id)))
+
+        files-stream
+        (->> (rx/from files-ids)
              (rx/merge-map #(rp/query :file {:id %}))
+             (rx/reduce #(assoc %1 (:id %2) %2) {})
+             (rx/share))
+
+        manifest-stream
+        (->> files-stream
+             (rx/map #(create-manifest team-id %))
+             (rx/map #(vector "manifest.json" %)))
+
+        render-stream
+        (->> files-stream
+             (rx/flat-map vals)
              (rx/flat-map process-pages)
              (rx/observe-on :async)
              (rx/flat-map get-page-data)
-             (rx/share))]
+             (rx/share))
+
+        pages-stream
+        (->> render-stream
+             (rx/map collect-page))]
 
     (rx/merge
      (->> render-stream
           (rx/map #(hash-map :type :progress
                              :data (str "Render " (:file-name %) " - " (:name %)))))
-     (->> render-stream
+     (->> (rx/merge pages-stream
-          (rx/reduce collect-page [])
+                    manifest-stream)
+          (rx/reduce conj [])
           (rx/flat-map uz/compress-files)
           (rx/map #(hash-map :type :finish
                              :data (dom/create-uri %)))))))

frontend/src/app/worker/import.cljs

@@ -13,6 +13,7 @@
    [app.main.repo :as rp]
    [app.util.http :as http]
    [app.util.import.parser :as cip]
+   [app.util.json :as json]
    [app.util.zip :as uz]
    [app.worker.impl :as impl]
    [beicon.core :as rx]
@@ -27,7 +28,7 @@
   [project-id name]
   (let [file-id (uuid/next)]
     (rp/mutation
-     :create-file
+     :create-temp-file
      {:id file-id
       :name name
       :project-id project-id
@@ -44,17 +45,20 @@
              (partition change-batch-size change-batch-size nil)
              (mapv vec))]
 
-    (->> (rx/from changes-batches)
+    (rx/concat
-         (rx/merge-map
+     (->> (rx/from changes-batches)
-          (fn [cur-changes-batch]
+          (rx/mapcat
-            (rp/mutation
+           (fn [cur-changes-batch]
-             :update-file
+             (rp/mutation
-             {:id file-id
+              :update-file
-              :session-id session-id
+              {:id file-id
-              :revn @revn
+               :session-id session-id
-              :changes cur-changes-batch})))
+               :revn @revn
+               :changes cur-changes-batch})))
 
-         (rx/tap #(reset! revn (:revn %))))))
+          (rx/tap #(reset! revn (:revn %))))
+
+     (rp/mutation :make-permanent {:id (:id file)}))))
 
 (defn upload-media-files
   "Upload a image to the backend and returns its id"
@@ -72,17 +76,6 @@
            :is-local true}))
        (rx/flat-map #(rp/mutation! :upload-file-media-object %))))
 
-(defn parse-file-name
-  [dir]
-  (if (str/ends-with? dir "/")
-    (subs dir 0 (dec (count dir)))
-    dir))
-
-(defn parse-page-name
-  [path]
-  (let [[file page] (str/split path "/")]
-    (str/replace page ".svg" "")))
-
 (defn add-shape-file
   [file node]
 
@@ -137,49 +130,50 @@
     (rx/of node)))
 
 (defn import-page
-  [file {:keys [path content]}]
+  [file [page-name content]]
-  (let [page-name (parse-page-name path)]
+  (if (cip/valid? content)
-    (if (cip/valid? content)
+    (let [nodes (->> content cip/node-seq)
-      (let [nodes (->> content cip/node-seq)
+          file-id (:id file)]
-            file-id (:id file)]
+      (->> (rx/from nodes)
-        (->> (rx/from nodes)
+           (rx/filter cip/shape?)
-             (rx/filter cip/shape?)
+           (rx/mapcat (partial resolve-images file-id))
-             (rx/mapcat (partial resolve-images file-id))
+           (rx/reduce add-shape-file (fb/add-page file page-name))
-             (rx/reduce add-shape-file (fb/add-page file page-name))
+           (rx/map fb/close-page)))
-             (rx/map fb/close-page)))
+    (rx/empty)))
-      (rx/empty))))
+
+(defn get-page-path [dir-id id]
+  (str dir-id "/" id ".svg"))
+
+(defn process-page [file-id zip [page-id page-name]]
+  (->> (uz/get-file zip (get-page-path (d/name file-id) page-id))
+       (rx/map (comp tubax/xml->clj :content))
+       (rx/map #(vector page-name %))))
+
+(defn process-file
+  [file file-id file-desc zip]
+  (let [index (:pagesIndex file-desc)
+        pages (->> (:pages file-desc)
+                   (mapv #(vector % (get-in index [(keyword %) :name]))))]
+    (->> (rx/from pages)
+         (rx/flat-map #(process-page file-id zip %))
+         (merge-reduce import-page file)
+         (rx/flat-map send-changes)
+         (rx/ignore))))
 
 (defmethod impl/handler :import-file
   [{:keys [project-id files]}]
 
-  (let [extract-stream
+  (let [zip-str (->> (rx/from files)
-        (->> (rx/from files)
+                     (rx/flat-map uz/load-from-url)
-             (rx/merge-map uz/extract-files))
+                     (rx/share))]
 
-        dir-str
+    (->> zip-str
-        (->> extract-stream
+         (rx/flat-map #(uz/get-file % "manifest.json"))
-             (rx/filter #(contains? % :dir))
+         (rx/flat-map (comp :files json/decode :content))
-             (rx/map :dir))
+         (rx/with-latest-from zip-str)
-
+         (rx/flat-map
-        file-str
+          (fn [[[file-id file-desc] zip]]
-        (->> extract-stream
+            (->> (create-file project-id (:name file-desc))
-             (rx/filter #(not (contains? % :dir)))
+                 (rx/flat-map #(process-file % file-id file-desc zip))
-             (rx/map #(d/update-when % :content tubax/xml->clj)))]
+                 (rx/catch (fn [err]
-
+                             (.error js/console "ERROR" err (clj->js (.-data err)))))))))))
-    (->> dir-str
-         (rx/merge-map #(create-file project-id (parse-file-name %)))
-         (rx/merge-map
-          (fn [file]
-            (rx/concat
-             (->> file-str
-                  (rx/filter #(str/starts-with? (:path %) (:name file)))
-                  (merge-reduce import-page file)
-                  (rx/flat-map send-changes)
-                  (rx/catch (fn [err]
-                              (.error js/console "ERROR" err (clj->js (.-data err)))
-
-                              ;; We delete the file when there is an error
-                              (rp/mutation! :delete-file {:id (:id file)})))
-                  (rx/ignore))
-
-             (rx/of (select-keys file [:id :name]))))))))