ActivityPub in OCaml using jsont/eio/requests
Add HTTP/2 support and use external uri library
HTTP/2 Implementation:
- Add h2_frame module for RFC 7540 frame parsing/serialization
- Add h2_hpack module for RFC 7541 header compression (HPACK)
- Add h2_stream for HTTP/2 stream state machine
- Add h2_connection for multiplexed connection management
- Add h2_client high-level API matching HTTP/1.1 interface
- Add h2_adapter for protocol version abstraction
URI Library Migration:
- Replace custom Huri.t with Uri.t from uri opam package
- Keep Huri.write for efficient Buf_write serialization
- Remove Uri module shadowing from requests and apubt libraries
- Use Uri.* functions directly throughout codebase
Requests Library Reorganization:
- core/: fundamental types (body, headers, status, method, error)
- features/: optional functionality (auth, cache, retry, signature)
- h1/: HTTP/1.1 client implementation
- h2/: HTTP/2 client implementation
- parsing/: header and structured field parsers
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+123
-144
+26
-26
bin/apub.ml
+26
-26
bin/apub.ml
···
63
63
let type_ = Apubt.Proto.Webfinger.Jrd_link.type_ link in
64
64
Fmt.pr " - rel: %s@," rel;
65
65
Option.iter (fun t -> Fmt.pr " type: %s@," t) type_;
66
-
Option.iter (fun h -> Fmt.pr " href: %s@," (Apubt.Proto.Uri.to_string h)) href
66
+
Option.iter (fun h -> Fmt.pr " href: %s@," (Uri.to_string h)) href
67
67
) links
68
68
| None -> ());
69
69
(* Show extracted ActivityPub actor URI *)
70
70
(match Apubt.Webfinger.actor_uri jrd with
71
71
| Some uri ->
72
-
Fmt.pr "@,ActivityPub Actor: %s@," (Apubt.Proto.Uri.to_string uri)
72
+
Fmt.pr "@,ActivityPub Actor: %s@," (Uri.to_string uri)
73
73
| None ->
74
74
Fmt.pr "@,No ActivityPub actor link found.@,");
75
75
Fmt.pr "@]"
···
116
116
if String.contains uri_or_acct '@' && not (String.starts_with ~prefix:"http" uri_or_acct) then
117
117
Apubt.Actor.lookup client uri_or_acct
118
118
else
119
-
Apubt.Actor.fetch client (Apubt.Proto.Uri.v uri_or_acct)
119
+
Apubt.Actor.fetch client (Uri.of_string uri_or_acct)
120
120
in
121
121
if json_output then begin
122
122
match Jsont_bytesrw.encode_string Apubt.Proto.Actor.jsont actor with
···
124
124
| Error e -> Fmt.epr "JSON encoding error: %s@." e
125
125
end else begin
126
126
Fmt.pr "@[<v>";
127
-
Fmt.pr "ID: %s@," (Apubt.Proto.Uri.to_string (Apubt.Proto.Actor.id actor));
127
+
Fmt.pr "ID: %s@," (Uri.to_string (Apubt.Proto.Actor.id actor));
128
128
Fmt.pr "Type: %s@," (Apubt.Proto.Actor_type.to_string (Apubt.Proto.Actor.type_ actor));
129
129
Option.iter (fun n -> Fmt.pr "Name: %s@," n) (Apubt.Proto.Actor.name actor);
130
130
Option.iter (fun u -> Fmt.pr "Username: %s@," u) (Apubt.Proto.Actor.preferred_username actor);
131
131
Option.iter (fun s -> Fmt.pr "Summary: %s@," s) (Apubt.Proto.Actor.summary actor);
132
-
Option.iter (fun u -> Fmt.pr "URL: %s@," (Apubt.Proto.Uri.to_string u)) (Apubt.Proto.Actor.url actor);
133
-
Fmt.pr "Inbox: %s@," (Apubt.Proto.Uri.to_string (Apubt.Proto.Actor.inbox actor));
134
-
Fmt.pr "Outbox: %s@," (Apubt.Proto.Uri.to_string (Apubt.Proto.Actor.outbox actor));
135
-
Option.iter (fun u -> Fmt.pr "Followers: %s@," (Apubt.Proto.Uri.to_string u)) (Apubt.Proto.Actor.followers actor);
136
-
Option.iter (fun u -> Fmt.pr "Following: %s@," (Apubt.Proto.Uri.to_string u)) (Apubt.Proto.Actor.following actor);
132
+
Option.iter (fun u -> Fmt.pr "URL: %s@," (Uri.to_string u)) (Apubt.Proto.Actor.url actor);
133
+
Fmt.pr "Inbox: %s@," (Uri.to_string (Apubt.Proto.Actor.inbox actor));
134
+
Fmt.pr "Outbox: %s@," (Uri.to_string (Apubt.Proto.Actor.outbox actor));
135
+
Option.iter (fun u -> Fmt.pr "Followers: %s@," (Uri.to_string u)) (Apubt.Proto.Actor.followers actor);
136
+
Option.iter (fun u -> Fmt.pr "Following: %s@," (Uri.to_string u)) (Apubt.Proto.Actor.following actor);
137
137
Fmt.pr "@]"
138
138
end;
139
139
`Ok ()
···
182
182
if String.contains uri_or_acct '@' && not (String.starts_with ~prefix:"http" uri_or_acct) then
183
183
Apubt.Actor.lookup client uri_or_acct
184
184
else
185
-
Apubt.Actor.fetch client (Apubt.Proto.Uri.v uri_or_acct)
185
+
Apubt.Actor.fetch client (Uri.of_string uri_or_acct)
186
186
in
187
187
let outbox = Apubt.Actor.outbox client actor in
188
188
if json_output then begin
···
191
191
| Error e -> Fmt.epr "JSON encoding error: %s@." e
192
192
end else begin
193
193
Fmt.pr "@[<v>";
194
-
Fmt.pr "Outbox for: %s@," (Apubt.Proto.Uri.to_string (Apubt.Proto.Actor.id actor));
194
+
Fmt.pr "Outbox for: %s@," (Uri.to_string (Apubt.Proto.Actor.id actor));
195
195
Option.iter (fun n -> Fmt.pr "Total items: %d@," n) (Apubt.Proto.Collection.total_items outbox);
196
196
Fmt.pr "@,";
197
197
(* Try to get items from collection or first page *)
···
212
212
in
213
213
List.iteri (fun i activity ->
214
214
Fmt.pr "--- Activity %d ---@," (i + 1);
215
-
Option.iter (fun id -> Fmt.pr "ID: %s@," (Apubt.Proto.Uri.to_string id)) (Apubt.Proto.Activity.id activity);
215
+
Option.iter (fun id -> Fmt.pr "ID: %s@," (Uri.to_string id)) (Apubt.Proto.Activity.id activity);
216
216
Fmt.pr "Type: %s@," (Apubt.Proto.Activity_type.to_string (Apubt.Proto.Activity.type_ activity));
217
217
Option.iter (fun p -> Fmt.pr "Published: %s@," (Apubt.Proto.Datetime.to_string p)) (Apubt.Proto.Activity.published activity);
218
218
Option.iter (fun s -> Fmt.pr "Summary: %s@," s) (Apubt.Proto.Activity.summary activity);
219
219
(* Show object info if present *)
220
220
(match Apubt.Proto.Activity.object_ activity with
221
221
| Some (Apubt.Proto.Object_ref.Uri uri) ->
222
-
Fmt.pr "Object: %s@," (Apubt.Proto.Uri.to_string uri)
222
+
Fmt.pr "Object: %s@," (Uri.to_string uri)
223
223
| Some (Apubt.Proto.Object_ref.Object obj) ->
224
224
Fmt.pr "Object type: %s@," (Apubt.Proto.Object_type.to_string (Apubt.Proto.Object.type_ obj));
225
225
Option.iter (fun c ->
···
394
394
(* Use ActivityPub federation with HTTP signatures *)
395
395
let client = create_client_with_credentials ~sw ~user_agent ~timeout env creds in
396
396
try
397
-
let actor = Apubt.Actor.fetch client (Apubt.Proto.Uri.v creds.actor_uri) in
398
-
let in_reply_to = Option.map Apubt.Proto.Uri.v reply_to in
397
+
let actor = Apubt.Actor.fetch client (Uri.of_string creds.actor_uri) in
398
+
let in_reply_to = Option.map Uri.of_string reply_to in
399
399
let _summary = if sensitive then cw_summary else None in
400
400
let activity =
401
401
if followers_only then
···
404
404
Apubt.Outbox.public_note client ~actor ?in_reply_to ~content ()
405
405
in
406
406
let activity_id = Option.get (Apubt.Proto.Activity.id activity) in
407
-
Fmt.pr "Posted: %s@." (Apubt.Proto.Uri.to_string activity_id);
407
+
Fmt.pr "Posted: %s@." (Uri.to_string activity_id);
408
408
`Ok ()
409
409
with
410
410
| Apubt.E err ->
···
469
469
(* Use ActivityPub federation with HTTP signatures *)
470
470
let client = create_client_with_credentials ~sw ~user_agent ~timeout env creds in
471
471
try
472
-
let actor = Apubt.Actor.fetch client (Apubt.Proto.Uri.v creds.actor_uri) in
472
+
let actor = Apubt.Actor.fetch client (Uri.of_string creds.actor_uri) in
473
473
let target_actor =
474
474
if String.contains target '@' && not (String.starts_with ~prefix:"http" target) then
475
475
Apubt.Actor.lookup client target
476
476
else
477
-
Apubt.Actor.fetch client (Apubt.Proto.Uri.v target)
477
+
Apubt.Actor.fetch client (Uri.of_string target)
478
478
in
479
479
let activity = Apubt.Actor.follow client ~actor ~target:target_actor in
480
480
let activity_id = Option.get (Apubt.Proto.Activity.id activity) in
481
-
Fmt.pr "Sent follow request: %s@." (Apubt.Proto.Uri.to_string activity_id);
481
+
Fmt.pr "Sent follow request: %s@." (Uri.to_string activity_id);
482
482
Fmt.pr "Target: %s (%s)@."
483
483
(Option.value ~default:"" (Apubt.Proto.Actor.preferred_username target_actor))
484
-
(Apubt.Proto.Uri.to_string (Apubt.Proto.Actor.id target_actor));
484
+
(Uri.to_string (Apubt.Proto.Actor.id target_actor));
485
485
`Ok ()
486
486
with
487
487
| Apubt.E err ->
···
542
542
(* Use ActivityPub federation with HTTP signatures *)
543
543
let client = create_client_with_credentials ~sw ~user_agent ~timeout env creds in
544
544
try
545
-
let actor = Apubt.Actor.fetch client (Apubt.Proto.Uri.v creds.actor_uri) in
546
-
let activity = Apubt.Outbox.like client ~actor ~object_:(Apubt.Proto.Uri.v object_uri) in
545
+
let actor = Apubt.Actor.fetch client (Uri.of_string creds.actor_uri) in
546
+
let activity = Apubt.Outbox.like client ~actor ~object_:(Uri.of_string object_uri) in
547
547
let activity_id = Option.get (Apubt.Proto.Activity.id activity) in
548
548
Fmt.pr "Liked: %s@." object_uri;
549
-
Fmt.pr "Activity: %s@." (Apubt.Proto.Uri.to_string activity_id);
549
+
Fmt.pr "Activity: %s@." (Uri.to_string activity_id);
550
550
`Ok ()
551
551
with
552
552
| Apubt.E err ->
···
606
606
(* Use ActivityPub federation with HTTP signatures *)
607
607
let client = create_client_with_credentials ~sw ~user_agent ~timeout env creds in
608
608
try
609
-
let actor = Apubt.Actor.fetch client (Apubt.Proto.Uri.v creds.actor_uri) in
610
-
let activity = Apubt.Outbox.announce client ~actor ~object_:(Apubt.Proto.Uri.v object_uri) in
609
+
let actor = Apubt.Actor.fetch client (Uri.of_string creds.actor_uri) in
610
+
let activity = Apubt.Outbox.announce client ~actor ~object_:(Uri.of_string object_uri) in
611
611
let activity_id = Option.get (Apubt.Proto.Activity.id activity) in
612
612
Fmt.pr "Boosted: %s@." object_uri;
613
-
Fmt.pr "Activity: %s@." (Apubt.Proto.Uri.to_string activity_id);
613
+
Fmt.pr "Activity: %s@." (Uri.to_string activity_id);
614
614
`Ok ()
615
615
with
616
616
| Apubt.E err ->
-1
lib/auth/dune
-1
lib/auth/dune
+16
-16
lib/client/apubt.ml
+16
-16
lib/client/apubt.ml
···
126
126
127
127
module Http = struct
128
128
let get t uri =
129
-
let url = Proto.Uri.to_string uri in
129
+
let url = Uri.to_string uri in
130
130
let resp = Requests.get t.requests url in
131
131
check_response resp;
132
132
Requests.Response.json resp
133
133
134
134
let get_typed t jsont uri =
135
-
let url = Proto.Uri.to_string uri in
135
+
let url = Uri.to_string uri in
136
136
let resp = Requests.get t.requests url in
137
137
check_response resp;
138
138
Requests.Response.jsonv jsont resp
···
149
149
(* Create request context for signing *)
150
150
let ctx = Requests.Signature.Context.request
151
151
~method_:`POST
152
-
~uri:(Requests.Uri.of_string (Proto.Uri.to_string uri))
152
+
~uri
153
153
~headers
154
154
in
155
155
(* Sign with digest (adds Content-Digest header and signs) *)
···
172
172
| Error msg -> raise (E (Json_error msg))
173
173
174
174
let post t uri body =
175
-
let url = Proto.Uri.to_string uri in
175
+
let url = Uri.to_string uri in
176
176
let body_str = encode_json_exn Jsont.json body in
177
177
let headers =
178
178
Requests.Headers.empty
···
183
183
check_response resp
184
184
185
185
let post_typed t jsont uri value =
186
-
let url = Proto.Uri.to_string uri in
186
+
let url = Uri.to_string uri in
187
187
let body_str = encode_json_exn jsont value in
188
188
let headers =
189
189
Requests.Headers.empty
···
201
201
Proto.Webfinger.Jrd_link.make
202
202
~rel:(Webfinger.Link.rel link)
203
203
?type_:(Webfinger.Link.type_ link)
204
-
?href:(Option.map Proto.Uri.v (Webfinger.Link.href link))
204
+
?href:(Option.map Uri.of_string (Webfinger.Link.href link))
205
205
?template:(
206
206
(* Try to get template from properties if it exists *)
207
207
Webfinger.Link.property ~uri:"template" link
···
273
273
) links
274
274
275
275
(** Extract ActivityPub actor URI from a raw Webfinger.Jrd.t *)
276
-
let actor_uri_raw (jrd : Webfinger.Jrd.t) : Proto.Uri.t option =
276
+
let actor_uri_raw (jrd : Webfinger.Jrd.t) : Uri.t option =
277
277
(* Look for self link with ActivityPub media type *)
278
278
match Webfinger.Jrd.find_link ~rel:Webfinger.Rel.activitypub jrd with
279
279
| Some link ->
280
280
(match Webfinger.Link.type_ link with
281
281
| Some t when String.equal t "application/activity+json" ->
282
-
Option.map Proto.Uri.v (Webfinger.Link.href link)
282
+
Option.map Uri.of_string (Webfinger.Link.href link)
283
283
| Some t when String.starts_with ~prefix:"application/ld+json" t ->
284
-
Option.map Proto.Uri.v (Webfinger.Link.href link)
284
+
Option.map Uri.of_string (Webfinger.Link.href link)
285
285
| _ -> None)
286
286
| None -> None
287
287
···
551
551
post t ~inbox:shared_inbox activity
552
552
| None ->
553
553
(* Fallback: construct a standard shared inbox URL *)
554
-
let shared_inbox = Proto.Uri.v (Printf.sprintf "https://%s/inbox" host) in
554
+
let shared_inbox = Uri.of_string (Printf.sprintf "https://%s/inbox" host) in
555
555
post t ~inbox:shared_inbox activity
556
556
end
557
557
···
559
559
(* Generate a unique URI for a new object/activity based on actor's base URI.
560
560
Uses timestamp + random suffix for uniqueness. *)
561
561
let generate_uri ~actor ~suffix =
562
-
let actor_uri = Proto.Uri.to_string (Proto.Actor.id actor) in
562
+
let actor_uri = Uri.to_string (Proto.Actor.id actor) in
563
563
let now = Ptime_clock.now () in
564
564
let ts = Ptime.to_float_s now |> int_of_float in
565
565
let rand = Random.bits () land 0xFFFFFF in
566
566
let unique_id = Printf.sprintf "%d-%06x" ts rand in
567
-
Proto.Uri.v (actor_uri ^ "/" ^ suffix ^ "/" ^ unique_id)
567
+
Uri.of_string (actor_uri ^ "/" ^ suffix ^ "/" ^ unique_id)
568
568
569
569
(* Get the current timestamp as an ISO 8601 string *)
570
570
let now_datetime () =
···
575
575
let resolve_recipient_inboxes t recipients =
576
576
List.filter_map (fun recipient ->
577
577
let uri = Proto.Recipient.id recipient in
578
-
let uri_str = Proto.Uri.to_string uri in
578
+
let uri_str = Uri.to_string uri in
579
579
(* Skip the public collection - it doesn't have an inbox *)
580
-
if String.equal uri_str (Proto.Uri.to_string Proto.Public.id) then
580
+
if String.equal uri_str (Uri.to_string Proto.Public.id) then
581
581
None
582
582
else begin
583
583
(* Try to fetch the actor to get their inbox *)
···
599
599
(* Deduplicate inboxes *)
600
600
let seen = Hashtbl.create 16 in
601
601
let unique_inboxes = List.filter (fun inbox ->
602
-
let uri_str = Proto.Uri.to_string inbox in
602
+
let uri_str = Uri.to_string inbox in
603
603
if Hashtbl.mem seen uri_str then false
604
604
else begin
605
605
Hashtbl.add seen uri_str ();
···
654
654
let followers_uri =
655
655
match Proto.Actor.followers actor with
656
656
| Some uri -> uri
657
-
| None -> Proto.Uri.v ""
657
+
| None -> Uri.of_string ""
658
658
in
659
659
create_note t ~actor ?in_reply_to
660
660
~to_:[Proto.Recipient.make Proto.Public.id]
+22
-22
lib/client/apubt.mli
+22
-22
lib/client/apubt.mli
···
196
196
197
197
@raise E on lookup failure *)
198
198
199
-
val actor_uri : Proto.Webfinger.t -> Proto.Uri.t option
199
+
val actor_uri : Proto.Webfinger.t -> Uri.t option
200
200
(** [actor_uri jrd] extracts the ActivityPub actor URI from a Webfinger response.
201
201
202
202
Looks for a link with [rel="self"] and [type="application/activity+json"]
···
205
205
Per the ActivityPub WebFinger spec, publishers SHOULD include exactly one
206
206
such link. *)
207
207
208
-
val actor_uri_raw : Webfinger.Jrd.t -> Proto.Uri.t option
208
+
val actor_uri_raw : Webfinger.Jrd.t -> Uri.t option
209
209
(** [actor_uri_raw jrd] extracts the ActivityPub actor URI from a raw JRD.
210
210
211
211
More efficient variant that works directly with {!Webfinger.Jrd.t}. *)
212
212
213
-
val profile_page : Proto.Webfinger.t -> Proto.Uri.t option
213
+
val profile_page : Proto.Webfinger.t -> Uri.t option
214
214
(** [profile_page jrd] extracts the HTML profile page URI from a Webfinger response.
215
215
216
216
Looks for [rel="http://webfinger.net/rel/profile-page"]. *)
···
250
250
251
251
(** Operations on ActivityPub actors. *)
252
252
module Actor : sig
253
-
val fetch : t -> Proto.Uri.t -> Proto.Actor.t
253
+
val fetch : t -> Uri.t -> Proto.Actor.t
254
254
(** [fetch client uri] fetches an actor by URI.
255
255
256
256
@raise E on fetch failure *)
···
264
264
265
265
(** {2 Collections} *)
266
266
267
-
val inbox : t -> Proto.Actor.t -> Proto.Uri.t
267
+
val inbox : t -> Proto.Actor.t -> Uri.t
268
268
(** [inbox client actor] returns the inbox URI for the actor. *)
269
269
270
270
val outbox : t -> Proto.Actor.t -> Proto.Activity.t Proto.Collection.t
···
275
275
val outbox_page :
276
276
t ->
277
277
Proto.Actor.t ->
278
-
?page:Proto.Uri.t ->
278
+
?page:Uri.t ->
279
279
unit ->
280
280
Proto.Activity.t Proto.Collection_page.t
281
281
(** [outbox_page client actor ?page ()] fetches a page of the outbox.
···
335
335
336
336
(** Operations on ActivityStreams objects (notes, articles, etc). *)
337
337
module Object : sig
338
-
val fetch : t -> Proto.Uri.t -> Proto.Object.t
338
+
val fetch : t -> Uri.t -> Proto.Object.t
339
339
(** [fetch client uri] fetches an object by URI.
340
340
341
341
@raise E on fetch failure *)
···
350
350
351
351
(** Operations for receiving activities in an inbox. *)
352
352
module Inbox : sig
353
-
val post : t -> inbox:Proto.Uri.t -> Proto.Activity.t -> unit
353
+
val post : t -> inbox:Uri.t -> Proto.Activity.t -> unit
354
354
(** [post client ~inbox activity] delivers an activity to a remote inbox.
355
355
356
356
The request is signed using the client's signing configuration.
···
386
386
val create_note :
387
387
t ->
388
388
actor:Proto.Actor.t ->
389
-
?in_reply_to:Proto.Uri.t ->
389
+
?in_reply_to:Uri.t ->
390
390
?to_:Proto.Recipient.t list ->
391
391
?cc:Proto.Recipient.t list ->
392
392
?sensitive:bool ->
···
409
409
val public_note :
410
410
t ->
411
411
actor:Proto.Actor.t ->
412
-
?in_reply_to:Proto.Uri.t ->
412
+
?in_reply_to:Uri.t ->
413
413
content:string ->
414
414
unit ->
415
415
Proto.Activity.t
···
423
423
val followers_only_note :
424
424
t ->
425
425
actor:Proto.Actor.t ->
426
-
?in_reply_to:Proto.Uri.t ->
426
+
?in_reply_to:Uri.t ->
427
427
content:string ->
428
428
unit ->
429
429
Proto.Activity.t
···
436
436
t ->
437
437
actor:Proto.Actor.t ->
438
438
to_:Proto.Actor.t list ->
439
-
?in_reply_to:Proto.Uri.t ->
439
+
?in_reply_to:Uri.t ->
440
440
content:string ->
441
441
unit ->
442
442
Proto.Activity.t
···
447
447
448
448
(** {2 Interactions} *)
449
449
450
-
val like : t -> actor:Proto.Actor.t -> object_:Proto.Uri.t -> Proto.Activity.t
450
+
val like : t -> actor:Proto.Actor.t -> object_:Uri.t -> Proto.Activity.t
451
451
(** [like client ~actor ~object_] likes an object.
452
452
453
453
@raise E on send failure *)
454
454
455
-
val unlike : t -> actor:Proto.Actor.t -> object_:Proto.Uri.t -> Proto.Activity.t
455
+
val unlike : t -> actor:Proto.Actor.t -> object_:Uri.t -> Proto.Activity.t
456
456
(** [unlike client ~actor ~object_] unlikes an object (Undo(Like)).
457
457
458
458
@raise E on send failure *)
459
459
460
-
val announce : t -> actor:Proto.Actor.t -> object_:Proto.Uri.t -> Proto.Activity.t
460
+
val announce : t -> actor:Proto.Actor.t -> object_:Uri.t -> Proto.Activity.t
461
461
(** [announce client ~actor ~object_] boosts/reblogs an object.
462
462
463
463
@raise E on send failure *)
464
464
465
-
val unannounce : t -> actor:Proto.Actor.t -> object_:Proto.Uri.t -> Proto.Activity.t
465
+
val unannounce : t -> actor:Proto.Actor.t -> object_:Uri.t -> Proto.Activity.t
466
466
(** [unannounce client ~actor ~object_] unboosts an object (Undo(Announce)).
467
467
468
468
@raise E on send failure *)
469
469
470
470
(** {2 Deletion} *)
471
471
472
-
val delete : t -> actor:Proto.Actor.t -> object_:Proto.Uri.t -> Proto.Activity.t
472
+
val delete : t -> actor:Proto.Actor.t -> object_:Uri.t -> Proto.Activity.t
473
473
(** [delete client ~actor ~object_] deletes an object.
474
474
475
475
Creates a Delete activity with a Tombstone object.
···
481
481
val update_note :
482
482
t ->
483
483
actor:Proto.Actor.t ->
484
-
object_:Proto.Uri.t ->
484
+
object_:Uri.t ->
485
485
content:string ->
486
486
unit ->
487
487
Proto.Activity.t
···
551
551
552
552
(** Low-level HTTP operations with ActivityPub content negotiation. *)
553
553
module Http : sig
554
-
val get : t -> Proto.Uri.t -> Jsont.json
554
+
val get : t -> Uri.t -> Jsont.json
555
555
(** [get client uri] performs a GET request with ActivityPub Accept header.
556
556
557
557
@raise E on request failure *)
558
558
559
-
val get_typed : t -> 'a Jsont.t -> Proto.Uri.t -> 'a
559
+
val get_typed : t -> 'a Jsont.t -> Uri.t -> 'a
560
560
(** [get_typed client jsont uri] performs a GET and decodes the response.
561
561
562
562
@raise E on request failure *)
563
563
564
-
val post : t -> Proto.Uri.t -> Jsont.json -> unit
564
+
val post : t -> Uri.t -> Jsont.json -> unit
565
565
(** [post client uri body] performs a signed POST request.
566
566
567
567
@raise E on request failure *)
568
568
569
-
val post_typed : t -> 'a Jsont.t -> Proto.Uri.t -> 'a -> unit
569
+
val post_typed : t -> 'a Jsont.t -> Uri.t -> 'a -> unit
570
570
(** [post_typed client jsont uri value] encodes and POSTs a typed value.
571
571
572
572
@raise E on request failure *)
+56
-65
lib/proto/apubt_proto.ml
+56
-65
lib/proto/apubt_proto.ml
···
22
22
let jsont = Jsont.string |> Jsont.with_doc ~kind:"datetime"
23
23
end
24
24
25
-
(** URI identifiers. *)
26
-
module Uri : sig
27
-
type t
28
-
val v : string -> t
29
-
val to_string : t -> string
30
-
val jsont : t Jsont.t
31
-
end = struct
32
-
type t = string
33
-
let v s = s
34
-
let to_string t = t
35
-
let jsont = Jsont.string |> Jsont.with_doc ~kind:"uri"
36
-
end
25
+
(** JSON codec for [Uri.t] values. *)
26
+
let uri_jsont : Uri.t Jsont.t =
27
+
Jsont.string |> Jsont.map ~dec:Uri.of_string ~enc:Uri.to_string
37
28
38
29
(** JSON-LD context. *)
39
30
module Context : sig
···
87
78
let uri_or_object_with_id : Uri.t Jsont.t =
88
79
let id_jsont =
89
80
Jsont.Object.map ~kind:"Object with id" (fun id -> id)
90
-
|> Jsont.Object.mem "id" Uri.jsont ~enc:Fun.id
81
+
|> Jsont.Object.mem "id" uri_jsont ~enc:Fun.id
91
82
|> Jsont.Object.skip_unknown
92
83
|> Jsont.Object.finish
93
84
in
94
85
Jsont.any ~kind:"URI or object"
95
-
~dec_string:Uri.jsont
86
+
~dec_string:uri_jsont
96
87
~dec_object:id_jsont
97
-
~enc:(fun _ -> Uri.jsont)
88
+
~enc:(fun _ -> uri_jsont)
98
89
()
99
90
100
91
···
150
141
Jsont.Object.map ~kind:"Link"
151
142
(fun href media_type name hreflang height width preview ->
152
143
{ href; media_type; name; hreflang; height; width; preview })
153
-
|> Jsont.Object.mem "href" Uri.jsont ~enc:href
144
+
|> Jsont.Object.mem "href" uri_jsont ~enc:href
154
145
|> Jsont.Object.opt_mem "mediaType" Jsont.string ~enc:media_type
155
146
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
156
147
|> Jsont.Object.opt_mem "hreflang" Jsont.string ~enc:hreflang
157
148
|> Jsont.Object.opt_mem "height" Jsont.int ~enc:height
158
149
|> Jsont.Object.opt_mem "width" Jsont.int ~enc:width
159
-
|> Jsont.Object.opt_mem "preview" Uri.jsont ~enc:preview
150
+
|> Jsont.Object.opt_mem "preview" uri_jsont ~enc:preview
160
151
|> Jsont.Object.finish
161
152
end
162
153
···
178
169
let link l = Link l
179
170
180
171
let jsont =
181
-
let dec_string = Jsont.map Uri.jsont ~dec:(fun u -> Uri u)
172
+
let dec_string = Jsont.map uri_jsont ~dec:(fun u -> Uri u)
182
173
~enc:(function Uri u -> u | Link _ -> assert false) in
183
174
let dec_object = Jsont.map Link.jsont ~dec:(fun l -> Link l)
184
175
~enc:(function Link l -> l | Uri _ -> assert false) in
···
238
229
Jsont.Object.map ~kind:"Image"
239
230
(fun id url name media_type width height ->
240
231
{ id; url; name; media_type; width; height })
241
-
|> Jsont.Object.opt_mem "id" Uri.jsont ~enc:id
232
+
|> Jsont.Object.opt_mem "id" uri_jsont ~enc:id
242
233
|> Jsont.Object.mem "url" Link_or_uri.jsont ~enc:url
243
234
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
244
235
|> Jsont.Object.opt_mem "mediaType" Jsont.string ~enc:media_type
···
270
261
271
262
let jsont =
272
263
(* For string case: URI *)
273
-
let dec_string = Jsont.map Uri.jsont ~dec:(fun u -> Uri u)
264
+
let dec_string = Jsont.map uri_jsont ~dec:(fun u -> Uri u)
274
265
~enc:(function Uri u -> u | _ -> assert false) in
275
266
(* For object case: either Link or Image *)
276
267
let dec_object =
···
293
284
module Public : sig
294
285
val id : Uri.t
295
286
end = struct
296
-
let id = Uri.v "https://www.w3.org/ns/activitystreams#Public"
287
+
let id = Uri.of_string "https://www.w3.org/ns/activitystreams#Public"
297
288
end
298
289
299
290
(** {1 Recipient} *)
···
320
311
let type_ t = t.type_
321
312
322
313
let jsont =
323
-
let dec_string = Jsont.map Uri.jsont
314
+
let dec_string = Jsont.map uri_jsont
324
315
~dec:(fun u -> { id = u; type_ = None })
325
316
~enc:(fun t -> t.id) in
326
317
let dec_object =
327
318
Jsont.Object.map ~kind:"Recipient"
328
319
(fun id type_ -> { id; type_ })
329
-
|> Jsont.Object.mem "id" Uri.jsont ~enc:id
320
+
|> Jsont.Object.mem "id" uri_jsont ~enc:id
330
321
|> Jsont.Object.opt_mem "type" Jsont.string ~enc:type_
331
322
|> Jsont.Object.finish
332
323
in
···
390
381
provide_client_key sign_client_key shared_inbox ->
391
382
{ proxy_url; oauth_authorization_endpoint; oauth_token_endpoint;
392
383
provide_client_key; sign_client_key; shared_inbox })
393
-
|> Jsont.Object.opt_mem "proxyUrl" Uri.jsont ~enc:proxy_url
394
-
|> Jsont.Object.opt_mem "oauthAuthorizationEndpoint" Uri.jsont
384
+
|> Jsont.Object.opt_mem "proxyUrl" uri_jsont ~enc:proxy_url
385
+
|> Jsont.Object.opt_mem "oauthAuthorizationEndpoint" uri_jsont
395
386
~enc:oauth_authorization_endpoint
396
-
|> Jsont.Object.opt_mem "oauthTokenEndpoint" Uri.jsont
387
+
|> Jsont.Object.opt_mem "oauthTokenEndpoint" uri_jsont
397
388
~enc:oauth_token_endpoint
398
-
|> Jsont.Object.opt_mem "provideClientKey" Uri.jsont ~enc:provide_client_key
399
-
|> Jsont.Object.opt_mem "signClientKey" Uri.jsont ~enc:sign_client_key
400
-
|> Jsont.Object.opt_mem "sharedInbox" Uri.jsont ~enc:shared_inbox
389
+
|> Jsont.Object.opt_mem "provideClientKey" uri_jsont ~enc:provide_client_key
390
+
|> Jsont.Object.opt_mem "signClientKey" uri_jsont ~enc:sign_client_key
391
+
|> Jsont.Object.opt_mem "sharedInbox" uri_jsont ~enc:shared_inbox
401
392
|> Jsont.Object.finish
402
393
end
403
394
···
435
426
let jsont =
436
427
Jsont.Object.map ~kind:"PublicKey"
437
428
(fun id owner public_key_pem -> { id; owner; public_key_pem })
438
-
|> Jsont.Object.mem "id" Uri.jsont ~enc:id
439
-
|> Jsont.Object.mem "owner" Uri.jsont ~enc:owner
429
+
|> Jsont.Object.mem "id" uri_jsont ~enc:id
430
+
|> Jsont.Object.mem "owner" uri_jsont ~enc:owner
440
431
|> Jsont.Object.mem "publicKeyPem" Jsont.string ~enc:public_key_pem
441
432
|> Jsont.Object.finish
442
433
end
···
624
615
also_known_as; discoverable; suspended; moved_to; featured;
625
616
featured_tags })
626
617
|> Jsont.Object.opt_mem "@context" Context.jsont ~enc:context
627
-
|> Jsont.Object.mem "id" Uri.jsont ~enc:id
618
+
|> Jsont.Object.mem "id" uri_jsont ~enc:id
628
619
|> Jsont.Object.mem "type" Actor_type.jsont ~enc:type_
629
620
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
630
621
|> Jsont.Object.opt_mem "preferredUsername" Jsont.string
631
622
~enc:preferred_username
632
623
|> Jsont.Object.opt_mem "summary" Jsont.string ~enc:summary
633
-
|> Jsont.Object.opt_mem "url" Uri.jsont ~enc:url
634
-
|> Jsont.Object.mem "inbox" Uri.jsont ~enc:inbox
635
-
|> Jsont.Object.mem "outbox" Uri.jsont ~enc:outbox
636
-
|> Jsont.Object.opt_mem "followers" Uri.jsont ~enc:followers
637
-
|> Jsont.Object.opt_mem "following" Uri.jsont ~enc:following
638
-
|> Jsont.Object.opt_mem "liked" Uri.jsont ~enc:liked
639
-
|> Jsont.Object.opt_mem "streams" (Jsont.list Uri.jsont) ~enc:streams
624
+
|> Jsont.Object.opt_mem "url" uri_jsont ~enc:url
625
+
|> Jsont.Object.mem "inbox" uri_jsont ~enc:inbox
626
+
|> Jsont.Object.mem "outbox" uri_jsont ~enc:outbox
627
+
|> Jsont.Object.opt_mem "followers" uri_jsont ~enc:followers
628
+
|> Jsont.Object.opt_mem "following" uri_jsont ~enc:following
629
+
|> Jsont.Object.opt_mem "liked" uri_jsont ~enc:liked
630
+
|> Jsont.Object.opt_mem "streams" (Jsont.list uri_jsont) ~enc:streams
640
631
|> Jsont.Object.opt_mem "endpoints" Endpoints.jsont ~enc:endpoints
641
632
|> Jsont.Object.opt_mem "publicKey" Public_key.jsont ~enc:public_key
642
633
|> Jsont.Object.opt_mem "icon" (one_or_many Image_ref.jsont) ~enc:icon
643
634
|> Jsont.Object.opt_mem "image" (one_or_many Image_ref.jsont) ~enc:image
644
635
|> Jsont.Object.opt_mem "manuallyApprovesFollowers" Jsont.bool
645
636
~enc:manually_approves_followers
646
-
|> Jsont.Object.opt_mem "alsoKnownAs" (one_or_many Uri.jsont)
637
+
|> Jsont.Object.opt_mem "alsoKnownAs" (one_or_many uri_jsont)
647
638
~enc:also_known_as
648
639
|> Jsont.Object.opt_mem "discoverable" Jsont.bool ~enc:discoverable
649
640
|> Jsont.Object.opt_mem "suspended" Jsont.bool ~enc:suspended
650
-
|> Jsont.Object.opt_mem "movedTo" Uri.jsont ~enc:moved_to
651
-
|> Jsont.Object.opt_mem "featured" Uri.jsont ~enc:featured
652
-
|> Jsont.Object.opt_mem "featuredTags" Uri.jsont ~enc:featured_tags
641
+
|> Jsont.Object.opt_mem "movedTo" uri_jsont ~enc:moved_to
642
+
|> Jsont.Object.opt_mem "featured" uri_jsont ~enc:featured
643
+
|> Jsont.Object.opt_mem "featuredTags" uri_jsont ~enc:featured_tags
653
644
|> Jsont.Object.finish
654
645
end
655
646
···
671
662
let actor a = Actor a
672
663
673
664
let jsont =
674
-
let dec_string = Jsont.map Uri.jsont
665
+
let dec_string = Jsont.map uri_jsont
675
666
~dec:(fun u -> Uri u)
676
667
~enc:(function Uri u -> u | Actor _ -> assert false) in
677
668
let dec_object = Jsont.map Actor.jsont
···
942
933
icon; image; start_time; end_time; duration; sensitive;
943
934
conversation; audience; location; preview })
944
935
|> Jsont.Object.opt_mem "@context" Context.jsont ~enc:context
945
-
|> Jsont.Object.opt_mem "id" Uri.jsont ~enc:id
936
+
|> Jsont.Object.opt_mem "id" uri_jsont ~enc:id
946
937
|> Jsont.Object.mem "type" Object_type.jsont ~enc:type_
947
938
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
948
939
|> Jsont.Object.mem "summary" (nullable Jsont.string)
···
952
943
|> Jsont.Object.opt_mem "mediaType" Jsont.string ~enc:media_type
953
944
|> Jsont.Object.opt_mem "url" (one_or_many Link_or_uri.jsont) ~enc:url
954
945
|> Jsont.Object.opt_mem "attributedTo" Actor_ref.jsont ~enc:attributed_to
955
-
|> Jsont.Object.mem "inReplyTo" (nullable Uri.jsont)
946
+
|> Jsont.Object.mem "inReplyTo" (nullable uri_jsont)
956
947
~dec_absent:None ~enc_omit:Option.is_none ~enc:in_reply_to
957
948
|> Jsont.Object.opt_mem "published" Datetime.jsont ~enc:published
958
949
|> Jsont.Object.opt_mem "updated" Datetime.jsont ~enc:updated
···
965
956
|> Jsont.Object.opt_mem "attachment" (Jsont.list Link_or_uri.jsont)
966
957
~enc:attachment
967
958
|> Jsont.Object.opt_mem "tag" (Jsont.list Link_or_uri.jsont) ~enc:tag
968
-
|> Jsont.Object.opt_mem "generator" Uri.jsont ~enc:generator
959
+
|> Jsont.Object.opt_mem "generator" uri_jsont ~enc:generator
969
960
|> Jsont.Object.opt_mem "icon" (one_or_many Image_ref.jsont) ~enc:icon
970
961
|> Jsont.Object.opt_mem "image" (one_or_many Image_ref.jsont) ~enc:image
971
962
|> Jsont.Object.opt_mem "startTime" Datetime.jsont ~enc:start_time
972
963
|> Jsont.Object.opt_mem "endTime" Datetime.jsont ~enc:end_time
973
964
|> Jsont.Object.opt_mem "duration" Jsont.string ~enc:duration
974
965
|> Jsont.Object.opt_mem "sensitive" Jsont.bool ~enc:sensitive
975
-
|> Jsont.Object.opt_mem "conversation" Uri.jsont ~enc:conversation
966
+
|> Jsont.Object.opt_mem "conversation" uri_jsont ~enc:conversation
976
967
|> Jsont.Object.opt_mem "audience" (one_or_many Recipient.jsont) ~enc:audience
977
968
|> Jsont.Object.opt_mem "location" Link_or_uri.jsont ~enc:location
978
969
|> Jsont.Object.opt_mem "preview" Link_or_uri.jsont ~enc:preview
···
997
988
let obj o = Object o
998
989
999
990
let jsont =
1000
-
let dec_string = Jsont.map Uri.jsont
991
+
let dec_string = Jsont.map uri_jsont
1001
992
~dec:(fun u -> Uri u)
1002
993
~enc:(function Uri u -> u | Object _ -> assert false) in
1003
994
let dec_object = Jsont.map Object.jsont
···
1288
1279
instrument; to_; cc; bto; bcc; published; updated; summary;
1289
1280
one_of; any_of; closed })
1290
1281
|> Jsont.Object.opt_mem "@context" Context.jsont ~enc:context
1291
-
|> Jsont.Object.opt_mem "id" Uri.jsont ~enc:id
1282
+
|> Jsont.Object.opt_mem "id" uri_jsont ~enc:id
1292
1283
|> Jsont.Object.mem "type" Activity_type.jsont ~enc:type_
1293
1284
|> Jsont.Object.mem "actor" Actor_ref.jsont ~enc:actor
1294
1285
|> Jsont.Object.opt_mem "object" Object_ref.jsont ~enc:object_
···
1327
1318
let activity a = Activity a
1328
1319
1329
1320
let jsont =
1330
-
let dec_string = Jsont.map Uri.jsont
1321
+
let dec_string = Jsont.map uri_jsont
1331
1322
~dec:(fun u -> Uri u)
1332
1323
~enc:(function Uri u -> u | Activity _ -> assert false) in
1333
1324
let dec_object = Jsont.map Activity.jsont
···
1410
1401
in
1411
1402
{ context; id; total_items; current; first; last; items; ordered })
1412
1403
|> Jsont.Object.opt_mem "@context" Context.jsont ~enc:context
1413
-
|> Jsont.Object.opt_mem "id" Uri.jsont ~enc:id
1404
+
|> Jsont.Object.opt_mem "id" uri_jsont ~enc:id
1414
1405
|> Jsont.Object.mem "type" type_jsont ~enc:ordered
1415
1406
|> Jsont.Object.opt_mem "totalItems" Jsont.int ~enc:total_items
1416
-
|> Jsont.Object.opt_mem "current" Uri.jsont ~enc:current
1417
-
|> Jsont.Object.opt_mem "first" Uri.jsont ~enc:first
1418
-
|> Jsont.Object.opt_mem "last" Uri.jsont ~enc:last
1407
+
|> Jsont.Object.opt_mem "current" uri_jsont ~enc:current
1408
+
|> Jsont.Object.opt_mem "first" uri_jsont ~enc:first
1409
+
|> Jsont.Object.opt_mem "last" uri_jsont ~enc:last
1419
1410
|> Jsont.Object.opt_mem "items" list_jsont
1420
1411
~enc:(fun t -> if t.ordered then None else t.items)
1421
1412
|> Jsont.Object.opt_mem "orderedItems" list_jsont
···
1508
1499
{ context; id; total_items; current; first; last; prev; next;
1509
1500
part_of; items; ordered })
1510
1501
|> Jsont.Object.opt_mem "@context" Context.jsont ~enc:context
1511
-
|> Jsont.Object.opt_mem "id" Uri.jsont ~enc:id
1502
+
|> Jsont.Object.opt_mem "id" uri_jsont ~enc:id
1512
1503
|> Jsont.Object.mem "type" type_jsont ~enc:ordered
1513
1504
|> Jsont.Object.opt_mem "totalItems" Jsont.int ~enc:total_items
1514
-
|> Jsont.Object.opt_mem "current" Uri.jsont ~enc:current
1515
-
|> Jsont.Object.opt_mem "first" Uri.jsont ~enc:first
1516
-
|> Jsont.Object.opt_mem "last" Uri.jsont ~enc:last
1517
-
|> Jsont.Object.opt_mem "prev" Uri.jsont ~enc:prev
1518
-
|> Jsont.Object.opt_mem "next" Uri.jsont ~enc:next
1519
-
|> Jsont.Object.opt_mem "partOf" Uri.jsont ~enc:part_of
1505
+
|> Jsont.Object.opt_mem "current" uri_jsont ~enc:current
1506
+
|> Jsont.Object.opt_mem "first" uri_jsont ~enc:first
1507
+
|> Jsont.Object.opt_mem "last" uri_jsont ~enc:last
1508
+
|> Jsont.Object.opt_mem "prev" uri_jsont ~enc:prev
1509
+
|> Jsont.Object.opt_mem "next" uri_jsont ~enc:next
1510
+
|> Jsont.Object.opt_mem "partOf" uri_jsont ~enc:part_of
1520
1511
|> Jsont.Object.opt_mem "items" list_jsont
1521
1512
~enc:(fun t -> if t.ordered then None else t.items)
1522
1513
|> Jsont.Object.opt_mem "orderedItems" list_jsont
···
1624
1615
(fun rel type_ href template -> { rel; type_; href; template })
1625
1616
|> Jsont.Object.mem "rel" Jsont.string ~enc:rel
1626
1617
|> Jsont.Object.opt_mem "type" Jsont.string ~enc:type_
1627
-
|> Jsont.Object.opt_mem "href" Uri.jsont ~enc:href
1618
+
|> Jsont.Object.opt_mem "href" uri_jsont ~enc:href
1628
1619
|> Jsont.Object.opt_mem "template" Jsont.string ~enc:template
1629
1620
|> Jsont.Object.finish
1630
1621
end
···
1751
1742
{ name; version; repository; homepage })
1752
1743
|> Jsont.Object.mem "name" Jsont.string ~enc:name
1753
1744
|> Jsont.Object.mem "version" Jsont.string ~enc:version
1754
-
|> Jsont.Object.opt_mem "repository" Uri.jsont ~enc:repository
1755
-
|> Jsont.Object.opt_mem "homepage" Uri.jsont ~enc:homepage
1745
+
|> Jsont.Object.opt_mem "repository" uri_jsont ~enc:repository
1746
+
|> Jsont.Object.opt_mem "homepage" uri_jsont ~enc:homepage
1756
1747
|> Jsont.Object.finish
1757
1748
end
1758
1749
+2
-13
lib/proto/apubt_proto.mli
+2
-13
lib/proto/apubt_proto.mli
···
41
41
(** JSON type for datetimes. *)
42
42
end
43
43
44
-
(** URI identifiers. *)
45
-
module Uri : sig
46
-
type t
47
-
48
-
val v : string -> t
49
-
(** [v s] creates a URI from the string [s]. *)
50
-
51
-
val to_string : t -> string
52
-
(** [to_string t] returns the URI as a string. *)
53
-
54
-
val jsont : t Jsont.t
55
-
(** JSON type for URIs. *)
56
-
end
44
+
val uri_jsont : Uri.t Jsont.t
45
+
(** JSON codec for [Uri.t] values. *)
57
46
58
47
(** JSON-LD context. *)
59
48
module Context : sig