mirror of github:amycatgirl/amycatgirl.github.io
wip(fallback): implement DID resolution and git cmd wrappers
DID resolution works with both DID methods outlined in
https://atproto.com/specs/did#blessed-did-methods
The resolve-pds method allows more DID methods to be implemented when they are needed.
Signed-off-by: Amy <amy+git@amogus.cloud>
+50
-3
+50
-3
fallback.lisp
+50
-3
fallback.lisp
···
1
1
;; amycatgirl.github.io no-js fallback
2
2
;; Last authored: Thu 19 Mar 18:41:03 AST 2026
3
+
;; Depends on: drakma, cl-json, uiop
4
+
5
+
(ql:quickload '(drakma yason uiop cl-ppcre trivia))
3
6
4
7
(defconstant +user_did+ "")
5
8
(defconstant +max-entries+ 5)
6
9
10
+
(defmacro run-command (command)
11
+
`(uiop:run-program ,command :output '(:string :stripped t)))
12
+
7
13
;; Git
8
-
(defun git-add (files))
9
-
(defun git-commit (message))
14
+
(defun git-add (&rest files)
15
+
(run-command `("git" "add" ,@files)))
16
+
17
+
(defun git-commit (message)
18
+
(run-command `("git" "commit" "-m" ,(concatenate 'string "[fallback-gen] " message))))
19
+
20
+
(defun make-request (where)
21
+
(let ((stream (drakma:http-request where
22
+
:want-stream t
23
+
:user-agent "amycatgirl.github.io/1.0")))
24
+
(setf (flexi-streams:flexi-stream-external-format stream) :utf-8)
25
+
(yason:parse stream :object-as :plist :object-key-fn #'intern)))
10
26
11
27
;; ATProto
12
-
(defun resolve-pds (did))
28
+
;;; DID
29
+
(defun resolve-did-document--plc (did)
30
+
(make-request (format nil "https://plc.directory/~a" did)))
31
+
32
+
(defun resolve-did-document--web (did)
33
+
"Resolve a DID document via DID:WEB method.
34
+
See https://w3c-ccg.github.io/did-method-web/ for specification details."
35
+
(let* ((document-location (subseq did (length "did:web:")))
36
+
(qualified-path (concatenate 'string "https://" document-location "/.well-known/did.json"))
37
+
(document (make-request qualified-path)))
38
+
(if (equal (getf document (intern "id")) did)
39
+
document
40
+
(error "Could not resolve document from did:web ~S" did))))
41
+
42
+
(defun get-did-method (did)
43
+
(cl-ppcre:register-groups-bind (method) ("^did:([a-z]+):[a-zA-Z0-9._:%-]*[a-zA-Z0-9._-]$" did)
44
+
method))
45
+
46
+
(defun resolve-pds (did)
47
+
"Resolve a PDS by DID."
48
+
(let* ((did-method (get-did-method did))
49
+
(document (trivia:match did-method
50
+
("web" (resolve-did-document--web did))
51
+
("plc" (resolve-did-document--plc did))
52
+
(_ (error "Unsuported DID method ~S" did-method))))
53
+
(services (getf document (intern "service"))))
54
+
(getf (find-if (lambda (service)
55
+
(equal (getf service (intern "id")) "#atproto_pds"))
56
+
services)
57
+
(intern "serviceEndpoint"))))
58
+
59
+
;;; PDS
13
60
(defun fetch-entries (did pds max))
14
61
(defun build-elements-from-entries (entries))
15
62