anil.recoil.org
ActivityPub in OCaml using jsont/eio/requests
Rename library to apubt with proto/client subpackages and CLI
Major restructuring of the ActivityPub library:
- Rename from activitypub to apubt
- Add W3C ActivityPub spec as git submodule in spec/activitypub
- Split into two subpackages:
- apubt.proto: Wire format types with jsont codecs
- apubt: Eio-based HTTP client using ocaml-requests
- Add apub CLI with cmdliner subcommands:
- webfinger: Look up accounts via Webfinger
- actor: Fetch ActivityPub actors
- outbox: Fetch actor outbox activities
- Fix ActivityPub JSON compatibility:
- Handle single values or arrays (one_or_many helper)
- Handle null values (nullable helper)
- Support replies as URI or inline Collection
- Use compact JSON-LD form (id/type vs @id/@type)
- Handle both items and orderedItems in collections
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+3
.gitmodules
+3
.gitmodules
-25
activitypub.opam
-25
activitypub.opam
···
1
-
# This file is generated by dune, edit dune-project instead
2
-
opam-version: "2.0"
3
-
synopsis: "ActivityPub protocol types with jsont codecs"
4
-
description:
5
-
"OCaml types and jsont codecs for the ActivityPub/ActivityStreams protocol"
6
-
depends: [
7
-
"dune" {>= "3.0"}
8
-
"ocaml" {>= "4.14.0"}
9
-
"jsont" {>= "0.2.0"}
10
-
"odoc" {with-doc}
11
-
]
12
-
build: [
13
-
["dune" "subst"] {dev}
14
-
[
15
-
"dune"
16
-
"build"
17
-
"-p"
18
-
name
19
-
"-j"
20
-
jobs
21
-
"@install"
22
-
"@runtest" {with-test}
23
-
"@doc" {with-doc}
24
-
]
25
-
]
+32
apubt.opam
+32
apubt.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "ActivityPub client library for OCaml with Eio"
4
+
description:
5
+
"ActivityPub/ActivityStreams protocol implementation with jsont codecs and Eio-based HTTP client"
6
+
depends: [
7
+
"dune" {>= "3.0"}
8
+
"ocaml" {>= "5.1.0"}
9
+
"jsont" {>= "0.2.0"}
10
+
"jsont-bytesrw"
11
+
"eio" {>= "1.0"}
12
+
"eio_main" {>= "1.0"}
13
+
"requests" {>= "0.1.0"}
14
+
"cmdliner" {>= "1.2.0"}
15
+
"logs" {>= "0.7.0"}
16
+
"fmt" {>= "0.9.0"}
17
+
"odoc" {with-doc}
18
+
]
19
+
build: [
20
+
["dune" "subst"] {dev}
21
+
[
22
+
"dune"
23
+
"build"
24
+
"-p"
25
+
name
26
+
"-j"
27
+
jobs
28
+
"@install"
29
+
"@runtest" {with-test}
30
+
"@doc" {with-doc}
31
+
]
32
+
]
+276
bin/apub.ml
+276
bin/apub.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** ActivityPub CLI tool *)
7
+
8
+
open Cmdliner
9
+
10
+
let setup_log style_renderer level =
11
+
Fmt_tty.setup_std_outputs ?style_renderer ();
12
+
Logs.set_level level;
13
+
Logs.set_reporter (Logs_fmt.reporter ())
14
+
15
+
(* Common options *)
16
+
let setup_log_term =
17
+
Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ())
18
+
19
+
let timeout =
20
+
let doc = "Request timeout in seconds." in
21
+
Arg.(value & opt float 30.0 & info ["timeout"; "t"] ~docv:"SECONDS" ~doc)
22
+
23
+
let user_agent =
24
+
let doc = "User-Agent header for HTTP requests." in
25
+
Arg.(value & opt string "apub/0.1" & info ["user-agent"; "A"] ~docv:"STRING" ~doc)
26
+
27
+
(* Webfinger command *)
28
+
module Webfinger_cmd = struct
29
+
let account =
30
+
let doc = "Account to look up (e.g., user@example.com or acct:user@example.com)." in
31
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"ACCOUNT" ~doc)
32
+
33
+
let json_output =
34
+
let doc = "Output raw JSON response." in
35
+
Arg.(value & flag & info ["json"; "j"] ~doc)
36
+
37
+
let run () timeout user_agent json_output account =
38
+
Eio_main.run @@ fun env ->
39
+
Eio.Switch.run @@ fun sw ->
40
+
let client = Apubt.create ~sw ~user_agent ~timeout env in
41
+
try
42
+
let jrd = Apubt.Webfinger.lookup client account in
43
+
if json_output then begin
44
+
match Jsont_bytesrw.encode_string Apubt.Proto.Webfinger.jsont jrd with
45
+
| Ok s -> print_endline s
46
+
| Error e -> Fmt.epr "JSON encoding error: %s@." e
47
+
end else begin
48
+
Fmt.pr "@[<v>";
49
+
Fmt.pr "Subject: %s@," (Apubt.Proto.Webfinger.subject jrd);
50
+
(match Apubt.Proto.Webfinger.aliases jrd with
51
+
| Some aliases ->
52
+
Fmt.pr "Aliases:@,";
53
+
List.iter (fun a -> Fmt.pr " - %s@," a) aliases
54
+
| None -> ());
55
+
(match Apubt.Proto.Webfinger.links jrd with
56
+
| Some links ->
57
+
Fmt.pr "Links:@,";
58
+
List.iter (fun link ->
59
+
let rel = Apubt.Proto.Webfinger.Jrd_link.rel link in
60
+
let href = Apubt.Proto.Webfinger.Jrd_link.href link in
61
+
let type_ = Apubt.Proto.Webfinger.Jrd_link.type_ link in
62
+
Fmt.pr " - rel: %s@," rel;
63
+
Option.iter (fun t -> Fmt.pr " type: %s@," t) type_;
64
+
Option.iter (fun h -> Fmt.pr " href: %s@," (Apubt.Proto.Uri.to_string h)) href
65
+
) links
66
+
| None -> ());
67
+
(* Show extracted ActivityPub actor URI *)
68
+
(match Apubt.Webfinger.actor_uri jrd with
69
+
| Some uri ->
70
+
Fmt.pr "@,ActivityPub Actor: %s@," (Apubt.Proto.Uri.to_string uri)
71
+
| None ->
72
+
Fmt.pr "@,No ActivityPub actor link found.@,");
73
+
Fmt.pr "@]"
74
+
end;
75
+
`Ok ()
76
+
with
77
+
| Apubt.E err ->
78
+
Fmt.epr "Error: %a@." Apubt.Error.pp err;
79
+
`Error (false, Apubt.Error.to_string err)
80
+
81
+
let term =
82
+
Term.(ret (const run $ setup_log_term $ timeout $ user_agent $ json_output $ account))
83
+
84
+
let cmd =
85
+
let doc = "Look up an account via Webfinger." in
86
+
let man = [
87
+
`S Manpage.s_description;
88
+
`P "Performs a Webfinger lookup for the given account and displays \
89
+
the JSON Resource Descriptor (JRD) response.";
90
+
`P "The account can be specified as 'user@domain' or 'acct:user@domain'.";
91
+
`S Manpage.s_examples;
92
+
`Pre " apub webfinger anil@recoil.org";
93
+
`Pre " apub webfinger --json acct:gargron@mastodon.social";
94
+
] in
95
+
Cmd.v (Cmd.info "webfinger" ~doc ~man) term
96
+
end
97
+
98
+
(* Actor command *)
99
+
module Actor_cmd = struct
100
+
let uri_or_acct =
101
+
let doc = "Actor URI or account (user@domain) to fetch." in
102
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"URI|ACCOUNT" ~doc)
103
+
104
+
let json_output =
105
+
let doc = "Output raw JSON response." in
106
+
Arg.(value & flag & info ["json"; "j"] ~doc)
107
+
108
+
let run () timeout user_agent json_output uri_or_acct =
109
+
Eio_main.run @@ fun env ->
110
+
Eio.Switch.run @@ fun sw ->
111
+
let client = Apubt.create ~sw ~user_agent ~timeout env in
112
+
try
113
+
let actor =
114
+
if String.contains uri_or_acct '@' && not (String.starts_with ~prefix:"http" uri_or_acct) then
115
+
Apubt.Actor.lookup client uri_or_acct
116
+
else
117
+
Apubt.Actor.fetch client (Apubt.Proto.Uri.v uri_or_acct)
118
+
in
119
+
if json_output then begin
120
+
match Jsont_bytesrw.encode_string Apubt.Proto.Actor.jsont actor with
121
+
| Ok s -> print_endline s
122
+
| Error e -> Fmt.epr "JSON encoding error: %s@." e
123
+
end else begin
124
+
Fmt.pr "@[<v>";
125
+
Fmt.pr "ID: %s@," (Apubt.Proto.Uri.to_string (Apubt.Proto.Actor.id actor));
126
+
Fmt.pr "Type: %s@," (Apubt.Proto.Actor_type.to_string (Apubt.Proto.Actor.type_ actor));
127
+
Option.iter (fun n -> Fmt.pr "Name: %s@," n) (Apubt.Proto.Actor.name actor);
128
+
Option.iter (fun u -> Fmt.pr "Username: %s@," u) (Apubt.Proto.Actor.preferred_username actor);
129
+
Option.iter (fun s -> Fmt.pr "Summary: %s@," s) (Apubt.Proto.Actor.summary actor);
130
+
Option.iter (fun u -> Fmt.pr "URL: %s@," (Apubt.Proto.Uri.to_string u)) (Apubt.Proto.Actor.url actor);
131
+
Fmt.pr "Inbox: %s@," (Apubt.Proto.Uri.to_string (Apubt.Proto.Actor.inbox actor));
132
+
Fmt.pr "Outbox: %s@," (Apubt.Proto.Uri.to_string (Apubt.Proto.Actor.outbox actor));
133
+
Option.iter (fun u -> Fmt.pr "Followers: %s@," (Apubt.Proto.Uri.to_string u)) (Apubt.Proto.Actor.followers actor);
134
+
Option.iter (fun u -> Fmt.pr "Following: %s@," (Apubt.Proto.Uri.to_string u)) (Apubt.Proto.Actor.following actor);
135
+
Fmt.pr "@]"
136
+
end;
137
+
`Ok ()
138
+
with
139
+
| Apubt.E err ->
140
+
Fmt.epr "Error: %a@." Apubt.Error.pp err;
141
+
`Error (false, Apubt.Error.to_string err)
142
+
143
+
let term =
144
+
Term.(ret (const run $ setup_log_term $ timeout $ user_agent $ json_output $ uri_or_acct))
145
+
146
+
let cmd =
147
+
let doc = "Fetch an ActivityPub actor." in
148
+
let man = [
149
+
`S Manpage.s_description;
150
+
`P "Fetches an ActivityPub actor by URI or performs a Webfinger lookup \
151
+
and then fetches the actor.";
152
+
`S Manpage.s_examples;
153
+
`Pre " apub actor anil@recoil.org";
154
+
`Pre " apub actor https://mastodon.social/users/Gargron";
155
+
`Pre " apub actor --json anil@recoil.org";
156
+
] in
157
+
Cmd.v (Cmd.info "actor" ~doc ~man) term
158
+
end
159
+
160
+
(* Outbox command *)
161
+
module Outbox_cmd = struct
162
+
let uri_or_acct =
163
+
let doc = "Actor URI or account (user@domain) whose outbox to fetch." in
164
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"URI|ACCOUNT" ~doc)
165
+
166
+
let limit =
167
+
let doc = "Maximum number of activities to display." in
168
+
Arg.(value & opt int 10 & info ["limit"; "n"] ~docv:"N" ~doc)
169
+
170
+
let json_output =
171
+
let doc = "Output raw JSON response." in
172
+
Arg.(value & flag & info ["json"; "j"] ~doc)
173
+
174
+
let run () timeout user_agent json_output limit uri_or_acct =
175
+
Eio_main.run @@ fun env ->
176
+
Eio.Switch.run @@ fun sw ->
177
+
let client = Apubt.create ~sw ~user_agent ~timeout env in
178
+
try
179
+
let actor =
180
+
if String.contains uri_or_acct '@' && not (String.starts_with ~prefix:"http" uri_or_acct) then
181
+
Apubt.Actor.lookup client uri_or_acct
182
+
else
183
+
Apubt.Actor.fetch client (Apubt.Proto.Uri.v uri_or_acct)
184
+
in
185
+
let outbox = Apubt.Actor.outbox client actor in
186
+
if json_output then begin
187
+
match Jsont_bytesrw.encode_string Apubt.Proto.Activity_collection.jsont outbox with
188
+
| Ok s -> print_endline s
189
+
| Error e -> Fmt.epr "JSON encoding error: %s@." e
190
+
end else begin
191
+
Fmt.pr "@[<v>";
192
+
Fmt.pr "Outbox for: %s@," (Apubt.Proto.Uri.to_string (Apubt.Proto.Actor.id actor));
193
+
Option.iter (fun n -> Fmt.pr "Total items: %d@," n) (Apubt.Proto.Collection.total_items outbox);
194
+
Fmt.pr "@,";
195
+
(* Try to get items from collection or first page *)
196
+
let items = match Apubt.Proto.Collection.items outbox with
197
+
| Some items -> items
198
+
| None ->
199
+
(* Try first page *)
200
+
(try
201
+
let page = Apubt.Actor.outbox_page client actor () in
202
+
Apubt.Proto.Collection_page.items page |> Option.value ~default:[]
203
+
with Apubt.E e ->
204
+
Fmt.pr "(Error fetching first page: %a)@," Apubt.Error.pp e;
205
+
[])
206
+
in
207
+
let items = if List.length items > limit then
208
+
List.filteri (fun i _ -> i < limit) items
209
+
else items
210
+
in
211
+
List.iteri (fun i activity ->
212
+
Fmt.pr "--- Activity %d ---@," (i + 1);
213
+
Option.iter (fun id -> Fmt.pr "ID: %s@," (Apubt.Proto.Uri.to_string id)) (Apubt.Proto.Activity.id activity);
214
+
Fmt.pr "Type: %s@," (Apubt.Proto.Activity_type.to_string (Apubt.Proto.Activity.type_ activity));
215
+
Option.iter (fun p -> Fmt.pr "Published: %s@," (Apubt.Proto.Datetime.to_string p)) (Apubt.Proto.Activity.published activity);
216
+
Option.iter (fun s -> Fmt.pr "Summary: %s@," s) (Apubt.Proto.Activity.summary activity);
217
+
(* Show object info if present *)
218
+
(match Apubt.Proto.Activity.object_ activity with
219
+
| Some (Apubt.Proto.Object_ref.Uri uri) ->
220
+
Fmt.pr "Object: %s@," (Apubt.Proto.Uri.to_string uri)
221
+
| Some (Apubt.Proto.Object_ref.Object obj) ->
222
+
Fmt.pr "Object type: %s@," (Apubt.Proto.Object_type.to_string (Apubt.Proto.Object.type_ obj));
223
+
Option.iter (fun c ->
224
+
let c = if String.length c > 100 then String.sub c 0 100 ^ "..." else c in
225
+
Fmt.pr "Content: %s@," c
226
+
) (Apubt.Proto.Object.content obj)
227
+
| None -> ());
228
+
Fmt.pr "@,"
229
+
) items;
230
+
if List.length items = 0 then
231
+
Fmt.pr "(No activities found or outbox is empty)@,";
232
+
Fmt.pr "@]"
233
+
end;
234
+
`Ok ()
235
+
with
236
+
| Apubt.E err ->
237
+
Fmt.epr "Error: %a@." Apubt.Error.pp err;
238
+
`Error (false, Apubt.Error.to_string err)
239
+
240
+
let term =
241
+
Term.(ret (const run $ setup_log_term $ timeout $ user_agent $ json_output $ limit $ uri_or_acct))
242
+
243
+
let cmd =
244
+
let doc = "Fetch an actor's outbox." in
245
+
let man = [
246
+
`S Manpage.s_description;
247
+
`P "Fetches the outbox of an ActivityPub actor, displaying recent activities.";
248
+
`S Manpage.s_examples;
249
+
`Pre " apub outbox anil@recoil.org";
250
+
`Pre " apub outbox --limit 5 https://mastodon.social/users/Gargron";
251
+
`Pre " apub outbox --json anil@recoil.org";
252
+
] in
253
+
Cmd.v (Cmd.info "outbox" ~doc ~man) term
254
+
end
255
+
256
+
(* Main command group *)
257
+
let main_cmd =
258
+
let doc = "ActivityPub command-line client" in
259
+
let man = [
260
+
`S Manpage.s_description;
261
+
`P "apub is a command-line tool for interacting with ActivityPub servers.";
262
+
`P "Use 'apub <command> --help' for more information on a specific command.";
263
+
`S Manpage.s_commands;
264
+
`S Manpage.s_examples;
265
+
`Pre " apub webfinger anil@recoil.org";
266
+
`Pre " apub actor anil@recoil.org";
267
+
`Pre " apub outbox anil@recoil.org";
268
+
] in
269
+
let info = Cmd.info "apub" ~version:"0.1" ~doc ~man in
270
+
Cmd.group info [
271
+
Webfinger_cmd.cmd;
272
+
Actor_cmd.cmd;
273
+
Outbox_cmd.cmd;
274
+
]
275
+
276
+
let () = exit (Cmd.eval main_cmd)
+5
bin/dune
+5
bin/dune
+13
-6
dune-project
+13
-6
dune-project
···
1
1
(lang dune 3.0)
2
-
(name activitypub)
2
+
(name apubt)
3
3
4
4
(generate_opam_files true)
5
5
6
6
(package
7
-
(name activitypub)
8
-
(synopsis "ActivityPub protocol types with jsont codecs")
9
-
(description "OCaml types and jsont codecs for the ActivityPub/ActivityStreams protocol")
7
+
(name apubt)
8
+
(synopsis "ActivityPub client library for OCaml with Eio")
9
+
(description "ActivityPub/ActivityStreams protocol implementation with jsont codecs and Eio-based HTTP client")
10
10
(depends
11
-
(ocaml (>= 4.14.0))
12
-
(jsont (>= 0.2.0))))
11
+
(ocaml (>= 5.1.0))
12
+
(jsont (>= 0.2.0))
13
+
jsont-bytesrw
14
+
(eio (>= 1.0))
15
+
(eio_main (>= 1.0))
16
+
(requests (>= 0.1.0))
17
+
(cmdliner (>= 1.2.0))
18
+
(logs (>= 0.7.0))
19
+
(fmt (>= 0.9.0))))
+376
lib/client/apubt.ml
+376
lib/client/apubt.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
module Proto = Apubt_proto
7
+
8
+
module Error = struct
9
+
type t =
10
+
| Http_error of int * string
11
+
| Json_error of string
12
+
| Webfinger_error of string
13
+
| Signature_error of string
14
+
| Not_found
15
+
| Unauthorized
16
+
| Rate_limited of float option
17
+
| Network_error of string
18
+
| Invalid_actor of string
19
+
20
+
let pp fmt = function
21
+
| Http_error (code, body) ->
22
+
Format.fprintf fmt "HTTP error %d: %s" code body
23
+
| Json_error msg -> Format.fprintf fmt "JSON error: %s" msg
24
+
| Webfinger_error msg -> Format.fprintf fmt "Webfinger error: %s" msg
25
+
| Signature_error msg -> Format.fprintf fmt "Signature error: %s" msg
26
+
| Not_found -> Format.fprintf fmt "Not found"
27
+
| Unauthorized -> Format.fprintf fmt "Unauthorized"
28
+
| Rate_limited None -> Format.fprintf fmt "Rate limited"
29
+
| Rate_limited (Some secs) ->
30
+
Format.fprintf fmt "Rate limited, retry after %.0f seconds" secs
31
+
| Network_error msg -> Format.fprintf fmt "Network error: %s" msg
32
+
| Invalid_actor msg -> Format.fprintf fmt "Invalid actor: %s" msg
33
+
34
+
let to_string t =
35
+
Format.asprintf "%a" pp t
36
+
end
37
+
38
+
exception E of Error.t
39
+
40
+
module Signing = struct
41
+
type t = {
42
+
key_id : string;
43
+
private_key : string;
44
+
algorithm : [ `Ed25519 | `Rsa_sha256 ];
45
+
}
46
+
47
+
let create ~key_id ~private_key ?(algorithm = `Rsa_sha256) () =
48
+
{ key_id; private_key; algorithm }
49
+
50
+
let key_id t = t.key_id
51
+
end
52
+
53
+
type t = {
54
+
requests : Requests.t;
55
+
signing : Signing.t option;
56
+
user_agent : string;
57
+
}
58
+
59
+
let activitypub_accept =
60
+
"application/activity+json, application/ld+json; profile=\"https://www.w3.org/ns/activitystreams\""
61
+
62
+
let create ~sw ?signing ?(user_agent = "Apubt/0.1") ?(timeout = 30.0) env =
63
+
let timeout_config = Requests.Timeout.create ~connect:timeout ~read:timeout () in
64
+
let default_headers =
65
+
Requests.Headers.empty
66
+
|> Requests.Headers.add `Accept activitypub_accept
67
+
|> Requests.Headers.add `User_agent user_agent
68
+
in
69
+
let requests = Requests.create ~sw ~default_headers ~timeout:timeout_config env in
70
+
{ requests; signing; user_agent }
71
+
72
+
(* Internal: check HTTP response for errors *)
73
+
let check_response resp =
74
+
let status = Requests.Response.status_code resp in
75
+
if status >= 200 && status < 300 then ()
76
+
else if status = 404 then raise (E Not_found)
77
+
else if status = 401 || status = 403 then raise (E Unauthorized)
78
+
else if status = 429 then begin
79
+
let retry_after =
80
+
Requests.Response.headers resp
81
+
|> Requests.Headers.get `Retry_after
82
+
|> Option.map float_of_string
83
+
in
84
+
raise (E (Rate_limited retry_after))
85
+
end
86
+
else begin
87
+
let body = Requests.Response.text resp in
88
+
raise (E (Http_error (status, body)))
89
+
end
90
+
91
+
module Http = struct
92
+
let get t uri =
93
+
let url = Proto.Uri.to_string uri in
94
+
let resp = Requests.get t.requests url in
95
+
check_response resp;
96
+
Requests.Response.json resp
97
+
98
+
let get_typed t jsont uri =
99
+
let url = Proto.Uri.to_string uri in
100
+
let resp = Requests.get t.requests url in
101
+
check_response resp;
102
+
Requests.Response.jsonv jsont resp
103
+
104
+
let post t uri body =
105
+
let url = Proto.Uri.to_string uri in
106
+
let resp = Requests.post t.requests ~body:(Requests.Body.json body) url in
107
+
check_response resp
108
+
109
+
let post_typed t jsont uri value =
110
+
let url = Proto.Uri.to_string uri in
111
+
let resp = Requests.post t.requests ~body:(Requests.Body.jsonv jsont value) url in
112
+
check_response resp
113
+
end
114
+
115
+
module Webfinger = struct
116
+
let lookup t acct =
117
+
(* Normalize account: remove acct: prefix if present *)
118
+
let acct =
119
+
if String.starts_with ~prefix:"acct:" acct then
120
+
String.sub acct 5 (String.length acct - 5)
121
+
else acct
122
+
in
123
+
(* Extract domain from user@domain *)
124
+
let domain =
125
+
match String.split_on_char '@' acct with
126
+
| [_; domain] -> domain
127
+
| _ -> raise (E (Webfinger_error ("Invalid account format: " ^ acct)))
128
+
in
129
+
(* Build Webfinger URL *)
130
+
let url = Printf.sprintf "https://%s/.well-known/webfinger?resource=acct:%s" domain acct in
131
+
let headers =
132
+
Requests.Headers.empty
133
+
|> Requests.Headers.add `Accept "application/jrd+json, application/json"
134
+
in
135
+
let resp = Requests.get t.requests ~headers url in
136
+
check_response resp;
137
+
Requests.Response.jsonv Proto.Webfinger.jsont resp
138
+
139
+
let actor_uri jrd =
140
+
match Proto.Webfinger.links jrd with
141
+
| None -> None
142
+
| Some links ->
143
+
List.find_map (fun link ->
144
+
if Proto.Webfinger.Jrd_link.rel link = "self" then
145
+
match Proto.Webfinger.Jrd_link.type_ link with
146
+
| Some t when String.equal t "application/activity+json" ->
147
+
Proto.Webfinger.Jrd_link.href link
148
+
| Some t when String.starts_with ~prefix:"application/ld+json" t ->
149
+
Proto.Webfinger.Jrd_link.href link
150
+
| _ -> None
151
+
else None
152
+
) links
153
+
154
+
let profile_page jrd =
155
+
match Proto.Webfinger.links jrd with
156
+
| None -> None
157
+
| Some links ->
158
+
List.find_map (fun link ->
159
+
if Proto.Webfinger.Jrd_link.rel link = "http://webfinger.net/rel/profile-page" then
160
+
Proto.Webfinger.Jrd_link.href link
161
+
else None
162
+
) links
163
+
164
+
let subscribe_template jrd =
165
+
match Proto.Webfinger.links jrd with
166
+
| None -> None
167
+
| Some links ->
168
+
List.find_map (fun link ->
169
+
if Proto.Webfinger.Jrd_link.rel link = "http://ostatus.org/schema/1.0/subscribe" then
170
+
Proto.Webfinger.Jrd_link.template link
171
+
else None
172
+
) links
173
+
end
174
+
175
+
module Nodeinfo = struct
176
+
let fetch _t ~host:_ =
177
+
failwith "TODO: Nodeinfo.fetch"
178
+
179
+
let software_name info =
180
+
Proto.Nodeinfo.Software.name (Proto.Nodeinfo.software info)
181
+
182
+
let software_version info =
183
+
Proto.Nodeinfo.Software.version (Proto.Nodeinfo.software info)
184
+
185
+
let supports_activitypub info =
186
+
List.mem "activitypub" (Proto.Nodeinfo.protocols info)
187
+
end
188
+
189
+
module Actor = struct
190
+
let fetch t uri =
191
+
Http.get_typed t Proto.Actor.jsont uri
192
+
193
+
let lookup t acct =
194
+
let jrd = Webfinger.lookup t acct in
195
+
match Webfinger.actor_uri jrd with
196
+
| Some uri -> fetch t uri
197
+
| None -> raise (E (Webfinger_error "No ActivityPub actor link in Webfinger response"))
198
+
199
+
let inbox _t actor = Proto.Actor.inbox actor
200
+
201
+
let outbox t actor =
202
+
let uri = Proto.Actor.outbox actor in
203
+
Http.get_typed t Proto.Activity_collection.jsont uri
204
+
205
+
let outbox_page t actor ?page () =
206
+
let uri = match page with
207
+
| Some p -> p
208
+
| None ->
209
+
let collection = outbox t actor in
210
+
match Proto.Collection.first collection with
211
+
| Some first -> first
212
+
| None -> raise (E (Invalid_actor "Outbox has no first page"))
213
+
in
214
+
Http.get_typed t Proto.Activity_collection_page.jsont uri
215
+
216
+
let followers t actor =
217
+
match Proto.Actor.followers actor with
218
+
| Some uri -> Http.get_typed t (Proto.Collection.jsont Proto.Actor.jsont) uri
219
+
| None -> raise (E (Invalid_actor "Actor has no followers collection"))
220
+
221
+
let following t actor =
222
+
match Proto.Actor.following actor with
223
+
| Some uri -> Http.get_typed t (Proto.Collection.jsont Proto.Actor.jsont) uri
224
+
| None -> raise (E (Invalid_actor "Actor has no following collection"))
225
+
226
+
let follow _t ~actor:_ ~target:_ =
227
+
failwith "TODO: Actor.follow"
228
+
229
+
let unfollow _t ~actor:_ ~target:_ =
230
+
failwith "TODO: Actor.unfollow"
231
+
232
+
let accept_follow _t ~actor:_ ~follow:_ =
233
+
failwith "TODO: Actor.accept_follow"
234
+
235
+
let reject_follow _t ~actor:_ ~follow:_ =
236
+
failwith "TODO: Actor.reject_follow"
237
+
end
238
+
239
+
module Object = struct
240
+
let fetch t uri =
241
+
Http.get_typed t Proto.Object.jsont uri
242
+
243
+
let replies t obj =
244
+
match Proto.Object.replies obj with
245
+
| Some uri -> Some (Http.get_typed t Proto.Object_collection.jsont uri)
246
+
| None -> None
247
+
end
248
+
249
+
module Inbox = struct
250
+
let post t ~inbox activity =
251
+
Http.post_typed t Proto.Activity.jsont inbox activity
252
+
253
+
let post_to_actor t actor activity =
254
+
let inbox = Actor.inbox t actor in
255
+
post t ~inbox activity
256
+
257
+
let post_to_shared_inbox _t ~host:_ _activity =
258
+
failwith "TODO: Inbox.post_to_shared_inbox"
259
+
end
260
+
261
+
module Outbox = struct
262
+
let create_note _t ~actor:_ ?in_reply_to:_ ?to_:_ ?cc:_ ?sensitive:_
263
+
?summary:_ ~content:_ () =
264
+
failwith "TODO: Outbox.create_note"
265
+
266
+
let public_note t ~actor ?in_reply_to ~content () =
267
+
let followers_uri =
268
+
match Proto.Actor.followers actor with
269
+
| Some uri -> uri
270
+
| None -> Proto.Uri.v ""
271
+
in
272
+
create_note t ~actor ?in_reply_to
273
+
~to_:[Proto.Recipient.make Proto.Public.id]
274
+
~cc:[Proto.Recipient.make followers_uri]
275
+
~content ()
276
+
277
+
let followers_only_note t ~actor ?in_reply_to ~content () =
278
+
let followers_uri =
279
+
match Proto.Actor.followers actor with
280
+
| Some uri -> uri
281
+
| None -> raise (E (Error.Invalid_actor "Actor has no followers collection"))
282
+
in
283
+
create_note t ~actor ?in_reply_to
284
+
~to_:[Proto.Recipient.make followers_uri]
285
+
~content ()
286
+
287
+
let direct_note t ~actor ~to_ ?in_reply_to ~content () =
288
+
let recipients = List.map (fun a -> Proto.Recipient.make (Proto.Actor.id a)) to_ in
289
+
create_note t ~actor ?in_reply_to ~to_:recipients ~content ()
290
+
291
+
let like _t ~actor:_ ~object_:_ =
292
+
failwith "TODO: Outbox.like"
293
+
294
+
let unlike _t ~actor:_ ~object_:_ =
295
+
failwith "TODO: Outbox.unlike"
296
+
297
+
let announce _t ~actor:_ ~object_:_ =
298
+
failwith "TODO: Outbox.announce"
299
+
300
+
let unannounce _t ~actor:_ ~object_:_ =
301
+
failwith "TODO: Outbox.unannounce"
302
+
303
+
let delete _t ~actor:_ ~object_:_ =
304
+
failwith "TODO: Outbox.delete"
305
+
306
+
let update_note _t ~actor:_ ~object_:_ ~content:_ () =
307
+
failwith "TODO: Outbox.update_note"
308
+
end
309
+
310
+
module Collection = struct
311
+
let rec iter t f collection item_jsont =
312
+
(* Process items in current collection if any *)
313
+
(match Proto.Collection.items collection with
314
+
| Some items -> List.iter f items
315
+
| None -> ());
316
+
(* Fetch first page if available *)
317
+
match Proto.Collection.first collection with
318
+
| Some first_uri ->
319
+
let page = Http.get_typed t (Proto.Collection_page.jsont item_jsont) first_uri in
320
+
iter_page t f page item_jsont
321
+
| None -> ()
322
+
323
+
and iter_page t f page item_jsont =
324
+
(* Process items in page *)
325
+
(match Proto.Collection_page.items page with
326
+
| Some items -> List.iter f items
327
+
| None -> ());
328
+
(* Fetch next page if available *)
329
+
match Proto.Collection_page.next page with
330
+
| Some next_uri ->
331
+
let next = Http.get_typed t (Proto.Collection_page.jsont item_jsont) next_uri in
332
+
iter_page t f next item_jsont
333
+
| None -> ()
334
+
335
+
let rec fold t f init collection item_jsont =
336
+
(* Fold over items in current collection *)
337
+
let acc = match Proto.Collection.items collection with
338
+
| Some items -> List.fold_left f init items
339
+
| None -> init
340
+
in
341
+
(* Fetch first page if available *)
342
+
match Proto.Collection.first collection with
343
+
| Some first_uri ->
344
+
let page = Http.get_typed t (Proto.Collection_page.jsont item_jsont) first_uri in
345
+
fold_page t f acc page item_jsont
346
+
| None -> acc
347
+
348
+
and fold_page t f acc page item_jsont =
349
+
(* Fold over items in page *)
350
+
let acc = match Proto.Collection_page.items page with
351
+
| Some items -> List.fold_left f acc items
352
+
| None -> acc
353
+
in
354
+
(* Fetch next page if available *)
355
+
match Proto.Collection_page.next page with
356
+
| Some next_uri ->
357
+
let next = Http.get_typed t (Proto.Collection_page.jsont item_jsont) next_uri in
358
+
fold_page t f acc next item_jsont
359
+
| None -> acc
360
+
361
+
let to_list t collection item_jsont =
362
+
fold t (fun acc item -> item :: acc) [] collection item_jsont
363
+
|> List.rev
364
+
365
+
let first_page t collection item_jsont =
366
+
match Proto.Collection.first collection with
367
+
| Some first_uri ->
368
+
Some (Http.get_typed t (Proto.Collection_page.jsont item_jsont) first_uri)
369
+
| None -> None
370
+
371
+
let next_page t page item_jsont =
372
+
match Proto.Collection_page.next page with
373
+
| Some next_uri ->
374
+
Some (Http.get_typed t (Proto.Collection_page.jsont item_jsont) next_uri)
375
+
| None -> None
376
+
end
+510
lib/client/apubt.mli
+510
lib/client/apubt.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** ActivityPub client library for OCaml with Eio
7
+
8
+
This library provides a direct-style ActivityPub client using Eio for
9
+
concurrent I/O. It handles actor discovery, inbox/outbox operations,
10
+
HTTP signatures, and federation with other ActivityPub servers.
11
+
12
+
{2 Overview}
13
+
14
+
The library is organized into several components:
15
+
16
+
- {!type:t}: Main client type for making ActivityPub requests
17
+
- {!module:Actor}: Operations on actors (fetch, follow, unfollow)
18
+
- {!module:Inbox}: Receiving and processing activities
19
+
- {!module:Outbox}: Posting activities to your outbox
20
+
- {!module:Webfinger}: Actor discovery via Webfinger protocol
21
+
- {!module:Nodeinfo}: Server metadata discovery
22
+
23
+
{2 Example}
24
+
25
+
{[
26
+
open Eio.Std
27
+
28
+
let () = Eio_main.run @@ fun env ->
29
+
Switch.run @@ fun sw ->
30
+
31
+
(* Create an ActivityPub client *)
32
+
let client = Apubt.create ~sw env in
33
+
34
+
(* Discover an actor via Webfinger *)
35
+
let actor = Apubt.Actor.lookup client "user@example.com" in
36
+
Printf.printf "Found: %s\n" (Option.value ~default:"<none>" (Proto.Actor.name actor));
37
+
38
+
(* Fetch their outbox *)
39
+
let outbox = Apubt.Actor.outbox client actor in
40
+
List.iter (fun activity ->
41
+
Printf.printf "Activity: %s\n"
42
+
(Proto.Activity_type.to_string (Proto.Activity.type_ activity))
43
+
) (Option.value ~default:[] (Proto.Collection.items outbox))
44
+
]}
45
+
46
+
{2 HTTP Signatures}
47
+
48
+
ActivityPub servers require HTTP signatures for authentication. Configure
49
+
signing with {!Signing}:
50
+
51
+
{[
52
+
let signing = Apubt.Signing.create
53
+
~key_id:"https://example.com/users/alice#main-key"
54
+
~private_key:private_key_pem
55
+
() in
56
+
let client = Apubt.create ~sw ~signing env
57
+
]}
58
+
59
+
@see <https://www.w3.org/TR/activitypub/> ActivityPub specification
60
+
@see <https://www.w3.org/TR/activitystreams-core/> ActivityStreams Core *)
61
+
62
+
(** {1 Protocol Types}
63
+
64
+
Re-exported from {!Apubt_proto} for convenience. *)
65
+
66
+
module Proto = Apubt_proto
67
+
68
+
(** {1 Client Configuration} *)
69
+
70
+
type t
71
+
(** An ActivityPub client with connection pooling and optional signing. *)
72
+
73
+
(** HTTP signature configuration for authenticated requests. *)
74
+
module Signing : sig
75
+
type t
76
+
(** Signing configuration. *)
77
+
78
+
val create :
79
+
key_id:string ->
80
+
private_key:string ->
81
+
?algorithm:[ `Ed25519 | `Rsa_sha256 ] ->
82
+
unit ->
83
+
t
84
+
(** [create ~key_id ~private_key ?algorithm ()] creates a signing configuration.
85
+
86
+
@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]) *)
89
+
90
+
val key_id : t -> string
91
+
(** [key_id t] returns the key ID URI. *)
92
+
end
93
+
94
+
val create :
95
+
sw:Eio.Switch.t ->
96
+
?signing:Signing.t ->
97
+
?user_agent:string ->
98
+
?timeout:float ->
99
+
< clock : _ Eio.Time.clock
100
+
; net : _ Eio.Net.t
101
+
; fs : Eio.Fs.dir_ty Eio.Path.t
102
+
; .. > ->
103
+
t
104
+
(** [create ~sw ?signing ?user_agent ?timeout env] creates an ActivityPub client.
105
+
106
+
@param sw Switch for resource management
107
+
@param signing HTTP signature configuration for authenticated requests
108
+
@param user_agent User-Agent header (default: "Apubt/0.1")
109
+
@param timeout Request timeout in seconds (default: 30.0) *)
110
+
111
+
(** {1 Error Handling} *)
112
+
113
+
(** Error types for ActivityPub operations. *)
114
+
module Error : sig
115
+
type t =
116
+
| Http_error of int * string (** HTTP error with status code and body *)
117
+
| Json_error of string (** JSON parsing error *)
118
+
| Webfinger_error of string (** Webfinger lookup failed *)
119
+
| Signature_error of string (** HTTP signature error *)
120
+
| Not_found (** Resource not found (404) *)
121
+
| Unauthorized (** Authentication required or failed (401/403) *)
122
+
| Rate_limited of float option (** Rate limited, with optional retry-after *)
123
+
| Network_error of string (** Network/connection error *)
124
+
| Invalid_actor of string (** Actor validation failed *)
125
+
126
+
val pp : Format.formatter -> t -> unit
127
+
(** Pretty-print an error. *)
128
+
129
+
val to_string : t -> string
130
+
(** Convert error to string. *)
131
+
end
132
+
133
+
exception E of Error.t
134
+
(** Exception raised by client operations. *)
135
+
136
+
(** {1 Webfinger Discovery} *)
137
+
138
+
(** Webfinger actor discovery per RFC 7033.
139
+
@see <https://www.rfc-editor.org/rfc/rfc7033> *)
140
+
module Webfinger : sig
141
+
val lookup : t -> string -> Proto.Webfinger.t
142
+
(** [lookup client acct] performs a Webfinger lookup for the given account.
143
+
144
+
The [acct] can be in the form "user@domain" or "acct:user@domain".
145
+
146
+
@raise E on lookup failure *)
147
+
148
+
val actor_uri : Proto.Webfinger.t -> Proto.Uri.t option
149
+
(** [actor_uri jrd] extracts the ActivityPub actor URI from a Webfinger response.
150
+
151
+
Looks for a link with [rel="self"] and [type="application/activity+json"]. *)
152
+
153
+
val profile_page : Proto.Webfinger.t -> Proto.Uri.t option
154
+
(** [profile_page jrd] extracts the HTML profile page URI from a Webfinger response. *)
155
+
156
+
val subscribe_template : Proto.Webfinger.t -> string option
157
+
(** [subscribe_template jrd] extracts the subscribe/follow template URI.
158
+
159
+
This is used for remote follow buttons. The template contains [{uri}]
160
+
which should be replaced with the actor to follow. *)
161
+
end
162
+
163
+
(** {1 NodeInfo Discovery} *)
164
+
165
+
(** NodeInfo server metadata discovery.
166
+
@see <https://nodeinfo.diaspora.software/> *)
167
+
module Nodeinfo : sig
168
+
val fetch : t -> host:string -> Proto.Nodeinfo.t
169
+
(** [fetch client ~host] fetches NodeInfo for the given host.
170
+
171
+
First fetches the well-known NodeInfo links, then fetches the actual
172
+
NodeInfo document.
173
+
174
+
@raise E on fetch failure *)
175
+
176
+
val software_name : Proto.Nodeinfo.t -> string
177
+
(** [software_name info] returns the server software name (e.g., "mastodon", "pleroma"). *)
178
+
179
+
val software_version : Proto.Nodeinfo.t -> string
180
+
(** [software_version info] returns the server software version. *)
181
+
182
+
val supports_activitypub : Proto.Nodeinfo.t -> bool
183
+
(** [supports_activitypub info] returns [true] if the server supports ActivityPub. *)
184
+
end
185
+
186
+
(** {1 Actor Operations} *)
187
+
188
+
(** Operations on ActivityPub actors. *)
189
+
module Actor : sig
190
+
val fetch : t -> Proto.Uri.t -> Proto.Actor.t
191
+
(** [fetch client uri] fetches an actor by URI.
192
+
193
+
@raise E on fetch failure *)
194
+
195
+
val lookup : t -> string -> Proto.Actor.t
196
+
(** [lookup client acct] looks up an actor by Webfinger account.
197
+
198
+
Combines {!Webfinger.lookup} and {!fetch} for convenience.
199
+
200
+
@raise E on lookup failure *)
201
+
202
+
(** {2 Collections} *)
203
+
204
+
val inbox : t -> Proto.Actor.t -> Proto.Uri.t
205
+
(** [inbox client actor] returns the inbox URI for the actor. *)
206
+
207
+
val outbox : t -> Proto.Actor.t -> Proto.Activity.t Proto.Collection.t
208
+
(** [outbox client actor] fetches the actor's outbox collection.
209
+
210
+
@raise E on fetch failure *)
211
+
212
+
val outbox_page :
213
+
t ->
214
+
Proto.Actor.t ->
215
+
?page:Proto.Uri.t ->
216
+
unit ->
217
+
Proto.Activity.t Proto.Collection_page.t
218
+
(** [outbox_page client actor ?page ()] fetches a page of the outbox.
219
+
220
+
@param page URI of specific page to fetch (default: first page)
221
+
@raise E on fetch failure *)
222
+
223
+
val followers : t -> Proto.Actor.t -> Proto.Actor.t Proto.Collection.t
224
+
(** [followers client actor] fetches the actor's followers collection.
225
+
226
+
Note: Many servers restrict follower list visibility.
227
+
228
+
@raise E on fetch failure *)
229
+
230
+
val following : t -> Proto.Actor.t -> Proto.Actor.t Proto.Collection.t
231
+
(** [following client actor] fetches the actor's following collection.
232
+
233
+
Note: Many servers restrict following list visibility.
234
+
235
+
@raise E on fetch failure *)
236
+
237
+
(** {2 Follow/Unfollow} *)
238
+
239
+
val follow : t -> actor:Proto.Actor.t -> target:Proto.Actor.t -> Proto.Activity.t
240
+
(** [follow client ~actor ~target] creates and sends a Follow activity.
241
+
242
+
The [actor] is the local actor performing the follow (requires signing).
243
+
The [target] is the remote actor to follow.
244
+
245
+
@raise E on send failure *)
246
+
247
+
val unfollow : t -> actor:Proto.Actor.t -> target:Proto.Actor.t -> Proto.Activity.t
248
+
(** [unfollow client ~actor ~target] creates and sends an Undo(Follow) activity.
249
+
250
+
@raise E on send failure *)
251
+
252
+
val accept_follow :
253
+
t ->
254
+
actor:Proto.Actor.t ->
255
+
follow:Proto.Activity.t ->
256
+
Proto.Activity.t
257
+
(** [accept_follow client ~actor ~follow] accepts an incoming Follow request.
258
+
259
+
@raise E on send failure *)
260
+
261
+
val reject_follow :
262
+
t ->
263
+
actor:Proto.Actor.t ->
264
+
follow:Proto.Activity.t ->
265
+
Proto.Activity.t
266
+
(** [reject_follow client ~actor ~follow] rejects an incoming Follow request.
267
+
268
+
@raise E on send failure *)
269
+
end
270
+
271
+
(** {1 Object Operations} *)
272
+
273
+
(** Operations on ActivityStreams objects (notes, articles, etc). *)
274
+
module Object : sig
275
+
val fetch : t -> Proto.Uri.t -> Proto.Object.t
276
+
(** [fetch client uri] fetches an object by URI.
277
+
278
+
@raise E on fetch failure *)
279
+
280
+
val replies : t -> Proto.Object.t -> Proto.Object.t Proto.Collection.t option
281
+
(** [replies client obj] fetches the replies collection for an object, if any.
282
+
283
+
@raise E on fetch failure *)
284
+
end
285
+
286
+
(** {1 Inbox Operations} *)
287
+
288
+
(** Operations for receiving activities in an inbox. *)
289
+
module Inbox : sig
290
+
val post : t -> inbox:Proto.Uri.t -> Proto.Activity.t -> unit
291
+
(** [post client ~inbox activity] delivers an activity to a remote inbox.
292
+
293
+
The request is signed using the client's signing configuration.
294
+
295
+
@raise E on delivery failure *)
296
+
297
+
val post_to_actor : t -> Proto.Actor.t -> Proto.Activity.t -> unit
298
+
(** [post_to_actor client actor activity] delivers an activity to an actor's inbox.
299
+
300
+
Equivalent to [post client ~inbox:(Actor.inbox client actor) activity].
301
+
302
+
@raise E on delivery failure *)
303
+
304
+
val post_to_shared_inbox :
305
+
t ->
306
+
host:string ->
307
+
Proto.Activity.t ->
308
+
unit
309
+
(** [post_to_shared_inbox client ~host activity] delivers to a server's shared inbox.
310
+
311
+
Uses the shared inbox from the server's NodeInfo if available,
312
+
otherwise falls back to individual inboxes.
313
+
314
+
@raise E on delivery failure *)
315
+
end
316
+
317
+
(** {1 Outbox Operations} *)
318
+
319
+
(** Operations for posting activities to an outbox. *)
320
+
module Outbox : sig
321
+
(** {2 Creating Notes} *)
322
+
323
+
val create_note :
324
+
t ->
325
+
actor:Proto.Actor.t ->
326
+
?in_reply_to:Proto.Uri.t ->
327
+
?to_:Proto.Recipient.t list ->
328
+
?cc:Proto.Recipient.t list ->
329
+
?sensitive:bool ->
330
+
?summary:string ->
331
+
content:string ->
332
+
unit ->
333
+
Proto.Activity.t
334
+
(** [create_note client ~actor ?in_reply_to ?to_ ?cc ?sensitive ?summary ~content ()]
335
+
creates and sends a Create(Note) activity.
336
+
337
+
@param actor The local actor creating the note
338
+
@param in_reply_to URI of note being replied to
339
+
@param to_ Primary recipients (default: public)
340
+
@param cc Secondary recipients
341
+
@param sensitive Content warning flag
342
+
@param summary Content warning text (if sensitive)
343
+
@param content Note content (HTML)
344
+
@raise E on send failure *)
345
+
346
+
val public_note :
347
+
t ->
348
+
actor:Proto.Actor.t ->
349
+
?in_reply_to:Proto.Uri.t ->
350
+
content:string ->
351
+
unit ->
352
+
Proto.Activity.t
353
+
(** [public_note client ~actor ?in_reply_to ~content ()] creates a public note.
354
+
355
+
Shorthand for {!create_note} with [to_] set to the public collection
356
+
and [cc] set to the actor's followers.
357
+
358
+
@raise E on send failure *)
359
+
360
+
val followers_only_note :
361
+
t ->
362
+
actor:Proto.Actor.t ->
363
+
?in_reply_to:Proto.Uri.t ->
364
+
content:string ->
365
+
unit ->
366
+
Proto.Activity.t
367
+
(** [followers_only_note client ~actor ?in_reply_to ~content ()] creates
368
+
a followers-only note.
369
+
370
+
@raise E on send failure *)
371
+
372
+
val direct_note :
373
+
t ->
374
+
actor:Proto.Actor.t ->
375
+
to_:Proto.Actor.t list ->
376
+
?in_reply_to:Proto.Uri.t ->
377
+
content:string ->
378
+
unit ->
379
+
Proto.Activity.t
380
+
(** [direct_note client ~actor ~to_ ?in_reply_to ~content ()] creates
381
+
a direct message to specific recipients.
382
+
383
+
@raise E on send failure *)
384
+
385
+
(** {2 Interactions} *)
386
+
387
+
val like : t -> actor:Proto.Actor.t -> object_:Proto.Uri.t -> Proto.Activity.t
388
+
(** [like client ~actor ~object_] likes an object.
389
+
390
+
@raise E on send failure *)
391
+
392
+
val unlike : t -> actor:Proto.Actor.t -> object_:Proto.Uri.t -> Proto.Activity.t
393
+
(** [unlike client ~actor ~object_] unlikes an object (Undo(Like)).
394
+
395
+
@raise E on send failure *)
396
+
397
+
val announce : t -> actor:Proto.Actor.t -> object_:Proto.Uri.t -> Proto.Activity.t
398
+
(** [announce client ~actor ~object_] boosts/reblogs an object.
399
+
400
+
@raise E on send failure *)
401
+
402
+
val unannounce : t -> actor:Proto.Actor.t -> object_:Proto.Uri.t -> Proto.Activity.t
403
+
(** [unannounce client ~actor ~object_] unboosts an object (Undo(Announce)).
404
+
405
+
@raise E on send failure *)
406
+
407
+
(** {2 Deletion} *)
408
+
409
+
val delete : t -> actor:Proto.Actor.t -> object_:Proto.Uri.t -> Proto.Activity.t
410
+
(** [delete client ~actor ~object_] deletes an object.
411
+
412
+
Creates a Delete activity with a Tombstone object.
413
+
414
+
@raise E on send failure *)
415
+
416
+
(** {2 Updates} *)
417
+
418
+
val update_note :
419
+
t ->
420
+
actor:Proto.Actor.t ->
421
+
object_:Proto.Uri.t ->
422
+
content:string ->
423
+
unit ->
424
+
Proto.Activity.t
425
+
(** [update_note client ~actor ~object_ ~content ()] updates a note's content.
426
+
427
+
@raise E on send failure *)
428
+
end
429
+
430
+
(** {1 Collection Iteration} *)
431
+
432
+
(** Utilities for iterating over paginated collections. *)
433
+
module Collection : sig
434
+
val iter :
435
+
t ->
436
+
('a -> unit) ->
437
+
'a Proto.Collection.t ->
438
+
'a Jsont.t ->
439
+
unit
440
+
(** [iter client f collection item_jsont] iterates over all items in a collection,
441
+
automatically fetching subsequent pages.
442
+
443
+
@raise E on fetch failure *)
444
+
445
+
val fold :
446
+
t ->
447
+
('acc -> 'a -> 'acc) ->
448
+
'acc ->
449
+
'a Proto.Collection.t ->
450
+
'a Jsont.t ->
451
+
'acc
452
+
(** [fold client f init collection item_jsont] folds over all items in a collection,
453
+
automatically fetching subsequent pages.
454
+
455
+
@raise E on fetch failure *)
456
+
457
+
val to_list :
458
+
t ->
459
+
'a Proto.Collection.t ->
460
+
'a Jsont.t ->
461
+
'a list
462
+
(** [to_list client collection item_jsont] returns all items in a collection as a list.
463
+
464
+
Warning: This may perform many HTTP requests for large collections.
465
+
466
+
@raise E on fetch failure *)
467
+
468
+
val first_page :
469
+
t ->
470
+
'a Proto.Collection.t ->
471
+
'a Jsont.t ->
472
+
'a Proto.Collection_page.t option
473
+
(** [first_page client collection item_jsont] fetches the first page of a collection.
474
+
475
+
@raise E on fetch failure *)
476
+
477
+
val next_page :
478
+
t ->
479
+
'a Proto.Collection_page.t ->
480
+
'a Jsont.t ->
481
+
'a Proto.Collection_page.t option
482
+
(** [next_page client page item_jsont] fetches the next page, if any.
483
+
484
+
@raise E on fetch failure *)
485
+
end
486
+
487
+
(** {1 Low-Level HTTP} *)
488
+
489
+
(** Low-level HTTP operations with ActivityPub content negotiation. *)
490
+
module Http : sig
491
+
val get : t -> Proto.Uri.t -> Jsont.json
492
+
(** [get client uri] performs a GET request with ActivityPub Accept header.
493
+
494
+
@raise E on request failure *)
495
+
496
+
val get_typed : t -> 'a Jsont.t -> Proto.Uri.t -> 'a
497
+
(** [get_typed client jsont uri] performs a GET and decodes the response.
498
+
499
+
@raise E on request failure *)
500
+
501
+
val post : t -> Proto.Uri.t -> Jsont.json -> unit
502
+
(** [post client uri body] performs a signed POST request.
503
+
504
+
@raise E on request failure *)
505
+
506
+
val post_typed : t -> 'a Jsont.t -> Proto.Uri.t -> 'a -> unit
507
+
(** [post_typed client jsont uri value] encodes and POSTs a typed value.
508
+
509
+
@raise E on request failure *)
510
+
end
+4
lib/client/dune
+4
lib/client/dune
+4
lib/proto/dune
+4
lib/proto/dune
+102
-48
src/activitypub.ml
lib/proto/apubt_proto.ml
+102
-48
src/activitypub.ml
lib/proto/apubt_proto.ml
···
47
47
let jsont = Jsont.json |> Jsont.with_doc ~kind:"@context"
48
48
end
49
49
50
+
(** Helper: JSON type that accepts either a single item or an array, normalizing to a list.
51
+
On encoding, always outputs an array for consistency. *)
52
+
let one_or_many (item_jsont : 'a Jsont.t) : 'a list Jsont.t =
53
+
let dec_array = Jsont.list item_jsont in
54
+
let dec_single = Jsont.map item_jsont
55
+
~dec:(fun x -> [x])
56
+
~enc:(fun _ -> assert false) (* never used for encoding *)
57
+
in
58
+
Jsont.any ~kind:"one or many"
59
+
~dec_array
60
+
~dec_string:dec_single
61
+
~dec_object:dec_single
62
+
~enc:(fun _ -> dec_array) (* always encode as array *)
63
+
()
64
+
65
+
(** Helper: Nullable value - accepts null as None, value as Some value *)
66
+
let nullable (jsont : 'a Jsont.t) : 'a option Jsont.t =
67
+
let dec_null = Jsont.null None in
68
+
let dec_value = Jsont.map jsont
69
+
~dec:(fun v -> Some v)
70
+
~enc:(function Some v -> v | None -> assert false)
71
+
in
72
+
Jsont.any ~kind:"nullable"
73
+
~dec_null
74
+
~dec_string:dec_value
75
+
~dec_number:dec_value
76
+
~dec_bool:dec_value
77
+
~dec_array:dec_value
78
+
~dec_object:dec_value
79
+
~enc:(function
80
+
| None -> dec_null
81
+
| Some _ -> dec_value)
82
+
()
83
+
84
+
(** Helper: URI that can also be an object with an id field.
85
+
This handles ActivityPub fields like 'replies' that can be either
86
+
a URI string or an inline Collection object. *)
87
+
let uri_or_object_with_id : Uri.t Jsont.t =
88
+
let id_jsont =
89
+
Jsont.Object.map ~kind:"Object with id" (fun id -> id)
90
+
|> Jsont.Object.mem "id" Uri.jsont ~enc:Fun.id
91
+
|> Jsont.Object.skip_unknown
92
+
|> Jsont.Object.finish
93
+
in
94
+
Jsont.any ~kind:"URI or object"
95
+
~dec_string:Uri.jsont
96
+
~dec_object:id_jsont
97
+
~enc:(fun _ -> Uri.jsont)
98
+
()
99
+
100
+
50
101
(** {1 Link} *)
51
102
52
103
(** Link objects represent references to other resources.
···
187
238
Jsont.Object.map ~kind:"Image"
188
239
(fun id url name media_type width height ->
189
240
{ id; url; name; media_type; width; height })
190
-
|> Jsont.Object.opt_mem "@id" Uri.jsont ~enc:id
241
+
|> Jsont.Object.opt_mem "id" Uri.jsont ~enc:id
191
242
|> Jsont.Object.mem "url" Link_or_uri.jsont ~enc:url
192
243
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
193
244
|> Jsont.Object.opt_mem "mediaType" Jsont.string ~enc:media_type
···
218
269
let image i = Image i
219
270
220
271
let jsont =
272
+
(* For string case: URI *)
221
273
let dec_string = Jsont.map Uri.jsont ~dec:(fun u -> Uri u)
222
274
~enc:(function Uri u -> u | _ -> assert false) in
223
-
let link_jsont =
224
-
Jsont.map Link.jsont
225
-
~dec:(fun l -> Link l)
226
-
~enc:(function Link l -> l | _ -> assert false)
227
-
in
228
-
let image_jsont =
275
+
(* For object case: either Link or Image *)
276
+
let dec_object =
277
+
(* Default: decode as Image if we can't determine type *)
229
278
Jsont.map Image.jsont
230
279
~dec:(fun i -> Image i)
231
280
~enc:(function Image i -> i | _ -> assert false)
232
281
in
233
-
let link_case = Jsont.Object.Case.map "Link" link_jsont in
234
-
let image_case = Jsont.Object.Case.map "Image" image_jsont in
235
-
let dec_object =
236
-
Jsont.Object.map ~kind:"Image or Link" Fun.id
237
-
|> Jsont.Object.case_mem "@type" Jsont.string
238
-
~tag_compare:String.compare ~tag_to_string:Fun.id
239
-
~dec_absent:"Image"
240
-
~enc:Fun.id
241
-
~enc_case:(function
242
-
| Link _ as v -> Jsont.Object.Case.value link_case v
243
-
| Image _ as v -> Jsont.Object.Case.value image_case v
244
-
| Uri _ -> assert false)
245
-
[ Jsont.Object.Case.make link_case;
246
-
Jsont.Object.Case.make image_case ]
247
-
|> Jsont.Object.finish
248
-
in
249
282
Jsont.any ~kind:"Image reference"
250
283
~dec_string ~dec_object
251
284
~enc:(function
···
293
326
let dec_object =
294
327
Jsont.Object.map ~kind:"Recipient"
295
328
(fun id type_ -> { id; type_ })
296
-
|> Jsont.Object.mem "@id" Uri.jsont ~enc:id
297
-
|> Jsont.Object.opt_mem "@type" Jsont.string ~enc:type_
329
+
|> Jsont.Object.mem "id" Uri.jsont ~enc:id
330
+
|> Jsont.Object.opt_mem "type" Jsont.string ~enc:type_
298
331
|> Jsont.Object.finish
299
332
in
300
333
Jsont.any ~kind:"Recipient"
···
560
593
inbox; outbox; followers; following; liked; streams; endpoints;
561
594
public_key; icon; image; manually_approves_followers })
562
595
|> Jsont.Object.opt_mem "@context" Context.jsont ~enc:context
563
-
|> Jsont.Object.mem "@id" Uri.jsont ~enc:id
564
-
|> Jsont.Object.mem "@type" Actor_type.jsont ~enc:type_
596
+
|> Jsont.Object.mem "id" Uri.jsont ~enc:id
597
+
|> Jsont.Object.mem "type" Actor_type.jsont ~enc:type_
565
598
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
566
599
|> Jsont.Object.opt_mem "preferredUsername" Jsont.string
567
600
~enc:preferred_username
···
575
608
|> Jsont.Object.opt_mem "streams" (Jsont.list Uri.jsont) ~enc:streams
576
609
|> Jsont.Object.opt_mem "endpoints" Endpoints.jsont ~enc:endpoints
577
610
|> Jsont.Object.opt_mem "publicKey" Public_key.jsont ~enc:public_key
578
-
|> Jsont.Object.opt_mem "icon" (Jsont.list Image_ref.jsont) ~enc:icon
579
-
|> Jsont.Object.opt_mem "image" (Jsont.list Image_ref.jsont) ~enc:image
611
+
|> Jsont.Object.opt_mem "icon" (one_or_many Image_ref.jsont) ~enc:icon
612
+
|> Jsont.Object.opt_mem "image" (one_or_many Image_ref.jsont) ~enc:image
580
613
|> Jsont.Object.opt_mem "manuallyApprovesFollowers" Jsont.bool
581
614
~enc:manually_approves_followers
582
615
|> Jsont.Object.finish
···
846
879
to_; cc; bto; bcc; replies; attachment; tag; generator;
847
880
icon; image; start_time; end_time; duration; sensitive })
848
881
|> Jsont.Object.opt_mem "@context" Context.jsont ~enc:context
849
-
|> Jsont.Object.opt_mem "@id" Uri.jsont ~enc:id
850
-
|> Jsont.Object.mem "@type" Object_type.jsont ~enc:type_
882
+
|> Jsont.Object.opt_mem "id" Uri.jsont ~enc:id
883
+
|> Jsont.Object.mem "type" Object_type.jsont ~enc:type_
851
884
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
852
-
|> Jsont.Object.opt_mem "summary" Jsont.string ~enc:summary
853
-
|> Jsont.Object.opt_mem "content" Jsont.string ~enc:content
885
+
|> Jsont.Object.mem "summary" (nullable Jsont.string)
886
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:summary
887
+
|> Jsont.Object.mem "content" (nullable Jsont.string)
888
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:content
854
889
|> Jsont.Object.opt_mem "mediaType" Jsont.string ~enc:media_type
855
-
|> Jsont.Object.opt_mem "url" (Jsont.list Link_or_uri.jsont) ~enc:url
890
+
|> Jsont.Object.opt_mem "url" (one_or_many Link_or_uri.jsont) ~enc:url
856
891
|> Jsont.Object.opt_mem "attributedTo" Actor_ref.jsont ~enc:attributed_to
857
-
|> Jsont.Object.opt_mem "inReplyTo" Uri.jsont ~enc:in_reply_to
892
+
|> Jsont.Object.mem "inReplyTo" (nullable Uri.jsont)
893
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:in_reply_to
858
894
|> Jsont.Object.opt_mem "published" Datetime.jsont ~enc:published
859
895
|> Jsont.Object.opt_mem "updated" Datetime.jsont ~enc:updated
860
896
|> Jsont.Object.opt_mem "deleted" Datetime.jsont ~enc:deleted
···
862
898
|> Jsont.Object.opt_mem "cc" (Jsont.list Recipient.jsont) ~enc:cc
863
899
|> Jsont.Object.opt_mem "bto" (Jsont.list Recipient.jsont) ~enc:bto
864
900
|> Jsont.Object.opt_mem "bcc" (Jsont.list Recipient.jsont) ~enc:bcc
865
-
|> Jsont.Object.opt_mem "replies" Uri.jsont ~enc:replies
901
+
|> Jsont.Object.opt_mem "replies" uri_or_object_with_id ~enc:replies
866
902
|> Jsont.Object.opt_mem "attachment" (Jsont.list Link_or_uri.jsont)
867
903
~enc:attachment
868
904
|> Jsont.Object.opt_mem "tag" (Jsont.list Link_or_uri.jsont) ~enc:tag
869
905
|> Jsont.Object.opt_mem "generator" Uri.jsont ~enc:generator
870
-
|> Jsont.Object.opt_mem "icon" (Jsont.list Image_ref.jsont) ~enc:icon
871
-
|> Jsont.Object.opt_mem "image" (Jsont.list Image_ref.jsont) ~enc:image
906
+
|> Jsont.Object.opt_mem "icon" (one_or_many Image_ref.jsont) ~enc:icon
907
+
|> Jsont.Object.opt_mem "image" (one_or_many Image_ref.jsont) ~enc:image
872
908
|> Jsont.Object.opt_mem "startTime" Datetime.jsont ~enc:start_time
873
909
|> Jsont.Object.opt_mem "endTime" Datetime.jsont ~enc:end_time
874
910
|> Jsont.Object.opt_mem "duration" Jsont.string ~enc:duration
···
1158
1194
{ context; id; type_; actor; object_; target; result; origin;
1159
1195
instrument; to_; cc; bto; bcc; published; updated; summary })
1160
1196
|> Jsont.Object.opt_mem "@context" Context.jsont ~enc:context
1161
-
|> Jsont.Object.opt_mem "@id" Uri.jsont ~enc:id
1162
-
|> Jsont.Object.mem "@type" Activity_type.jsont ~enc:type_
1197
+
|> Jsont.Object.opt_mem "id" Uri.jsont ~enc:id
1198
+
|> Jsont.Object.mem "type" Activity_type.jsont ~enc:type_
1163
1199
|> Jsont.Object.mem "actor" Actor_ref.jsont ~enc:actor
1164
1200
|> Jsont.Object.opt_mem "object" Object_ref.jsont ~enc:object_
1165
1201
|> Jsont.Object.opt_mem "target" Object_ref.jsont ~enc:target
···
1267
1303
"OrderedCollection", true;
1268
1304
]
1269
1305
in
1306
+
let list_jsont = Jsont.list item_jsont in
1270
1307
Jsont.Object.map ~kind:"Collection"
1271
-
(fun context id ordered total_items current first last items ->
1308
+
(fun context id ordered total_items current first last items ordered_items ->
1309
+
let items = match items, ordered_items with
1310
+
| Some i, _ -> Some i
1311
+
| None, Some i -> Some i
1312
+
| None, None -> None
1313
+
in
1272
1314
{ context; id; total_items; current; first; last; items; ordered })
1273
1315
|> Jsont.Object.opt_mem "@context" Context.jsont ~enc:context
1274
-
|> Jsont.Object.opt_mem "@id" Uri.jsont ~enc:id
1275
-
|> Jsont.Object.mem "@type" type_jsont ~enc:ordered
1316
+
|> Jsont.Object.opt_mem "id" Uri.jsont ~enc:id
1317
+
|> Jsont.Object.mem "type" type_jsont ~enc:ordered
1276
1318
|> Jsont.Object.opt_mem "totalItems" Jsont.int ~enc:total_items
1277
1319
|> Jsont.Object.opt_mem "current" Uri.jsont ~enc:current
1278
1320
|> Jsont.Object.opt_mem "first" Uri.jsont ~enc:first
1279
1321
|> Jsont.Object.opt_mem "last" Uri.jsont ~enc:last
1280
-
|> Jsont.Object.opt_mem "items" (Jsont.list item_jsont) ~enc:items
1322
+
|> Jsont.Object.opt_mem "items" list_jsont
1323
+
~enc:(fun t -> if t.ordered then None else t.items)
1324
+
|> Jsont.Object.opt_mem "orderedItems" list_jsont
1325
+
~enc:(fun t -> if t.ordered then t.items else None)
1281
1326
|> Jsont.Object.finish
1282
1327
end
1283
1328
···
1354
1399
"OrderedCollectionPage", true;
1355
1400
]
1356
1401
in
1402
+
let list_jsont = Jsont.list item_jsont in
1357
1403
Jsont.Object.map ~kind:"CollectionPage"
1358
1404
(fun context id ordered total_items current first last prev next
1359
-
part_of items ->
1405
+
part_of items ordered_items ->
1406
+
let items = match items, ordered_items with
1407
+
| Some i, _ -> Some i
1408
+
| None, Some i -> Some i
1409
+
| None, None -> None
1410
+
in
1360
1411
{ context; id; total_items; current; first; last; prev; next;
1361
1412
part_of; items; ordered })
1362
1413
|> Jsont.Object.opt_mem "@context" Context.jsont ~enc:context
1363
-
|> Jsont.Object.opt_mem "@id" Uri.jsont ~enc:id
1364
-
|> Jsont.Object.mem "@type" type_jsont ~enc:ordered
1414
+
|> Jsont.Object.opt_mem "id" Uri.jsont ~enc:id
1415
+
|> Jsont.Object.mem "type" type_jsont ~enc:ordered
1365
1416
|> Jsont.Object.opt_mem "totalItems" Jsont.int ~enc:total_items
1366
1417
|> Jsont.Object.opt_mem "current" Uri.jsont ~enc:current
1367
1418
|> Jsont.Object.opt_mem "first" Uri.jsont ~enc:first
···
1369
1420
|> Jsont.Object.opt_mem "prev" Uri.jsont ~enc:prev
1370
1421
|> Jsont.Object.opt_mem "next" Uri.jsont ~enc:next
1371
1422
|> Jsont.Object.opt_mem "partOf" Uri.jsont ~enc:part_of
1372
-
|> Jsont.Object.opt_mem "items" (Jsont.list item_jsont) ~enc:items
1423
+
|> Jsont.Object.opt_mem "items" list_jsont
1424
+
~enc:(fun t -> if t.ordered then None else t.items)
1425
+
|> Jsont.Object.opt_mem "orderedItems" list_jsont
1426
+
~enc:(fun t -> if t.ordered then t.items else None)
1373
1427
|> Jsont.Object.finish
1374
1428
end
1375
1429
+8
-7
src/activitypub.mli
lib/proto/apubt_proto.mli
+8
-7
src/activitypub.mli
lib/proto/apubt_proto.mli
···
1
-
(** ActivityPub/ActivityStreams types with jsont codecs.
1
+
(** ActivityPub/ActivityStreams protocol types with jsont codecs.
2
2
3
3
This module provides OCaml types and bidirectional JSON codecs for the
4
-
ActivityPub and ActivityStreams 2.0 specifications.
4
+
ActivityPub and ActivityStreams 2.0 specifications. It is the wire format
5
+
layer of the {!Apubt} library.
5
6
6
7
{1 Example}
7
8
8
9
{[
9
10
(* Decode an actor from JSON *)
10
11
let json_str = {|{"@id": "...", "@type": "Person", ...}|} in
11
-
match Jsont_codec.decode_string Actor.jsont json_str with
12
-
| Ok actor -> Printf.printf "Actor: %s\n" (Actor.name actor)
13
-
| Error e -> Printf.eprintf "Error: %s\n" e
12
+
match Jsont_bytesrw.decode_string Actor.jsont json_str with
13
+
| Ok actor -> Printf.printf "Actor: %s\n" (Option.value ~default:"" (Actor.name actor))
14
+
| Error e -> Printf.eprintf "Error: %a\n" Jsont.Error.pp e
14
15
15
16
(* Create and encode a Note *)
16
17
let note = Object.make ~type_:Object_type.Note
17
18
~content:"Hello ActivityPub!" () in
18
-
match Jsont_codec.encode_string Object.jsont note with
19
+
match Jsont_bytesrw.encode_string Object.jsont note with
19
20
| Ok json_str -> print_endline json_str
20
-
| Error e -> Printf.eprintf "Error: %s\n" e
21
+
| Error e -> Printf.eprintf "Error: %a\n" Jsont.Error.pp e
21
22
]}
22
23
23
24
@see <https://www.w3.org/TR/activitypub/> ActivityPub specification