AI agent skills related to using social media
Begin work on porting scripts to racket
+188
+16
.gitignore
+16
.gitignore
···
1
+
compiled/
2
+
doc/
3
+
*~
4
+
*.backup
5
+
coverage/
6
+
# These only come up if you generate the scribble docs manually, instead of
7
+
# through `raco setup`. But we exclude them anyway to help newcomers (and
8
+
# agents) avoid accidentally committing rendered documentation files.
9
+
main.html
10
+
manual-fonts.css
11
+
manual-racket.css
12
+
manual-racket.js
13
+
manual-style.css
14
+
racket.css
15
+
scribble-common.js
16
+
scribble.css
+39
atproto/agent-config.rkt
+39
atproto/agent-config.rkt
···
1
+
#lang racket/base
2
+
3
+
4
+
(require racket/contract/base)
5
+
6
+
7
+
(provide
8
+
(contract-out
9
+
[agent-atproto-did (-> immutable-string?)]
10
+
[agent-admin-atproto-did (-> immutable-string?)]
11
+
[agent-atproto-app-password (-> complete-path?)]))
12
+
13
+
14
+
(require racket/mutability)
15
+
16
+
17
+
;@----------------------------------------------------------------------------------------------------
18
+
19
+
20
+
(define (agent-atproto-did)
21
+
(string->immutable-string
22
+
(or (getenv "AGENT_ATPROTO_DID")
23
+
(raise-arguments-error 'agent-atproto-did
24
+
"environment variable AGENT_ATPROTO_DID not configured"))))
25
+
26
+
27
+
(define (agent-admin-atproto-did)
28
+
(string->immutable-string
29
+
(or (getenv "AGENT_ADMIN_ATPROTO_DID")
30
+
(raise-arguments-error 'agent-admin-atproto-did
31
+
"environment variable AGENT_ADMIN_ATPROTO_DID not configured"))))
32
+
33
+
34
+
(define (agent-atproto-app-password)
35
+
(path->complete-path
36
+
(simplify-path
37
+
(or (getenv "AGENT_ATPROTO_APP_PASSWORD")
38
+
(raise-arguments-error 'agent-atproto-app-password
39
+
"environment variable AGENT_ATPROTO_APP_PASSWORD not configured")))))
+44
atproto/authenticate.rkt
+44
atproto/authenticate.rkt
···
1
+
#lang racket/base
2
+
3
+
4
+
(require racket/contract/base)
5
+
6
+
7
+
(provide
8
+
(contract-out
9
+
[atproto-authenticate (-> string? path-string? immutable-string?)]))
10
+
11
+
12
+
(require net/http-easy
13
+
racket/file
14
+
racket/mutability
15
+
racket/string
16
+
social-skills/atproto/lookup-pds
17
+
social-skills/private/check-response-ok)
18
+
19
+
20
+
(module+ main
21
+
(require (submod "..")
22
+
racket/cmdline
23
+
social-skills/atproto/agent-config))
24
+
25
+
26
+
;@----------------------------------------------------------------------------------------------------
27
+
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)))
38
+
39
+
40
+
(module+ main
41
+
(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))))
+11
atproto/info.rkt
+11
atproto/info.rkt
+48
atproto/lookup-pds.rkt
+48
atproto/lookup-pds.rkt
···
1
+
#lang racket/base
2
+
3
+
4
+
(require racket/contract/base)
5
+
6
+
7
+
(provide
8
+
(contract-out
9
+
[atproto-lookup-pds (-> string? immutable-string?)]))
10
+
11
+
12
+
(require net/http-easy
13
+
racket/mutability
14
+
racket/string
15
+
rebellion/streaming/reducer
16
+
rebellion/streaming/transducer
17
+
social-skills/private/check-response-ok)
18
+
19
+
20
+
(module+ main
21
+
(require (submod "..")
22
+
racket/cmdline
23
+
social-skills/atproto/agent-config))
24
+
25
+
26
+
;@----------------------------------------------------------------------------------------------------
27
+
28
+
29
+
(define (atproto-lookup-pds account-did)
30
+
(unless (string-prefix? account-did "did:plc:")
31
+
(raise-arguments-error
32
+
'atproto-lookup-pds
33
+
(string-append "cannot lookup PDS for given account because its DID does not use the PLC scheme"
34
+
"\n PLC DIDs must start with \"did:plc:\"")
35
+
"account DID" account-did))
36
+
(define response (get (format "https://plc.directory/~a" account-did)))
37
+
(check-response-ok 'atproto-lookup-pds response)
38
+
(define pds-service
39
+
(transduce (hash-ref (response-json response) 'service '())
40
+
(filtering (λ (svc) (equal? (hash-ref svc 'type #false) "AtprotoPersonalDataServer")))
41
+
#:into into-only-element))
42
+
(string->immutable-string (hash-ref pds-service 'serviceEndpoint)))
43
+
44
+
45
+
(module+ main
46
+
(command-line
47
+
#:args ([account-did (agent-atproto-did)])
48
+
(displayln (atproto-lookup-pds account-did))))
+7
info.rkt
+7
info.rkt
+23
private/check-response-ok.rkt
+23
private/check-response-ok.rkt
···
1
+
#lang racket/base
2
+
3
+
4
+
(require racket/contract/base)
5
+
6
+
7
+
(provide
8
+
(contract-out
9
+
[check-response-ok (-> symbol? response? void?)]))
10
+
11
+
12
+
(require net/http-easy)
13
+
14
+
15
+
;@----------------------------------------------------------------------------------------------------
16
+
17
+
18
+
(define (check-response-ok who response)
19
+
(unless (<= 200 (response-status-code response) 299)
20
+
(raise-arguments-error who "received a non-2XX HTTP response"
21
+
"response code" (response-status-code response)
22
+
"message" (response-status-message response)
23
+
"response" response)))