WIP: various changes

.ocamlformat

···
-version=0.27.0
+version=0.28.1

dune-project

···
   (fmt (>= 0.9))
   (logs (>= 0.7))
   (jsont (>= 0.1))
+  (bytesrw (>= 0.1))
   (alcotest :with-test)))

lib/dune

···
 (library
  (name runc)
  (public_name runc)
- (libraries eio fmt logs jsont))
+ (libraries eio fmt logs jsont jsont.bytesrw))

lib/runc.ml

···
 
   let jsont =
     Jsont.Object.map ~kind:"user" (fun uid gid additional_gids ->
-        { uid; gid; additional_gids })
+        { uid; gid; additional_gids = Option.value ~default:[] additional_gids })
     |> Jsont.Object.mem "uid" Jsont.int ~enc:(fun u -> u.uid)
     |> Jsont.Object.mem "gid" Jsont.int ~enc:(fun u -> u.gid)
     |> Jsont.Object.opt_mem "additionalGids" (Jsont.list Jsont.int)
···
     in
     v ~typ:"bind" ~source ~options destination
 
-  let proc = v ~typ:"proc" ~source:"proc" ~options:[ "nosuid"; "noexec"; "nodev" ] "/proc"
+  let proc =
+    v ~typ:"proc" ~source:"proc"
+      ~options:[ "nosuid"; "noexec"; "nodev" ]
+      "/proc"
 
   let sysfs =
     v ~typ:"sysfs" ~source:"sysfs"
···
 
   let jsont =
     Jsont.Object.map ~kind:"mount" (fun destination typ source options ->
-        { destination; typ; source; options })
+        { destination; typ; source; options = Option.value ~default:[] options })
     |> Jsont.Object.mem "destination" Jsont.string ~enc:(fun m -> m.destination)
     |> Jsont.Object.mem "type" Jsont.string ~enc:(fun m -> m.typ)
     |> Jsont.Object.mem "source" Jsont.string ~enc:(fun m -> m.source)
     |> Jsont.Object.opt_mem "options" (Jsont.list Jsont.string) ~enc:(fun m ->
-           if m.options = [] then None else Some m.options)
+        if m.options = [] then None else Some m.options)
     |> Jsont.Object.finish
 end
 
 module Namespace = struct
   type typ = Pid | Network | Ipc | Uts | Mount | User | Cgroup
-
   type t = { typ : typ; path : string option }
 
   let v ?path typ = { typ; path }
···
   let typ_jsont =
     Jsont.string
     |> Jsont.recode ~dec:(fun s ->
-           match typ_of_string s with Ok t -> t | Error e -> failwith e)
+        match typ_of_string s with Ok t -> t | Error e -> failwith e)
     |> Jsont.recode ~enc:typ_to_string
 
   let jsont =
···
 
   let default =
     let caps = Capability.default in
-    { bounding = caps; effective = caps; inheritable = caps; permitted = caps; ambient = [] }
+    {
+      bounding = caps;
+      effective = caps;
+      inheritable = caps;
+      permitted = caps;
+      ambient = [];
+    }
 
   let jsont =
     let string_list = Jsont.list Jsont.string in
     Jsont.Object.map ~kind:"capabilities"
       (fun bounding effective inheritable permitted ambient ->
-        { bounding; effective; inheritable; permitted; ambient })
+        {
+          bounding;
+          effective;
+          inheritable;
+          permitted;
+          ambient = Option.value ~default:[] ambient;
+        })
     |> Jsont.Object.mem "bounding" string_list ~enc:(fun c -> c.bounding)
     |> Jsont.Object.mem "effective" string_list ~enc:(fun c -> c.effective)
     |> Jsont.Object.mem "inheritable" string_list ~enc:(fun c -> c.inheritable)
     |> Jsont.Object.mem "permitted" string_list ~enc:(fun c -> c.permitted)
     |> Jsont.Object.opt_mem "ambient" string_list ~enc:(fun c ->
-           if c.ambient = [] then None else Some c.ambient)
+        if c.ambient = [] then None else Some c.ambient)
     |> Jsont.Object.finish
 end
 
 module Rlimit = struct
   type typ = Nofile | Nproc | Core | Memlock
