atproto libraries implementation in ocaml
gdiazlo.tngl.sh
1(** High-level API Agent for AT Protocol.
2
3 This module provides a user-friendly interface for common AT Protocol
4 operations like authentication, posting, following, and reading feeds. *)
5
6open Atproto_syntax
7open Atproto_xrpc
8
9type session = {
10 did : string;
11 handle : string;
12 access_jwt : string;
13 refresh_jwt : string option;
14 pds_endpoint : Uri.t;
15}
16
17type t = { client : Client.t; session : session option }
18
19type error =
20 | Not_authenticated
21 | Xrpc_error of Client.error
22 | Parse_error of string
23 | Invalid_response of string
24
25let error_to_string = function
26 | Not_authenticated -> "Not authenticated"
27 | Xrpc_error e -> Client.error_to_string e
28 | Parse_error msg -> Printf.sprintf "Parse error: %s" msg
29 | Invalid_response msg -> Printf.sprintf "Invalid response: %s" msg
30
31let create ~pds =
32 let client = Client.of_uri pds in
33 { client; session = None }
34
35let create_from_url ~url =
36 let client = Client.create ~base_url:url in
37 { client; session = None }
38
39let client t = t.client
40let is_authenticated t = Option.is_some t.session
41let session t = t.session
42let did t = Option.map (fun s -> s.did) t.session
43let handle t = Option.map (fun s -> s.handle) t.session
44
45let login t ~identifier ~password =
46 match Client.create_session t.client ~identifier ~password with
47 | Error e -> Error (Xrpc_error e)
48 | Ok json -> (
49 match Atproto_json.to_object_opt json with
50 | Some pairs -> (
51 match
52 ( Atproto_json.get_string_opt "did" pairs,
53 Atproto_json.get_string_opt "handle" pairs,
54 Atproto_json.get_string_opt "accessJwt" pairs )
55 with
56 | Some did, Some handle, Some access_jwt ->
57 let refresh_jwt =
58 Atproto_json.get_string_opt "refreshJwt" pairs
59 in
60 let session =
61 {
62 did;
63 handle;
64 access_jwt;
65 refresh_jwt;
66 pds_endpoint = Client.base_url t.client;
67 }
68 in
69 let client = Client.with_auth ~token:access_jwt t.client in
70 Ok { client; session = Some session }
71 | _ -> Error (Invalid_response "Missing required session fields"))
72 | None -> Error (Invalid_response "Expected object"))
73
74let logout t =
75 match t.session with
76 | None -> Ok { t with client = Client.without_auth t.client }
77 | Some _ ->
78 let _ = Client.delete_session t.client in
79 Ok { client = Client.without_auth t.client; session = None }
80
81let refresh_session t =
82 match t.session with
83 | None -> Error Not_authenticated
84 | Some session -> (
85 match session.refresh_jwt with
86 | None -> Error (Invalid_response "No refresh token available")
87 | Some refresh_token -> (
88 let refresh_client = Client.with_auth ~token:refresh_token t.client in
89 match Client.refresh_session refresh_client with
90 | Error e -> Error (Xrpc_error e)
91 | Ok json -> (
92 match Atproto_json.to_object_opt json with
93 | Some pairs -> (
94 match
95 ( Atproto_json.get_string_opt "did" pairs,
96 Atproto_json.get_string_opt "handle" pairs,
97 Atproto_json.get_string_opt "accessJwt" pairs )
98 with
99 | Some did, Some handle, Some access_jwt ->
100 let refresh_jwt =
101 Atproto_json.get_string_opt "refreshJwt" pairs
102 in
103 let new_session =
104 { session with did; handle; access_jwt; refresh_jwt }
105 in
106 let client =
107 Client.with_auth ~token:access_jwt t.client
108 in
109 Ok { client; session = Some new_session }
110 | _ ->
111 Error (Invalid_response "Missing required session fields")
112 )
113 | None -> Error (Invalid_response "Expected object"))))
114
115let get_session t =
116 match t.session with
117 | None -> Error Not_authenticated
118 | Some _ -> (
119 match Client.get_session t.client with
120 | Error e -> Error (Xrpc_error e)
121 | Ok json -> Ok json)
122
123type profile = {
124 did : string;
125 handle : string;
126 display_name : string option;
127 description : string option;
128 avatar : string option;
129 banner : string option;
130 followers_count : int;
131 follows_count : int;
132 posts_count : int;
133}
134
135let parse_profile json =
136 match Atproto_json.to_object_opt json with
137 | Some pairs -> (
138 match
139 ( Atproto_json.get_string_opt "did" pairs,
140 Atproto_json.get_string_opt "handle" pairs )
141 with
142 | Some did, Some handle ->
143 Ok
144 {
145 did;
146 handle;
147 display_name = Atproto_json.get_string_opt "displayName" pairs;
148 description = Atproto_json.get_string_opt "description" pairs;
149 avatar = Atproto_json.get_string_opt "avatar" pairs;
150 banner = Atproto_json.get_string_opt "banner" pairs;
151 followers_count =
152 (match Atproto_json.get_int_opt "followersCount" pairs with
153 | Some i -> i
154 | None -> 0);
155 follows_count =
156 (match Atproto_json.get_int_opt "followsCount" pairs with
157 | Some i -> i
158 | None -> 0);
159 posts_count =
160 (match Atproto_json.get_int_opt "postsCount" pairs with
161 | Some i -> i
162 | None -> 0);
163 }
164 | _ -> Error (Invalid_response "Missing did or handle"))
165 | None -> Error (Invalid_response "Expected object")
166
167let get_profile t ~actor =
168 match Nsid.of_string "app.bsky.actor.getProfile" with
169 | Error _ -> Error (Parse_error "invalid nsid")
170 | Ok nsid -> (
171 match Client.query t.client ~nsid ~params:[ ("actor", actor) ] () with
172 | Error e -> Error (Xrpc_error e)
173 | Ok json -> parse_profile json)
174
175type post_ref = { uri : string; cid : string }
176type reply_ref = { root : post_ref; parent : post_ref }
177
178let parse_post_ref json =
179 match Atproto_json.to_object_opt json with
180 | Some pairs -> (
181 match
182 ( Atproto_json.get_string_opt "uri" pairs,
183 Atproto_json.get_string_opt "cid" pairs )
184 with
185 | Some uri, Some cid -> Ok { uri; cid }
186 | _ -> Error (Invalid_response "Missing uri or cid"))
187 | None -> Error (Invalid_response "Expected object")
188
189let make_timestamp () =
190 let t = Unix.gettimeofday () in
191 let tm = Unix.gmtime t in
192 Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02d.%03dZ" (tm.Unix.tm_year + 1900)
193 (tm.Unix.tm_mon + 1) tm.Unix.tm_mday tm.Unix.tm_hour tm.Unix.tm_min
194 tm.Unix.tm_sec
195 (int_of_float ((t -. floor t) *. 1000.))
196
197let create_post t ~text ?reply ?langs () =
198 match t.session with
199 | None -> Error Not_authenticated
200 | Some session -> (
201 match Nsid.of_string "com.atproto.repo.createRecord" with
202 | Error _ -> Error (Parse_error "invalid nsid")
203 | Ok nsid -> (
204 let now = make_timestamp () in
205 let record =
206 [
207 ("$type", Atproto_json.string "app.bsky.feed.post");
208 ("text", Atproto_json.string text);
209 ("createdAt", Atproto_json.string now);
210 ]
211 in
212 let record =
213 match reply with
214 | Some r ->
215 ( "reply",
216 Atproto_json.object_
217 [
218 ( "root",
219 Atproto_json.object_
220 [
221 ("uri", Atproto_json.string r.root.uri);
222 ("cid", Atproto_json.string r.root.cid);
223 ] );
224 ( "parent",
225 Atproto_json.object_
226 [
227 ("uri", Atproto_json.string r.parent.uri);
228 ("cid", Atproto_json.string r.parent.cid);
229 ] );
230 ] )
231 :: record
232 | None -> record
233 in
234 let record =
235 match langs with
236 | Some ls ->
237 ("langs", Atproto_json.array (List.map Atproto_json.string ls))
238 :: record
239 | None -> record
240 in
241 let input =
242 Atproto_json.object_
243 [
244 ("repo", Atproto_json.string session.did);
245 ("collection", Atproto_json.string "app.bsky.feed.post");
246 ("record", Atproto_json.object_ record);
247 ]
248 in
249 match Client.procedure t.client ~nsid ~input () with
250 | Error e -> Error (Xrpc_error e)
251 | Ok json -> parse_post_ref json))
252
253let create_post_richtext t ~richtext ?reply ?langs () =
254 match t.session with
255 | None -> Error Not_authenticated
256 | Some session -> (
257 match Nsid.of_string "com.atproto.repo.createRecord" with
258 | Error _ -> Error (Parse_error "invalid nsid")
259 | Ok nsid -> (
260 let now = make_timestamp () in
261 let rt_json = Richtext.to_json richtext in
262 let base_record =
263 match Atproto_json.to_object_opt rt_json with
264 | Some pairs -> pairs
265 | None -> []
266 in
267 let record =
268 ("$type", Atproto_json.string "app.bsky.feed.post")
269 :: ("createdAt", Atproto_json.string now)
270 :: base_record
271 in
272 let record =
273 match reply with
274 | Some r ->
275 ( "reply",
276 Atproto_json.object_
277 [
278 ( "root",
279 Atproto_json.object_
280 [
281 ("uri", Atproto_json.string r.root.uri);
282 ("cid", Atproto_json.string r.root.cid);
283 ] );
284 ( "parent",
285 Atproto_json.object_
286 [
287 ("uri", Atproto_json.string r.parent.uri);
288 ("cid", Atproto_json.string r.parent.cid);
289 ] );
290 ] )
291 :: record
292 | None -> record
293 in
294 let record =
295 match langs with
296 | Some ls ->
297 ("langs", Atproto_json.array (List.map Atproto_json.string ls))
298 :: record
299 | None -> record
300 in
301 let input =
302 Atproto_json.object_
303 [
304 ("repo", Atproto_json.string session.did);
305 ("collection", Atproto_json.string "app.bsky.feed.post");
306 ("record", Atproto_json.object_ record);
307 ]
308 in
309 match Client.procedure t.client ~nsid ~input () with
310 | Error e -> Error (Xrpc_error e)
311 | Ok json -> parse_post_ref json))
312
313let delete_post t ~uri =
314 match t.session with
315 | None -> Error Not_authenticated
316 | Some session -> (
317 match Nsid.of_string "com.atproto.repo.deleteRecord" with
318 | Error _ -> Error (Parse_error "invalid nsid")
319 | Ok nsid -> (
320 match At_uri.of_string uri with
321 | Error _ -> Error (Parse_error "invalid AT-URI")
322 | Ok at_uri -> (
323 let rkey =
324 match At_uri.rkey at_uri with Some r -> r | None -> ""
325 in
326 let input =
327 Atproto_json.object_
328 [
329 ("repo", Atproto_json.string session.did);
330 ("collection", Atproto_json.string "app.bsky.feed.post");
331 ("rkey", Atproto_json.string rkey);
332 ]
333 in
334 match Client.procedure t.client ~nsid ~input () with
335 | Error e -> Error (Xrpc_error e)
336 | Ok _ -> Ok ())))
337
338let like t ~uri ~cid =
339 match t.session with
340 | None -> Error Not_authenticated
341 | Some session -> (
342 match Nsid.of_string "com.atproto.repo.createRecord" with
343 | Error _ -> Error (Parse_error "invalid nsid")
344 | Ok nsid -> (
345 let now = make_timestamp () in
346 let input =
347 Atproto_json.object_
348 [
349 ("repo", Atproto_json.string session.did);
350 ("collection", Atproto_json.string "app.bsky.feed.like");
351 ( "record",
352 Atproto_json.object_
353 [
354 ("$type", Atproto_json.string "app.bsky.feed.like");
355 ( "subject",
356 Atproto_json.object_
357 [
358 ("uri", Atproto_json.string uri);
359 ("cid", Atproto_json.string cid);
360 ] );
361 ("createdAt", Atproto_json.string now);
362 ] );
363 ]
364 in
365 match Client.procedure t.client ~nsid ~input () with
366 | Error e -> Error (Xrpc_error e)
367 | Ok json -> parse_post_ref json))
368
369let unlike t ~uri =
370 match t.session with
371 | None -> Error Not_authenticated
372 | Some session -> (
373 match Nsid.of_string "com.atproto.repo.deleteRecord" with
374 | Error _ -> Error (Parse_error "invalid nsid")
375 | Ok nsid -> (
376 match At_uri.of_string uri with
377 | Error _ -> Error (Parse_error "invalid AT-URI")
378 | Ok at_uri -> (
379 let rkey =
380 match At_uri.rkey at_uri with Some r -> r | None -> ""
381 in
382 let input =
383 Atproto_json.object_
384 [
385 ("repo", Atproto_json.string session.did);
386 ("collection", Atproto_json.string "app.bsky.feed.like");
387 ("rkey", Atproto_json.string rkey);
388 ]
389 in
390 match Client.procedure t.client ~nsid ~input () with
391 | Error e -> Error (Xrpc_error e)
392 | Ok _ -> Ok ())))
393
394let follow t ~did =
395 match t.session with
396 | None -> Error Not_authenticated
397 | Some session -> (
398 match Nsid.of_string "com.atproto.repo.createRecord" with
399 | Error _ -> Error (Parse_error "invalid nsid")
400 | Ok nsid -> (
401 let now = make_timestamp () in
402 let input =
403 Atproto_json.object_
404 [
405 ("repo", Atproto_json.string session.did);
406 ("collection", Atproto_json.string "app.bsky.graph.follow");
407 ( "record",
408 Atproto_json.object_
409 [
410 ("$type", Atproto_json.string "app.bsky.graph.follow");
411 ("subject", Atproto_json.string did);
412 ("createdAt", Atproto_json.string now);
413 ] );
414 ]
415 in
416 match Client.procedure t.client ~nsid ~input () with
417 | Error e -> Error (Xrpc_error e)
418 | Ok json -> parse_post_ref json))
419
420let unfollow t ~uri =
421 match t.session with
422 | None -> Error Not_authenticated
423 | Some session -> (
424 match Nsid.of_string "com.atproto.repo.deleteRecord" with
425 | Error _ -> Error (Parse_error "invalid nsid")
426 | Ok nsid -> (
427 match At_uri.of_string uri with
428 | Error _ -> Error (Parse_error "invalid AT-URI")
429 | Ok at_uri -> (
430 let rkey =
431 match At_uri.rkey at_uri with Some r -> r | None -> ""
432 in
433 let input =
434 Atproto_json.object_
435 [
436 ("repo", Atproto_json.string session.did);
437 ("collection", Atproto_json.string "app.bsky.graph.follow");
438 ("rkey", Atproto_json.string rkey);
439 ]
440 in
441 match Client.procedure t.client ~nsid ~input () with
442 | Error e -> Error (Xrpc_error e)
443 | Ok _ -> Ok ())))
444
445let repost t ~uri ~cid =
446 match t.session with
447 | None -> Error Not_authenticated
448 | Some session -> (
449 match Nsid.of_string "com.atproto.repo.createRecord" with
450 | Error _ -> Error (Parse_error "invalid nsid")
451 | Ok nsid -> (
452 let now = make_timestamp () in
453 let input =
454 Atproto_json.object_
455 [
456 ("repo", Atproto_json.string session.did);
457 ("collection", Atproto_json.string "app.bsky.feed.repost");
458 ( "record",
459 Atproto_json.object_
460 [
461 ("$type", Atproto_json.string "app.bsky.feed.repost");
462 ( "subject",
463 Atproto_json.object_
464 [
465 ("uri", Atproto_json.string uri);
466 ("cid", Atproto_json.string cid);
467 ] );
468 ("createdAt", Atproto_json.string now);
469 ] );
470 ]
471 in
472 match Client.procedure t.client ~nsid ~input () with
473 | Error e -> Error (Xrpc_error e)
474 | Ok json -> parse_post_ref json))
475
476type feed_item = {
477 post_uri : string;
478 post_cid : string;
479 author_did : string;
480 author_handle : string;
481 text : string;
482 created_at : string;
483 reply_count : int;
484 repost_count : int;
485 like_count : int;
486}
487
488type feed = { items : feed_item list; cursor : string option }
489
490let parse_feed_item json =
491 match Atproto_json.to_object_opt json with
492 | Some pairs -> (
493 match Atproto_json.get_object_opt "post" pairs with
494 | Some post_pairs ->
495 let uri =
496 Option.value ~default:""
497 (Atproto_json.get_string_opt "uri" post_pairs)
498 in
499 let cid =
500 Option.value ~default:""
501 (Atproto_json.get_string_opt "cid" post_pairs)
502 in
503 let author =
504 match Atproto_json.get_object_opt "author" post_pairs with
505 | Some a -> a
506 | None -> []
507 in
508 let record =
509 match Atproto_json.get_object_opt "record" post_pairs with
510 | Some r -> r
511 | None -> []
512 in
513 Some
514 {
515 post_uri = uri;
516 post_cid = cid;
517 author_did =
518 Option.value ~default:""
519 (Atproto_json.get_string_opt "did" author);
520 author_handle =
521 Option.value ~default:""
522 (Atproto_json.get_string_opt "handle" author);
523 text =
524 Option.value ~default:""
525 (Atproto_json.get_string_opt "text" record);
526 created_at =
527 Option.value ~default:""
528 (Atproto_json.get_string_opt "createdAt" record);
529 reply_count =
530 Option.value ~default:0
531 (Atproto_json.get_int_opt "replyCount" post_pairs);
532 repost_count =
533 Option.value ~default:0
534 (Atproto_json.get_int_opt "repostCount" post_pairs);
535 like_count =
536 Option.value ~default:0
537 (Atproto_json.get_int_opt "likeCount" post_pairs);
538 }
539 | None -> None)
540 | None -> None
541
542let get_timeline t ?cursor ?limit () =
543 match t.session with
544 | None -> Error Not_authenticated
545 | Some _ -> (
546 match Nsid.of_string "app.bsky.feed.getTimeline" with
547 | Error _ -> Error (Parse_error "invalid nsid")
548 | Ok nsid -> (
549 let params = [] in
550 let params =
551 match cursor with
552 | Some c -> ("cursor", c) :: params
553 | None -> params
554 in
555 let params =
556 match limit with
557 | Some l -> ("limit", string_of_int l) :: params
558 | None -> params
559 in
560 match Client.query t.client ~nsid ~params () with
561 | Error e -> Error (Xrpc_error e)
562 | Ok json -> (
563 match Atproto_json.to_object_opt json with
564 | Some pairs ->
565 let items =
566 match Atproto_json.get_array_opt "feed" pairs with
567 | Some items -> List.filter_map parse_feed_item items
568 | None -> []
569 in
570 let cursor = Atproto_json.get_string_opt "cursor" pairs in
571 Ok { items; cursor }
572 | None -> Error (Invalid_response "Expected object"))))
573
574let get_author_feed t ~actor ?cursor ?limit () =
575 match Nsid.of_string "app.bsky.feed.getAuthorFeed" with
576 | Error _ -> Error (Parse_error "invalid nsid")
577 | Ok nsid -> (
578 let params = [ ("actor", actor) ] in
579 let params =
580 match cursor with Some c -> ("cursor", c) :: params | None -> params
581 in
582 let params =
583 match limit with
584 | Some l -> ("limit", string_of_int l) :: params
585 | None -> params
586 in
587 match Client.query t.client ~nsid ~params () with
588 | Error e -> Error (Xrpc_error e)
589 | Ok json -> (
590 match Atproto_json.to_object_opt json with
591 | Some pairs ->
592 let items =
593 match Atproto_json.get_array_opt "feed" pairs with
594 | Some items -> List.filter_map parse_feed_item items
595 | None -> []
596 in
597 let cursor = Atproto_json.get_string_opt "cursor" pairs in
598 Ok { items; cursor }
599 | None -> Error (Invalid_response "Expected object")))