futur.blue
objective categorical abstract machine language personal data server
hermes: Return bytes for bytes output
+2
-2
hermes-cli/lib/codegen.ml
+2
-2
hermes-cli/lib/codegen.ml
···
423
(* generate output type *)
424
( if output_is_bytes then begin
425
emitln out " (** raw bytes output with content type *)" ;
426
-
emitln out " type output = string * string" ;
427
emit_newline out
428
end
429
else
···
564
(* generate output type *)
565
( if output_is_bytes then begin
566
emitln out " (** raw bytes output with content type *)" ;
567
-
emitln out " type output = (string * string) option" ;
568
emit_newline out
569
end
570
else
···
423
(* generate output type *)
424
( if output_is_bytes then begin
425
emitln out " (** raw bytes output with content type *)" ;
426
+
emitln out " type output = bytes * string" ;
427
emit_newline out
428
end
429
else
···
564
(* generate output type *)
565
( if output_is_bytes then begin
566
emitln out " (** raw bytes output with content type *)" ;
567
+
emitln out " type output = (bytes * string) option" ;
568
emit_newline out
569
end
570
else
+3
-3
hermes-cli/test/test_codegen.ml
+3
-3
hermes-cli/test/test_codegen.ml
···
110
[make_def "result" (Lexicon_types.Union union_spec)]
111
in
112
let code = Codegen.gen_lexicon_module doc in
113
-
check bool "contains type result" true (contains code "type result =") ;
114
check bool "contains TypeA variant" true (contains code "| TypeA of") ;
115
check bool "contains TypeB variant" true (contains code "| TypeB of") ;
116
check bool "contains Unknown (open)" true
···
452
in
453
let code = Codegen.gen_lexicon_module doc in
454
check bool "contains module Main" true (contains code "module Main = struct") ;
455
-
check bool "output is string * string tuple" true
456
-
(contains code "type output = string * string") ;
457
check bool "calls Hermes.query_bytes" true
458
(contains code "Hermes.query_bytes")
459
···
110
[make_def "result" (Lexicon_types.Union union_spec)]
111
in
112
let code = Codegen.gen_lexicon_module doc in
113
+
check bool "contains type result" true (contains code "type result_ =") ;
114
check bool "contains TypeA variant" true (contains code "| TypeA of") ;
115
check bool "contains TypeB variant" true (contains code "| TypeB of") ;
116
check bool "contains Unknown (open)" true
···
452
in
453
let code = Codegen.gen_lexicon_module doc in
454
check bool "contains module Main" true (contains code "module Main = struct") ;
455
+
check bool "output is bytes * string tuple" true
456
+
(contains code "type output = bytes * string") ;
457
check bool "calls Hermes.query_bytes" true
458
(contains code "Hermes.query_bytes")
459
+1
-1
hermes/README.md
+1
-1
hermes/README.md
···
281
Endpoints with non-JSON encoding are automatically detected and handled:
282
283
- **Queries with bytes output** (e.g., `com.atproto.sync.getBlob` with `encoding: "*/*"`):
284
-
- Output type is `string * string` (data, content_type)
285
- Generated code uses `Hermes.query_bytes`
286
287
- **Procedures with bytes input**:
···
281
Endpoints with non-JSON encoding are automatically detected and handled:
282
283
- **Queries with bytes output** (e.g., `com.atproto.sync.getBlob` with `encoding: "*/*"`):
284
+
- Output type is `bytes * string` (data, content_type)
285
- Generated code uses `Hermes.query_bytes`
286
287
- **Procedures with bytes input**:
+12
-10
hermes/lib/client.ml
+12
-10
hermes/lib/client.ml
···
36
-> (Yojson.Safe.t -> ('a, string) result)
37
-> 'a Lwt.t
38
39
-
val query_bytes : t -> string -> Yojson.Safe.t -> (string * string) Lwt.t
40
41
val procedure_bytes :
42
t
43
-> string
44
-> Yojson.Safe.t
45
-
-> string option
46
-> content_type:string
47
-
-> (string * string) option Lwt.t
48
49
val procedure_blob :
50
t
···
229
Types.raise_xrpc_error ~status payload
230
231
let query_bytes (t : t) (nsid : string) (params : Yojson.Safe.t) :
232
-
(string * string) Lwt.t =
233
(* call interceptor if present for token refresh *)
234
let* () =
235
match t.on_request with Some f -> f t | None -> Lwt.return_unit
···
249
in
250
let status = Cohttp.Response.status resp |> Cohttp.Code.code_of_status in
251
let* body_str = Cohttp_lwt.Body.to_string body in
252
if status >= 200 && status < 300 then
253
let content_type =
254
Cohttp.Response.headers resp
···
256
Cohttp.Header.get h "content-type"
257
|> Option.value ~default:"application/octet-stream"
258
in
259
-
Lwt.return (body_str, content_type)
260
else
261
let payload =
262
try
···
272
273
(* execute procedure with raw bytes input, returns raw bytes or none if no output *)
274
let procedure_bytes (t : t) (nsid : string) (params : Yojson.Safe.t)
275
-
(input : string option) ~(content_type : string) :
276
-
(string * string) option Lwt.t =
277
(* call interceptor if present for token refresh *)
278
let* () =
279
match t.on_request with Some f -> f t | None -> Lwt.return_unit
···
286
let body =
287
match input with
288
| Some data ->
289
-
Cohttp_lwt.Body.of_string data
290
| None ->
291
Cohttp_lwt.Body.empty
292
in
···
303
in
304
let status = Cohttp.Response.status resp |> Cohttp.Code.code_of_status in
305
let* body_str = Cohttp_lwt.Body.to_string resp_body in
306
if status >= 200 && status < 300 then
307
-
if String.length body_str = 0 then Lwt.return None
308
else
309
let resp_content_type =
310
Cohttp.Response.headers resp
···
312
Cohttp.Header.get h "content-type"
313
|> Option.value ~default:"application/octet-stream"
314
in
315
-
Lwt.return (Some (body_str, resp_content_type))
316
else
317
let payload =
318
try
···
36
-> (Yojson.Safe.t -> ('a, string) result)
37
-> 'a Lwt.t
38
39
+
val query_bytes : t -> string -> Yojson.Safe.t -> (bytes * string) Lwt.t
40
41
val procedure_bytes :
42
t
43
-> string
44
-> Yojson.Safe.t
45
+
-> bytes option
46
-> content_type:string
47
+
-> (bytes * string) option Lwt.t
48
49
val procedure_blob :
50
t
···
229
Types.raise_xrpc_error ~status payload
230
231
let query_bytes (t : t) (nsid : string) (params : Yojson.Safe.t) :
232
+
(bytes * string) Lwt.t =
233
(* call interceptor if present for token refresh *)
234
let* () =
235
match t.on_request with Some f -> f t | None -> Lwt.return_unit
···
249
in
250
let status = Cohttp.Response.status resp |> Cohttp.Code.code_of_status in
251
let* body_str = Cohttp_lwt.Body.to_string body in
252
+
let body = Bytes.of_string body_str in
253
if status >= 200 && status < 300 then
254
let content_type =
255
Cohttp.Response.headers resp
···
257
Cohttp.Header.get h "content-type"
258
|> Option.value ~default:"application/octet-stream"
259
in
260
+
Lwt.return (body, content_type)
261
else
262
let payload =
263
try
···
273
274
(* execute procedure with raw bytes input, returns raw bytes or none if no output *)
275
let procedure_bytes (t : t) (nsid : string) (params : Yojson.Safe.t)
276
+
(input : bytes option) ~(content_type : string) :
277
+
(bytes * string) option Lwt.t =
278
(* call interceptor if present for token refresh *)
279
let* () =
280
match t.on_request with Some f -> f t | None -> Lwt.return_unit
···
287
let body =
288
match input with
289
| Some data ->
290
+
Cohttp_lwt.Body.of_string (Bytes.to_string data)
291
| None ->
292
Cohttp_lwt.Body.empty
293
in
···
304
in
305
let status = Cohttp.Response.status resp |> Cohttp.Code.code_of_status in
306
let* body_str = Cohttp_lwt.Body.to_string resp_body in
307
+
let body = Bytes.of_string body_str in
308
if status >= 200 && status < 300 then
309
+
if Bytes.length body = 0 then Lwt.return None
310
else
311
let resp_content_type =
312
Cohttp.Response.headers resp
···
314
Cohttp.Header.get h "content-type"
315
|> Option.value ~default:"application/octet-stream"
316
in
317
+
Lwt.return (Some (body, resp_content_type))
318
else
319
let payload =
320
try
+6
-6
hermes/lib/hermes.mli
+6
-6
hermes/lib/hermes.mli
···
77
-> (Yojson.Safe.t -> ('a, string) result)
78
-> 'a Lwt.t
79
80
-
val query_bytes : client -> string -> Yojson.Safe.t -> (string * string) Lwt.t
81
82
val procedure_bytes :
83
client
84
-> string
85
-> Yojson.Safe.t
86
-
-> string option
87
-> content_type:string
88
-
-> (string * string) option Lwt.t
89
90
val session_to_yojson : session -> Yojson.Safe.t
91
···
158
-> (Yojson.Safe.t -> ('a, string) result)
159
-> 'a Lwt.t
160
161
-
val query_bytes : t -> string -> Yojson.Safe.t -> (string * string) Lwt.t
162
163
val procedure_bytes :
164
t
165
-> string
166
-> Yojson.Safe.t
167
-
-> string option
168
-> content_type:string
169
-
-> (string * string) option Lwt.t
170
171
val procedure_blob :
172
t
···
77
-> (Yojson.Safe.t -> ('a, string) result)
78
-> 'a Lwt.t
79
80
+
val query_bytes : client -> string -> Yojson.Safe.t -> (bytes * string) Lwt.t
81
82
val procedure_bytes :
83
client
84
-> string
85
-> Yojson.Safe.t
86
+
-> bytes option
87
-> content_type:string
88
+
-> (bytes * string) option Lwt.t
89
90
val session_to_yojson : session -> Yojson.Safe.t
91
···
158
-> (Yojson.Safe.t -> ('a, string) result)
159
-> 'a Lwt.t
160
161
+
val query_bytes : t -> string -> Yojson.Safe.t -> (bytes * string) Lwt.t
162
163
val procedure_bytes :
164
t
165
-> string
166
-> Yojson.Safe.t
167
+
-> bytes option
168
-> content_type:string
169
+
-> (bytes * string) option Lwt.t
170
171
val procedure_blob :
172
t
+9
-3
hermes/test/test_client.ml
+9
-3
hermes/test/test_client.ml
···
7
(* helpers *)
8
let test_string = testable Fmt.string String.equal
9
10
(** query tests *)
11
12
let test_query_success () =
···
105
C.query_bytes client "com.atproto.sync.getBlob"
106
(`Assoc [("did", `String "did:plc:123"); ("cid", `String "bafyabc")]) )
107
in
108
-
check test_string "data" "fake-image-data" data ;
109
check test_string "content_type" "image/jpeg" content_type ;
110
let req = List.hd requests in
111
Test_utils.assert_request_has_header "accept" "*/*" req ;
···
163
let* result, requests =
164
Test_utils.with_mock_responses [response] (fun (module C) client ->
165
C.procedure_bytes client "com.atproto.repo.importRepo" (`Assoc [])
166
-
(Some "fake-car-data") ~content_type:"application/vnd.ipld.car" )
167
in
168
-
check (option (pair test_string test_string)) "result" None result ;
169
let req = List.hd requests in
170
Test_utils.assert_request_has_header "content-type" "application/vnd.ipld.car"
171
req ;
···
7
(* helpers *)
8
let test_string = testable Fmt.string String.equal
9
10
+
let test_bytes =
11
+
testable
12
+
(Fmt.of_to_string (fun b -> String.sub (Bytes.to_string b) 0 10))
13
+
Bytes.equal
14
+
15
(** query tests *)
16
17
let test_query_success () =
···
110
C.query_bytes client "com.atproto.sync.getBlob"
111
(`Assoc [("did", `String "did:plc:123"); ("cid", `String "bafyabc")]) )
112
in
113
+
check test_bytes "data" (Bytes.of_string "fake-image-data") data ;
114
check test_string "content_type" "image/jpeg" content_type ;
115
let req = List.hd requests in
116
Test_utils.assert_request_has_header "accept" "*/*" req ;
···
168
let* result, requests =
169
Test_utils.with_mock_responses [response] (fun (module C) client ->
170
C.procedure_bytes client "com.atproto.repo.importRepo" (`Assoc [])
171
+
(Some (Bytes.of_string "fake-car-data"))
172
+
~content_type:"application/vnd.ipld.car" )
173
in
174
+
check (option (pair test_bytes test_string)) "result" None result ;
175
let req = List.hd requests in
176
Test_utils.assert_request_has_header "content-type" "application/vnd.ipld.car"
177
req ;
+5
-5
hermes_ppx/test/test_ppx.ml
+5
-5
hermes_ppx/test/test_ppx.ml
···
19
check (list string) "single segment" ["Test"] result
20
21
let test_build_call_expr () =
22
-
let result = Hermes_ppx.build_call_expr ~loc "app.bsky.graph.getProfile" in
23
-
let expected_str = "App.Bsky.Graph.GetProfile.call" in
24
check string "call expr" expected_str
25
(Ppxlib.Pprintast.string_of_expression result)
26
···
38
39
let test_expand_get_nsid () =
40
let actual = expand_xrpc {|[%xrpc get "app.bsky.graph.getRelationships"]|} in
41
-
let expected_str = "App.Bsky.Graph.GetRelationships.call" in
42
check string "get expansion" expected_str
43
(Ppxlib.Pprintast.string_of_expression actual)
44
···
46
let actual =
47
expand_xrpc {|[%xrpc post "com.atproto.server.createSession"]|}
48
in
49
-
let expected_str = "Com.Atproto.Server.CreateSession.call" in
50
check string "post expansion" expected_str
51
(Ppxlib.Pprintast.string_of_expression actual)
52
53
let test_expand_nsid_only () =
54
(* [%xrpc "nsid"] defaults to get *)
55
let actual = expand_xrpc {|[%xrpc "app.bsky.actor.getProfile"]|} in
56
-
let expected_str = "App.Bsky.Actor.GetProfile.call" in
57
check string "nsid only expansion" expected_str
58
(Ppxlib.Pprintast.string_of_expression actual)
59
···
19
check (list string) "single segment" ["Test"] result
20
21
let test_build_call_expr () =
22
+
let result = Hermes_ppx.build_call_expr ~loc "app.bsky.actor.getProfile" in
23
+
let expected_str = "App.Bsky.Actor.GetProfile.Main.call" in
24
check string "call expr" expected_str
25
(Ppxlib.Pprintast.string_of_expression result)
26
···
38
39
let test_expand_get_nsid () =
40
let actual = expand_xrpc {|[%xrpc get "app.bsky.graph.getRelationships"]|} in
41
+
let expected_str = "App.Bsky.Graph.GetRelationships.Main.call" in
42
check string "get expansion" expected_str
43
(Ppxlib.Pprintast.string_of_expression actual)
44
···
46
let actual =
47
expand_xrpc {|[%xrpc post "com.atproto.server.createSession"]|}
48
in
49
+
let expected_str = "Com.Atproto.Server.CreateSession.Main.call" in
50
check string "post expansion" expected_str
51
(Ppxlib.Pprintast.string_of_expression actual)
52
53
let test_expand_nsid_only () =
54
(* [%xrpc "nsid"] defaults to get *)
55
let actual = expand_xrpc {|[%xrpc "app.bsky.actor.getProfile"]|} in
56
+
let expected_str = "App.Bsky.Actor.GetProfile.Main.call" in
57
check string "nsid only expansion" expected_str
58
(Ppxlib.Pprintast.string_of_expression actual)
59
+1
-1
pegasus/lexicons/com_atproto_sync_getBlob.ml
+1
-1
pegasus/lexicons/com_atproto_sync_getBlob.ml
+1
-1
pegasus/lexicons/com_atproto_sync_getBlocks.ml
+1
-1
pegasus/lexicons/com_atproto_sync_getBlocks.ml
+1
-1
pegasus/lexicons/com_atproto_sync_getCheckout.ml
+1
-1
pegasus/lexicons/com_atproto_sync_getCheckout.ml
+1
-1
pegasus/lexicons/com_atproto_sync_getRecord.ml
+1
-1
pegasus/lexicons/com_atproto_sync_getRecord.ml
+1
-1
pegasus/lexicons/com_atproto_sync_getRepo.ml
+1
-1
pegasus/lexicons/com_atproto_sync_getRepo.ml
+8
-18
pegasus/lib/api/account_/migrate/migrate.ml
+8
-18
pegasus/lib/api/account_/migrate/migrate.ml
···
417
match%lwt Remote.fetch_repo old_client ~did with
418
| Error err ->
419
render_err ~did ~handle ~old_pds ("Failed to fetch repository: " ^ err)
420
-
| Ok car_data -> (
421
-
match%lwt
422
-
Ops.import_repo ~did ~car_data:(Bytes.of_string (fst car_data))
423
-
with
424
| Error err ->
425
render_err ~did ~handle ~old_pds err
426
| Ok () ->
···
432
match%lwt Remote.fetch_repo old_client ~did with
433
| Error e ->
434
render_err ("Failed to fetch repository: " ^ e)
435
-
| Ok car_data -> (
436
-
match%lwt
437
-
Ops.import_repo ~did ~car_data:(Bytes.of_string (fst car_data))
438
-
with
439
| Error e ->
440
render_err e
441
| Ok () -> (
···
784
match%lwt Remote.fetch_repo client ~did with
785
| Error e ->
786
render_err ("Failed to fetch repository: " ^ e)
787
-
| Ok car_data -> (
788
-
match%lwt
789
-
Ops.import_repo ~did
790
-
~car_data:(Bytes.of_string @@ fst car_data)
791
-
with
792
| Error e ->
793
render_err e
794
| Ok () ->
···
885
| Error e ->
886
render_err ~did ~handle ~old_pds
887
("Failed to fetch repository: " ^ e)
888
-
| Ok car_data -> (
889
-
match%lwt
890
-
Ops.import_repo ~did
891
-
~car_data:(Bytes.of_string @@ fst car_data)
892
-
with
893
| Error e ->
894
render_err ~did ~handle ~old_pds e
895
| Ok () -> (
···
417
match%lwt Remote.fetch_repo old_client ~did with
418
| Error err ->
419
render_err ~did ~handle ~old_pds ("Failed to fetch repository: " ^ err)
420
+
| Ok (car_data, _) -> (
421
+
match%lwt Ops.import_repo ~did ~car_data with
422
| Error err ->
423
render_err ~did ~handle ~old_pds err
424
| Ok () ->
···
430
match%lwt Remote.fetch_repo old_client ~did with
431
| Error e ->
432
render_err ("Failed to fetch repository: " ^ e)
433
+
| Ok (car_data, _) -> (
434
+
match%lwt Ops.import_repo ~did ~car_data with
435
| Error e ->
436
render_err e
437
| Ok () -> (
···
780
match%lwt Remote.fetch_repo client ~did with
781
| Error e ->
782
render_err ("Failed to fetch repository: " ^ e)
783
+
| Ok (car_data, _) -> (
784
+
match%lwt Ops.import_repo ~did ~car_data with
785
| Error e ->
786
render_err e
787
| Ok () ->
···
878
| Error e ->
879
render_err ~did ~handle ~old_pds
880
("Failed to fetch repository: " ^ e)
881
+
| Ok (car_data, _) -> (
882
+
match%lwt Ops.import_repo ~did ~car_data with
883
| Error e ->
884
render_err ~did ~handle ~old_pds e
885
| Ok () -> (
+1
-3
pegasus/lib/api/account_/migrate/ops.ml
+1
-3
pegasus/lib/api/account_/migrate/ops.ml