QEMU/KVM virtual machine management via QMP
ocaml-qemu: migrate to new Json API
Wrap Json.Error.t with Json.Error.to_string where per-package string
error types cross module boundaries. Internal propagation of Json.Error.t
stays structured.
+125
-115
+5
-3
bin/main.ml
+5
-3
bin/main.ml
···
171
171
Fmt.pr "Connected.@.";
172
172
(match Qemu.Vm.query_status vm with
173
173
| Ok status -> Fmt.pr "Status: %a@." Qemu.Qmp.Status.pp status
174
-
| Error e -> Fmt.epr "Status error: %s@." e);
174
+
| Error e ->
175
+
Fmt.epr "Status error: %s@." e);
175
176
`Ok ()))
176
177
$ name_arg $ cpus_arg $ memory_arg $ kernel_arg $ initrd_arg $ cmdline_arg
177
178
$ disk_arg $ accel_arg $ kvm_arg $ no_kvm_arg $ socket_arg)
···
376
377
Fmt.epr "QMP error: %a@." Qemu.Qmp.Error.pp e;
377
378
`Error (false, "QMP error")
378
379
| Ok (Ok json) ->
379
-
(match Json_bytesrw.encode_string Json.json json with
380
+
(match Json.to_string Json.Codec.Value.t json with
380
381
| Ok s -> Fmt.pr "%s@." s
381
-
| Error e -> Fmt.epr "JSON error: %s@." e);
382
+
| Error e ->
383
+
Fmt.epr "JSON error: %s@." (Json.Error.to_string e));
382
384
`Ok ())))
383
385
$ name_arg $ socket_arg $ command_arg)
384
386
in
+79
-73
lib/qmp_protocol.ml
+79
-73
lib/qmp_protocol.ml
···
22
22
{ qemu = { major; minor; micro }; package }
23
23
24
24
let qemu_jsont =
25
-
Json.Object.map ~kind:"qemu_version" (fun major minor micro ->
25
+
Json.Codec.Object.map ~kind:"qemu_version" (fun major minor micro ->
26
26
{ major; minor; micro })
27
-
|> Json.Object.mem "major" Json.int ~enc:(fun v -> v.major)
28
-
|> Json.Object.mem "minor" Json.int ~enc:(fun v -> v.minor)
29
-
|> Json.Object.mem "micro" Json.int ~enc:(fun v -> v.micro)
30
-
|> Json.Object.skip_unknown |> Json.Object.finish
27
+
|> Json.Codec.Object.mem "major" Json.Codec.int ~enc:(fun v -> v.major)
28
+
|> Json.Codec.Object.mem "minor" Json.Codec.int ~enc:(fun v -> v.minor)
29
+
|> Json.Codec.Object.mem "micro" Json.Codec.int ~enc:(fun v -> v.micro)
30
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.finish
31
31
32
32
let jsont =
33
-
Json.Object.map ~kind:"version" (fun qemu package -> { qemu; package })
34
-
|> Json.Object.mem "qemu" qemu_jsont ~enc:(fun v -> v.qemu)
35
-
|> Json.Object.mem "package" Json.string ~enc:(fun v -> v.package)
36
-
|> Json.Object.skip_unknown |> Json.Object.finish
33
+
Json.Codec.Object.map ~kind:"version" (fun qemu package ->
34
+
{ qemu; package })
35
+
|> Json.Codec.Object.mem "qemu" qemu_jsont ~enc:(fun v -> v.qemu)
36
+
|> Json.Codec.Object.mem "package" Json.Codec.string ~enc:(fun v ->
37
+
v.package)
38
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.finish
37
39
38
40
let pp ppf v =
39
41
Fmt.pf ppf "%d.%d.%d%s" v.qemu.major v.qemu.minor v.qemu.micro
···
45
47
type t = { qmp : qmp_info }
46
48
47
49
let qmp_info_jsont =
48
-
Json.Object.map ~kind:"qmp_info" (fun version capabilities ->
50
+
Json.Codec.Object.map ~kind:"qmp_info" (fun version capabilities ->
49
51
{ version; capabilities })
50
-
|> Json.Object.mem "version" Version.jsont ~enc:(fun q -> q.version)
51
-
|> Json.Object.mem "capabilities" (Json.list Json.string) ~enc:(fun q ->
52
-
q.capabilities)
53
-
|> Json.Object.skip_unknown |> Json.Object.finish
52
+
|> Json.Codec.Object.mem "version" Version.jsont ~enc:(fun q -> q.version)
53
+
|> Json.Codec.Object.mem "capabilities" (Json.Codec.list Json.Codec.string)
54
+
~enc:(fun q -> q.capabilities)
55
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.finish
54
56
55
57
let jsont =
56
-
Json.Object.map ~kind:"greeting" (fun qmp -> { qmp })
57
-
|> Json.Object.mem "QMP" qmp_info_jsont ~enc:(fun g -> g.qmp)
58
-
|> Json.Object.skip_unknown |> Json.Object.finish
58
+
Json.Codec.Object.map ~kind:"greeting" (fun qmp -> { qmp })
59
+
|> Json.Codec.Object.mem "QMP" qmp_info_jsont ~enc:(fun g -> g.qmp)
60
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.finish
59
61
60
62
let version t = t.qmp.version
61
63
let capabilities t = t.qmp.capabilities
···
65
67
type t = { seconds : int; microseconds : int }
66
68
67
69
let jsont =
68
-
Json.Object.map ~kind:"timestamp" (fun seconds microseconds ->
70
+
Json.Codec.Object.map ~kind:"timestamp" (fun seconds microseconds ->
69
71
{ seconds; microseconds })
70
-
|> Json.Object.mem "seconds" Json.int ~enc:(fun t -> t.seconds)
71
-
|> Json.Object.mem "microseconds" Json.int ~enc:(fun t -> t.microseconds)
72
-
|> Json.Object.skip_unknown |> Json.Object.finish
72
+
|> Json.Codec.Object.mem "seconds" Json.Codec.int ~enc:(fun t -> t.seconds)
73
+
|> Json.Codec.Object.mem "microseconds" Json.Codec.int ~enc:(fun t ->
74
+
t.microseconds)
75
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.finish
73
76
74
77
let to_float t = Float.of_int t.seconds +. (Float.of_int t.microseconds /. 1e6)
75
78
end
···
78
81
type t = { class_ : string; desc : string }
79
82
80
83
let jsont =
81
-
Json.Object.map ~kind:"qmp_error" (fun class_ desc -> { class_; desc })
82
-
|> Json.Object.mem "class" Json.string ~enc:(fun e -> e.class_)
83
-
|> Json.Object.mem "desc" Json.string ~enc:(fun e -> e.desc)
84
-
|> Json.Object.skip_unknown |> Json.Object.finish
84
+
Json.Codec.Object.map ~kind:"qmp_error" (fun class_ desc ->
85
+
{ class_; desc })
86
+
|> Json.Codec.Object.mem "class" Json.Codec.string ~enc:(fun e -> e.class_)
87
+
|> Json.Codec.Object.mem "desc" Json.Codec.string ~enc:(fun e -> e.desc)
88
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.finish
85
89
86
90
let pp ppf e = Fmt.pf ppf "%s: %s" e.class_ e.desc
87
91
end
···
90
94
type t = { event : string; data : Json.t option; timestamp : Timestamp.t }
91
95
92
96
let jsont =
93
-
Json.Object.map ~kind:"event" (fun event data timestamp ->
97
+
Json.Codec.Object.map ~kind:"event" (fun event data timestamp ->
94
98
{ event; data; timestamp })
95
-
|> Json.Object.mem "event" Json.string ~enc:(fun e -> e.event)
96
-
|> Json.Object.opt_mem "data" Json.json ~enc:(fun e -> e.data)
97
-
|> Json.Object.mem "timestamp" Timestamp.jsont ~enc:(fun e -> e.timestamp)
98
-
|> Json.Object.skip_unknown |> Json.Object.finish
99
+
|> Json.Codec.Object.mem "event" Json.Codec.string ~enc:(fun e -> e.event)
100
+
|> Json.Codec.Object.opt_mem "data" Json.Codec.Value.t ~enc:(fun e ->
101
+
e.data)
102
+
|> Json.Codec.Object.mem "timestamp" Timestamp.jsont ~enc:(fun e ->
103
+
e.timestamp)
104
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.finish
99
105
100
106
let name t = t.event
101
107
let data t = t.data
···
105
111
(** {1 Commands} *)
106
112
107
113
module Command = struct
108
-
type t = {
109
-
execute : string;
110
-
arguments : Json.t option;
111
-
id : string option;
112
-
}
114
+
type t = { execute : string; arguments : Json.t option; id : string option }
113
115
114
116
let make ?arguments ?id execute = { execute; arguments; id }
115
117
116
118
let jsont =
117
-
Json.Object.map ~kind:"command" (fun execute arguments id ->
119
+
Json.Codec.Object.map ~kind:"command" (fun execute arguments id ->
118
120
{ execute; arguments; id })
119
-
|> Json.Object.mem "execute" Json.string ~enc:(fun c -> c.execute)
120
-
|> Json.Object.opt_mem "arguments" Json.json ~enc:(fun c -> c.arguments)
121
-
|> Json.Object.opt_mem "id" Json.string ~enc:(fun c -> c.id)
122
-
|> Json.Object.skip_unknown |> Json.Object.finish
121
+
|> Json.Codec.Object.mem "execute" Json.Codec.string ~enc:(fun c ->
122
+
c.execute)
123
+
|> Json.Codec.Object.opt_mem "arguments" Json.Codec.Value.t ~enc:(fun c ->
124
+
c.arguments)
125
+
|> Json.Codec.Object.opt_mem "id" Json.Codec.string ~enc:(fun c -> c.id)
126
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.finish
123
127
124
128
let to_json t =
125
-
match Json.Value.encode jsont t with
129
+
match Json.encode jsont t with
126
130
| Ok json -> json
127
-
| Error e -> Fmt.failwith "Failed to encode command: %s" e
131
+
| Error e ->
132
+
Fmt.failwith "Failed to encode command: %s" (Json.Error.to_string e)
128
133
129
134
(* Common commands *)
130
135
let qmp_capabilities = make "qmp_capabilities"
···
147
152
type t = Success of success | Error of error_response
148
153
149
154
let success_jsont : success Json.codec =
150
-
Json.Object.map ~kind:"success" (fun return success_id ->
155
+
Json.Codec.Object.map ~kind:"success" (fun return success_id ->
151
156
{ return; success_id })
152
-
|> Json.Object.mem "return" Json.json ~enc:(fun s -> s.return)
153
-
|> Json.Object.opt_mem "id" Json.string ~enc:(fun s -> s.success_id)
154
-
|> Json.Object.skip_unknown |> Json.Object.finish
157
+
|> Json.Codec.Object.mem "return" Json.Codec.Value.t ~enc:(fun s ->
158
+
s.return)
159
+
|> Json.Codec.Object.opt_mem "id" Json.Codec.string ~enc:(fun s ->
160
+
s.success_id)
161
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.finish
155
162
156
163
let error_jsont : error_response Json.codec =
157
-
Json.Object.map ~kind:"error_response" (fun qmp_error error_id ->
164
+
Json.Codec.Object.map ~kind:"error_response" (fun qmp_error error_id ->
158
165
{ qmp_error; error_id })
159
-
|> Json.Object.mem "error" Error.jsont ~enc:(fun e -> e.qmp_error)
160
-
|> Json.Object.opt_mem "id" Json.string ~enc:(fun e -> e.error_id)
161
-
|> Json.Object.skip_unknown |> Json.Object.finish
166
+
|> Json.Codec.Object.mem "error" Error.jsont ~enc:(fun e -> e.qmp_error)
167
+
|> Json.Codec.Object.opt_mem "id" Json.Codec.string ~enc:(fun e ->
168
+
e.error_id)
169
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.finish
162
170
end
163
171
164
172
(** {1 Message parsing} *)
···
172
180
173
181
(* Helper to check if an object has a member *)
174
182
let has_member name = function
175
-
| Json.Object (mems, _) -> Option.is_some (Json.Value.find_mem name mems)
183
+
| Json.Object (mems, _) -> Option.is_some (Json.find_mem name mems)
176
184
| _ -> false
177
185
178
-
let err_invalid_greeting e = Result.error (Fmt.str "Invalid greeting: %s" e)
179
-
let err_invalid_event e = Result.error (Fmt.str "Invalid event: %s" e)
180
-
let err_invalid_success e = Result.error (Fmt.str "Invalid success: %s" e)
181
-
let err_invalid_error e = Result.error (Fmt.str "Invalid error: %s" e)
182
-
let err_json_parse e = Result.error (Fmt.str "JSON parse error: %s" e)
186
+
let err e = Result.Error (Json.Error.to_string e)
183
187
184
188
let of_json json =
185
189
(* Try to detect message type by checking for key fields *)
186
190
if has_member "QMP" json then
187
-
match Json.Value.decode Greeting.jsont json with
191
+
match Json.decode Greeting.jsont json with
188
192
| Ok g -> Ok (Greeting g)
189
-
| Error e -> err_invalid_greeting e
193
+
| Error e -> err e
190
194
else if has_member "event" json then
191
-
match Json.Value.decode Event.jsont json with
195
+
match Json.decode Event.jsont json with
192
196
| Ok e -> Ok (Event e)
193
-
| Error e -> err_invalid_event e
197
+
| Error e -> err e
194
198
else if has_member "return" json then
195
-
match Json.Value.decode Response.success_jsont json with
199
+
match Json.decode Response.success_jsont json with
196
200
| Ok s -> Ok (Success s)
197
-
| Error e -> err_invalid_success e
201
+
| Error e -> err e
198
202
else if has_member "error" json then
199
-
match Json.Value.decode Response.error_jsont json with
203
+
match Json.decode Response.error_jsont json with
200
204
| Ok e -> Ok (Error e)
201
-
| Error e -> err_invalid_error e
205
+
| Error e -> err e
202
206
else Error "Unknown QMP message type"
203
207
204
208
let of_string s =
205
-
match Json_bytesrw.decode_string Json.json s with
209
+
match Json.of_string Json.Codec.Value.t s with
206
210
| Ok json -> of_json json
207
-
| Error e -> err_json_parse e
211
+
| Error e -> err e
208
212
end
209
213
210
214
(** {1 Status types} *)
···
268
272
type t = { running : bool; singlestep : bool; status : run_state }
269
273
270
274
let run_state_jsont =
271
-
Json.enum ~kind:"run_state"
275
+
Json.Codec.enum ~kind:"run_state"
272
276
[
273
277
("debug", Debug);
274
278
("inmigrate", Inmigrate);
···
289
293
]
290
294
291
295
let jsont =
292
-
Json.Object.map ~kind:"status" (fun running singlestep status ->
296
+
Json.Codec.Object.map ~kind:"status" (fun running singlestep status ->
293
297
{ running; singlestep; status })
294
-
|> Json.Object.mem "running" Json.bool ~enc:(fun s -> s.running)
295
-
|> Json.Object.mem "singlestep" Json.bool ~enc:(fun s -> s.singlestep)
296
-
|> Json.Object.mem "status" run_state_jsont ~enc:(fun s -> s.status)
297
-
|> Json.Object.skip_unknown |> Json.Object.finish
298
+
|> Json.Codec.Object.mem "running" Json.Codec.bool ~enc:(fun s -> s.running)
299
+
|> Json.Codec.Object.mem "singlestep" Json.Codec.bool ~enc:(fun s ->
300
+
s.singlestep)
301
+
|> Json.Codec.Object.mem "status" run_state_jsont ~enc:(fun s -> s.status)
302
+
|> Json.Codec.Object.skip_unknown |> Json.Codec.Object.finish
298
303
299
-
let of_json json = Json.Value.decode jsont json
304
+
let of_json json =
305
+
Result.map_error Json.Error.to_string (Json.decode jsont json)
300
306
301
307
let pp ppf t =
302
308
Fmt.pf ppf "%s%s"
+5
-5
lib/vm.ml
+5
-5
lib/vm.ml
···
10
10
module Log = (val Logs.src_log src)
11
11
12
12
let err_qmp e = Error (Fmt.str "%a" Qmp_protocol.Error.pp e)
13
+
13
14
let err_greeting_read e = Error (Fmt.str "Failed to read greeting: %s" e)
14
15
15
16
let err_capabilities e =
···
242
243
type t = {
243
244
socket : Eio.Flow.two_way_ty Eio.Resource.t;
244
245
buf_read : Eio.Buf_read.t;
245
-
mutable greeting : Qmp_protocol.Greeting.t option;
246
246
}
247
247
248
248
let connect ~sw ~net socket_path =
···
250
250
Log.debug (fun m -> m "Connecting to QMP socket: %s" socket_path);
251
251
let socket = Eio.Net.connect ~sw net addr in
252
252
let buf_read = Eio.Buf_read.of_flow socket ~max_size:65536 in
253
-
{ socket :> Eio.Flow.two_way_ty Eio.Resource.t; buf_read; greeting = None }
253
+
{ socket :> Eio.Flow.two_way_ty Eio.Resource.t; buf_read }
254
254
255
255
let read_line t =
256
256
try Some (Eio.Buf_read.line t.buf_read) with End_of_file -> None
···
264
264
265
265
let send_command t cmd =
266
266
let json = Qmp_protocol.Command.to_json cmd in
267
-
match Json_bytesrw.encode_string Json.json json with
267
+
match Json.to_string Json.Codec.Value.t json with
268
268
| Ok s ->
269
269
Log.debug (fun m -> m "Sending: %s" s);
270
270
write_line t s
271
-
| Error e -> Fmt.failwith "Failed to encode command: %s" e
271
+
| Error e ->
272
+
Fmt.failwith "Failed to encode command: %s" (Json.Error.to_string e)
272
273
273
274
let receive_response t =
274
275
let rec loop () =
···
292
293
match read_message t with
293
294
| Error e -> err_greeting_read e
294
295
| Ok (Qmp_protocol.Message.Greeting g) -> (
295
-
t.greeting <- Some g;
296
296
Log.info (fun m ->
297
297
m "Connected to QEMU %a" Qmp_protocol.Version.pp
298
298
(Qmp_protocol.Greeting.version g));
+16
-14
test/test_qemu.ml
+16
-14
test/test_qemu.ml
···
11
11
module Qmp = Qemu.Qmp
12
12
13
13
let parse_json s =
14
-
match Json_bytesrw.decode_string Json.json s with
14
+
match Json.of_string Json.Codec.Value.t s with
15
15
| Ok json -> json
16
-
| Error e -> failwith e
16
+
| Error e -> failwith (Json.Error.to_string e)
17
17
18
18
let check_message_ok msg json =
19
19
match Qmp.Message.of_string json with
···
271
271
let test_command_encode () =
272
272
let cmd = Qmp.Command.query_status in
273
273
let json = Qmp.Command.to_json cmd in
274
-
match Json_bytesrw.encode_string Json.json json with
274
+
match Json.to_string Json.Codec.Value.t json with
275
275
| Ok s ->
276
276
Alcotest.(check bool)
277
277
"contains execute" true
278
278
(String.sub s 0 10 = "{\"execute\"")
279
-
| Error e -> Alcotest.fail e
279
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
280
280
281
281
let test_command_with_id () =
282
282
let cmd = Qmp.Command.make ~id:"cookie#1" "query-name" in
283
283
let json = Qmp.Command.to_json cmd in
284
284
(* Roundtrip through Command codec *)
285
-
match Json_bytesrw.encode_string Json.json json with
285
+
match Json.to_string Json.Codec.Value.t json with
286
286
| Ok s -> (
287
-
match Json_bytesrw.decode_string Qmp.Command.jsont s with
287
+
match Json.of_string Qmp.Command.jsont s with
288
288
| Ok cmd' ->
289
289
(* Encode again and check it still contains our id *)
290
290
let json' = Qmp.Command.to_json cmd' in
291
291
let s' =
292
-
match Json_bytesrw.encode_string Json.json json' with
292
+
match Json.to_string Json.Codec.Value.t json' with
293
293
| Ok s -> s
294
-
| Error e -> Alcotest.failf "re-encode: %s" e
294
+
| Error e -> Alcotest.failf "re-encode: %s" (Json.Error.to_string e)
295
295
in
296
296
(* Both serializations should match *)
297
297
Alcotest.(check string) "roundtrip" s s'
298
-
| Error e -> Alcotest.failf "decode: %s" e)
299
-
| Error e -> Alcotest.fail e
298
+
| Error e -> Alcotest.failf "decode: %s" (Json.Error.to_string e))
299
+
| Error e -> Alcotest.fail (Json.Error.to_string e)
300
300
301
301
let test_command_roundtrip () =
302
302
let cmds =
···
318
318
List.iter
319
319
(fun cmd ->
320
320
let json = Qmp.Command.to_json cmd in
321
-
match Json_bytesrw.encode_string Json.json json with
321
+
match Json.to_string Json.Codec.Value.t json with
322
322
| Ok s -> (
323
-
match Json_bytesrw.decode_string Qmp.Command.jsont s with
323
+
match Json.of_string Qmp.Command.jsont s with
324
324
| Ok _ -> ()
325
-
| Error e -> Alcotest.failf "roundtrip decode: %s" e)
326
-
| Error e -> Alcotest.failf "roundtrip encode: %s" e)
325
+
| Error e ->
326
+
Alcotest.failf "roundtrip decode: %s" (Json.Error.to_string e))
327
+
| Error e ->
328
+
Alcotest.failf "roundtrip encode: %s" (Json.Error.to_string e))
327
329
cmds
328
330
329
331
(* {1 Status parsing tests} *)
+20
-20
test/test_qmp_protocol.ml
+20
-20
test/test_qmp_protocol.ml
···
18
18
module Qmp = Qemu.Qmp
19
19
20
20
let parse_json s =
21
-
match Json_bytesrw.decode_string Json.json s with
21
+
match Json.of_string Json.Codec.Value.t s with
22
22
| Ok json -> json
23
-
| Error e -> failwith e
23
+
| Error e -> failwith (Json.Error.to_string e)
24
24
25
25
let encode_json json =
26
-
match Json_bytesrw.encode_string Json.json json with
26
+
match Json.to_string Json.Codec.Value.t json with
27
27
| Ok s -> s
28
-
| Error e -> failwith e
28
+
| Error e -> failwith (Json.Error.to_string e)
29
29
30
30
(* {1 Version codec tests} *)
31
31
32
32
let test_version_make_roundtrip () =
33
33
(* make -> jsont encode -> jsont decode -> check fields *)
34
34
let v = Qmp.Version.make 9 0 0 "v9.0.0" in
35
-
let json = Json.Value.encode Qmp.Version.jsont v in
35
+
let json = Json.encode Qmp.Version.jsont v in
36
36
match json with
37
37
| Ok json -> (
38
-
match Json.Value.decode Qmp.Version.jsont json with
38
+
match Json.decode Qmp.Version.jsont json with
39
39
| Ok v' ->
40
40
Alcotest.(check int) "major" 9 v'.qemu.major;
41
41
Alcotest.(check int) "minor" 0 v'.qemu.minor;
42
42
Alcotest.(check int) "micro" 0 v'.qemu.micro;
43
43
Alcotest.(check string) "package" "v9.0.0" v'.package
44
-
| Error e -> Alcotest.failf "decode: %s" e)
45
-
| Error e -> Alcotest.failf "encode: %s" e
44
+
| Error e -> Alcotest.failf "decode: %s" (Json.Error.to_string e))
45
+
| Error e -> Alcotest.failf "encode: %s" (Json.Error.to_string e)
46
46
47
47
let test_version_high_numbers () =
48
48
let v = Qmp.Version.make 99 12 3 "custom-build-2025" in
···
55
55
parse_json
56
56
{|{"qemu": {"major": 7, "minor": 2, "micro": 5}, "package": "Debian 1:7.2+dfsg-7"}|}
57
57
in
58
-
match Json.Value.decode Qmp.Version.jsont json with
58
+
match Json.decode Qmp.Version.jsont json with
59
59
| Ok v ->
60
60
Alcotest.(check int) "major" 7 v.qemu.major;
61
61
Alcotest.(check int) "minor" 2 v.qemu.minor;
62
62
Alcotest.(check int) "micro" 5 v.qemu.micro;
63
63
Alcotest.(check string) "package" "Debian 1:7.2+dfsg-7" v.package
64
-
| Error e -> Alcotest.failf "decode: %s" e
64
+
| Error e -> Alcotest.failf "decode: %s" (Json.Error.to_string e)
65
65
66
66
let test_version_extra_fields_ignored () =
67
67
(* Jsont skip_unknown should tolerate extra fields *)
···
69
69
parse_json
70
70
{|{"qemu": {"major": 8, "minor": 0, "micro": 0, "extra": true}, "package": "", "build-date": "2023-04"}|}
71
71
in
72
-
match Json.Value.decode Qmp.Version.jsont json with
72
+
match Json.decode Qmp.Version.jsont json with
73
73
| Ok v ->
74
74
Alcotest.(check int) "major" 8 v.qemu.major;
75
75
Alcotest.(check string) "package" "" v.package
76
-
| Error e -> Alcotest.failf "decode: %s" e
76
+
| Error e -> Alcotest.failf "decode: %s" (Json.Error.to_string e)
77
77
78
78
(* {1 Greeting tests -- QEMU 9.0 spec vector} *)
79
79
···
163
163
(* The serialized form should contain "device_del" and the argument *)
164
164
Alcotest.(check bool) "has execute" true (String.length s > 0);
165
165
(* Roundtrip through codec *)
166
-
match Json_bytesrw.decode_string Qmp.Command.jsont s with
166
+
match Json.of_string Qmp.Command.jsont s with
167
167
| Ok _ -> ()
168
-
| Error e -> Alcotest.failf "roundtrip: %s" e
168
+
| Error e -> Alcotest.failf "roundtrip: %s" (Json.Error.to_string e)
169
169
170
170
let test_command_with_id_args () =
171
171
let args = parse_json {|{"protocol": "tcp", "hostname": "localhost"}|} in
172
172
let cmd = Qmp.Command.make ~arguments:args ~id:"migrate-1" "migrate" in
173
173
let json = Qmp.Command.to_json cmd in
174
174
let s = encode_json json in
175
-
match Json_bytesrw.decode_string Qmp.Command.jsont s with
175
+
match Json.of_string Qmp.Command.jsont s with
176
176
| Ok _ -> ()
177
-
| Error e -> Alcotest.failf "roundtrip: %s" e
177
+
| Error e -> Alcotest.failf "roundtrip: %s" (Json.Error.to_string e)
178
178
179
179
let test_command_blockdev_add () =
180
180
(* More complex arguments -- blockdev-add with nested config *)
···
185
185
let cmd = Qmp.Command.make ~arguments:args "blockdev-add" in
186
186
let json = Qmp.Command.to_json cmd in
187
187
let s = encode_json json in
188
-
match Json_bytesrw.decode_string Qmp.Command.jsont s with
188
+
match Json.of_string Qmp.Command.jsont s with
189
189
| Ok _ -> ()
190
-
| Error e -> Alcotest.failf "roundtrip: %s" e
190
+
| Error e -> Alcotest.failf "roundtrip: %s" (Json.Error.to_string e)
191
191
192
192
(* {1 Status run_state string roundtrip} *)
193
193
···
303
303
304
304
let test_timestamp_jsont_roundtrip () =
305
305
let json = parse_json {|{"seconds": 1267040730, "microseconds": 682951}|} in
306
-
match Json.Value.decode Qmp.Timestamp.jsont json with
306
+
match Json.decode Qmp.Timestamp.jsont json with
307
307
| Ok ts ->
308
308
Alcotest.(check int) "seconds" 1267040730 ts.seconds;
309
309
Alcotest.(check int) "microseconds" 682951 ts.microseconds
310
-
| Error e -> Alcotest.failf "decode: %s" e
310
+
| Error e -> Alcotest.failf "decode: %s" (Json.Error.to_string e)
311
311
312
312
(* {1 Event data extraction} *)
313
313