-
   type t = { typ : typ; hard : int; soft : int }
 
   let v ~hard ~soft typ = { typ; hard; soft }
···
   let env_of_string s =
     match String.index_opt s '=' with
     | None -> (s, "")
-    | Some i -> (String.sub s 0 i, String.sub s (i + 1) (String.length s - i - 1))
+    | Some i ->
+        (String.sub s 0 i, String.sub s (i + 1) (String.length s - i - 1))
 
   let jsont =
     Jsont.Object.map ~kind:"process"
       (fun terminal user args env cwd capabilities rlimits no_new_privileges ->
-        { terminal; user; args; env; cwd; capabilities; rlimits; no_new_privileges })
+        {
+          terminal;
+          user;
+          args;
+          env;
+          cwd;
+          capabilities;
+          rlimits;
+          no_new_privileges;
+        })
     |> Jsont.Object.mem "terminal" Jsont.bool ~enc:(fun p -> p.terminal)
     |> Jsont.Object.mem "user" User.jsont ~enc:(fun p -> p.user)
     |> Jsont.Object.mem "args" (Jsont.list Jsont.string) ~enc:(fun p -> p.args)
     |> Jsont.Object.mem "env"
          (Jsont.list
-            (Jsont.string
-            |> Jsont.recode ~dec:env_of_string ~enc:env_to_string))
+            (Jsont.string |> Jsont.recode ~dec:env_of_string ~enc:env_to_string))
          ~enc:(fun p -> p.env)
     |> Jsont.Object.mem "cwd" Jsont.string ~enc:(fun p -> p.cwd)
-    |> Jsont.Object.mem "capabilities" Capabilities.jsont
-         ~enc:(fun p -> p.capabilities)
-    |> Jsont.Object.mem "rlimits" (Jsont.list Rlimit.jsont)
-         ~enc:(fun p -> p.rlimits)
-    |> Jsont.Object.mem "noNewPrivileges" Jsont.bool
-         ~enc:(fun p -> p.no_new_privileges)
+    |> Jsont.Object.mem "capabilities" Capabilities.jsont ~enc:(fun p ->
+        p.capabilities)
+    |> Jsont.Object.mem "rlimits" (Jsont.list Rlimit.jsont) ~enc:(fun p ->
+        p.rlimits)
+    |> Jsont.Object.mem "noNewPrivileges" Jsont.bool ~enc:(fun p ->
+        p.no_new_privileges)
     |> Jsont.Object.finish
 end
 
···
     ]
 
   let default_readonly_paths =
-    [
-      "/proc/bus";
-      "/proc/fs";
-      "/proc/irq";
-      "/proc/sys";
-      "/proc/sysrq-trigger";
-    ]
+    [ "/proc/bus"; "/proc/fs"; "/proc/irq"; "/proc/sys"; "/proc/sysrq-trigger" ]
 
-  let v ?(namespaces = Namespace.default)
-      ?(masked_paths = default_masked_paths)
+  let v ?(namespaces = Namespace.default) ?(masked_paths = default_masked_paths)
       ?(readonly_paths = default_readonly_paths) () =
     { namespaces; masked_paths; readonly_paths }
 
···
     Jsont.Object.map ~kind:"linux"
       (fun namespaces masked_paths readonly_paths ->
         { namespaces; masked_paths; readonly_paths })
-    |> Jsont.Object.mem "namespaces" (Jsont.list Namespace.jsont)
-         ~enc:(fun l -> l.namespaces)
-    |> Jsont.Object.mem "maskedPaths" (Jsont.list Jsont.string)
-         ~enc:(fun l -> l.masked_paths)
-    |> Jsont.Object.mem "readonlyPaths" (Jsont.list Jsont.string)
-         ~enc:(fun l -> l.readonly_paths)
+    |> Jsont.Object.mem "namespaces" (Jsont.list Namespace.jsont) ~enc:(fun l ->
+        l.namespaces)
+    |> Jsont.Object.mem "maskedPaths" (Jsont.list Jsont.string) ~enc:(fun l ->
+        l.masked_paths)
+    |> Jsont.Object.mem "readonlyPaths" (Jsont.list Jsont.string) ~enc:(fun l ->
+        l.readonly_paths)
     |> Jsont.Object.finish
 end
 
