m1emi1em.dev
this repo has no description
feat: add publish.bb and run it in the build, which might work
+274
-2
+2
-2
.tangled/workflows/build.yml
+2
-2
.tangled/workflows/build.yml
···
5
5
dependencies:
6
6
nixpkgs:
7
7
- atproto-goat
8
+
- babashka
8
9
9
10
steps:
10
11
- name: Sync posts
11
12
command: |
12
-
goat account login --username did:plc:4ijrxutxndrcbmwd2bzchsum
13
-
goat bsky post "me when test CI and secrets by setting up a pipeline to make this post when i push this commit to main"
13
+
bb publish.bb
+272
publish.bb
+272
publish.bb
···
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
+