nostr/more-speech
1
0
Fork 0
mirror of https://github.com/unclebob/more-speech.git synced 2024-09-30 10:30:56 +00:00
Code Issues Packages Projects Releases Wiki Activity

Migration 10 to XTDB

Browse Source
This commit is contained in:
Robert C. Martin 2023-02-02 10:03:15 -06:00
parent dae63cb63a
commit cb7eea5bda
4 changed files with 162 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
spec/more_speech/migrator_spec.clj
View File

@ -3,9 +3,23 @@
[more-speech.migrator :refer :all]
[more-speech.config :as config]
[clojure.java.io :as io]
[more-speech.user-configuration :as user-configuration]))
[more-speech.user-configuration :as user-configuration]
[more-speech.db.gateway :as gateway]
[more-speech.db.in-memory :as in-memory]))
(defn delete-dir
[& fs]
(when-let [f (first fs)]
(when (file-exists? f)
(if-let [cs (seq (.listFiles (io/file f)))]
(recur (concat cs fs))
(do
(io/delete-file f)
(recur (rest fs)))))))
(defn change-to-tmp-files []
(when (file-exists? "tmp")
(delete-dir "tmp"))
(reset! config/private-directory "tmp")
(reset! config/migration-filename "tmp/migration")
(reset! config/nicknames-filename "tmp/nicknames") ;grandfathered
@ -23,21 +37,8 @@
(prn 'changed-to-tmp)
)
(defn delete-all-files-in [dir]
(let [files (.listFiles (io/file dir))]
(doseq [file files]
(let [fname (str dir "/" (.getName file))]
(delete-file fname))))
)
(defn delete-all-tmp-files []
(delete-all-files-in "tmp/messages")
(delete-all-files-in "tmp"))
(defn revert-from-tmp []
(delete-all-tmp-files)
(delete-file "tmp")
(delete-dir "tmp")
(reset! config/private-directory "private")
(reset! config/migration-filename "private/migration")
(reset! config/nicknames-filename "private/nicknames") ;grandfathered
@ -53,10 +54,13 @@
(reset! config/contact-lists-filename "private/contact-lists")
)
(declare db)
(describe "The Migrator"
(with-stubs)
(before-all (change-to-tmp-files))
(after (delete-all-tmp-files))
(after (delete-dir "tmp")
(.mkdir (io/file "tmp")))
(after-all (revert-from-tmp))
(context "the migration framework"
@ -225,4 +229,75 @@
(migration-9-contact-lists)
(should (file-exists? @config/contact-lists-filename))
(should= {} (read-string (slurp @config/contact-lists-filename)))))
(context "migration 10 XTDB database"
(with db (in-memory/get-db))
(before-all (config/set-db! :in-memory))
(before (in-memory/clear-db @db))
(it "does not load profiles if no profile file is found"
(with-redefs [gateway/add-profile (stub :add-profile)]
(migration-10-load-profiles)
(should-not-have-invoked :add-profile)))
(it "loads profiles"
(spit @config/profiles-filename {1 {:name "user 1"}
2 {:name "user 2"}})
(migration-10-load-profiles)
(should= {:name "user 1"} (gateway/get-profile @db 1))
(should= {:name "user 2"} (gateway/get-profile @db 2))
(should-not (file-exists? @config/profiles-filename))
(should (file-exists? (str @config/profiles-filename ".migrated"))))
(it "does not load contacts if no contacts file is found"
(with-redefs [gateway/add-contacts (stub :add-contacts)]
(migration-10-load-contacts)
(should-not-have-invoked :add-contacts)))
(it "loads contacts"
(spit @config/contact-lists-filename
{1 [{:pubkey 99 :petname "pet-99"}
{:pubkey 98 :petname "pet-98"}]
2 [{:pubkey 97 :petname "pet-97"}
{:pubkey 96 :petname "pet-96"}]})
(migration-10-load-contacts)
(should= [{:pubkey 99 :petname "pet-99"}
{:pubkey 98 :petname "pet-98"}]
(gateway/get-contacts @db 1))
(should= [{:pubkey 97 :petname "pet-97"}
{:pubkey 96 :petname "pet-96"}]
(gateway/get-contacts @db 2))
(should-not (file-exists? @config/contact-lists-filename))
(should (file-exists? (str @config/contact-lists-filename ".migrated"))))
(it "does not load events if there are no event files"
(with-redefs [gateway/add-event (stub :add-event)]
(migration-10-load-events)
(should-not-have-invoked :add-event)))
(it "loads events from all matching event files"
(let [dir @config/messages-directory
f1 "/1-1jan23"
f2 "/2-2jan23"
path1 (str dir f1)
path2 (str dir f2)
renamed-dir (str @config/messages-directory ".migrated")]
(.mkdir (io/file "tmp/messages"))
(spit path1 [{:id 1 :content "c1"}
{:id 2 :content "c2"}])
(spit path2 [{:id 3 :content "c3"}
{:id 4 :content "c4"}])
(migration-10-load-events)
(should= {:id 1 :content "c1"} (gateway/get-event @db 1))
(should= {:id 2 :content "c2"} (gateway/get-event @db 2))
(should= {:id 3 :content "c3"} (gateway/get-event @db 3))
(should= {:id 4 :content "c4"} (gateway/get-event @db 4))
(should-not (file-exists? @config/messages-directory))
(should-not (file-exists? path1))
(should-not (file-exists? path2))
(should (file-exists? renamed-dir))
(should (file-exists? (str renamed-dir f1 ".migrated")))
(should (file-exists? (str renamed-dir f2 ".migrated")))
(prn 'got-here)))
)
)

2
src/more_speech/config.clj
View File

@ -47,7 +47,7 @@
;; https://daringfireball.net/2010/07/improved_regex_for_matching_urls
(def url-pattern #"(?i)\b(?:(?:[a-z][\w-]+:(?:/{1,3}|[a-z0-9%])|www\d{0,3}[.]|[a-z0-9.\-]+[.][a-z]{2,4}/)(?:[^\s()<>]+|\(?:(?:[^\s()<>]+|(?:\(?:[^\s()<>]+\)))*\))+(?:\(?:(?:[^\s()<>]+|(?:\(?:[^\s()<>]+\)))*\)|[^\s`!()\[\]{};:'\".,<>?«»“”‘’]))")
(def production-db :in-memory)
(def production-db :xtdb)
(def db-type (atom nil))
(defn set-db! [type] (reset! db-type type))

3
src/more_speech/core.clj
View File

@ -20,8 +20,7 @@
(config/test-run!))
(if (config/is-test-run?)
(config/set-db! :in-memory)
(config/set-db! config/production-db)
)
(config/set-db! config/production-db))
(migrator/migrate-to config/migration-level)
(prn 'main 'loading-configuration)
(data-storage/load-configuration)

70
src/more_speech/migrator.clj
View File

@ -8,7 +8,8 @@
[elliptic-signature :as ecc]
[event-handlers :as handlers]]
[more-speech.data-storage :as data-storage]
[more-speech.user-configuration :as user-configuration]))
[more-speech.user-configuration :as user-configuration]
[more-speech.db.gateway :as gateway]))
(defn file-exists? [fname]
(.exists (io/file fname)))
@ -20,6 +21,10 @@
(when (file-exists? fname)
(io/delete-file fname)))
(defn rename-file [fname to-fname]
(when (file-exists? fname)
(.renameTo (io/file fname) (io/file to-fname))))
;---The Migrations
(defn initial-migration []
@ -118,6 +123,66 @@
@config/contact-lists-filename {})
)
;--- Migration 10 XTDB database conversion
(defn migrate-id-map-file [filename add-f]
(when (file-exists? filename)
(let [id-map (read-string (slurp filename))]
(loop [ids (keys id-map)
n-vals 0]
(if (empty? ids)
(prn n-vals 'from filename 'added)
(let [id (first ids)
a-val (get id-map id)]
(when (zero? (rem n-vals 100))
(prn n-vals 'id-map 'added))
(add-f (config/get-db) id a-val)
(recur (rest ids) (inc n-vals)))))
(rename-file filename (str filename ".migrated"))))
)
(defn migration-10-load-profiles []
(migrate-id-map-file @config/profiles-filename gateway/add-profile))
(defn migration-10-load-contacts []
(migrate-id-map-file @config/contact-lists-filename gateway/add-contacts))
(defn is-message-file? [file-name]
(re-matches #"\d+\-\d+\w+\d+" file-name))
(defn load-event-file [file-name]
(loop [events (read-string (slurp file-name))]
(if (empty? events)
nil
(let [event (first events)
id (:id event)]
(gateway/add-event (config/get-db) id event)
(recur (rest events))))))
(defn migration-10-load-events []
(when (file-exists? @config/messages-directory)
(let [message-directory (io/file @config/messages-directory)
files (.listFiles message-directory)
file-names (for [file files] (.getName file))
file-names (filter is-message-file? file-names)]
(loop [file-names file-names]
(if (empty? file-names)
(println "Done loading event files.\n")
(let [file-name (first file-names)
file-path (str @config/messages-directory "/" file-name)]
(printf "Loading event file: %s\n" file-path)
(load-event-file file-path)
(rename-file file-path (str file-path ".migrated"))
(recur (rest file-names)))))
(rename-file @config/messages-directory (str @config/messages-directory ".migrated")))))
(defn migration-10-XTDB-converstion []
(migration-10-load-profiles)
(migration-10-load-contacts)
(migration-10-load-events))
;---------- The Migrations List -------
@ -130,6 +195,7 @@
7 migration-7-break-messages-into-daily-files
8 migration-8-user-configuration
9 migration-9-contact-lists
10 migration-10-XTDB-converstion
}))
;--------------------------------------
@ -166,3 +232,5 @@
(recur (rest levels))))))
(set-migration-level level))
(throw (Exception. (format "Missing migrations %s." (vec missing-levels)))))))