✨ Add automatic v2 migration process on startup

backend/src/app/config.clj

@@ -338,7 +338,8 @@
    :enable-backend-openapi-doc
    :enable-backend-worker
    :enable-secure-session-cookies
-   :enable-email-verification])
+   :enable-email-verification
+   :enable-v2-migration])
 
 (defn- parse-flags
   [config]

backend/src/app/main.clj

@@ -24,6 +24,7 @@
    [app.loggers.webhooks :as-alias webhooks]
    [app.metrics :as-alias mtx]
    [app.metrics.definition :as-alias mdef]
+   [app.migrations.v2 :as migrations.v2]
    [app.msgbus :as-alias mbus]
    [app.redis :as-alias rds]
    [app.rpc :as-alias rpc]
@@ -582,6 +583,11 @@
         (nrepl/start-server :bind "0.0.0.0" :port 6064 :handler cider-nrepl-handler))
 
       (start)
+
+      (when (contains? cf/flags :v2-migration)
+        (px/sleep 5000)
+        (migrations.v2/migrate app.main/system))
+
       (deref p))
     (catch Throwable cause
       (binding [*out* *err*]

backend/src/app/migrations/v2.clj

@@ -0,0 +1,104 @@
+;; 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 app.migrations.v2
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.db :as db]
+   [app.features.components-v2 :as feat]
+   [app.setup :as setup]
+   [app.util.time :as dt]))
+
+(def ^:private sql:get-teams
+  "SELECT id, features,
+          row_number() OVER (ORDER BY created_at DESC) AS rown
+    FROM team
+   WHERE deleted_at IS NULL
+     AND (features <@ '{components/v2}' OR features IS NULL)
+   ORDER BY created_at DESC")
+
+(defn- get-teams
+  [conn]
+  (->> (db/cursor conn [sql:get-teams] {:chunk-size 1})
+       (map feat/decode-row)))
+
+(defn- migrate-teams
+  [{:keys [::db/conn] :as system}]
+  ;; Allow long running transaction for this connection
+  (db/exec-one! conn ["SET LOCAL idle_in_transaction_session_timeout = 0"])
+
+  ;; Do not allow other migration running in the same time
+  (db/xact-lock! conn 0)
+
+  ;; Run teams migration
+  (run! (fn [{:keys [id rown]}]
+          (try
+            (-> (assoc system ::db/rollback true)
+                (feat/migrate-team! id
+                                    :rown rown
+                                    :label "v2-migration"
+                                    :validate? false
+                                    :skip-on-graphics-error? true))
+            (catch Throwable _
+              (swap! feat/*stats* update :errors (fnil inc 0))
+              (l/wrn :hint "error on migrating team (skiping)"))))
+        (get-teams conn))
+
+  (setup/set-prop! system :v2-migrated true))
+
+(defn migrate
+  [system]
+  (let [tpoint    (dt/tpoint)
+        stats     (atom {})
+        migrated? (setup/get-prop system :v2-migrated false)]
+
+    (when-not migrated?
+      (l/inf :hint "v2 migration started"
+             :files (:processed-files stats))
+      (try
+        (binding [feat/*stats* stats]
+          (db/tx-run! system migrate-teams))
+
+        (let [stats   (deref stats)
+              elapsed (dt/format-duration (tpoint))]
+          (l/inf :hint "v2 migration finished"
+                 :files (:processed-files stats)
+                 :teams (:processed-teams stats)
+                 :errors (:errors stats)
+                 :elapsed elapsed))
+
+        (catch Throwable cause
+          (l/err :hint "error on aplying v2 migration" :cause cause))))))
+
+(def ^:private required-services
+  [[:app.main/assets :app.storage.s3/backend]
+   [:app.main/assets :app.storage.fs/backend]
+   :app.storage/storage
+   :app.db/pool
+   :app.setup/props
+   :app.svgo/optimizer
+   :app.metrics/metrics
+   :app.migrations/migrations
+   :app.http.client/client])
+
+(defn -main
+  [& _args]
+  (try
+    (let [config-var (requiring-resolve 'app.main/system-config)
+          start-var  (requiring-resolve 'app.main/start-custom)
+          stop-var   (requiring-resolve 'app.main/stop)
+          system-var (requiring-resolve 'app.main/system)
+          config     (select-keys @config-var required-services)]
+
+      (start-var config)
+      (migrate @system-var)
+      (stop-var)
+      (System/exit 0))
+    (catch Throwable cause
+      (ex/print-throwable cause)
+      (flush)
+      (System/exit -1))))

backend/src/app/setup.clj

@@ -7,6 +7,7 @@
 (ns app.setup
   "Initial data setup of instance."
   (:require
+   [app.common.data :as d]
    [app.common.logging :as l]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
@@ -25,7 +26,7 @@
       (bc/bytes->b64u)
       (bc/bytes->str)))
 
-(defn- retrieve-all
+(defn- get-all-props
   [conn]
   (->> (db/query conn :server-prop {:preload true})
        (filter #(not= "secret-key" (:id %)))
@@ -50,6 +51,28 @@
                       :cause cause))))
         instance-id)))
 
+
+(def sql:add-prop
+  "INSERT INTO server_prop (id, content, preload)
+   VALUES (?, ?, ?)
+       ON CONFLICT (id)
+       DO UPDATE SET content=?, preload=?")
+
+(defn get-prop
+  ([system prop] (get-prop system prop nil))
+  ([system prop default]
+   (let [prop (d/name prop)]
+     (db/run! system (fn [{:keys [::db/conn]}]
+                       (or (db/get* conn :server-prop {:id prop})
+                           default))))))
+
+(defn set-prop!
+  [system prop value]
+  (let [value (db/tjson value)
+        prop  (d/name prop)]
+    (db/run! system (fn [{:keys [::db/conn]}]
+                      (db/exec-one! conn [sql:add-prop prop value false value false])))))
+
 (s/def ::key ::us/string)
 (s/def ::props (s/map-of ::us/keyword some?))
 
@@ -67,7 +90,7 @@
                          "PENPOT_SECRET_KEY environment variable")))
 
     (let [secret (or key (generate-random-key))]
-      (-> (retrieve-all conn)
+      (-> (get-all-props conn)
           (assoc :secret-key secret)
           (assoc :tokens-key (keys/derive secret :salt "tokens"))
           (update :instance-id handle-instance-id conn (db/read-only? pool))))))

backend/src/app/srepl/components_v2.clj

@@ -6,7 +6,6 @@
 
 (ns app.srepl.components-v2
   (:require
-   [app.common.exceptions :as ex]
    [app.common.fressian :as fres]
    [app.common.logging :as l]
    [app.db :as db]
@@ -305,79 +304,3 @@
         (let [elapsed (dt/format-duration (tpoint))]
           (l/dbg :hint "populate:end"
                  :elapsed elapsed))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; MAIN (SCRIPT ENTRY POINT)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def ^:private required-services
-  [[:app.main/assets :app.storage.s3/backend]
-   [:app.main/assets :app.storage.fs/backend]
-   :app.storage/storage
-   :app.db/pool
-   :app.setup/props
-   :app.svgo/optimizer
-   :app.metrics/metrics
-   :app.migrations/migrations
-   :app.http.client/client])
-
-(def ^:private sql:get-teams-by-created-at
-  "SELECT id, features,
-          row_number() OVER (ORDER BY created_at DESC) AS rown
-    FROM team
-   WHERE deleted_at IS NULL
-   ORDER BY created_at DESC")
-
-(defn- get-teams
-  [conn]
-  (->> (db/cursor conn [sql:get-teams-by-created-at] {:chunk-size 1})
-       (map feat/decode-row)
-       (remove (fn [{:keys [features]}]
-                 (contains? features "components/v2")))))
-
-(defn- migrate-teams
-  [{:keys [::db/conn] :as system}]
-  (db/exec-one! conn ["SET LOCAL idle_in_transaction_session_timeout = 0"])
-  (run! (fn [{:keys [id rown]}]
-          (try
-            (-> (assoc system ::db/rollback true)
-                (feat/migrate-team! id
-                                    :rown rown
-                                    :label "migration-v2"
-                                    :validate? false
-                                    :skip-on-graphics-error? true))
-            (catch Throwable _
-              (swap! feat/*stats* update :errors (fnil inc 0))
-              (l/wrn :hint "error on migrating team (skiping)"))))
-        (get-teams conn)))
-
-(defn run-migration
-  []
-  (let [config (select-keys main/system-config required-services)
-        tpoint (dt/tpoint)
-        stats  (atom {})]
-    (main/start-custom config)
-
-    (binding [feat/*stats* stats]
-      (db/tx-run! main/system migrate-teams))
-
-    (let [stats   (deref stats)
-          elapsed (dt/format-duration (tpoint))]
-      (l/inf :hint "migration finished"
-             :files (:processed-files stats)
-             :teams (:processed-teams stats)
-             :errors (:errors stats)
-             :elapsed elapsed))
-
-    (main/stop)))
-
-(defn -main
-  [& _args]
-  (try
-    (run-migration)
-    (System/exit 0)
-
-    (catch Throwable cause
-      (ex/print-throwable cause)
-      (flush)
-      (System/exit -1))))