+25 -15

atproto/authenticate.rkt

··· 6 6 7 7 (provide 8 8 (contract-out 9 9 - [atproto-authenticate (-> string? path-string? immutable-string?)])) 9 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 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 22 - racket/cmdline 23 23 - social-skills/atproto/agent-config)) 23 23 + racket/cmdline)) 24 24 25 25 26 26 ;@---------------------------------------------------------------------------------------------------- 27 27 28 28 29 29 - (define (atproto-authenticate account-did app-password-file) 30 30 - (define pds-url (atproto-lookup-pds account-did)) 31 31 - (define app-password (string-trim (file->string app-password-file))) 32 32 - (define response 33 33 - (post (format "~a/xrpc/com.atproto.server.createSession" pds-url) 34 34 - #:headers (hash 'content-type "application/json") 35 35 - #:data (json-payload (hash 'identifier account-did 'password app-password)))) 36 36 - (check-response-ok 'atproto-authenticate response) 37 37 - (string->immutable-string (hash-ref (response-json response) 'accessJwt))) 29 29 + (define jwt-cache (box #false)) 30 30 + 31 31 + 32 32 + (define (atproto-authenticate) 33 33 + (define cached (unbox jwt-cache)) 34 34 + (cond 35 35 + [cached cached] 36 36 + [else 37 37 + (define did (agent-atproto-did)) 38 38 + (define pds-url (atproto-lookup-pds)) 39 39 + (define app-password (string-trim (file->string (agent-atproto-app-password)))) 40 40 + (define response 41 41 + (post (format "~a/xrpc/com.atproto.server.createSession" pds-url) 42 42 + #:headers (hash 'content-type "application/json") 43 43 + #:data (json-payload (hash 'identifier did 'password app-password)))) 44 44 + (check-response-ok 'atproto-authenticate response) 45 45 + (define jwt 46 46 + (string->immutable-string (hash-ref (response-json response) 'accessJwt))) 47 47 + (set-box! jwt-cache jwt) 48 48 + jwt])) 38 49 39 50 40 51 (module+ main 41 52 (command-line 42 42 - #:args ([account-did (agent-atproto-did)] 43 43 - [app-password-file (agent-atproto-app-password)]) 44 44 - (displayln (atproto-authenticate account-did app-password-file)))) 53 53 + #:args () 54 54 + (displayln (atproto-authenticate))))

+34 -22

atproto/lookup-pds.rkt

··· 6 6 7 7 (provide 8 8 (contract-out 9 9 - [atproto-lookup-pds (-> string? immutable-string?)])) 9 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 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 22 - racket/cmdline 23 23 - social-skills/atproto/agent-config)) 23 23 + racket/cmdline)) 24 24 25 25 26 26 ;@---------------------------------------------------------------------------------------------------- 27 27 28 28 29 29 - (define (atproto-lookup-pds account-did) 30 30 - ;; Currently only supports did:plc: DIDs (resolved via plc.directory). 31 31 - ;; did:web: DIDs would require resolution via /.well-known/did.json on the DNS domain, 32 32 - ;; which is a different lookup path not yet implemented. 33 33 - (unless (string-prefix? account-did "did:plc:") 34 34 - (raise-arguments-error 35 35 - 'atproto-lookup-pds 36 36 - (string-append "cannot lookup PDS for given account because its DID does not use the PLC scheme" 37 37 - "\n PLC DIDs must start with \"did:plc:\"") 38 38 - "account DID" account-did)) 39 39 - (define response (get (format "https://plc.directory/~a" account-did))) 40 40 - (check-response-ok 'atproto-lookup-pds response) 41 41 - (define pds-service 42 42 - (transduce (hash-ref (response-json response) 'service '()) 43 43 - (filtering (λ (svc) (equal? (hash-ref svc 'type #false) "AtprotoPersonalDataServer"))) 44 44 - #:into into-only-element)) 45 45 - (string->immutable-string (hash-ref pds-service 'serviceEndpoint))) 29 29 + (define pds-cache (box #false)) 30 30 + 31 31 + 32 32 + (define (atproto-lookup-pds) 33 33 + (define cached (unbox pds-cache)) 34 34 + (cond 35 35 + [cached cached] 36 36 + [else 37 37 + (define account-did (agent-atproto-did)) 38 38 + ;; Currently only supports did:plc: DIDs (resolved via plc.directory). 39 39 + ;; did:web: DIDs would require resolution via /.well-known/did.json on the DNS domain, 40 40 + ;; which is a different lookup path not yet implemented. 41 41 + (unless (string-prefix? account-did "did:plc:") 42 42 + (raise-arguments-error 43 43 + 'atproto-lookup-pds 44 44 + (string-append 45 45 + "cannot lookup PDS for given account because its DID does not use the PLC scheme" 46 46 + "\n PLC DIDs must start with \"did:plc:\"") 47 47 + "account DID" account-did)) 48 48 + (define response (get (format "https://plc.directory/~a" account-did))) 49 49 + (check-response-ok 'atproto-lookup-pds response) 50 50 + (define pds-service 51 51 + (transduce (hash-ref (response-json response) 'service '()) 52 52 + (filtering 53 53 + (λ (svc) (equal? (hash-ref svc 'type #false) "AtprotoPersonalDataServer"))) 54 54 + #:into into-only-element)) 55 55 + (define pds (string->immutable-string (hash-ref pds-service 'serviceEndpoint))) 56 56 + (set-box! pds-cache pds) 57 57 + pds])) 46 58 47 59 48 60 (module+ main 49 61 (command-line 50 50 - #:args ([account-did (agent-atproto-did)]) 51 51 - (displayln (atproto-lookup-pds account-did)))) 62 62 + #:args () 63 63 + (displayln (atproto-lookup-pds))))

+2 -2

atproto/xrpc.rkt

··· 23 23 24 24 25 25 (define (agent-xrpc-get method-nsid [query-params (hash)] #:service [service #false]) 26 26 - (define pds-url (atproto-lookup-pds (agent-atproto-did))) 27 27 - (define jwt (atproto-authenticate (agent-atproto-did) (agent-atproto-app-password))) 26 26 + (define pds-url (atproto-lookup-pds)) 27 27 + (define jwt (atproto-authenticate)) 28 28 (define query-string 29 29 (if (hash-empty? query-params) 30 30 ""