this repo has no description
Add CBOR encoding for RPC transport
Implement type-safe CBOR codec for Rpc.t values using the cbort library,
providing a compact binary alternative to JSON-RPC encoding.
- Add rpc_cbor module with tagged encoding for Rpc.t variants
- Add transport abstraction with Json, Cbor, and Auto implementations
- Add cbort dependency (pinned from tangled.org)
- Clean up duplicate entries in findlibish preloaded list
- Add comprehensive tests for CBOR encoding/decoding
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+514
-18
+2
-2
idl/dune
+2
-2
idl/dune
···
1
1
(library
2
2
(name js_top_worker_rpc)
3
3
(public_name js_top_worker-rpc)
4
-
(modules toplevel_api_gen)
5
-
(libraries rresult mime_printer merlin-lib.query_protocol rpclib))
4
+
(modules toplevel_api_gen rpc_cbor transport)
5
+
(libraries rresult mime_printer merlin-lib.query_protocol rpclib rpclib.json cbort))
6
6
7
7
(library
8
8
(name js_top_worker_client)
+185
idl/rpc_cbor.ml
+185
idl/rpc_cbor.ml
···
1
+
(** CBOR encoding for Rpc.t values. *)
2
+
3
+
(** We use tagged encoding to distinguish Rpc.t variants in CBOR:
4
+
- Tag 0: Int (int64)
5
+
- Tag 1: Int32
6
+
- Tag 2: Bool
7
+
- Tag 3: Float
8
+
- Tag 4: String
9
+
- Tag 5: DateTime
10
+
- Tag 6: Enum (array)
11
+
- Tag 7: Dict (map)
12
+
- Tag 8: Base64 (bytes)
13
+
- Null: CBOR null (no tag needed)
14
+
*)
15
+
16
+
let codec : Rpc.t Cbort.t =
17
+
let open Cbort in
18
+
fix @@ fun self ->
19
+
let case_int =
20
+
Variant.case 0 int64
21
+
(fun i -> Rpc.Int i)
22
+
(function Rpc.Int i -> Some i | _ -> None)
23
+
in
24
+
let case_int32 =
25
+
Variant.case 1 int32
26
+
(fun i -> Rpc.Int32 i)
27
+
(function Rpc.Int32 i -> Some i | _ -> None)
28
+
in
29
+
let case_bool =
30
+
Variant.case 2 bool
31
+
(fun b -> Rpc.Bool b)
32
+
(function Rpc.Bool b -> Some b | _ -> None)
33
+
in
34
+
let case_float =
35
+
Variant.case 3 float
36
+
(fun f -> Rpc.Float f)
37
+
(function Rpc.Float f -> Some f | _ -> None)
38
+
in
39
+
let case_string =
40
+
Variant.case 4 string
41
+
(fun s -> Rpc.String s)
42
+
(function Rpc.String s -> Some s | _ -> None)
43
+
in
44
+
let case_datetime =
45
+
Variant.case 5 string
46
+
(fun s -> Rpc.DateTime s)
47
+
(function Rpc.DateTime s -> Some s | _ -> None)
48
+
in
49
+
let case_enum =
50
+
Variant.case 6 (array self)
51
+
(fun l -> Rpc.Enum l)
52
+
(function Rpc.Enum l -> Some l | _ -> None)
53
+
in
54
+
let case_dict =
55
+
Variant.case 7 (string_map self)
56
+
(fun l -> Rpc.Dict l)
57
+
(function Rpc.Dict l -> Some l | _ -> None)
58
+
in
59
+
let case_base64 =
60
+
Variant.case 8 bytes
61
+
(fun s -> Rpc.Base64 s)
62
+
(function Rpc.Base64 s -> Some s | _ -> None)
63
+
in
64
+
let case_null =
65
+
Variant.case0 9 Rpc.Null
66
+
(function Rpc.Null -> true | _ -> false)
67
+
in
68
+
Variant.variant [
69
+
case_int;
70
+
case_int32;
71
+
case_bool;
72
+
case_float;
73
+
case_string;
74
+
case_datetime;
75
+
case_enum;
76
+
case_dict;
77
+
case_base64;
78
+
case_null;
79
+
]
80
+
81
+
let encode v = Cbort.encode_string codec v
82
+
83
+
let decode s = Cbort.decode_string codec s
84
+
85
+
let decode_exn s = Cbort.decode_string_exn codec s
86
+
87
+
(* RPC call codec *)
88
+
let call_codec : Rpc.call Cbort.t =
89
+
let ( let* ) = Cbort.Obj.( let* ) in
90
+
Cbort.Obj.finish
91
+
(let* name =
92
+
Cbort.Obj.mem "name" (fun (c : Rpc.call) -> c.name) Cbort.string
93
+
in
94
+
let* params =
95
+
Cbort.Obj.mem "params" (fun (c : Rpc.call) -> c.params) (Cbort.array codec)
96
+
in
97
+
let* is_notification =
98
+
Cbort.Obj.mem "is_notification" (fun (c : Rpc.call) -> c.is_notification) Cbort.bool
99
+
in
100
+
Cbort.Obj.return { Rpc.name; params; is_notification })
101
+
102
+
let encode_call c = Cbort.encode_string call_codec c
103
+
104
+
let decode_call s = Cbort.decode_string call_codec s
105
+
106
+
(* RPC response codec *)
107
+
let response_codec : Rpc.response Cbort.t =
108
+
let ( let* ) = Cbort.Obj.( let* ) in
109
+
Cbort.Obj.finish
110
+
(let* success =
111
+
Cbort.Obj.mem "success" (fun (r : Rpc.response) -> r.success) Cbort.bool
112
+
in
113
+
let* contents =
114
+
Cbort.Obj.mem "contents" (fun (r : Rpc.response) -> r.contents) codec
115
+
in
116
+
let* is_notification =
117
+
Cbort.Obj.mem "is_notification" (fun (r : Rpc.response) -> r.is_notification) Cbort.bool
118
+
in
119
+
Cbort.Obj.return { Rpc.success; contents; is_notification })
120
+
121
+
let encode_response r = Cbort.encode_string response_codec r
122
+
123
+
let decode_response s = Cbort.decode_string response_codec s
124
+
125
+
(* Message envelope types for protocol-level encoding (includes request ID) *)
126
+
127
+
type request = {
128
+
id : Rpc.t;
129
+
call : Rpc.call;
130
+
}
131
+
132
+
type response_msg = {
133
+
id : Rpc.t;
134
+
response : Rpc.response;
135
+
}
136
+
137
+
(* Request envelope codec *)
138
+
let request_codec : request Cbort.t =
139
+
let ( let* ) = Cbort.Obj.( let* ) in
140
+
Cbort.Obj.finish
141
+
(let* id =
142
+
Cbort.Obj.mem "id" (fun (r : request) -> r.id) codec
143
+
in
144
+
let* call =
145
+
Cbort.Obj.mem "call" (fun (r : request) -> r.call) call_codec
146
+
in
147
+
Cbort.Obj.return { id; call })
148
+
149
+
(* Response envelope codec *)
150
+
let response_msg_codec : response_msg Cbort.t =
151
+
let ( let* ) = Cbort.Obj.( let* ) in
152
+
Cbort.Obj.finish
153
+
(let* id =
154
+
Cbort.Obj.mem "id" (fun (r : response_msg) -> r.id) codec
155
+
in
156
+
let* response =
157
+
Cbort.Obj.mem "response" (fun (r : response_msg) -> r.response) response_codec
158
+
in
159
+
Cbort.Obj.return { id; response })
160
+
161
+
let encode_request r = Cbort.encode_string request_codec r
162
+
163
+
let decode_request s = Cbort.decode_string request_codec s
164
+
165
+
let encode_response_msg r = Cbort.encode_string response_msg_codec r
166
+
167
+
let decode_response_msg s = Cbort.decode_string response_msg_codec s
168
+
169
+
(* Convenience functions matching Jsonrpc API *)
170
+
171
+
let string_of_call ?(id = Rpc.Int 0L) call =
172
+
encode_request { id; call }
173
+
174
+
let id_and_call_of_string s =
175
+
match decode_request s with
176
+
| Ok req -> (req.id, req.call)
177
+
| Error e -> failwith (Cbort.Error.to_string e)
178
+
179
+
let string_of_response ~id response =
180
+
encode_response_msg { id; response }
181
+
182
+
let response_of_string s =
183
+
match decode_response_msg s with
184
+
| Ok msg -> msg.response
185
+
| Error e -> failwith (Cbort.Error.to_string e)
+82
idl/rpc_cbor.mli
+82
idl/rpc_cbor.mli
···
1
+
(** CBOR encoding for Rpc.t values.
2
+
3
+
This module provides encoding and decoding of [Rpc.t] values to/from
4
+
CBOR format, allowing ocaml-rpc to use CBOR as a wire format instead
5
+
of JSON or XML. *)
6
+
7
+
val codec : Rpc.t Cbort.t
8
+
(** Codec for [Rpc.t] values. Can be used with [Cbort.encode_string]
9
+
and [Cbort.decode_string]. *)
10
+
11
+
val encode : Rpc.t -> string
12
+
(** [encode v] encodes an [Rpc.t] value to a CBOR byte string. *)
13
+
14
+
val decode : string -> (Rpc.t, Cbort.Error.t) result
15
+
(** [decode s] decodes a CBOR byte string to an [Rpc.t] value. *)
16
+
17
+
val decode_exn : string -> Rpc.t
18
+
(** [decode_exn s] is like [decode] but raises on error. *)
19
+
20
+
(** {1 RPC Call Encoding}
21
+
22
+
Convenience functions for encoding/decoding RPC calls and responses. *)
23
+
24
+
val encode_call : Rpc.call -> string
25
+
(** [encode_call c] encodes an RPC call to CBOR. *)
26
+
27
+
val decode_call : string -> (Rpc.call, Cbort.Error.t) result
28
+
(** [decode_call s] decodes a CBOR byte string to an RPC call. *)
29
+
30
+
val encode_response : Rpc.response -> string
31
+
(** [encode_response r] encodes an RPC response to CBOR. *)
32
+
33
+
val decode_response : string -> (Rpc.response, Cbort.Error.t) result
34
+
(** [decode_response s] decodes a CBOR byte string to an RPC response. *)
35
+
36
+
(** {1 Message Envelope Encoding}
37
+
38
+
These types and functions handle protocol-level encoding that includes
39
+
request IDs for matching requests with responses. *)
40
+
41
+
type request = {
42
+
id : Rpc.t;
43
+
call : Rpc.call;
44
+
}
45
+
(** A request message envelope containing the request ID and call. *)
46
+
47
+
type response_msg = {
48
+
id : Rpc.t;
49
+
response : Rpc.response;
50
+
}
51
+
(** A response message envelope containing the request ID and response. *)
52
+
53
+
val encode_request : request -> string
54
+
(** [encode_request r] encodes a request envelope to CBOR. *)
55
+
56
+
val decode_request : string -> (request, Cbort.Error.t) result
57
+
(** [decode_request s] decodes a CBOR byte string to a request envelope. *)
58
+
59
+
val encode_response_msg : response_msg -> string
60
+
(** [encode_response_msg r] encodes a response envelope to CBOR. *)
61
+
62
+
val decode_response_msg : string -> (response_msg, Cbort.Error.t) result
63
+
(** [decode_response_msg s] decodes a CBOR byte string to a response envelope. *)
64
+
65
+
(** {1 Jsonrpc-compatible API}
66
+
67
+
These functions match the Jsonrpc module's API for easy drop-in replacement. *)
68
+
69
+
val string_of_call : ?id:Rpc.t -> Rpc.call -> string
70
+
(** [string_of_call ~id call] encodes a call with the given ID to CBOR.
71
+
If [id] is not provided, defaults to [Rpc.Int 0L]. *)
72
+
73
+
val id_and_call_of_string : string -> Rpc.t * Rpc.call
74
+
(** [id_and_call_of_string s] decodes a CBOR request and returns the ID and call.
75
+
@raise Failure if decoding fails. *)
76
+
77
+
val string_of_response : id:Rpc.t -> Rpc.response -> string
78
+
(** [string_of_response ~id response] encodes a response with the given ID to CBOR. *)
79
+
80
+
val response_of_string : string -> Rpc.response
81
+
(** [response_of_string s] decodes a CBOR response message and returns the response.
82
+
@raise Failure if decoding fails. *)
+77
idl/transport.ml
+77
idl/transport.ml
···
1
+
(** Transport abstraction for RPC encoding.
2
+
3
+
This module provides a common interface for encoding/decoding RPC messages,
4
+
allowing switching between JSON and CBOR transports. *)
5
+
6
+
module type S = sig
7
+
(** Encode a call (ID is auto-generated) *)
8
+
val string_of_call : Rpc.call -> string
9
+
10
+
(** Decode a message to get the ID and call *)
11
+
val id_and_call_of_string : string -> Rpc.t * Rpc.call
12
+
13
+
(** Encode a response with the given ID *)
14
+
val string_of_response : id:Rpc.t -> Rpc.response -> string
15
+
16
+
(** Decode a message to get the response *)
17
+
val response_of_string : string -> Rpc.response
18
+
end
19
+
20
+
(* Counter for generating unique request IDs *)
21
+
let cbor_id_counter = ref 0L
22
+
23
+
let new_cbor_id () =
24
+
cbor_id_counter := Int64.add 1L !cbor_id_counter;
25
+
!cbor_id_counter
26
+
27
+
(** JSON-RPC transport (existing protocol) *)
28
+
module Json : S = struct
29
+
let string_of_call call =
30
+
Jsonrpc.string_of_call call
31
+
32
+
let id_and_call_of_string s =
33
+
let _, id, call = Jsonrpc.version_id_and_call_of_string s in
34
+
(id, call)
35
+
36
+
let string_of_response ~id response =
37
+
Jsonrpc.string_of_response ~id response
38
+
39
+
let response_of_string s =
40
+
Jsonrpc.response_of_string s
41
+
end
42
+
43
+
(** CBOR transport (compact binary protocol) *)
44
+
module Cbor : S = struct
45
+
let string_of_call call =
46
+
let id = Rpc.Int (new_cbor_id ()) in
47
+
Rpc_cbor.string_of_call ~id call
48
+
49
+
let id_and_call_of_string = Rpc_cbor.id_and_call_of_string
50
+
let string_of_response = Rpc_cbor.string_of_response
51
+
let response_of_string = Rpc_cbor.response_of_string
52
+
end
53
+
54
+
(** Auto-detecting transport that decodes based on message format *)
55
+
module Auto : S = struct
56
+
(* CBOR messages start with specific byte patterns based on major type.
57
+
JSON messages typically start with '{' (0x7B).
58
+
Since CBOR uses major types 0-7 in the high 3 bits, the first byte
59
+
for a CBOR map (what we encode) would be 0xA0-0xBF (major type 5).
60
+
JSON '{' is 0x7B which is different from any CBOR map prefix. *)
61
+
62
+
let is_json s =
63
+
String.length s > 0 && s.[0] = '{'
64
+
65
+
let string_of_call call =
66
+
let id = Rpc.Int (new_cbor_id ()) in
67
+
Rpc_cbor.string_of_call ~id call
68
+
69
+
let id_and_call_of_string = Rpc_cbor.id_and_call_of_string
70
+
let string_of_response = Rpc_cbor.string_of_response
71
+
72
+
let response_of_string s =
73
+
if is_json s then
74
+
Json.response_of_string s
75
+
else
76
+
Rpc_cbor.response_of_string s
77
+
end
+34
idl/transport.mli
+34
idl/transport.mli
···
1
+
(** Transport abstraction for RPC encoding.
2
+
3
+
This module provides a common interface for encoding/decoding RPC messages,
4
+
allowing switching between JSON and CBOR transports. *)
5
+
6
+
(** Transport signature defining the encoding/decoding interface. *)
7
+
module type S = sig
8
+
val string_of_call : Rpc.call -> string
9
+
(** Encode a call. A unique request ID is auto-generated. *)
10
+
11
+
val id_and_call_of_string : string -> Rpc.t * Rpc.call
12
+
(** Decode a message to get the ID and call.
13
+
@raise Failure if decoding fails. *)
14
+
15
+
val string_of_response : id:Rpc.t -> Rpc.response -> string
16
+
(** Encode a response with the given ID. *)
17
+
18
+
val response_of_string : string -> Rpc.response
19
+
(** Decode a message to get the response.
20
+
@raise Failure if decoding fails. *)
21
+
end
22
+
23
+
(** JSON-RPC transport (existing protocol).
24
+
Uses the standard JSON-RPC 2.0 encoding from [rpclib.json]. *)
25
+
module Json : S
26
+
27
+
(** CBOR transport (compact binary protocol).
28
+
Uses {!Rpc_cbor} for type-safe binary encoding. *)
29
+
module Cbor : S
30
+
31
+
(** Auto-detecting transport.
32
+
Uses CBOR for encoding but can decode either JSON or CBOR responses.
33
+
Useful for gradual migration or mixed-protocol environments. *)
34
+
module Auto : S
+6
-2
js_top_worker-rpc.opam
+6
-2
js_top_worker-rpc.opam
···
6
6
homepage: "https://github.com/jonludlam/js_top_worker"
7
7
bug-reports: "https://github.com/jonludlam/js_top_worker/issues"
8
8
depends: [
9
-
"ocaml" {>= "4.04"}
10
-
"dune" {>= "2.9.1"}
9
+
"ocaml" {>= "5.1"}
10
+
"dune" {>= "3.10"}
11
11
"mime_printer"
12
12
"rresult"
13
13
"merlin-lib"
14
14
"rpclib"
15
+
"cbort"
16
+
"zarith"
17
+
"bytesrw"
15
18
]
16
19
build : [
17
20
["dune" "subst"] {pinned}
···
23
26
"""
24
27
pin-depends: [
25
28
[ "mime_printer.dev" "git+https://github.com/jonludlam/mime_printer.git#odoc_notebook" ]
29
+
[ "cbort.dev" "git+https://tangled.org/@anil.recoil.org/ocaml-cbort.git" ]
26
30
]
+12
-14
lib/findlibish.ml
+12
-14
lib/findlibish.ml
···
19
19
20
20
let preloaded =
21
21
[
22
-
"logs";
23
-
"js_top_worker-rpc";
24
-
"js_of_ocaml-compiler";
25
-
"js_of_ocaml-ppx";
22
+
"angstrom";
26
23
"astring";
27
-
"mime_printer";
28
24
"compiler-libs.common";
29
25
"compiler-libs.toplevel";
30
-
"merlin-lib.kernel";
31
-
"merlin-lib.utils";
32
-
"merlin-lib.query_protocol";
33
-
"merlin-lib.query_commands";
34
-
"merlin-lib.ocaml_parsing";
35
26
"findlib";
36
27
"findlib.top";
37
-
"js_top_worker";
28
+
"fpath";
29
+
"js_of_ocaml-compiler";
38
30
"js_of_ocaml-ppx";
39
31
"js_of_ocaml-toplevel";
32
+
"js_top_worker";
33
+
"js_top_worker-rpc";
34
+
"logs";
40
35
"logs.browser";
36
+
"merlin-lib.kernel";
37
+
"merlin-lib.ocaml_parsing";
38
+
"merlin-lib.query_commands";
39
+
"merlin-lib.query_protocol";
40
+
"merlin-lib.utils";
41
+
"mime_printer";
41
42
"uri";
42
-
"angstrom";
43
-
"findlib";
44
-
"fpath";
45
43
]
46
44
47
45
let rec read_libraries_from_pkg_defs ~library_name ~dir meta_uri pkg_expr =
+3
test/cbor/dune
+3
test/cbor/dune
+113
test/cbor/test_cbor.ml
+113
test/cbor/test_cbor.ml
···
1
+
(** Test CBOR encoding of Rpc.t values *)
2
+
3
+
module Rpc_cbor = Js_top_worker_rpc.Rpc_cbor
4
+
5
+
let () =
6
+
let test_roundtrip name v =
7
+
let encoded = Rpc_cbor.encode v in
8
+
match Rpc_cbor.decode encoded with
9
+
| Ok decoded when decoded = v -> Printf.printf "%s: OK\n" name
10
+
| Ok decoded ->
11
+
Printf.printf "%s: FAIL - mismatch\n expected: %s\n got: %s\n"
12
+
name (Rpc.to_string v) (Rpc.to_string decoded)
13
+
| Error e -> Printf.printf "%s: FAIL - %s\n" name (Cbort.Error.to_string e)
14
+
in
15
+
test_roundtrip "Int" (Rpc.Int 42L);
16
+
test_roundtrip "Int negative" (Rpc.Int (-100L));
17
+
test_roundtrip "Int32" (Rpc.Int32 42l);
18
+
test_roundtrip "Bool true" (Rpc.Bool true);
19
+
test_roundtrip "Bool false" (Rpc.Bool false);
20
+
test_roundtrip "Float" (Rpc.Float 3.14);
21
+
test_roundtrip "String" (Rpc.String "hello");
22
+
test_roundtrip "String empty" (Rpc.String "");
23
+
test_roundtrip "DateTime" (Rpc.DateTime "2024-01-20T12:00:00Z");
24
+
test_roundtrip "Null" Rpc.Null;
25
+
test_roundtrip "Base64" (Rpc.Base64 "\x00\x01\x02");
26
+
test_roundtrip "Enum empty" (Rpc.Enum []);
27
+
test_roundtrip "Enum" (Rpc.Enum [Rpc.Int 1L; Rpc.String "a"]);
28
+
test_roundtrip "Dict empty" (Rpc.Dict []);
29
+
test_roundtrip "Dict" (Rpc.Dict [("key", Rpc.Int 42L)]);
30
+
test_roundtrip "Nested" (Rpc.Dict [
31
+
("list", Rpc.Enum [Rpc.Int 1L; Rpc.Int 2L]);
32
+
("obj", Rpc.Dict [("inner", Rpc.String "value")]);
33
+
]);
34
+
35
+
print_newline ();
36
+
37
+
(* Test call codec *)
38
+
let call = Rpc.call "test_method" [Rpc.String "arg1"; Rpc.Int 42L] in
39
+
let encoded_call = Rpc_cbor.encode_call call in
40
+
(match Rpc_cbor.decode_call encoded_call with
41
+
| Ok decoded when decoded = call -> print_endline "Call: OK"
42
+
| Ok _ -> print_endline "Call: FAIL - mismatch"
43
+
| Error e -> Printf.printf "Call: FAIL - %s\n" (Cbort.Error.to_string e));
44
+
45
+
(* Test notification call *)
46
+
let notif = Rpc.notification "notify" [Rpc.Bool true] in
47
+
let encoded_notif = Rpc_cbor.encode_call notif in
48
+
(match Rpc_cbor.decode_call encoded_notif with
49
+
| Ok decoded when decoded = notif -> print_endline "Notification: OK"
50
+
| Ok _ -> print_endline "Notification: FAIL - mismatch"
51
+
| Error e -> Printf.printf "Notification: FAIL - %s\n" (Cbort.Error.to_string e));
52
+
53
+
(* Test response codec *)
54
+
let response = Rpc.success (Rpc.String "result") in
55
+
let encoded_response = Rpc_cbor.encode_response response in
56
+
(match Rpc_cbor.decode_response encoded_response with
57
+
| Ok decoded when decoded = response -> print_endline "Success response: OK"
58
+
| Ok _ -> print_endline "Success response: FAIL - mismatch"
59
+
| Error e -> Printf.printf "Success response: FAIL - %s\n" (Cbort.Error.to_string e));
60
+
61
+
(* Test failure response *)
62
+
let failure = Rpc.failure (Rpc.String "error message") in
63
+
let encoded_failure = Rpc_cbor.encode_response failure in
64
+
(match Rpc_cbor.decode_response encoded_failure with
65
+
| Ok decoded when decoded = failure -> print_endline "Failure response: OK"
66
+
| Ok _ -> print_endline "Failure response: FAIL - mismatch"
67
+
| Error e -> Printf.printf "Failure response: FAIL - %s\n" (Cbort.Error.to_string e));
68
+
69
+
print_newline ();
70
+
print_endline "=== Message Envelope Tests ===";
71
+
72
+
(* Test request envelope *)
73
+
let req : Rpc_cbor.request = {
74
+
id = Rpc.Int 42L;
75
+
call = Rpc.call "test_method" [Rpc.String "arg1"];
76
+
} in
77
+
let encoded_req = Rpc_cbor.encode_request req in
78
+
(match Rpc_cbor.decode_request encoded_req with
79
+
| Ok decoded when decoded = req -> print_endline "Request envelope: OK"
80
+
| Ok _ -> print_endline "Request envelope: FAIL - mismatch"
81
+
| Error e -> Printf.printf "Request envelope: FAIL - %s\n" (Cbort.Error.to_string e));
82
+
83
+
(* Test response envelope *)
84
+
let resp_msg : Rpc_cbor.response_msg = {
85
+
id = Rpc.Int 42L;
86
+
response = Rpc.success (Rpc.String "result");
87
+
} in
88
+
let encoded_resp = Rpc_cbor.encode_response_msg resp_msg in
89
+
(match Rpc_cbor.decode_response_msg encoded_resp with
90
+
| Ok decoded when decoded = resp_msg -> print_endline "Response envelope: OK"
91
+
| Ok _ -> print_endline "Response envelope: FAIL - mismatch"
92
+
| Error e -> Printf.printf "Response envelope: FAIL - %s\n" (Cbort.Error.to_string e));
93
+
94
+
(* Test Jsonrpc-compatible API *)
95
+
let call = Rpc.call "test" [Rpc.Bool true] in
96
+
let id = Rpc.Int 123L in
97
+
let encoded = Rpc_cbor.string_of_call ~id call in
98
+
let (decoded_id, decoded_call) = Rpc_cbor.id_and_call_of_string encoded in
99
+
if decoded_id = id && decoded_call = call then
100
+
print_endline "string_of_call/id_and_call_of_string: OK"
101
+
else
102
+
print_endline "string_of_call/id_and_call_of_string: FAIL - mismatch";
103
+
104
+
let response = Rpc.success (Rpc.Int 999L) in
105
+
let encoded_resp = Rpc_cbor.string_of_response ~id response in
106
+
let decoded_resp = Rpc_cbor.response_of_string encoded_resp in
107
+
if decoded_resp = response then
108
+
print_endline "string_of_response/response_of_string: OK"
109
+
else
110
+
print_endline "string_of_response/response_of_string: FAIL - mismatch";
111
+
112
+
print_newline ();
113
+
print_endline "All tests complete!"