#!/usr/bin/env bb (require '[babashka.curl :as curl] '[babashka.fs :as fs] '[babashka.process :refer [shell]] '[cheshire.core :as json] '[clojure.string :as str]) ;; (def repo-details {:collection "com.whtwnd.blog.entry"}) (def collection-nsids {:ww "com.whtwnd.blog.entry" :m1 "dev.m1emi1em.blog.postRef"}) (def default-shell!!-args {:out :string}) (defn shell! "My guts tells me there's an easier way to wrap this involving :arglists metadata but I'm not entirely sure how that works so yolo" [cmd-or-opts & args] (let [defaults? (not (instance? clojure.lang.PersistentArrayMap cmd-or-opts)) opts (cond-> default-shell!!-args (not defaults?) (merge cmd-or-opts)) args (cond->> args defaults? (cons cmd-or-opts))] (:out (apply shell opts args)))) ;; goat helpers (defn goat-login "Username and password are picked up from the ATP_AUTH_USERNAME and ATP_AUTH_PASSWORD env vars" [] (shell! "goat account login")) (defn goat-ls-coll [repo collection] (->> (shell! "goat ls --collection" collection repo) str/split-lines (map #(->> (str/split % #"\t") rest (zipmap [:rkey :cid]))))) (defn goat-get-record [repo collection rkey] (do (println "Getting record " rkey " from collection " collection " in " repo) (if (nil? rkey) {} (-> (shell! "goat record get" (str "at://" repo "/" collection "/" rkey)) json/parse-string (update-keys keyword)) ))) (defn goat-create-record [rkey fname] (do (println "Creating record " rkey " from " fname) (shell! "goat record create -r" rkey "-n" fname))) (defn goat-update-record [rkey fname] (do (println "Updating record " rkey " from " fname) (shell! "goat record update -r" rkey "-n" fname))) (defn goat-delete-record [collection rkey] (do (println "Deleting record " rkey " from " collection)) (if (nil? rkey) nil (shell! (str "goat record delete -c " collection " -r " rkey)))) ;; TID Stuff ;; Loosely adapted from https://github.com/BlushSocial/atproto-tid ;; Not written with concurrency in mind ;; Or error handling (what can possibly go wrong?) (defn gen-timestamp [] ;; Not actually sure why we multiply this here but rolling with it (->> (java.util.Date.) .getTime (* 1000))) (def s32-char (vec "234567abcdefghijklmnopqrstuvwxyz")) (defn base32 [n padding] (let [pieces (->> n (iterate #(quot % 32)) (take-while #(> % 0)) (map #(mod % 32)))] (as-> pieces $ (map (partial nth s32-char) $) (reverse $) (concat $ (repeat \2)) (take padding $) (apply str $)))) ;; I think this would be more readable but I'm too lazy to make sure it works rn ;; (-> pieces ;; (->> (map #(nth s32-char %)) reverse) ;; (concat (repeat \2)) ;; (->> (take padding) (apply str)) (defn unbase32 [tid] (let [table (->> s32-char (map-indexed #(vector %2 %1)) (into {})) lookup #(get table %)] (->> tid (map lookup) (reduce #(+ (* %1 32) %2) 0)))) (defn gen-tid ([] (gen-tid (gen-timestamp) (rand-int 1023))) ([timestamp clockid] (str (base32 timestamp 11) (base32 clockid 2)))) (defn parse-tid [tid] {:timestamp (unbase32 (subs tid 0 11)) :clockid (unbase32 (subs tid 11 13))}) (defn stringify-tid "I'm just gonna use date for this lol" [tid] (let [{:keys [timestamp clockid]} (parse-tid tid) unix-timestamp (-> timestamp (quot 1000) (quot 1000)) ;; Dividing by 1000 twice since we multiplied by it once when making the TID, and also because java.util.Date.getTime() returns milliseconds but date uses seconds date-format-str "+%Y-%m-%dT%H:%M:%S" time-string (-> (shell {:out :string} "date -d" (str "@" unix-timestamp) date-format-str) :out str/trim)] (format "%s.%03dZ" time-string clockid))) ;;; (defn blog-record [title content visibility tid] {:$type (:ww collection-nsids) #_"com.whtwnd.blog.entry" :theme "github-light" :title title :content content :createdAt (stringify-tid tid) :visibility visibility}) (defn blog-ref-record [path] {:$type (:m1 collection-nsids) #_"dev.m1emi1em.blog.postRef" ;; Original the NSID do not steal :path path}) (defn records-from-file "Creates records for both whitewind and also for our own collection to keep track of which records (blog posts) under whitewind were added and are being managed by this script" [fs-file] (let [created (gen-tid) fname (fs/file-name fs-file) fpath (str fs-file)] {:blog-record (blog-record (->> fname (re-seq #"(.*)\.md$") first second) (slurp fpath) "public" created) :blog-ref-record (blog-ref-record fpath) :rkey created})) (defn get-tracked-posts [repo] (->> (goat-ls-coll repo (:m1 collection-nsids) #_"dev.m1emi1em.blog.postRef") (map (juxt (comp :path #(goat-get-record repo (:m1 collection-nsids) %) :rkey) :rkey)))) (def folders {:posts "posts" :m1-json "json/m1emi1em" :ww-json "json/whtwnd"}) (defn get-local-posts ([] (get-local-posts (:posts folders))) ([path] (->> path fs/list-dir (map str)))) ;;; Fiddling below (defn title-from-fname [fname] (->> fname fs/file fs/file-name (re-seq #"(.*)\.md$") first second)) (defn blog-record-from-file [fname rkey] (blog-record (title-from-fname fname) (slurp fname) "public" rkey)) (defn hash-blog-record [{:keys [title content visibility]}] (let [raw (str title content visibility)] (-> (shell! {:in raw} "md5sum") (str/split #" ") first))) (defn hash-blog-file [fname] (let [title (->> fname fs/file fs/file-name (re-seq #"(.*)\.md$") first second) visibility "public"] (hash-blog-record {:title title :content (slurp fname) :visibility visibility}))) (defn create-working-folders [] (let [folders-to-make (select-keys folders [:m1-json :ww-json])] (doseq [folder folders-to-make] (->> folder second fs/create-dirs)) #_(map (comp fs/create-dirs second) folders-to-make))) (defn find-deleted-posts [local pds] (if (not (empty? pds)) (select-keys (into {} pds) (set/difference (->> pds (map first) set) (set local))) {})) (defn find-updated-posts [repo local pds] (if (empty? pds) {} (let [local-hashes (zipmap local (map hash-blog-file local)) remote-hashes (zipmap (map first pds) (map (comp hash-blog-record (partial goat-get-record repo (:ww collection-nsids)) second) pds)) rkey-table (into {} pds)] (->> local-hashes (map (fn [[fname lhash]] [fname lhash (get remote-hashes fname)])) (remove (comp nil? last)) (remove (comp #(apply = %) (juxt second last))) (map first) (map (juxt identity #(get rkey-table %))))))) (defn find-new-posts [local pds] (set/difference (set local) (if (empty? pds) #{} (->> pds (map first) set)))) ;; Actual write functions (defn create-both-records! [stuff] (let [rkey (:rkey stuff) brecord (:blog-record stuff) blog-json-fname (str (:ww-json folders) "/" rkey ".json") rrecord (:blog-ref-record stuff) ref-json-fname (str (:m1-json folders) "/" rkey ".json")] (do (println "Creating blog and ref records with rkey " rkey) (->> brecord json/generate-string (spit blog-json-fname)) (->> rrecord json/generate-string (spit ref-json-fname)) (goat-create-record rkey ref-json-fname) (goat-create-record rkey blog-json-fname)))) (defn update-blog-record! [brecord rkey] (let [blog-json-fname (str (:ww-json folders) "/" rkey ".json")] (do (println "Updating blogpost " (:title brecord) " at rkey" rkey) (->> brecord json/generate-string (spit blog-json-fname)) (goat-update-record rkey blog-json-fname)))) (defn find-and-do-updates! [local pds] (let [to-update (find-updated-posts "m1emi1em.dev" local pds)] (doseq [[fname rkey] to-update] (let [blog-json-fname (str (:ww-json folders) "/" rkey ".json")] (update-blog-record! (blog-record-from-file fname rkey) rkey))))) (defn do-deletions! [rkey] (doseq [c (vals collection-nsids)] (println "Deleting rkey " rkey " in " c) (goat-delete-record c rkey))) (defn run [] (let [local (get-local-posts) remote (get-tracked-posts "m1emi1em.dev") created (find-new-posts local remote)] ;; ] (do (create-working-folders) (println "Checking for new posts") (doseq [c created] (-> c records-from-file create-both-records!)) (when (not (empty? remote)) (let [deleted (find-deleted-posts local remote)] (do (println "Checking for updated posts") (find-and-do-updates! local remote) (println "Checking for deleted posts") (doseq [d (vals deleted)] (do-deletions! d))))) (println "All done!")))) (defn -main [& args] (do (goat-login) (run))) (when (= *file* (System/getProperty "babashka.file")) (apply -main *command-line-args*))