mirror of github:amycatgirl/amycatgirl.github.io
wip: xrpc requests
Took a bit to lay out a good API, but it works well.
Next up is generating HTML elements & writing to the index.html page
inside the noscript block. I assume it's going to take a while to get
as good as possible, but things have been going smoothly so far, so I
don't think it will take me a long time.
Signed-off-by: Amy <amy+git@amogus.cloud>
+36
-9
+36
-9
fallback.lisp
+36
-9
fallback.lisp
···
2
2
;; Last authored: Thu 19 Mar 18:41:03 AST 2026
3
3
;; Depends on: drakma, cl-json, uiop
4
4
5
-
(ql:quickload '(drakma yason uiop cl-ppcre trivia))
5
+
(ql:quickload '(drakma yason uiop cl-ppcre trivia alexandria))
6
6
7
7
(defconstant +user_did+ "")
8
8
(defconstant +max-entries+ 5)
9
9
10
+
;; utilities
10
11
(defmacro run-command (command)
11
12
`(uiop:run-program ,command :output '(:string :stripped t)))
13
+
14
+
(defun keywordize (name)
15
+
(intern (string-upcase name) "KEYWORD"))
12
16
13
17
;; Git
14
18
(defun git-add (&rest files)
···
17
21
(defun git-commit (message)
18
22
(run-command `("git" "commit" "-m" ,(concatenate 'string "[fallback-gen] " message))))
19
23
24
+
;; HTTP
25
+
(defun build-query-params-from-plist (parameters)
26
+
"Build a string of URL-encoded query parameters from a plist."
27
+
;; HACK: ~: consumes the argument, so we need to pass it twice for iteration to work
28
+
(let ((params-cleaned (mapcar #'(lambda (value)
29
+
(if (keywordp value)
30
+
(string-downcase (symbol-name value))
31
+
value))
32
+
parameters)))
33
+
(format nil "~:[~;?~{~(~A~)=~A~^&~}~]" parameters params-cleaned)))
34
+
20
35
(defun make-request (where)
21
36
(let ((stream (drakma:http-request where
22
37
:want-stream t
23
-
:user-agent "amycatgirl.github.io/1.0")))
38
+
:user-agent " amycatgirl.github.io/1.0")))
24
39
(setf (flexi-streams:flexi-stream-external-format stream) :utf-8)
25
-
(yason:parse stream :object-as :plist :object-key-fn #'intern)))
40
+
(yason:parse stream :object-as :plist :object-key-fn #'keywordize)))
26
41
27
42
;; ATProto
28
43
;;; DID
···
35
50
(let* ((document-location (subseq did (length "did:web:")))
36
51
(qualified-path (concatenate 'string "https://" document-location "/.well-known/did.json"))
37
52
(document (make-request qualified-path)))
38
-
(if (equal (getf document (intern "id")) did)
53
+
(if (equal (getf document :id) did)
39
54
document
40
55
(error "Could not resolve document from did:web ~S" did))))
41
56
···
50
65
("web" (resolve-did-document--web did))
51
66
("plc" (resolve-did-document--plc did))
52
67
(_ (error "Unsuported DID method ~S" did-method))))
53
-
(services (getf document (intern "service"))))
68
+
(services (getf document :service)))
69
+
(print document)
54
70
(getf (find-if (lambda (service)
55
-
(equal (getf service (intern "id")) "#atproto_pds"))
71
+
(equal (getf service :id) "#atproto_pds"))
56
72
services)
57
-
(intern "serviceEndpoint"))))
73
+
:serviceEndpoint)))
58
74
59
75
;;; PDS
60
-
(defun fetch-entries (did pds max))
61
-
(defun build-elements-from-entries (entries))
76
+
(defun make-pds-request (pds method &rest query)
77
+
"Make a unauthenticated XRPC call to the PDS, where `method' is the NSID of the endpoint to call.
78
+
Aditional query parameters in the request must be passed inside of `query', where key-value pairs are denoted by keywords and values."
79
+
(let ((url (format nil "~A/xrpc/~A~A" pds method (build-query-params-from-plist query))))
80
+
(make-request url)))
81
+
82
+
(defun fetch-entries (did &optional (maximum 5))
83
+
(let* ((pds (resolve-pds did)))
84
+
(make-pds-request pds "com.atproto.repo.listRecords"
85
+
:repo did
86
+
:collection "site.standard.document"
87
+
:limit maximum)))
62
88
63
89
;; Generator
90
+
(defun build-elements-from-entries (entries))
64
91
(defun sort-entries-by-date (entries))
65
92
(defun generate-html ())
66
93
(defun publish ())