use R2 for both graph upload/download

src/main/frontend/handler/db_based/db_sync.cljs

@@ -30,7 +30,60 @@
   (or config/db-sync-http-base
       (ws->http-base config/db-sync-ws-url)))
 
-(def ^:private snapshot-rows-limit 2000)
+(def ^:private snapshot-text-decoder (js/TextDecoder.))
+
+(defn- ->uint8 [data]
+  (cond
+    (instance? js/Uint8Array data) data
+    (instance? js/ArrayBuffer data) (js/Uint8Array. data)
+    (string? data) (.encode (js/TextEncoder.) data)
+    :else (js/Uint8Array. data)))
+
+(defn- decode-snapshot-rows [bytes]
+  (sqlite-util/read-transit-str (.decode snapshot-text-decoder (->uint8 bytes))))
+
+(defn- frame-len [^js data offset]
+  (let [view (js/DataView. (.-buffer data) offset 4)]
+    (.getUint32 view 0 false)))
+
+(defn- concat-bytes
+  [^js a ^js b]
+  (cond
+    (nil? a) b
+    (nil? b) a
+    :else
+    (let [out (js/Uint8Array. (+ (.-byteLength a) (.-byteLength b)))]
+      (.set out a 0)
+      (.set out b (.-byteLength a))
+      out)))
+
+(defn- parse-framed-chunk
+  [buffer chunk]
+  (let [data (concat-bytes buffer chunk)
+        total (.-byteLength data)]
+    (loop [offset 0
+           rows []]
+      (if (< (- total offset) 4)
+        {:rows rows
+         :buffer (when (< offset total)
+                   (.slice data offset total))}
+        (let [len (frame-len data offset)
+              next-offset (+ offset 4 len)]
+          (if (<= next-offset total)
+            (let [payload (.slice data (+ offset 4) next-offset)
+                  decoded (decode-snapshot-rows payload)]
+              (recur next-offset (into rows decoded)))
+            {:rows rows
+             :buffer (.slice data offset total)}))))))
+
+(defn- finalize-framed-buffer
+  [buffer]
+  (if (or (nil? buffer) (zero? (.-byteLength buffer)))
+    []
+    (let [{:keys [rows buffer]} (parse-framed-chunk nil buffer)]
+      (if (and (seq rows) (or (nil? buffer) (zero? (.-byteLength buffer))))
+        rows
+        (throw (ex-info "incomplete framed buffer" {:buffer buffer :rows rows}))))))
 
 (defn- auth-headers []
   (when-let [token (state/get-auth-id-token)]
@@ -176,31 +229,57 @@
   (state/set-state! :rtc/downloading-graph-uuid graph-uuid)
   (let [base (http-base)]
     (-> (if (and graph-uuid base)
-          (p/let [_ (js/Promise. user-handler/task--ensure-id&access-token)
-                  graph (str config/db-version-prefix graph-name)]
-            (p/loop [after -1           ; root addr is 0
-                     first-batch? true]
-              (p/let [pull-resp (fetch-json (str base "/sync/" graph-uuid "/pull")
-                                            {:method "GET"}
-                                            {:response-schema :sync/pull})
-                      remote-tx (:t pull-resp)
-                      _ (when-not (integer? remote-tx)
-                          (throw (ex-info "non-integer remote-tx when downloading graph"
-                                          {:graph graph-name
-                                           :remote-tx remote-tx})))
-                      resp (fetch-json (str base "/sync/" graph-uuid "/snapshot/rows"
-                                            "?after=" after "&limit=" snapshot-rows-limit)
-                                       {:method "GET"}
-                                       {:response-schema :sync/snapshot-rows})
-                      rows (:rows resp)
-                      done? (true? (:done resp))
-                      last-addr (or (:last-addr resp) after)]
-                (p/do!
-                 (state/<invoke-db-worker :thread-api/db-sync-import-kvs-rows
-                                          graph rows first-batch?)
-                 (if done?
-                   (state/<invoke-db-worker :thread-api/db-sync-finalize-kvs-import graph remote-tx)
-                   (p/recur last-addr false))))))
+          (let [download-url* (atom nil)]
+            (-> (p/let [_ (js/Promise. user-handler/task--ensure-id&access-token)
+                        graph (str config/db-version-prefix graph-name)
+                        pull-resp (fetch-json (str base "/sync/" graph-uuid "/pull")
+                                              {:method "GET"}
+                                              {:response-schema :sync/pull})
+                        remote-tx (:t pull-resp)
+                        _ (when-not (integer? remote-tx)
+                            (throw (ex-info "non-integer remote-tx when downloading graph"
+                                            {:graph graph-name
+                                             :remote-tx remote-tx})))
+                        download-resp (fetch-json (str base "/sync/" graph-uuid "/snapshot/download")
+                                                  {:method "GET"}
+                                                  {:response-schema :sync/snapshot-download})
+                        download-url (:url download-resp)
+                        _ (reset! download-url* download-url)
+                        _ (when-not (string? download-url)
+                            (throw (ex-info "missing snapshot download url"
+                                            {:graph graph-name
+                                             :response download-resp})))
+                        resp (js/fetch download-url (clj->js (with-auth-headers {:method "GET"})))]
+                  (when-not (.-ok resp)
+                    (throw (ex-info "snapshot download failed"
+                                    {:graph graph-name
+                                     :status (.-status resp)})))
+                  (when-not (.-body resp)
+                    (throw (ex-info "snapshot download missing body"
+                                    {:graph graph-name})))
+                  (p/let [reader (.getReader (.-body resp))]
+                    (p/loop [buffer nil
+                             total 0
+                             total-rows []]
+                      (p/let [chunk (.read reader)]
+                        (if (.-done chunk)
+                          (let [rows (finalize-framed-buffer buffer)
+                                total' (+ total (count rows))
+                                total-rows' (into total-rows rows)]
+                            (when (seq total-rows')
+                              (p/do!
+                               (state/<invoke-db-worker :thread-api/db-sync-import-kvs-rows
+                                                        graph total-rows' true)
+                               (state/<invoke-db-worker :thread-api/db-sync-finalize-kvs-import graph remote-tx)))
+                            total')
+                          (let [value (.-value chunk)
+                                {:keys [rows buffer]} (parse-framed-chunk buffer value)
+                                total' (+ total (count rows))]
+                            (p/recur buffer total' (into total-rows rows))))))))
+                (p/finally
+                  (fn []
+                    (when-let [download-url @download-url*]
+                      (js/fetch download-url (clj->js (with-auth-headers {:method "DELETE"}))))))))
           (p/rejected (ex-info "db-sync missing graph info"
                                {:type :db-sync/invalid-graph
                                 :graph-uuid graph-uuid

src/main/frontend/worker/db_sync.cljs

@@ -129,6 +129,9 @@
 
 (def ^:private max-asset-size (* 100 1024 1024))
 (def ^:private upload-kvs-batch-size 2000)
+(def ^:private snapshot-content-type "application/transit+json")
+(def ^:private snapshot-content-encoding "gzip")
+(def ^:private snapshot-text-encoder (js/TextEncoder.))
 (def ^:private reconnect-base-delay-ms 1000)
 (def ^:private reconnect-max-delay-ms 30000)
 (def ^:private reconnect-jitter-ms 250)
@@ -996,43 +999,85 @@
 (defn- normalize-snapshot-rows [rows]
   (mapv (fn [row] (vec row)) (array-seq rows)))
 
+(defn- encode-snapshot-rows [rows]
+  (.encode snapshot-text-encoder (sqlite-util/write-transit-str rows)))
+
+(defn- frame-bytes [^js bytes]
+  (let [len (.-byteLength bytes)
+        out (js/Uint8Array. (+ 4 len))
+        view (js/DataView. (.-buffer out))]
+    (.setUint32 view 0 len false)
+    (.set out bytes 4)
+    out))
+
+(defn- snapshot-upload-stream [db]
+  (let [state (volatile! {:after -1 :done? false})]
+    (js/ReadableStream.
+     #js {:pull (fn [controller]
+                  (p/let [{:keys [after done?]} @state]
+                    (if done?
+                      (.close controller)
+                      (let [rows (fetch-kvs-rows db after upload-kvs-batch-size)]
+                        (if (empty? rows)
+                          (.close controller)
+                          (let [rows (normalize-snapshot-rows rows)
+                                last-addr (apply max (map first rows))
+                                done? (< (count rows) upload-kvs-batch-size)
+                                payload (encode-snapshot-rows rows)
+                                framed (frame-bytes payload)]
+                            (.enqueue controller framed)
+                            (vswap! state assoc :after last-addr :done? done?)))))))})))
+
+(defn- maybe-compress-stream [stream]
+  (if (exists? js/CompressionStream)
+    (.pipeThrough stream (js/CompressionStream. "gzip"))
+    stream))
+
+(defn- should-buffer-snapshot-upload?
+  [base]
+  (when (string? base)
+    (try
+      (let [url (js/URL. base)
+            host (.-hostname url)]
+        (and (= "http:" (.-protocol url))
+             (contains? #{"localhost" "127.0.0.1"} host)))
+      (catch :default _
+        false))))
+
+(defn- <buffer-stream
+  [stream]
+  (p/let [resp (js/Response. stream)
+          buf (.arrayBuffer resp)]
+    buf))
+
 (defn upload-graph!
   [repo]
   (let [base (http-base-url)
         graph-id (get-graph-id repo)]
-    (if-not (and (seq base) (seq graph-id))
-      (p/rejected (ex-info "db-sync missing upload info"
-                           {:repo repo :base base :graph-id graph-id}))
+    (if (and (seq base) (seq graph-id))
       (if-let [db (worker-state/get-sqlite-conn repo :db)]
         (do
           (ensure-client-graph-uuid! repo graph-id)
-          (p/loop [last-addr -1
-                   first-batch? true]
-            (let [rows (fetch-kvs-rows db last-addr upload-kvs-batch-size)]
-              (if (empty? rows)
-                (let [body (coerce-http-request :sync/snapshot-import {:reset false :rows []})]
-                  (if (nil? body)
-                    (p/rejected (ex-info "db-sync invalid snapshot body"
-                                         {:repo repo :graph-id graph-id}))
-                    (p/let [_ (fetch-json (str base "/sync/" graph-id "/snapshot/import")
-                                          {:method "POST"
-                                           :headers {"content-type" "application/json"}
-                                           :body (js/JSON.stringify (clj->js body))}
-                                          {:response-schema :sync/snapshot-import})]
-                      (client-op/add-all-exists-asset-as-ops repo)
-                      {:graph-id graph-id})))
-                (let [max-addr (apply max (map first rows))
-                      rows (normalize-snapshot-rows rows)
-                      body (coerce-http-request :sync/snapshot-import {:reset first-batch?
-                                                                       :rows rows})]
-                  (if (nil? body)
-                    (p/rejected (ex-info "db-sync invalid snapshot body"
-                                         {:repo repo :graph-id graph-id}))
-                    (p/let [_ (fetch-json (str base "/sync/" graph-id "/snapshot/import")
-                                          {:method "POST"
-                                           :headers {"content-type" "application/json"}
-                                           :body (js/JSON.stringify (clj->js body))}
-                                          {:response-schema :sync/snapshot-import})]
-                      (p/recur max-addr false))))))))
+          (let [stream (snapshot-upload-stream db)
+                use-compression? (exists? js/CompressionStream)
+                body (if use-compression? (maybe-compress-stream stream) stream)
+                headers (cond-> {"content-type" snapshot-content-type}
+                          use-compression? (assoc "content-encoding" snapshot-content-encoding))
+                upload-url (str base "/sync/" graph-id "/snapshot/upload?reset=true")
+                upload-opts {:method "POST"
+                             :headers headers
+                             :body body
+                             :duplex "half"}
+                fallback? (should-buffer-snapshot-upload? base)
+                do-upload (fn [opts]
+                            (fetch-json upload-url opts {:response-schema :sync/snapshot-upload}))]
+            (p/let [_ (if fallback?
+                        (p/let [buf (<buffer-stream body)]
+                          (do-upload (assoc upload-opts :body buf)))
+                        (do-upload upload-opts))]
+              (client-op/add-all-exists-asset-as-ops repo)
+              {:graph-id graph-id})))
         (p/rejected (ex-info "db-sync missing sqlite db"
-                             {:repo repo :graph-id graph-id}))))))
+                             {:repo repo :graph-id graph-id})))
+      (p/rejected (ex-info "db-sync missing upload info"
+                           {:repo repo :base base :graph-id graph-id})))))

src/main/frontend/worker/db_worker.cljs

@@ -124,7 +124,7 @@
 
 (defn- rows->sqlite-binds
   [rows]
-  (mapv (fn [{:keys [addr content addresses]}]
+  (mapv (fn [[addr content addresses]]
           #js {:$addr addr
                :$content content
                :$addresses addresses})