gazagnaire.org
SpaceOS wire protocol codecs for host-guest communication
1open Wire
2
3type error_code =
4 | Unknown_type
5 | Unknown_version
6 | Message_too_large
7 | Apid_not_allocated
8 | Host_busy
9 | Malformed
10
11let error_code_to_int = function
12 | Unknown_type -> 0x01
13 | Unknown_version -> 0x02
14 | Message_too_large -> 0x03
15 | Apid_not_allocated -> 0x04
16 | Host_busy -> 0x05
17 | Malformed -> 0x06
18
19let error_code_of_int = function
20 | 0x01 -> Some Unknown_type
21 | 0x02 -> Some Unknown_version
22 | 0x03 -> Some Message_too_large
23 | 0x04 -> Some Apid_not_allocated
24 | 0x05 -> Some Host_busy
25 | 0x06 -> Some Malformed
26 | _ -> None
27
28type t = {
29 error_code : int;
30 offending_type : int;
31 offending_apid : int;
32 offending_pay_len : int;
33 reserved : int;
34}
35
36let codec =
37 let open Codec in
38 record "ErrorPayload"
39 (fun error_code offending_type offending_apid offending_pay_len reserved ->
40 {
41 error_code;
42 offending_type;
43 offending_apid;
44 offending_pay_len;
45 reserved;
46 })
47 |+ field "error_code" uint8 (fun t -> t.error_code)
48 |+ field "offending_type" uint8 (fun t -> t.offending_type)
49 |+ field "offending_apid" uint16be (fun t -> t.offending_apid)
50 |+ field "offending_pay_len" uint16be (fun t -> t.offending_pay_len)
51 |+ field "reserved" uint16be (fun t -> t.reserved)
52 |> seal
53
54let v code ~offending_type ~offending_apid ~offending_pay_len =
55 {
56 error_code = error_code_to_int code;
57 offending_type;
58 offending_apid;
59 offending_pay_len;
60 reserved = 0;
61 }
62
63let pp ppf t =
64 Fmt.pf ppf "@[<h>error(code=0x%02x type=0x%02x apid=%d pay_len=%d)@]"
65 t.error_code t.offending_type t.offending_apid t.offending_pay_len
66
67let equal a b =
68 a.error_code = b.error_code
69 && a.offending_type = b.offending_type
70 && a.offending_apid = b.offending_apid
71 && a.offending_pay_len = b.offending_pay_len