···
     linux : Linux.t;
   }
 
-  let v ?(oci_version = "1.0.2") ?(hostname = "container") ?(mounts = Mount.default)
-      ?(linux = Linux.v ()) ~process ~root () =
+  let v ?(oci_version = "1.0.2") ?(hostname = "container")
+      ?(mounts = Mount.default) ?(linux = Linux.v ()) ~process ~root () =
     { oci_version; process; root; hostname; mounts; linux }
 
   let jsont =
···
     |> Jsont.Object.mem "process" Process.jsont ~enc:(fun c -> c.process)
     |> Jsont.Object.mem "root" Root.jsont ~enc:(fun c -> c.root)
     |> Jsont.Object.mem "hostname" Jsont.string ~enc:(fun c -> c.hostname)
-    |> Jsont.Object.mem "mounts" (Jsont.list Mount.jsont) ~enc:(fun c -> c.mounts)
+    |> Jsont.Object.mem "mounts" (Jsont.list Mount.jsont) ~enc:(fun c ->
+        c.mounts)
     |> Jsont.Object.mem "linux" Linux.jsont ~enc:(fun c -> c.linux)
     |> Jsont.Object.finish
 
   let to_json config =
-    Jsont.encode Jsont.json_string jsont config |> Result.get_ok
+    match Jsont_bytesrw.encode_string jsont config with
+    | Ok s -> s
+    | Error e -> failwith (Jsont.Error.to_string e)
 
   let of_json str =
-    Jsont.decode Jsont.json_string jsont str
+    match Jsont_bytesrw.decode_string jsont str with
+    | Ok t -> Ok t
+    | Error e -> Error (Jsont.Error.to_string e)
 end
 
 (** {1 Runc Commands} *)
···
     let process_mgr = Eio.Stdenv.process_mgr env in
     { sw; process_mgr; state_dir }
 
-  let runc t args =
-    "runc" :: "--root" :: t.state_dir :: args
+  let runc t args = "runc" :: "--root" :: t.state_dir :: args
 
   let run_runc t args =
     let cmd = runc t args in
