1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
open Core
let dumper_for_deserialization_errors =
ref (fun (_buf : Bigstring.t) ~pos:(_ : int) -> "")
;;
let dump_and_message buf ~pos =
match
try !dumper_for_deserialization_errors buf ~pos with
| exn -> sprintf "Tried to dump message but got exn %s" (Exn.to_string exn)
with
| "" -> None
| s -> Some s
;;
exception
Dumped_buffer_info of
{ info : string
; exn : Exn.t
}
let bin_read_from_bigstring
(bin_reader_t : _ Bin_prot.Type_class.reader)
?add_len
buf
~pos_ref
~(len : Nat0.t)
~location
=
let init_pos = !pos_ref in
try
let data = bin_reader_t.read buf ~pos_ref in
let add_len =
match add_len with
| None -> 0
| Some add_len -> add_len data
in
if !pos_ref - init_pos + add_len <> (len :> int)
then (
let dump =
match dump_and_message buf ~pos:init_pos with
| None -> ""
| Some s -> ". " ^ s
in
failwithf
"message length (%d) did not match expected length (%d)%s"
(!pos_ref - init_pos)
(len : Nat0.t :> int)
dump
());
Ok data
with
| e ->
let e =
match dump_and_message buf ~pos:init_pos with
| None -> e
| Some info -> Dumped_buffer_info { info; exn = e }
in
Rpc_result.bin_io_exn ~location e
;;