unikernel/duniverse/mirage-crypto/tests/wycheproof/wycheproof.ml

@@ -0,0 +1,149 @@
+type json = Yojson.Safe.t [@@deriving of_yojson]
+
+let pp_json = Yojson.Safe.pretty_print
+
+type hex = string [@@deriving eq]
+
+let pp_hex fmt buf =
+  let n = String.length buf in
+  let bbuf = Bytes.unsafe_of_string buf in
+  for i = n - 1 downto 0 do
+    let byte = Bytes.get_uint8 bbuf i in
+    Format.fprintf fmt "%02x" byte
+  done
+
+let hex_of_string s =
+  let fold f acc str =
+    let st = ref acc in
+    String.iter (fun c -> st := f !st c) str;
+    !st
+  and digit c =
+    match c with
+    | '0'..'9' -> int_of_char c - 0x30
+    | 'A'..'F' -> int_of_char c - 0x41 + 10
+    | 'a'..'f' -> int_of_char c - 0x61 + 10
+    | _ -> invalid_arg "bad character"
+  in
+  let out = Bytes.create (String.length s / 2) in
+  let _idx, leftover =
+    fold (fun (idx, leftover) c ->
+        let c = digit c in
+        match leftover with
+        | None -> idx, Some (c lsl 4)
+        | Some c' ->
+          Bytes.set_uint8 out idx (c' lor c);
+          succ idx, None)
+      (0, None) s
+  in
+  assert (leftover = None);
+  Bytes.unsafe_to_string out
+
+let hex_of_yojson json =
+  let padded s = if String.length s mod 2 = 0 then s else "0" ^ s in
+  match [%of_yojson: string] json with
+  | Ok s -> Ok (hex_of_string (padded s))
+  | Error _ as e -> e
+
+type test_result = Valid | Acceptable | Invalid [@@deriving show]
+
+let test_result_of_yojson = function
+  | `String "valid" -> Ok Valid
+  | `String "acceptable" -> Ok Acceptable
+  | `String "invalid" -> Ok Invalid
+  | _ -> Error "test_result"
+
+type ecdh_test = {
+  tcId : int;
+  comment : string;
+  curve : json option; [@yojson.default None]
+  public : hex;
+  private_ : hex; [@yojson.key "private"]
+  shared : hex;
+  result : test_result;
+  flags : string list;
+}
+[@@deriving of_yojson, show]
+
+let has_ignored_flag test ~ignored_flags =
+  List.exists
+    (fun ignored_flag -> List.mem ignored_flag test.flags)
+    ignored_flags
+
+type ecdh_test_group = {
+  curve : string;
+  tests : ecdh_test list;
+  encoding : json option; [@yojson.default None]
+  type_ : json option; [@yojson.default None] [@yojson.key "type"]
+}
+[@@deriving of_yojson, show]
+
+type ecdsa_key = {
+  curve : string;
+  keySize : int;
+  type_ : json; [@yojson.key "type"]
+  uncompressed : hex;
+  wx : hex;
+  wy : hex;
+}
+[@@deriving of_yojson, show]
+
+type dsa_test = {
+  tcId : int;
+  comment : string;
+  msg : hex;
+  sig_ : hex; [@yojson.key "sig"]
+  result : test_result;
+  flags : string list;
+}
+[@@deriving of_yojson, show]
+
+type ecdsa_test_group = {
+  key : ecdsa_key;
+  keyDer : string;
+  keyPem : string;
+  sha : string;
+  tests : dsa_test list;
+  type_ : json option; [@yojson.default None] [@yojson.key "type"]
+}
+[@@deriving of_yojson, show]
+
+type eddsa_key = {
+  curve : string;
+  keySize : int;
+  pk : hex;
+  sk : hex;
+  type_ : json; [@yojson.key "type"]
+}
+[@@deriving of_yojson, show]
+
+type eddsa_test_group = {
+  jwk : json;
+  key : eddsa_key;
+  keyDer : string;
+  keyPem : string;
+  type_ : json; [@yojson.key "type"]
+  tests : dsa_test list;
+}
+[@@deriving of_yojson, show]
+
+type test_file = {
+  algorithm : json;
+  generatorVersion : json;
+  header : json;
+  notes : json;
+  numberOfTests : json;
+  schema : json;
+  testGroups : json list;
+}
+[@@deriving of_yojson, show]
+
+let get_json = function Ok x -> x | Error s -> failwith s
+
+let load_file_exn path =
+  Yojson.Safe.from_file path |> [%of_yojson: test_file] |> get_json
+
+let ecdh_test_group_exn json = [%of_yojson: ecdh_test_group] json |> get_json
+
+let ecdsa_test_group_exn json = [%of_yojson: ecdsa_test_group] json |> get_json
+
+let eddsa_test_group_exn json = [%of_yojson: eddsa_test_group] json |> get_json