···
     container.status <- `Running
 
   let kill t container signal =
-    Log.info (fun m -> m "Killing container %s with signal %d" container.id signal);
+    Log.info (fun m ->
+        m "Killing container %s with signal %d" container.id signal);
     run_runc_result t [ "kill"; container.id; string_of_int signal ]
 
   let delete ?(force = false) t container =

lib/runc.mli

···
   val cgroup : t
   val mqueue : t
   val default : t list
-
   val jsont : t Jsont.t
 end
 

runc.opam

···
   "fmt" {>= "0.9"}
   "logs" {>= "0.7"}
   "jsont" {>= "0.1"}
+  "bytesrw" {>= "0.1"}
   "alcotest" {with-test}
   "odoc" {with-doc}
 ]

test/dune

···
 (test
  (name test)
- (libraries runc alcotest))
+ (libraries runc alcotest jsont jsont.bytesrw))

test/test_runc.ml

···
 
 let json_testable = Alcotest.testable Fmt.string String.equal
 
+let encode_json jsont v =
+  match Jsont_bytesrw.encode_string jsont v with
+  | Ok s -> s
+  | Error e -> failwith (Jsont.Error.to_string e)
+
 (** {2 User tests} *)
 
 let test_user_root () =
   let user = Runc.User.root in
-  let json = Jsont.encode Jsont.json_string Runc.User.jsont user |> Result.get_ok in
+  let json = encode_json Runc.User.jsont user |> Result.get_ok in
   Alcotest.(check bool) "contains uid 0" true (String.length json > 0);
-  Alcotest.(check bool) "has uid field" true
+  Alcotest.(check bool)
+    "has uid field" true
     (is_substring ~affix:"\"uid\"" json)
 
 let test_user_custom () =
   let user = Runc.User.v ~uid:1000 ~gid:1000 ~additional_gids:[ 100; 200 ] () in
-  let json = Jsont.encode Jsont.json_string Runc.User.jsont user |> Result.get_ok in
-  Alcotest.(check bool) "has uid 1000" true
-    (is_substring ~affix:"1000" json);
-  Alcotest.(check bool) "has additional gids" true
+  let json = encode_json Runc.User.jsont user |> Result.get_ok in
+  Alcotest.(check bool) "has uid 1000" true (is_substring ~affix:"1000" json);
+  Alcotest.(check bool)
+    "has additional gids" true
     (is_substring ~affix:"additionalGids" json)
 
 (** {2 Mount tests} *)
 
 let test_mount_proc () =
-  let json =
-    Jsont.encode Jsont.json_string Runc.Mount.jsont Runc.Mount.proc |> Result.get_ok
-  in
-  Alcotest.(check bool) "destination is /proc" true
+  let json = encode_json Runc.Mount.jsont Runc.Mount.proc in
+  Alcotest.(check bool)
+    "destination is /proc" true
     (is_substring ~affix:"/proc" json);
-  Alcotest.(check bool) "type is proc" true
+  Alcotest.(check bool)
+    "type is proc" true
     (is_substring ~affix:"\"type\":\"proc\"" json)
 
 let test_mount_bind () =
   let mount = Runc.Mount.bind ~source:"/host/path" "/container/path" in
-  let json = Jsont.encode Jsont.json_string Runc.Mount.jsont mount |> Result.get_ok in
-  Alcotest.(check bool) "has bind option" true
-    (is_substring ~affix:"bind" json)
+  let json = encode_json Runc.Mount.jsont mount |> Result.get_ok in
+  Alcotest.(check bool) "has bind option" true (is_substring ~affix:"bind" json)
 
 let test_mount_bind_readonly () =
-  let mount = Runc.Mount.bind ~readonly:true ~source:"/host/path" "/container/path" in
-  let json = Jsont.encode Jsont.json_string Runc.Mount.jsont mount |> Result.get_ok in
+  let mount =
+    Runc.Mount.bind ~readonly:true ~source:"/host/path" "/container/path"
+  in
+  let json = encode_json Runc.Mount.jsont mount |> Result.get_ok in
   Alcotest.(check bool) "has ro option" true (is_substring ~affix:"ro" json)
 
 let test_mount_default () =
···
 
 let test_namespace_json () =
   let ns = Runc.Namespace.v Runc.Namespace.Pid in
-  let json = Jsont.encode Jsont.json_string Runc.Namespace.jsont ns |> Result.get_ok in
-  Alcotest.(check bool) "type is pid" true
+  let json = encode_json Runc.Namespace.jsont ns |> Result.get_ok in
+  Alcotest.(check bool)
+    "type is pid" true
     (is_substring ~affix:"\"type\":\"pid\"" json)
 
 let test_namespace_with_path () =
   let ns = Runc.Namespace.v ~path:"/proc/1/ns/net" Runc.Namespace.Network in
-  let json = Jsont.encode Jsont.json_string Runc.Namespace.jsont ns |> Result.get_ok in
-  Alcotest.(check bool) "has path" true
+  let json = encode_json Runc.Namespace.jsont ns |> Result.get_ok in
+  Alcotest.(check bool)
+    "has path" true
     (is_substring ~affix:"/proc/1/ns/net" json)
 
 (** {2 Capability tests} *)
···
   Alcotest.(check bool) "has capabilities" true (count > 0)
 
 let test_capabilities_default () =
-  let json =
-    Jsont.encode Jsont.json_string Runc.Capabilities.jsont Runc.Capabilities.default
-    |> Result.get_ok
-  in
-  Alcotest.(check bool) "has bounding" true
+  let json = encode_json Runc.Capabilities.jsont Runc.Capabilities.default in
+  Alcotest.(check bool)
+    "has bounding" true
     (is_substring ~affix:"bounding" json);
-  Alcotest.(check bool) "has CAP_CHOWN" true
+  Alcotest.(check bool)
+    "has CAP_CHOWN" true
     (is_substring ~affix:"CAP_CHOWN" json)
 
 (** {2 Process tests} *)
 
 let test_process_simple () =
   let process = Runc.Process.v [ "/bin/echo"; "hello" ] in
-  let json =
-    Jsont.encode Jsont.json_string Runc.Process.jsont process |> Result.get_ok
-  in
+  let json = encode_json Runc.Process.jsont process in
   Alcotest.(check bool) "has args" true (is_substring ~affix:"args" json);
   Alcotest.(check bool) "has echo" true (is_substring ~affix:"echo" json)
 
 let test_process_with_env () =
-  let process = Runc.Process.v ~env:[ ("PATH", "/bin"); ("HOME", "/root") ] [ "/bin/sh" ] in
-  let json =
-    Jsont.encode Jsont.json_string Runc.Process.jsont process |> Result.get_ok
+  let process =
+    Runc.Process.v ~env:[ ("PATH", "/bin"); ("HOME", "/root") ] [ "/bin/sh" ]
   in
-  Alcotest.(check bool) "has PATH env" true
+  let json = encode_json Runc.Process.jsont process in
+  Alcotest.(check bool)
+    "has PATH env" true
     (is_substring ~affix:"PATH=/bin" json);
-  Alcotest.(check bool) "has HOME env" true
+  Alcotest.(check bool)
+    "has HOME env" true
     (is_substring ~affix:"HOME=/root" json)
 
 (** {2 Root tests} *)
 
 let test_root_simple () =
   let root = Runc.Root.v "rootfs" in
-  let json = Jsont.encode Jsont.json_string Runc.Root.jsont root |> Result.get_ok in
+  let json = encode_json Runc.Root.jsont root |> Result.get_ok in
   Alcotest.(check bool) "has path" true (is_substring ~affix:"rootfs" json);
-  Alcotest.(check bool) "readonly is false" true
+  Alcotest.(check bool)
+    "readonly is false" true
     (is_substring ~affix:"\"readonly\":false" json)
 
 let test_root_readonly () =
   let root = Runc.Root.v ~readonly:true "rootfs" in
-  let json = Jsont.encode Jsont.json_string Runc.Root.jsont root |> Result.get_ok in
-  Alcotest.(check bool) "readonly is true" true
+  let json = encode_json Runc.Root.jsont root |> Result.get_ok in
+  Alcotest.(check bool)
+    "readonly is true" true
     (is_substring ~affix:"\"readonly\":true" json)
 
 (** {2 Linux tests} *)
 
 let test_linux_default () =
   let linux = Runc.Linux.v () in
-  let json = Jsont.encode Jsont.json_string Runc.Linux.jsont linux |> Result.get_ok in
-  Alcotest.(check bool) "has namespaces" true
+  let json = encode_json Runc.Linux.jsont linux |> Result.get_ok in
+  Alcotest.(check bool)
+    "has namespaces" true
     (is_substring ~affix:"namespaces" json);
-  Alcotest.(check bool) "has masked paths" true
+  Alcotest.(check bool)
+    "has masked paths" true
     (is_substring ~affix:"maskedPaths" json)
 
 let test_linux_masked_paths () =
···
   let root = Runc.Root.v "rootfs" in
   let config = Runc.Config.v ~process ~root () in
   let json = Runc.Config.to_json config in
-  Alcotest.(check bool) "has ociVersion" true
+  Alcotest.(check bool)
+    "has ociVersion" true
     (is_substring ~affix:"ociVersion" json);
   Alcotest.(check bool) "has process" true (is_substring ~affix:"process" json);
   Alcotest.(check bool) "has root" true (is_substring ~affix:"root" json)
···
 let test_config_roundtrip () =
   let process = Runc.Process.v [ "/bin/sh"; "-c"; "echo test" ] in
   let root = Runc.Root.v ~readonly:true "rootfs" in
-  let config =
-    Runc.Config.v ~hostname:"test-container" ~process ~root ()
-  in
+  let config = Runc.Config.v ~hostname:"test-container" ~process ~root () in
   let json = Runc.Config.to_json config in
   match Runc.Config.of_json json with
   | Ok config' ->
···
     ( "capability",
       [
         Alcotest.test_case "default" `Quick test_capability_default;
-        Alcotest.test_case "capabilities default" `Quick test_capabilities_default;
+        Alcotest.test_case "capabilities default" `Quick
+          test_capabilities_default;
       ] );
     ( "process",
       [