ActivityPub in OCaml using jsont/eio/requests
Implement ActivityPub client operations and extend proto types
Proto layer additions:
- Actor: also_known_as, discoverable, suspended, moved_to, featured, featured_tags
- Object: conversation (for threading), audience (additional addressing)
Client layer implementations:
- HTTP Signatures via requests library (RFC 9421)
- Signing.from_pem to parse PEM private keys
- Auto-sign POST requests with Content-Digest
- NodeInfo discovery (well-known + schema 2.0/2.1)
- Inbox delivery with signature support
- Outbox operations:
- create_note, public_note, followers_only_note, direct_note
- like/unlike, announce/unannounce
- delete (with Tombstone), update_note
- Follow protocol:
- follow, unfollow
- accept_follow, reject_follow
Also adds PLAN.md documenting implementation status.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+765
-48
+117
PLAN.md
+117
PLAN.md
···
1
+
# ActivityPub Implementation Plan
2
+
3
+
## Overview
4
+
5
+
The `requests` library already provides RFC 9421 HTTP Message Signatures via `Requests.Signature`.
6
+
This simplifies Phase 1 significantly - we just need to integrate the existing signing.
7
+
8
+
## Phase 1: Integrate HTTP Signatures ✓ (requests library)
9
+
10
+
The requests library provides:
11
+
- `Signature.config` - signing configuration with key, keyid, components
12
+
- `Signature.Key` - Ed25519, RSA, ECDSA P-256/P-384, HMAC keys
13
+
- `Signature.sign` - sign request headers
14
+
- `Signature.sign_with_digest` - sign with Content-Digest (RFC 9530)
15
+
- `Signature.verify` - verify signatures
16
+
- `Signature.Content_digest` - body digest computation
17
+
18
+
### 1.1 Update Apubt.Signing
19
+
- [x] Already has key_id and private_key fields
20
+
- [ ] Add proper Key.t construction from PEM
21
+
- [ ] Configure default signed components for ActivityPub
22
+
23
+
### 1.2 Integrate into Http.post
24
+
- [ ] Create signature config from Apubt.Signing
25
+
- [ ] Sign requests before sending
26
+
- [ ] Add Content-Digest for POST bodies
27
+
28
+
## Phase 2: Activity Delivery
29
+
30
+
### 2.1 Inbox Delivery
31
+
- [ ] `Inbox.post` - POST signed activity to inbox URI
32
+
- [ ] `Inbox.post_to_actor` - resolve inbox from actor, deliver
33
+
- [ ] `Inbox.post_to_shared_inbox` - batch delivery to shared inbox
34
+
35
+
### 2.2 Recipient Resolution
36
+
- [ ] Extract recipients from to/cc/bto/bcc fields
37
+
- [ ] Dereference collection URIs to get actor list
38
+
- [ ] Handle Public collection (use shared inbox)
39
+
- [ ] De-duplicate recipients
40
+
41
+
## Phase 3: Outbox Operations
42
+
43
+
### 3.1 Note Creation
44
+
- [ ] `Outbox.create_note` - construct Create(Note) activity
45
+
- [ ] `Outbox.public_note` - to: Public, cc: followers
46
+
- [ ] `Outbox.followers_only_note` - to: followers only
47
+
- [ ] `Outbox.direct_note` - to: specific actors
48
+
- [ ] Generate unique activity/object IDs
49
+
50
+
### 3.2 Interactions
51
+
- [ ] `Outbox.like` - Like activity
52
+
- [ ] `Outbox.unlike` - Undo(Like)
53
+
- [ ] `Outbox.announce` - boost/reblog
54
+
- [ ] `Outbox.unannounce` - Undo(Announce)
55
+
56
+
### 3.3 Modifications
57
+
- [ ] `Outbox.delete` - Delete with Tombstone
58
+
- [ ] `Outbox.update_note` - Update activity
59
+
60
+
## Phase 4: Follow Protocol
61
+
62
+
### 4.1 Outgoing Follows
63
+
- [ ] `Actor.follow` - send Follow to target inbox
64
+
- [ ] `Actor.unfollow` - send Undo(Follow)
65
+
66
+
### 4.2 Incoming Follows
67
+
- [ ] `Actor.accept_follow` - send Accept(Follow)
68
+
- [ ] `Actor.reject_follow` - send Reject(Follow)
69
+
70
+
## Phase 5: Missing Proto Properties
71
+
72
+
### 5.1 Actor Properties
73
+
- [ ] `also_known_as: Uri.t list option`
74
+
- [ ] `discoverable: bool option`
75
+
- [ ] `suspended: bool option`
76
+
- [ ] `moved_to: Uri.t option`
77
+
- [ ] `featured: Uri.t option`
78
+
- [ ] `featured_tags: Uri.t option`
79
+
80
+
### 5.2 Object Properties
81
+
- [ ] `context: Uri.t option` (conversation threading)
82
+
- [ ] `audience: Recipient.t list option`
83
+
- [ ] `location` support
84
+
- [ ] `preview: Link_or_uri.t option`
85
+
86
+
### 5.3 Question Activity
87
+
- [ ] `one_of: Object.t list option`
88
+
- [ ] `any_of: Object.t list option`
89
+
- [ ] `closed: Datetime.t option`
90
+
91
+
## Phase 6: NodeInfo
92
+
93
+
- [ ] Fetch `/.well-known/nodeinfo`
94
+
- [ ] Parse nodeinfo links for schema 2.0/2.1
95
+
- [ ] Fetch and decode nodeinfo document
96
+
97
+
## Phase 7: CLI Enhancements
98
+
99
+
- [ ] `apub post` - create and post a note
100
+
- [ ] `apub follow` - follow an actor
101
+
- [ ] `apub like` - like a post
102
+
- [ ] `apub boost` - announce/reblog a post
103
+
104
+
## Implementation Order
105
+
106
+
```
107
+
Phase 1.1-1.2 (Signing integration)
108
+
↓
109
+
Phase 2 (Delivery) ──→ Phase 4 (Follow)
110
+
↓
111
+
Phase 3 (Outbox)
112
+
↓
113
+
Phase 7 (CLI)
114
+
115
+
Phase 5 (Properties) - parallel
116
+
Phase 6 (NodeInfo) - parallel
117
+
```
+538
-33
lib/client/apubt.ml
+538
-33
lib/client/apubt.ml
···
40
40
module Signing = struct
41
41
type t = {
42
42
key_id : string;
43
-
private_key : string;
44
-
algorithm : [ `Ed25519 | `Rsa_sha256 ];
43
+
key : Requests.Signature.Key.t;
44
+
config : Requests.Signature.config;
45
45
}
46
46
47
-
let create ~key_id ~private_key ?(algorithm = `Rsa_sha256) () =
48
-
{ key_id; private_key; algorithm }
47
+
(** ActivityPub signing components: @method, @authority, @path, date, digest, content-type *)
48
+
let activitypub_components =
49
+
Requests.Signature.Component.[
50
+
method_;
51
+
authority;
52
+
path;
53
+
date;
54
+
content_digest;
55
+
content_type;
56
+
]
57
+
58
+
let create ~key_id ~key () =
59
+
let config = Requests.Signature.config
60
+
~key
61
+
~keyid:key_id
62
+
~components:activitypub_components
63
+
()
64
+
in
65
+
{ key_id; key; config }
66
+
67
+
let from_pem ~key_id ~pem () =
68
+
(* Parse PEM-encoded RSA private key *)
69
+
match X509.Private_key.decode_pem pem with
70
+
| Ok (`RSA priv) ->
71
+
let key = Requests.Signature.Key.rsa ~priv in
72
+
Ok (create ~key_id ~key ())
73
+
| Ok _ ->
74
+
Error "Only RSA keys are supported for ActivityPub signatures"
75
+
| Error (`Msg msg) ->
76
+
Error ("Failed to parse PEM key: " ^ msg)
77
+
78
+
let from_pem_exn ~key_id ~pem () =
79
+
match from_pem ~key_id ~pem () with
80
+
| Ok t -> t
81
+
| Error msg -> raise (E (Signature_error msg))
49
82
50
83
let key_id t = t.key_id
51
84
end
···
101
134
check_response resp;
102
135
Requests.Response.jsonv jsont resp
103
136
137
+
(* Internal: sign a POST request if signing is configured *)
138
+
let sign_post_request t ~uri ~body ~headers =
139
+
match t.signing with
140
+
| None -> headers
141
+
| Some signing ->
142
+
(* Add Date header *)
143
+
let now = Ptime_clock.now () in
144
+
let date_str = Requests.Headers.http_date_of_ptime now in
145
+
let headers = Requests.Headers.set `Date date_str headers in
146
+
(* Create request context for signing *)
147
+
let ctx = Requests.Signature.Context.request
148
+
~method_:`POST
149
+
~uri:(Requests.Uri.of_string (Proto.Uri.to_string uri))
150
+
~headers
151
+
in
152
+
(* Sign with digest (adds Content-Digest header and signs) *)
153
+
match Requests.Signature.sign_with_digest
154
+
~config:signing.config
155
+
~context:ctx
156
+
~headers
157
+
~body
158
+
~digest_algorithm:`Sha256
159
+
with
160
+
| Ok signed_headers -> signed_headers
161
+
| Error err ->
162
+
let msg = Requests.Signature.sign_error_to_string err in
163
+
raise (E (Signature_error msg))
164
+
165
+
(* Helper to encode JSON to string, raising on error *)
166
+
let encode_json_exn jsont value =
167
+
match Jsont_bytesrw.encode_string jsont value with
168
+
| Ok s -> s
169
+
| Error msg -> raise (E (Json_error msg))
170
+
104
171
let post t uri body =
105
172
let url = Proto.Uri.to_string uri in
106
-
let resp = Requests.post t.requests ~body:(Requests.Body.json body) url in
173
+
let body_str = encode_json_exn Jsont.json body in
174
+
let headers =
175
+
Requests.Headers.empty
176
+
|> Requests.Headers.set `Content_type "application/activity+json"
177
+
in
178
+
let headers = sign_post_request t ~uri ~body:body_str ~headers in
179
+
let resp = Requests.post t.requests ~headers ~body:(Requests.Body.of_string Requests.Mime.json body_str) url in
107
180
check_response resp
108
181
109
182
let post_typed t jsont uri value =
110
183
let url = Proto.Uri.to_string uri in
111
-
let resp = Requests.post t.requests ~body:(Requests.Body.jsonv jsont value) url in
184
+
let body_str = encode_json_exn jsont value in
185
+
let headers =
186
+
Requests.Headers.empty
187
+
|> Requests.Headers.set `Content_type "application/activity+json"
188
+
in
189
+
let headers = sign_post_request t ~uri ~body:body_str ~headers in
190
+
let resp = Requests.post t.requests ~headers ~body:(Requests.Body.of_string Requests.Mime.json body_str) url in
112
191
check_response resp
113
192
end
114
193
···
173
252
end
174
253
175
254
module Nodeinfo = struct
176
-
let fetch _t ~host:_ =
177
-
failwith "TODO: Nodeinfo.fetch"
255
+
(* Well-known nodeinfo link structure *)
256
+
module Well_known_link = struct
257
+
type t = {
258
+
rel : string;
259
+
href : string;
260
+
}
261
+
262
+
let jsont =
263
+
Jsont.Object.map ~kind:"WellKnownLink"
264
+
(fun rel href -> { rel; href })
265
+
|> Jsont.Object.mem "rel" Jsont.string ~enc:(fun t -> t.rel)
266
+
|> Jsont.Object.mem "href" Jsont.string ~enc:(fun t -> t.href)
267
+
|> Jsont.Object.finish
268
+
end
269
+
270
+
module Well_known = struct
271
+
type t = {
272
+
links : Well_known_link.t list;
273
+
}
274
+
275
+
let jsont =
276
+
Jsont.Object.map ~kind:"WellKnownNodeinfo"
277
+
(fun links -> { links })
278
+
|> Jsont.Object.mem "links" (Jsont.list Well_known_link.jsont)
279
+
~enc:(fun t -> t.links)
280
+
|> Jsont.Object.finish
281
+
end
282
+
283
+
let fetch t ~host =
284
+
(* Step 1: Fetch the well-known nodeinfo discovery document *)
285
+
let well_known_url = Printf.sprintf "https://%s/.well-known/nodeinfo" host in
286
+
let headers =
287
+
Requests.Headers.empty
288
+
|> Requests.Headers.add `Accept "application/json"
289
+
in
290
+
let resp = Requests.get t.requests ~headers well_known_url in
291
+
check_response resp;
292
+
let well_known = Requests.Response.jsonv Well_known.jsont resp in
293
+
(* Step 2: Find a link with rel containing "nodeinfo" and schema 2.0 or 2.1 *)
294
+
let nodeinfo_href =
295
+
List.find_map (fun (link : Well_known_link.t) ->
296
+
(* Check if rel contains nodeinfo and is schema 2.0 or 2.1 *)
297
+
if String.length link.rel > 0 &&
298
+
(String.ends_with ~suffix:"/schema/2.0" link.rel ||
299
+
String.ends_with ~suffix:"/schema/2.1" link.rel)
300
+
then Some link.href
301
+
else None
302
+
) well_known.links
303
+
in
304
+
match nodeinfo_href with
305
+
| None -> raise (E (Json_error "No NodeInfo 2.0 or 2.1 link found in well-known response"))
306
+
| Some href ->
307
+
(* Step 3: Fetch the actual NodeInfo document *)
308
+
let resp = Requests.get t.requests ~headers href in
309
+
check_response resp;
310
+
Requests.Response.jsonv Proto.Nodeinfo.jsont resp
178
311
179
312
let software_name info =
180
313
Proto.Nodeinfo.Software.name (Proto.Nodeinfo.software info)
···
223
356
| Some uri -> Http.get_typed t (Proto.Collection.jsont Proto.Actor.jsont) uri
224
357
| None -> raise (E (Invalid_actor "Actor has no following collection"))
225
358
226
-
let follow _t ~actor:_ ~target:_ =
227
-
failwith "TODO: Actor.follow"
359
+
(* Helper to post activity to an actor's inbox *)
360
+
let post_to_inbox t actor activity =
361
+
let inbox_uri = Proto.Actor.inbox actor in
362
+
Http.post_typed t Proto.Activity.jsont inbox_uri activity
228
363
229
-
let unfollow _t ~actor:_ ~target:_ =
230
-
failwith "TODO: Actor.unfollow"
364
+
let follow t ~actor ~target =
365
+
(* Create a Follow activity: actor follows target *)
366
+
let follow_activity = Proto.Activity.make
367
+
~context:Proto.Context.default
368
+
~type_:Proto.Activity_type.Follow
369
+
~actor:(Proto.Actor_ref.actor actor)
370
+
~object_:(Proto.Object_ref.uri (Proto.Actor.id target))
371
+
()
372
+
in
373
+
(* Deliver to target's inbox *)
374
+
post_to_inbox t target follow_activity;
375
+
follow_activity
231
376
232
-
let accept_follow _t ~actor:_ ~follow:_ =
233
-
failwith "TODO: Actor.accept_follow"
377
+
let unfollow t ~actor ~target =
378
+
(* Create a Follow activity representing the original follow *)
379
+
let follow_activity = Proto.Activity.make
380
+
~type_:Proto.Activity_type.Follow
381
+
~actor:(Proto.Actor_ref.actor actor)
382
+
~object_:(Proto.Object_ref.uri (Proto.Actor.id target))
383
+
()
384
+
in
385
+
(* Wrap in an Undo activity *)
386
+
let undo_activity = Proto.Activity.make
387
+
~context:Proto.Context.default
388
+
~type_:Proto.Activity_type.Undo
389
+
~actor:(Proto.Actor_ref.actor actor)
390
+
~object_:(Proto.Object_ref.uri (
391
+
match Proto.Activity.id follow_activity with
392
+
| Some id -> id
393
+
| None -> Proto.Actor.id actor (* fallback: use actor ID as base *)
394
+
))
395
+
()
396
+
in
397
+
(* Deliver to target's inbox *)
398
+
post_to_inbox t target undo_activity;
399
+
undo_activity
400
+
401
+
let accept_follow t ~actor ~follow =
402
+
(* Create an Accept activity *)
403
+
(* The object is the Follow activity being accepted *)
404
+
let follow_ref = match Proto.Activity.id follow with
405
+
| Some id -> Proto.Object_ref.uri id
406
+
| None ->
407
+
(* If the follow has no ID, we need to reference it somehow.
408
+
In practice, Follow activities should always have IDs. *)
409
+
Proto.Object_ref.uri (Proto.Actor.id actor)
410
+
in
411
+
let accept_activity = Proto.Activity.make
412
+
~context:Proto.Context.default
413
+
~type_:Proto.Activity_type.Accept
414
+
~actor:(Proto.Actor_ref.actor actor)
415
+
~object_:follow_ref
416
+
()
417
+
in
418
+
(* Get the follower's URI from the Follow activity's actor *)
419
+
let follower_uri = match Proto.Activity.actor follow with
420
+
| Proto.Actor_ref.Uri uri -> uri
421
+
| Proto.Actor_ref.Actor a -> Proto.Actor.id a
422
+
in
423
+
(* Deliver to the follower's inbox - we need to fetch their actor info *)
424
+
let follower = fetch t follower_uri in
425
+
post_to_inbox t follower accept_activity;
426
+
accept_activity
234
427
235
-
let reject_follow _t ~actor:_ ~follow:_ =
236
-
failwith "TODO: Actor.reject_follow"
428
+
let reject_follow t ~actor ~follow =
429
+
(* Create a Reject activity *)
430
+
(* The object is the Follow activity being rejected *)
431
+
let follow_ref = match Proto.Activity.id follow with
432
+
| Some id -> Proto.Object_ref.uri id
433
+
| None ->
434
+
(* If the follow has no ID, we need to reference it somehow.
435
+
In practice, Follow activities should always have IDs. *)
436
+
Proto.Object_ref.uri (Proto.Actor.id actor)
437
+
in
438
+
let reject_activity = Proto.Activity.make
439
+
~context:Proto.Context.default
440
+
~type_:Proto.Activity_type.Reject
441
+
~actor:(Proto.Actor_ref.actor actor)
442
+
~object_:follow_ref
443
+
()
444
+
in
445
+
(* Get the follower's URI from the Follow activity's actor *)
446
+
let follower_uri = match Proto.Activity.actor follow with
447
+
| Proto.Actor_ref.Uri uri -> uri
448
+
| Proto.Actor_ref.Actor a -> Proto.Actor.id a
449
+
in
450
+
(* Deliver to the follower's inbox - we need to fetch their actor info *)
451
+
let follower = fetch t follower_uri in
452
+
post_to_inbox t follower reject_activity;
453
+
reject_activity
237
454
end
238
455
239
456
module Object = struct
···
254
471
let inbox = Actor.inbox t actor in
255
472
post t ~inbox activity
256
473
257
-
let post_to_shared_inbox _t ~host:_ _activity =
258
-
failwith "TODO: Inbox.post_to_shared_inbox"
474
+
let discover_shared_inbox t ~host =
475
+
(* Try to get shared inbox from instance actor endpoint *)
476
+
let instance_actor_url = Printf.sprintf "https://%s/actor" host in
477
+
try
478
+
let resp = Requests.get t.requests instance_actor_url in
479
+
if Requests.Response.status_code resp >= 200 &&
480
+
Requests.Response.status_code resp < 300 then begin
481
+
let actor = Requests.Response.jsonv Proto.Actor.jsont resp in
482
+
match Proto.Actor.endpoints actor with
483
+
| Some endpoints ->
484
+
Proto.Endpoints.shared_inbox endpoints
485
+
| None -> None
486
+
end else
487
+
None
488
+
with _ ->
489
+
(* If fetching instance actor fails, there's no shared inbox *)
490
+
None
491
+
492
+
let post_to_shared_inbox t ~host activity =
493
+
match discover_shared_inbox t ~host with
494
+
| Some shared_inbox ->
495
+
post t ~inbox:shared_inbox activity
496
+
| None ->
497
+
(* Fallback: construct a standard shared inbox URL *)
498
+
let shared_inbox = Proto.Uri.v (Printf.sprintf "https://%s/inbox" host) in
499
+
post t ~inbox:shared_inbox activity
259
500
end
260
501
261
502
module Outbox = struct
262
-
let create_note _t ~actor:_ ?in_reply_to:_ ?to_:_ ?cc:_ ?sensitive:_
263
-
?summary:_ ~content:_ () =
264
-
failwith "TODO: Outbox.create_note"
503
+
(* Generate a unique URI for a new object/activity based on actor's base URI.
504
+
Uses timestamp + random suffix for uniqueness. *)
505
+
let generate_uri ~actor ~suffix =
506
+
let actor_uri = Proto.Uri.to_string (Proto.Actor.id actor) in
507
+
let now = Ptime_clock.now () in
508
+
let ts = Ptime.to_float_s now |> int_of_float in
509
+
let rand = Random.bits () land 0xFFFFFF in
510
+
let unique_id = Printf.sprintf "%d-%06x" ts rand in
511
+
Proto.Uri.v (actor_uri ^ "/" ^ suffix ^ "/" ^ unique_id)
512
+
513
+
(* Get the current timestamp as an ISO 8601 string *)
514
+
let now_datetime () =
515
+
let now = Ptime_clock.now () in
516
+
Proto.Datetime.v (Ptime.to_rfc3339 now)
517
+
518
+
(* Extract inbox URIs from a list of recipients, resolving actors as needed *)
519
+
let resolve_recipient_inboxes t recipients =
520
+
List.filter_map (fun recipient ->
521
+
let uri = Proto.Recipient.id recipient in
522
+
let uri_str = Proto.Uri.to_string uri in
523
+
(* Skip the public collection - it doesn't have an inbox *)
524
+
if String.equal uri_str (Proto.Uri.to_string Proto.Public.id) then
525
+
None
526
+
else begin
527
+
(* Try to fetch the actor to get their inbox *)
528
+
try
529
+
let actor = Actor.fetch t uri in
530
+
Some (Proto.Actor.inbox actor)
531
+
with E _ ->
532
+
(* If we can't fetch the actor, skip this recipient *)
533
+
None
534
+
end
535
+
) recipients
536
+
537
+
(* Deliver an activity to all recipients in to/cc *)
538
+
let deliver t activity =
539
+
let to_recipients = Option.value ~default:[] (Proto.Activity.to_ activity) in
540
+
let cc_recipients = Option.value ~default:[] (Proto.Activity.cc activity) in
541
+
let all_recipients = to_recipients @ cc_recipients in
542
+
let inboxes = resolve_recipient_inboxes t all_recipients in
543
+
(* Deduplicate inboxes *)
544
+
let seen = Hashtbl.create 16 in
545
+
let unique_inboxes = List.filter (fun inbox ->
546
+
let uri_str = Proto.Uri.to_string inbox in
547
+
if Hashtbl.mem seen uri_str then false
548
+
else begin
549
+
Hashtbl.add seen uri_str ();
550
+
true
551
+
end
552
+
) inboxes in
553
+
(* Post to each inbox *)
554
+
List.iter (fun inbox ->
555
+
try
556
+
Inbox.post t ~inbox activity
557
+
with E _ ->
558
+
(* Log delivery failures but don't fail the whole operation *)
559
+
()
560
+
) unique_inboxes
561
+
562
+
let create_note t ~actor ?in_reply_to ?to_ ?cc ?sensitive ?summary ~content () =
563
+
let note_id = generate_uri ~actor ~suffix:"notes" in
564
+
let activity_id = generate_uri ~actor ~suffix:"activities" in
565
+
let published = now_datetime () in
566
+
(* Build the Note object *)
567
+
let note = Proto.Object.make
568
+
~context:Proto.Context.default
569
+
~id:note_id
570
+
~type_:Proto.Object_type.Note
571
+
~content
572
+
~attributed_to:(Proto.Actor_ref.uri (Proto.Actor.id actor))
573
+
?in_reply_to
574
+
?to_
575
+
?cc
576
+
?sensitive
577
+
?summary
578
+
~published
579
+
()
580
+
in
581
+
(* Build the Create activity *)
582
+
let activity = Proto.Activity.make
583
+
~context:Proto.Context.default
584
+
~id:activity_id
585
+
~type_:Proto.Activity_type.Create
586
+
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
587
+
~object_:(Proto.Object_ref.obj note)
588
+
?to_
589
+
?cc
590
+
~published
591
+
()
592
+
in
593
+
(* Deliver to all recipients *)
594
+
deliver t activity;
595
+
activity
265
596
266
597
let public_note t ~actor ?in_reply_to ~content () =
267
598
let followers_uri =
···
288
619
let recipients = List.map (fun a -> Proto.Recipient.make (Proto.Actor.id a)) to_ in
289
620
create_note t ~actor ?in_reply_to ~to_:recipients ~content ()
290
621
291
-
let like _t ~actor:_ ~object_:_ =
292
-
failwith "TODO: Outbox.like"
622
+
let like t ~actor ~object_ =
623
+
let activity_id = generate_uri ~actor ~suffix:"likes" in
624
+
let published = now_datetime () in
625
+
(* Fetch the object to find its author for delivery *)
626
+
let obj = Object.fetch t object_ in
627
+
let to_recipients =
628
+
match Proto.Object.attributed_to obj with
629
+
| Some (Proto.Actor_ref.Uri uri) -> [Proto.Recipient.make uri]
630
+
| Some (Proto.Actor_ref.Actor a) -> [Proto.Recipient.make (Proto.Actor.id a)]
631
+
| None -> []
632
+
in
633
+
(* Build the Like activity *)
634
+
let activity = Proto.Activity.make
635
+
~context:Proto.Context.default
636
+
~id:activity_id
637
+
~type_:Proto.Activity_type.Like
638
+
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
639
+
~object_:(Proto.Object_ref.uri object_)
640
+
~to_:to_recipients
641
+
~published
642
+
()
643
+
in
644
+
(* Deliver to the object's author *)
645
+
deliver t activity;
646
+
activity
293
647
294
-
let unlike _t ~actor:_ ~object_:_ =
295
-
failwith "TODO: Outbox.unlike"
648
+
let unlike t ~actor ~object_ =
649
+
let activity_id = generate_uri ~actor ~suffix:"undo" in
650
+
let like_id = generate_uri ~actor ~suffix:"likes" in
651
+
let published = now_datetime () in
652
+
(* Fetch the object to find its author for delivery *)
653
+
let obj = Object.fetch t object_ in
654
+
let to_recipients =
655
+
match Proto.Object.attributed_to obj with
656
+
| Some (Proto.Actor_ref.Uri uri) -> [Proto.Recipient.make uri]
657
+
| Some (Proto.Actor_ref.Actor a) -> [Proto.Recipient.make (Proto.Actor.id a)]
658
+
| None -> []
659
+
in
660
+
(* Build the Undo(Like) activity - reference the Like by URI *)
661
+
let activity = Proto.Activity.make
662
+
~context:Proto.Context.default
663
+
~id:activity_id
664
+
~type_:Proto.Activity_type.Undo
665
+
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
666
+
~object_:(Proto.Object_ref.uri like_id)
667
+
~to_:to_recipients
668
+
~published
669
+
()
670
+
in
671
+
(* Deliver to the object's author *)
672
+
deliver t activity;
673
+
activity
296
674
297
-
let announce _t ~actor:_ ~object_:_ =
298
-
failwith "TODO: Outbox.announce"
675
+
let announce t ~actor ~object_ =
676
+
let activity_id = generate_uri ~actor ~suffix:"announces" in
677
+
let published = now_datetime () in
678
+
(* Get actor's followers for cc *)
679
+
let followers_uri = Proto.Actor.followers actor in
680
+
let cc_recipients = match followers_uri with
681
+
| Some uri -> [Proto.Recipient.make uri]
682
+
| None -> []
683
+
in
684
+
(* Fetch the object to find its author for delivery *)
685
+
let obj = Object.fetch t object_ in
686
+
let author_recipients =
687
+
match Proto.Object.attributed_to obj with
688
+
| Some (Proto.Actor_ref.Uri uri) -> [Proto.Recipient.make uri]
689
+
| Some (Proto.Actor_ref.Actor a) -> [Proto.Recipient.make (Proto.Actor.id a)]
690
+
| None -> []
691
+
in
692
+
(* to: public, author; cc: followers *)
693
+
let to_recipients = Proto.Recipient.make Proto.Public.id :: author_recipients in
694
+
(* Build the Announce activity *)
695
+
let activity = Proto.Activity.make
696
+
~context:Proto.Context.default
697
+
~id:activity_id
698
+
~type_:Proto.Activity_type.Announce
699
+
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
700
+
~object_:(Proto.Object_ref.uri object_)
701
+
~to_:to_recipients
702
+
~cc:cc_recipients
703
+
~published
704
+
()
705
+
in
706
+
(* Deliver to followers and the object's author *)
707
+
deliver t activity;
708
+
activity
299
709
300
-
let unannounce _t ~actor:_ ~object_:_ =
301
-
failwith "TODO: Outbox.unannounce"
710
+
let unannounce t ~actor ~object_ =
711
+
let activity_id = generate_uri ~actor ~suffix:"undo" in
712
+
let announce_id = generate_uri ~actor ~suffix:"announces" in
713
+
let published = now_datetime () in
714
+
(* Get actor's followers for cc *)
715
+
let followers_uri = Proto.Actor.followers actor in
716
+
let cc_recipients = match followers_uri with
717
+
| Some uri -> [Proto.Recipient.make uri]
718
+
| None -> []
719
+
in
720
+
(* Fetch the object to find its author for delivery *)
721
+
let obj = Object.fetch t object_ in
722
+
let author_recipients =
723
+
match Proto.Object.attributed_to obj with
724
+
| Some (Proto.Actor_ref.Uri uri) -> [Proto.Recipient.make uri]
725
+
| Some (Proto.Actor_ref.Actor a) -> [Proto.Recipient.make (Proto.Actor.id a)]
726
+
| None -> []
727
+
in
728
+
let to_recipients = Proto.Recipient.make Proto.Public.id :: author_recipients in
729
+
(* Build the Undo(Announce) activity *)
730
+
let activity = Proto.Activity.make
731
+
~context:Proto.Context.default
732
+
~id:activity_id
733
+
~type_:Proto.Activity_type.Undo
734
+
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
735
+
~object_:(Proto.Object_ref.uri announce_id)
736
+
~to_:to_recipients
737
+
~cc:cc_recipients
738
+
~published
739
+
()
740
+
in
741
+
(* Deliver to followers and the object's author *)
742
+
deliver t activity;
743
+
activity
302
744
303
-
let delete _t ~actor:_ ~object_:_ =
304
-
failwith "TODO: Outbox.delete"
745
+
let delete t ~actor ~object_ =
746
+
let activity_id = generate_uri ~actor ~suffix:"deletes" in
747
+
let published = now_datetime () in
748
+
(* Fetch the original object to get its recipients *)
749
+
let obj = Object.fetch t object_ in
750
+
let to_recipients = Option.value ~default:[] (Proto.Object.to_ obj) in
751
+
let cc_recipients = Option.value ~default:[] (Proto.Object.cc obj) in
752
+
(* Create a Tombstone object *)
753
+
let tombstone = Proto.Object.make
754
+
~id:object_
755
+
~type_:Proto.Object_type.Tombstone
756
+
~published
757
+
()
758
+
in
759
+
(* Build the Delete activity *)
760
+
let activity = Proto.Activity.make
761
+
~context:Proto.Context.default
762
+
~id:activity_id
763
+
~type_:Proto.Activity_type.Delete
764
+
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
765
+
~object_:(Proto.Object_ref.obj tombstone)
766
+
~to_:to_recipients
767
+
~cc:cc_recipients
768
+
~published
769
+
()
770
+
in
771
+
(* Deliver to previous recipients *)
772
+
deliver t activity;
773
+
activity
305
774
306
-
let update_note _t ~actor:_ ~object_:_ ~content:_ () =
307
-
failwith "TODO: Outbox.update_note"
775
+
let update_note t ~actor ~object_ ~content () =
776
+
let activity_id = generate_uri ~actor ~suffix:"updates" in
777
+
let published = now_datetime () in
778
+
(* Fetch the original note to preserve its metadata *)
779
+
let original = Object.fetch t object_ in
780
+
let to_recipients = Option.value ~default:[] (Proto.Object.to_ original) in
781
+
let cc_recipients = Option.value ~default:[] (Proto.Object.cc original) in
782
+
(* Create the updated Note object *)
783
+
let updated_note = Proto.Object.make
784
+
~context:Proto.Context.default
785
+
~id:object_
786
+
~type_:Proto.Object_type.Note
787
+
~content
788
+
~attributed_to:(Proto.Actor_ref.uri (Proto.Actor.id actor))
789
+
?in_reply_to:(Proto.Object.in_reply_to original)
790
+
~to_:to_recipients
791
+
~cc:cc_recipients
792
+
?summary:(Proto.Object.summary original)
793
+
?sensitive:(Proto.Object.sensitive original)
794
+
~updated:published
795
+
?published:(Proto.Object.published original)
796
+
()
797
+
in
798
+
(* Build the Update activity *)
799
+
let activity = Proto.Activity.make
800
+
~context:Proto.Context.default
801
+
~id:activity_id
802
+
~type_:Proto.Activity_type.Update
803
+
~actor:(Proto.Actor_ref.uri (Proto.Actor.id actor))
804
+
~object_:(Proto.Object_ref.obj updated_note)
805
+
~to_:to_recipients
806
+
~cc:cc_recipients
807
+
~published
808
+
()
809
+
in
810
+
(* Deliver to recipients *)
811
+
deliver t activity;
812
+
activity
308
813
end
309
814
310
815
module Collection = struct
+35
-6
lib/client/apubt.mli
+35
-6
lib/client/apubt.mli
···
70
70
type t
71
71
(** An ActivityPub client with connection pooling and optional signing. *)
72
72
73
-
(** HTTP signature configuration for authenticated requests. *)
73
+
(** HTTP signature configuration for authenticated requests.
74
+
75
+
Uses RFC 9421 HTTP Message Signatures via the Requests library.
76
+
ActivityPub typically uses RSA-SHA256 signatures.
77
+
78
+
The following message components are signed:
79
+
- [@method] - HTTP request method
80
+
- [@authority] - Target host
81
+
- [@path] - Request target path
82
+
- [date] - Date header
83
+
- [content-digest] - SHA-256 digest of request body
84
+
- [content-type] - Content-Type header *)
74
85
module Signing : sig
75
86
type t
76
87
(** Signing configuration. *)
77
88
78
89
val create :
79
90
key_id:string ->
80
-
private_key:string ->
81
-
?algorithm:[ `Ed25519 | `Rsa_sha256 ] ->
91
+
key:Requests.Signature.Key.t ->
82
92
unit ->
83
93
t
84
-
(** [create ~key_id ~private_key ?algorithm ()] creates a signing configuration.
94
+
(** [create ~key_id ~key ()] creates a signing configuration.
95
+
96
+
@param key_id The key ID URI (typically actor URI + "#main-key")
97
+
@param key The cryptographic key from {!Requests.Signature.Key} *)
98
+
99
+
val from_pem :
100
+
key_id:string ->
101
+
pem:string ->
102
+
unit ->
103
+
(t, string) result
104
+
(** [from_pem ~key_id ~pem ()] creates a signing configuration from a
105
+
PEM-encoded RSA private key.
85
106
86
107
@param key_id The key ID URI (typically actor URI + "#main-key")
87
-
@param private_key PEM-encoded private key
88
-
@param algorithm Signature algorithm (default: [`Rsa_sha256]) *)
108
+
@param pem PEM-encoded RSA private key
109
+
@return [Ok t] on success, [Error msg] if PEM parsing fails *)
110
+
111
+
val from_pem_exn :
112
+
key_id:string ->
113
+
pem:string ->
114
+
unit ->
115
+
t
116
+
(** [from_pem_exn ~key_id ~pem ()] is like {!from_pem} but raises
117
+
{!E} with {!Error.Signature_error} on failure. *)
89
118
90
119
val key_id : t -> string
91
120
(** [key_id t] returns the key ID URI. *)
+1
-1
lib/client/dune
+1
-1
lib/client/dune
+58
-8
lib/proto/apubt_proto.ml
+58
-8
lib/proto/apubt_proto.ml
···
514
514
?icon:Image_ref.t list ->
515
515
?image:Image_ref.t list ->
516
516
?manually_approves_followers:bool ->
517
+
?also_known_as:Uri.t list ->
518
+
?discoverable:bool ->
519
+
?suspended:bool ->
520
+
?moved_to:Uri.t ->
521
+
?featured:Uri.t ->
522
+
?featured_tags:Uri.t ->
517
523
unit -> t
518
524
519
525
val context : t -> Context.t option
···
534
540
val icon : t -> Image_ref.t list option
535
541
val image : t -> Image_ref.t list option
536
542
val manually_approves_followers : t -> bool option
543
+
val also_known_as : t -> Uri.t list option
544
+
val discoverable : t -> bool option
545
+
val suspended : t -> bool option
546
+
val moved_to : t -> Uri.t option
547
+
val featured : t -> Uri.t option
548
+
val featured_tags : t -> Uri.t option
537
549
538
550
val jsont : t Jsont.t
539
551
end = struct
···
556
568
icon : Image_ref.t list option;
557
569
image : Image_ref.t list option;
558
570
manually_approves_followers : bool option;
571
+
also_known_as : Uri.t list option;
572
+
discoverable : bool option;
573
+
suspended : bool option;
574
+
moved_to : Uri.t option;
575
+
featured : Uri.t option;
576
+
featured_tags : Uri.t option;
559
577
}
560
578
561
579
let make ?context ~id ~type_ ?name ?preferred_username ?summary ?url
562
580
~inbox ~outbox ?followers ?following ?liked ?streams ?endpoints
563
-
?public_key ?icon ?image ?manually_approves_followers () =
581
+
?public_key ?icon ?image ?manually_approves_followers
582
+
?also_known_as ?discoverable ?suspended ?moved_to ?featured
583
+
?featured_tags () =
564
584
{ context; id; type_; name; preferred_username; summary; url;
565
585
inbox; outbox; followers; following; liked; streams; endpoints;
566
-
public_key; icon; image; manually_approves_followers }
586
+
public_key; icon; image; manually_approves_followers;
587
+
also_known_as; discoverable; suspended; moved_to; featured;
588
+
featured_tags }
567
589
568
590
let context t = t.context
569
591
let id t = t.id
···
583
605
let icon t = t.icon
584
606
let image t = t.image
585
607
let manually_approves_followers t = t.manually_approves_followers
608
+
let also_known_as t = t.also_known_as
609
+
let discoverable t = t.discoverable
610
+
let suspended t = t.suspended
611
+
let moved_to t = t.moved_to
612
+
let featured t = t.featured
613
+
let featured_tags t = t.featured_tags
586
614
587
615
let jsont =
588
616
Jsont.Object.map ~kind:"Actor"
589
617
(fun context id type_ name preferred_username summary url inbox outbox
590
618
followers following liked streams endpoints public_key icon image
591
-
manually_approves_followers ->
619
+
manually_approves_followers also_known_as discoverable suspended
620
+
moved_to featured featured_tags ->
592
621
{ context; id; type_; name; preferred_username; summary; url;
593
622
inbox; outbox; followers; following; liked; streams; endpoints;
594
-
public_key; icon; image; manually_approves_followers })
623
+
public_key; icon; image; manually_approves_followers;
624
+
also_known_as; discoverable; suspended; moved_to; featured;
625
+
featured_tags })
595
626
|> Jsont.Object.opt_mem "@context" Context.jsont ~enc:context
596
627
|> Jsont.Object.mem "id" Uri.jsont ~enc:id
597
628
|> Jsont.Object.mem "type" Actor_type.jsont ~enc:type_
···
612
643
|> Jsont.Object.opt_mem "image" (one_or_many Image_ref.jsont) ~enc:image
613
644
|> Jsont.Object.opt_mem "manuallyApprovesFollowers" Jsont.bool
614
645
~enc:manually_approves_followers
646
+
|> Jsont.Object.opt_mem "alsoKnownAs" (one_or_many Uri.jsont)
647
+
~enc:also_known_as
648
+
|> Jsont.Object.opt_mem "discoverable" Jsont.bool ~enc:discoverable
649
+
|> 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
615
653
|> Jsont.Object.finish
616
654
end
617
655
···
769
807
?end_time:Datetime.t ->
770
808
?duration:string ->
771
809
?sensitive:bool ->
810
+
?conversation:Uri.t ->
811
+
?audience:Recipient.t list ->
772
812
unit -> t
773
813
774
814
val context : t -> Context.t option
···
798
838
val end_time : t -> Datetime.t option
799
839
val duration : t -> string option
800
840
val sensitive : t -> bool option
841
+
val conversation : t -> Uri.t option
842
+
val audience : t -> Recipient.t list option
801
843
802
844
val jsont : t Jsont.t
803
845
end = struct
···
829
871
end_time : Datetime.t option;
830
872
duration : string option;
831
873
sensitive : bool option;
874
+
conversation : Uri.t option;
875
+
audience : Recipient.t list option;
832
876
}
833
877
834
878
let make ?context ?id ~type_ ?name ?summary ?content ?media_type ?url
835
879
?attributed_to ?in_reply_to ?published ?updated ?deleted ?to_ ?cc
836
880
?bto ?bcc ?replies ?attachment ?tag ?generator ?icon ?image
837
-
?start_time ?end_time ?duration ?sensitive () =
881
+
?start_time ?end_time ?duration ?sensitive ?conversation ?audience () =
838
882
{ context; id; type_; name; summary; content; media_type; url;
839
883
attributed_to; in_reply_to; published; updated; deleted;
840
884
to_; cc; bto; bcc; replies; attachment; tag; generator;
841
-
icon; image; start_time; end_time; duration; sensitive }
885
+
icon; image; start_time; end_time; duration; sensitive;
886
+
conversation; audience }
842
887
843
888
let context t = t.context
844
889
let id t = t.id
···
867
912
let end_time t = t.end_time
868
913
let duration t = t.duration
869
914
let sensitive t = t.sensitive
915
+
let conversation t = t.conversation
916
+
let audience t = t.audience
870
917
871
918
let jsont =
872
919
Jsont.Object.map ~kind:"Object"
873
920
(fun context id type_ name summary content media_type url attributed_to
874
921
in_reply_to published updated deleted to_ cc bto bcc replies
875
922
attachment tag generator icon image start_time end_time duration
876
-
sensitive ->
923
+
sensitive conversation audience ->
877
924
{ context; id; type_; name; summary; content; media_type; url;
878
925
attributed_to; in_reply_to; published; updated; deleted;
879
926
to_; cc; bto; bcc; replies; attachment; tag; generator;
880
-
icon; image; start_time; end_time; duration; sensitive })
927
+
icon; image; start_time; end_time; duration; sensitive;
928
+
conversation; audience })
881
929
|> Jsont.Object.opt_mem "@context" Context.jsont ~enc:context
882
930
|> Jsont.Object.opt_mem "id" Uri.jsont ~enc:id
883
931
|> Jsont.Object.mem "type" Object_type.jsont ~enc:type_
···
909
957
|> Jsont.Object.opt_mem "endTime" Datetime.jsont ~enc:end_time
910
958
|> Jsont.Object.opt_mem "duration" Jsont.string ~enc:duration
911
959
|> Jsont.Object.opt_mem "sensitive" Jsont.bool ~enc:sensitive
960
+
|> Jsont.Object.opt_mem "conversation" Uri.jsont ~enc:conversation
961
+
|> Jsont.Object.opt_mem "audience" (one_or_many Recipient.jsont) ~enc:audience
912
962
|> Jsont.Object.finish
913
963
end
914
964
+16
lib/proto/apubt_proto.mli
+16
lib/proto/apubt_proto.mli
···
252
252
?icon:Image_ref.t list ->
253
253
?image:Image_ref.t list ->
254
254
?manually_approves_followers:bool ->
255
+
?also_known_as:Uri.t list ->
256
+
?discoverable:bool ->
257
+
?suspended:bool ->
258
+
?moved_to:Uri.t ->
259
+
?featured:Uri.t ->
260
+
?featured_tags:Uri.t ->
255
261
unit -> t
256
262
(** Create a new Actor. *)
257
263
···
273
279
val icon : t -> Image_ref.t list option
274
280
val image : t -> Image_ref.t list option
275
281
val manually_approves_followers : t -> bool option
282
+
val also_known_as : t -> Uri.t list option
283
+
val discoverable : t -> bool option
284
+
val suspended : t -> bool option
285
+
val moved_to : t -> Uri.t option
286
+
val featured : t -> Uri.t option
287
+
val featured_tags : t -> Uri.t option
276
288
277
289
val jsont : t Jsont.t
278
290
(** JSON type for Actors. *)
···
348
360
?end_time:Datetime.t ->
349
361
?duration:string ->
350
362
?sensitive:bool ->
363
+
?conversation:Uri.t ->
364
+
?audience:Recipient.t list ->
351
365
unit -> t
352
366
(** Create a new Object. *)
353
367
···
378
392
val end_time : t -> Datetime.t option
379
393
val duration : t -> string option
380
394
val sensitive : t -> bool option
395
+
val conversation : t -> Uri.t option
396
+
val audience : t -> Recipient.t list option
381
397
382
398
val jsont : t Jsont.t
383
399
(** JSON type for Objects. *)