AI agent skills related to using social media
Cache JWTs and PDS lookup
+61
-39
+25
-15
atproto/authenticate.rkt
+25
-15
atproto/authenticate.rkt
···
6
6
7
7
(provide
8
8
(contract-out
9
-
[atproto-authenticate (-> string? path-string? immutable-string?)]))
9
+
[atproto-authenticate (-> string?)]))
10
10
11
11
12
12
(require net/http-easy
13
13
racket/file
14
14
racket/mutability
15
15
racket/string
16
+
social-skills/atproto/agent-config
16
17
social-skills/atproto/lookup-pds
17
18
social-skills/private/check-response-ok)
18
19
19
20
20
21
(module+ main
21
22
(require (submod "..")
22
-
racket/cmdline
23
-
social-skills/atproto/agent-config))
23
+
racket/cmdline))
24
24
25
25
26
26
;@----------------------------------------------------------------------------------------------------
27
27
28
28
29
-
(define (atproto-authenticate account-did app-password-file)
30
-
(define pds-url (atproto-lookup-pds account-did))
31
-
(define app-password (string-trim (file->string app-password-file)))
32
-
(define response
33
-
(post (format "~a/xrpc/com.atproto.server.createSession" pds-url)
34
-
#:headers (hash 'content-type "application/json")
35
-
#:data (json-payload (hash 'identifier account-did 'password app-password))))
36
-
(check-response-ok 'atproto-authenticate response)
37
-
(string->immutable-string (hash-ref (response-json response) 'accessJwt)))
29
+
(define jwt-cache (box #false))
30
+
31
+
32
+
(define (atproto-authenticate)
33
+
(define cached (unbox jwt-cache))
34
+
(cond
35
+
[cached cached]
36
+
[else
37
+
(define did (agent-atproto-did))
38
+
(define pds-url (atproto-lookup-pds))
39
+
(define app-password (string-trim (file->string (agent-atproto-app-password))))
40
+
(define response
41
+
(post (format "~a/xrpc/com.atproto.server.createSession" pds-url)
42
+
#:headers (hash 'content-type "application/json")
43
+
#:data (json-payload (hash 'identifier did 'password app-password))))
44
+
(check-response-ok 'atproto-authenticate response)
45
+
(define jwt
46
+
(string->immutable-string (hash-ref (response-json response) 'accessJwt)))
47
+
(set-box! jwt-cache jwt)
48
+
jwt]))
38
49
39
50
40
51
(module+ main
41
52
(command-line
42
-
#:args ([account-did (agent-atproto-did)]
43
-
[app-password-file (agent-atproto-app-password)])
44
-
(displayln (atproto-authenticate account-did app-password-file))))
53
+
#:args ()
54
+
(displayln (atproto-authenticate))))
+34
-22
atproto/lookup-pds.rkt
+34
-22
atproto/lookup-pds.rkt
···
6
6
7
7
(provide
8
8
(contract-out
9
-
[atproto-lookup-pds (-> string? immutable-string?)]))
9
+
[atproto-lookup-pds (-> immutable-string?)]))
10
10
11
11
12
12
(require net/http-easy
···
14
14
racket/string
15
15
rebellion/streaming/reducer
16
16
rebellion/streaming/transducer
17
+
social-skills/atproto/agent-config
17
18
social-skills/private/check-response-ok)
18
19
19
20
20
21
(module+ main
21
22
(require (submod "..")
22
-
racket/cmdline
23
-
social-skills/atproto/agent-config))
23
+
racket/cmdline))
24
24
25
25
26
26
;@----------------------------------------------------------------------------------------------------
27
27
28
28
29
-
(define (atproto-lookup-pds account-did)
30
-
;; Currently only supports did:plc: DIDs (resolved via plc.directory).
31
-
;; did:web: DIDs would require resolution via /.well-known/did.json on the DNS domain,
32
-
;; which is a different lookup path not yet implemented.
33
-
(unless (string-prefix? account-did "did:plc:")
34
-
(raise-arguments-error
35
-
'atproto-lookup-pds
36
-
(string-append "cannot lookup PDS for given account because its DID does not use the PLC scheme"
37
-
"\n PLC DIDs must start with \"did:plc:\"")
38
-
"account DID" account-did))
39
-
(define response (get (format "https://plc.directory/~a" account-did)))
40
-
(check-response-ok 'atproto-lookup-pds response)
41
-
(define pds-service
42
-
(transduce (hash-ref (response-json response) 'service '())
43
-
(filtering (λ (svc) (equal? (hash-ref svc 'type #false) "AtprotoPersonalDataServer")))
44
-
#:into into-only-element))
45
-
(string->immutable-string (hash-ref pds-service 'serviceEndpoint)))
29
+
(define pds-cache (box #false))
30
+
31
+
32
+
(define (atproto-lookup-pds)
33
+
(define cached (unbox pds-cache))
34
+
(cond
35
+
[cached cached]
36
+
[else
37
+
(define account-did (agent-atproto-did))
38
+
;; Currently only supports did:plc: DIDs (resolved via plc.directory).
39
+
;; did:web: DIDs would require resolution via /.well-known/did.json on the DNS domain,
40
+
;; which is a different lookup path not yet implemented.
41
+
(unless (string-prefix? account-did "did:plc:")
42
+
(raise-arguments-error
43
+
'atproto-lookup-pds
44
+
(string-append
45
+
"cannot lookup PDS for given account because its DID does not use the PLC scheme"
46
+
"\n PLC DIDs must start with \"did:plc:\"")
47
+
"account DID" account-did))
48
+
(define response (get (format "https://plc.directory/~a" account-did)))
49
+
(check-response-ok 'atproto-lookup-pds response)
50
+
(define pds-service
51
+
(transduce (hash-ref (response-json response) 'service '())
52
+
(filtering
53
+
(λ (svc) (equal? (hash-ref svc 'type #false) "AtprotoPersonalDataServer")))
54
+
#:into into-only-element))
55
+
(define pds (string->immutable-string (hash-ref pds-service 'serviceEndpoint)))
56
+
(set-box! pds-cache pds)
57
+
pds]))
46
58
47
59
48
60
(module+ main
49
61
(command-line
50
-
#:args ([account-did (agent-atproto-did)])
51
-
(displayln (atproto-lookup-pds account-did))))
62
+
#:args ()
63
+
(displayln (atproto-lookup-pds))))
+2
-2
atproto/xrpc.rkt
+2
-2
atproto/xrpc.rkt
···
23
23
24
24
25
25
(define (agent-xrpc-get method-nsid [query-params (hash)] #:service [service #false])
26
-
(define pds-url (atproto-lookup-pds (agent-atproto-did)))
27
-
(define jwt (atproto-authenticate (agent-atproto-did) (agent-atproto-app-password)))
26
+
(define pds-url (atproto-lookup-pds))
27
+
(define jwt (atproto-authenticate))
28
28
(define query-string
29
29
(if (hash-empty? query-params)
30
30
""