this repo has no description
m1emi1em.dev
1#!/usr/bin/env bb
2(require '[babashka.curl :as curl]
3 '[babashka.fs :as fs]
4 '[babashka.process :refer [shell]]
5 '[cheshire.core :as json]
6 '[clojure.string :as str])
7
8;; (def repo-details {:collection "com.whtwnd.blog.entry"})
9(def collection-nsids {:ww "com.whtwnd.blog.entry"
10 :m1 "dev.m1emi1em.blog.postRef"})
11
12(def default-shell!!-args {:out :string})
13
14(defn shell!
15 "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"
16 [cmd-or-opts & args]
17 (let [defaults? (not (instance? clojure.lang.PersistentArrayMap cmd-or-opts))
18 opts (cond-> default-shell!!-args
19 (not defaults?) (merge cmd-or-opts))
20 args (cond->> args
21 defaults? (cons cmd-or-opts))]
22 (:out (apply shell opts args))))
23;; goat helpers
24
25(defn goat-login
26 "Username and password are picked up from the ATP_AUTH_USERNAME and ATP_AUTH_PASSWORD env vars"
27 [] (shell! "goat account login"))
28
29(defn goat-ls-coll [repo collection]
30 (->> (shell! "goat ls --collection" collection repo)
31 str/split-lines
32 (map #(->> (str/split % #"\t")
33 rest
34 (zipmap [:rkey :cid])))))
35
36(defn goat-get-record [repo collection rkey]
37 (do (println "Getting record " rkey " from collection " collection " in " repo)
38 (if (nil? rkey)
39 {}
40 (-> (shell! "goat record get"
41 (str "at://" repo "/" collection "/" rkey))
42 json/parse-string
43 (update-keys keyword))
44 )))
45
46(defn goat-create-record [rkey fname]
47 (do (println "Creating record " rkey " from " fname)
48 (shell! "goat record create -r" rkey "-n" fname)))
49
50(defn goat-update-record [rkey fname]
51 (do (println "Updating record " rkey " from " fname)
52 (shell! "goat record update -r" rkey "-n" fname)))
53
54(defn goat-delete-record [collection rkey]
55 (do (println "Deleting record " rkey " from " collection))
56 (if (nil? rkey)
57 nil
58 (shell! (str "goat record delete -c " collection " -r " rkey))))
59
60;; TID Stuff
61;; Loosely adapted from https://github.com/BlushSocial/atproto-tid
62;; Not written with concurrency in mind
63;; Or error handling (what can possibly go wrong?)
64
65(defn gen-timestamp []
66 ;; Not actually sure why we multiply this here but rolling with it
67 (->> (java.util.Date.) .getTime (* 1000)))
68
69(def s32-char (vec "234567abcdefghijklmnopqrstuvwxyz"))
70
71(defn base32 [n padding]
72 (let [pieces (->> n
73 (iterate #(quot % 32))
74 (take-while #(> % 0))
75 (map #(mod % 32)))]
76 (as-> pieces $
77 (map (partial nth s32-char) $)
78 (reverse $)
79 (concat $ (repeat \2))
80 (take padding $)
81 (apply str $))))
82
83;; I think this would be more readable but I'm too lazy to make sure it works rn
84;; (-> pieces
85;; (->> (map #(nth s32-char %)) reverse)
86;; (concat (repeat \2))
87;; (->> (take padding) (apply str))
88
89(defn unbase32 [tid]
90 (let [table (->> s32-char (map-indexed #(vector %2 %1)) (into {}))
91 lookup #(get table %)]
92 (->> tid
93 (map lookup)
94 (reduce #(+ (* %1 32) %2) 0))))
95
96(defn gen-tid
97 ([] (gen-tid (gen-timestamp) (rand-int 1023)))
98 ([timestamp clockid]
99 (str (base32 timestamp 11) (base32 clockid 2))))
100
101(defn parse-tid [tid]
102 {:timestamp (unbase32 (subs tid 0 11))
103 :clockid (unbase32 (subs tid 11 13))})
104
105(defn stringify-tid
106 "I'm just gonna use date for this lol"
107 [tid]
108 (let [{:keys [timestamp clockid]} (parse-tid tid)
109 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
110 date-format-str "+%Y-%m-%dT%H:%M:%S"
111
112 time-string
113 (-> (shell {:out :string}
114 "date -d"
115 (str "@" unix-timestamp)
116 date-format-str)
117 :out str/trim)]
118 (format "%s.%03dZ" time-string clockid)))
119
120;;;
121
122(defn blog-record [title content visibility tid]
123 {:$type (:ww collection-nsids) #_"com.whtwnd.blog.entry"
124 :theme "github-light"
125 :title title
126 :content content
127 :createdAt (stringify-tid tid)
128 :visibility visibility})
129
130(defn blog-ref-record [path]
131 {:$type (:m1 collection-nsids) #_"dev.m1emi1em.blog.postRef" ;; Original the NSID do not steal
132 :path path})
133
134(defn records-from-file
135 "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"
136 [fs-file]
137 (let [created (gen-tid)
138 fname (fs/file-name fs-file)
139 fpath (str fs-file)]
140 {:blog-record (blog-record (->> fname (re-seq #"(.*)\.md$") first second)
141 (slurp fpath)
142 "public"
143 created)
144 :blog-ref-record (blog-ref-record fpath)
145 :rkey created}))
146
147(defn get-tracked-posts [repo]
148 (->> (goat-ls-coll repo (:m1 collection-nsids) #_"dev.m1emi1em.blog.postRef")
149 (map (juxt (comp :path #(goat-get-record repo (:m1 collection-nsids) %) :rkey)
150 :rkey))))
151
152(def folders {:posts "posts"
153 :m1-json "json/m1emi1em"
154 :ww-json "json/whtwnd"})
155
156(defn get-local-posts
157 ([] (get-local-posts (:posts folders)))
158 ([path] (->> path fs/list-dir (map str))))
159
160;;; Fiddling below
161
162(defn title-from-fname [fname] (->> fname fs/file fs/file-name (re-seq #"(.*)\.md$") first second))
163
164(defn blog-record-from-file [fname rkey]
165 (blog-record (title-from-fname fname) (slurp fname) "public" rkey))
166
167(defn hash-blog-record [{:keys [title content visibility]}]
168 (let [raw (str title content visibility)]
169 (-> (shell! {:in raw} "md5sum") (str/split #" ") first)))
170
171(defn hash-blog-file [fname]
172 (let [title (->> fname fs/file fs/file-name (re-seq #"(.*)\.md$") first second)
173 visibility "public"]
174 (hash-blog-record {:title title :content (slurp fname) :visibility visibility})))
175
176(defn create-working-folders []
177 (let [folders-to-make (select-keys folders [:m1-json :ww-json])]
178 (doseq [folder folders-to-make]
179 (->> folder second fs/create-dirs))
180 #_(map (comp fs/create-dirs second) folders-to-make)))
181
182(defn find-deleted-posts [local pds]
183 (if (not (empty? pds))
184 (select-keys (into {} pds)
185 (set/difference (->> pds (map first) set) (set local)))
186 {}))
187
188(defn find-updated-posts [repo local pds]
189 (if (empty? pds)
190 {}
191 (let [local-hashes (zipmap local (map hash-blog-file local))
192
193 remote-hashes (zipmap (map first pds)
194 (map (comp hash-blog-record
195 (partial goat-get-record repo (:ww collection-nsids))
196 second)
197 pds))
198
199 rkey-table (into {} pds)]
200 (->> local-hashes
201 (map (fn [[fname lhash]] [fname lhash (get remote-hashes fname)]))
202 (remove (comp nil? last))
203 (remove (comp #(apply = %) (juxt second last)))
204 (map first)
205 (map (juxt identity #(get rkey-table %)))))))
206
207(defn find-new-posts [local pds]
208 (set/difference (set local) (if (empty? pds) #{} (->> pds (map first) set))))
209
210;; Actual write functions
211
212(defn create-both-records! [stuff]
213 (let [rkey (:rkey stuff)
214
215 brecord (:blog-record stuff)
216 blog-json-fname (str (:ww-json folders) "/" rkey ".json")
217
218 rrecord (:blog-ref-record stuff)
219 ref-json-fname (str (:m1-json folders) "/" rkey ".json")]
220 (do
221 (println "Creating blog and ref records with rkey " rkey)
222 (->> brecord json/generate-string (spit blog-json-fname))
223 (->> rrecord json/generate-string (spit ref-json-fname))
224 (goat-create-record rkey ref-json-fname)
225 (goat-create-record rkey blog-json-fname))))
226
227(defn update-blog-record! [brecord rkey]
228 (let [blog-json-fname (str (:ww-json folders) "/" rkey ".json")]
229 (do
230 (println "Updating blogpost " (:title brecord) " at rkey" rkey)
231 (->> brecord json/generate-string (spit blog-json-fname))
232 (goat-update-record rkey blog-json-fname))))
233
234(defn find-and-do-updates! [local pds]
235 (let [to-update (find-updated-posts "m1emi1em.dev" local pds)]
236 (doseq [[fname rkey] to-update]
237 (let [blog-json-fname (str (:ww-json folders) "/" rkey ".json")]
238 (update-blog-record! (blog-record-from-file fname rkey) rkey)))))
239
240(defn do-deletions! [rkey]
241 (doseq [c (vals collection-nsids)]
242 (println "Deleting rkey " rkey " in " c)
243 (goat-delete-record c rkey)))
244
245(defn run []
246 (let [local (get-local-posts)
247 remote (get-tracked-posts "m1emi1em.dev")
248 created (find-new-posts local remote)]
249 ;; ]
250 (do
251 (create-working-folders)
252 (println "Checking for new posts")
253
254 (doseq [c created] (-> c records-from-file create-both-records!))
255
256 (when (not (empty? remote))
257 (let [deleted (find-deleted-posts local remote)]
258 (do
259 (println "Checking for updated posts")
260 (find-and-do-updates! local remote)
261
262 (println "Checking for deleted posts")
263 (doseq [d (vals deleted)] (do-deletions! d)))))
264
265 (println "All done!"))))
266
267(defn -main [& args]
268 (do (goat-login) (run)))
269
270(when (= *file* (System/getProperty "babashka.file"))
271 (apply -main *command-line-args*))
272