unikernel/duniverse/httpun/lib_test/dune

@@ -0,0 +1,15 @@
+(test
+ (package httpun)
+ (libraries bigstringaf httpun alcotest)
+ (modules
+  helpers
+  test_client_connection
+  test_headers
+  test_httpun
+  test_iovec
+  test_method
+  test_request
+  test_response
+  test_server_connection
+  test_version)
+ (name test_httpun))

unikernel/duniverse/httpun/lib_test/helpers.ml

@@ -0,0 +1,73 @@
+open Httpun
+
+let maybe_serialize_body f body =
+  match body with
+  | None -> ()
+  | Some body -> Faraday.write_string f body
+
+let request_to_string ?body r =
+  let f = Faraday.create 0x1000 in
+  Httpun_private.Serialize.write_request f r;
+  maybe_serialize_body f body;
+  Faraday.serialize_to_string f
+
+let response_to_string ?body r =
+  let f = Faraday.create 0x1000 in
+  Httpun_private.Serialize.write_response f r;
+  maybe_serialize_body f body;
+  Faraday.serialize_to_string f
+
+module Read_operation = struct
+  type t = [ `Read | `Yield | `Close ]
+
+  let pp_hum fmt (t : t) =
+    let str =
+      match t with
+      | `Read -> "Read"
+      | `Yield -> "Yield"
+      | `Close -> "Close"
+    in
+    Format.pp_print_string fmt str
+  ;;
+end
+
+module Write_operation = struct
+  type t = [ `Write of Bigstringaf.t IOVec.t list | `Yield | `Close of int ]
+
+  let iovecs_to_string iovecs =
+    let len = IOVec.lengthv iovecs in
+    let bytes = Bytes.create len in
+    let dst_off = ref 0 in
+    List.iter (fun { IOVec.buffer; off = src_off; len } ->
+      Bigstringaf.unsafe_blit_to_bytes buffer ~src_off bytes ~dst_off:!dst_off ~len;
+      dst_off := !dst_off + len)
+    iovecs;
+    Bytes.unsafe_to_string bytes
+  ;;
+
+  let pp_hum fmt (t : t) =
+    match t with
+    | `Write iovecs -> Format.fprintf fmt "Write %S" (iovecs_to_string iovecs)
+    | `Yield -> Format.pp_print_string fmt "Yield"
+    | `Close len -> Format.fprintf fmt "Close %i" len
+  ;;
+
+  let to_write_as_string t =
+    match t with
+    | `Write iovecs -> Some (iovecs_to_string iovecs)
+    | `Close _ | `Yield -> None
+  ;;
+end
+
+let write_operation = Alcotest.of_pp Write_operation.pp_hum
+let read_operation = Alcotest.of_pp Read_operation.pp_hum
+
+module Headers = struct
+  include Headers
+
+  let (@) a b = Headers.add_list a (Headers.to_list b)
+
+  let connection_close = Headers.of_list ["connection", "close"]
+  let encoding_chunked = Headers.of_list ["transfer-encoding", "chunked"]
+  let encoding_fixed n = Headers.of_list ["content-length", string_of_int n]
+end

unikernel/duniverse/httpun/lib_test/test_headers.ml

@@ -0,0 +1,78 @@
+open Httpun
+module Array = ArrayLabels
+module List = ListLabels
+
+let check msg ~expect actual =
+  Alcotest.(check (list (pair string string))) msg expect (Headers.to_list actual)
+;;
+
+let test_replace () =
+  check "replace trailing element"
+    ~expect:["c", "d"; "a", "d"]
+    (Headers.replace
+      (Headers.of_list ["c", "d"; "a", "b"])
+      "a"
+      "d");
+
+  check "replace middle element"
+    ~expect:["e", "f"; "c", "z"; "a", "b"]
+    (Headers.replace
+       (Headers.of_list ["e", "f"; "c", "d"; "a", "b"])
+       "c"
+       "z");
+
+  check "remove multiple trailing elements"
+    ~expect:["c", "d"; "a", "d"]
+    (Headers.replace
+      (Headers.of_list [ "c", "d"; "a", "b"; "a", "c"])
+      "a"
+      "d");
+;;
+
+let test_remove () =
+  check "remove leading element"
+    ~expect:["c", "d"]
+    (Headers.remove
+      (Headers.of_list ["a", "b"; "c", "d"])
+      "a");
+  check "remove trailing element"
+    ~expect:["c", "d"]
+    (Headers.remove
+      (Headers.of_list ["c", "d"; "a", "b"])
+      "a");
+;;
+
+let test_ci_equal () =
+  let string_of_char x = String.init 1 (fun _ -> x) in
+  let ascii =
+    Array.init (0xff + 1) ~f:Char.chr
+    |> Array.to_list
+  in
+  let ascii_pairs =
+    List.map ascii ~f:(fun x ->
+      List.map ascii ~f:(fun y -> x, y))
+    |> List.concat
+  in
+  (* Ensure that the branch free case-insensitive equality check is consistent
+   * with a naive implementation. *)
+  List.iter ascii_pairs ~f:(fun (x, y) ->
+    let char_ci_equal =
+      Char.compare (Char.lowercase_ascii x) (Char.lowercase_ascii y) = 0
+    in
+    let headers_equal =
+      let headers = Headers.of_list [ string_of_char y, "value" ] in
+      Headers.mem headers (string_of_char x)
+    in
+    Alcotest.(check bool)
+      (Printf.sprintf "CI: %C = %C" x y)
+      char_ci_equal
+      headers_equal)
+;;
+
+
+
+let tests =
+  [ "remove"  , `Quick, test_remove
+  ; "replace" , `Quick, test_replace
+  ; "CI equal", `Quick, test_ci_equal
+  ]

unikernel/duniverse/httpun/lib_test/test_httpun.ml

@@ -0,0 +1,11 @@
+let () =
+  Alcotest.run "httpun unit tests"
+    [ "version"          , Test_version.tests
+    ; "method"           , Test_method.tests
+    ; "iovec"            , Test_iovec.tests
+    ; "headers"          , Test_headers.tests
+    ; "request"          , Test_request.tests
+    ; "response"         , Test_response.tests
+    ; "client connection", Test_client_connection.tests
+    ; "server connection", Test_server_connection.tests
+    ]

unikernel/duniverse/httpun/lib_test/test_iovec.ml

@@ -0,0 +1,43 @@
+open Httpun
+open IOVec
+
+(* The length of the buffer is ignored by iovec operations *)
+let buffer = Bigstringaf.empty
+
+let test_lengthv () =
+  Alcotest.(check int) "lengthv [] = 0"                 (lengthv []) 0;
+  Alcotest.(check int) "lengthv [iovec] = length iovec"
+    (lengthv [{ buffer; off = 0; len = 0 }]) (length {buffer; off = 0; len = 0 });
+  Alcotest.(check int) "lengthv [iovec] = length iovec"
+    (lengthv [{ buffer; off = 0; len = 10 }]) (length {buffer; off = 0; len = 10 });
+;;
+
+let test_shiftv_raises () =
+  Alcotest.check_raises
+    "IOVec.shiftv: -1 is a negative number"
+    (Failure "IOVec.shiftv: -1 is a negative number")
+    (fun () -> ignore (shiftv [] (-1)));
+  let test f =
+    Alcotest.check_raises
+      "shiftv iovecs n raises when n > lengthv iovecs"
+      (Failure "shiftv: n > lengthv iovecs")
+    (fun () -> ignore (f ()))
+  in
+  test (fun () -> shiftv [] 1);
+  test (fun () -> shiftv [{ buffer; off = 0; len = 1 }] 2);
+  test (fun () -> shiftv [{ buffer; off = 0; len = 1 }; { buffer; off = 0; len = 1 }] 3);
+;;
+
+let test_shiftv () =
+  Alcotest.(check (of_pp pp_hum |> list)) "shiftv [] 0 = []" (shiftv [] 0) [];
+  Alcotest.(check (of_pp pp_hum |> list)) "shiftv [{... len ... }] len = []"
+    (shiftv [{ buffer; off = 0; len = 1 }] 1) [];
+  Alcotest.(check (of_pp pp_hum |> list)) "shiftv [iovec] n when length iovec < n"
+    (shiftv [{ buffer; off = 0; len = 4 }] 2) [{ buffer; off = 2; len = 2 }];
+;;
+
+let tests =
+  [ "lengthv"       , `Quick, test_lengthv
+  ; "shiftv"        , `Quick, test_shiftv
+  ; "shiftv raises ", `Quick, test_shiftv_raises
+  ]

unikernel/duniverse/httpun/lib_test/test_method.ml

@@ -0,0 +1,41 @@
+open Httpun
+open Method
+
+let test_is_safe () =
+  Alcotest.(check bool) "GET is safe"     (is_safe `GET )    true;
+  Alcotest.(check bool) "HEAD is safe"    (is_safe `HEAD)    true;
+  Alcotest.(check bool) "POST is safe"    (is_safe `POST)    false;
+  Alcotest.(check bool) "PUT is safe"     (is_safe `PUT )    false;
+  Alcotest.(check bool) "DELETE is safe"  (is_safe `DELETE ) false;
+  Alcotest.(check bool) "CONNECT is safe" (is_safe `CONNECT) false;
+  Alcotest.(check bool) "OPTIONS is safe" (is_safe `OPTIONS) true;
+  Alcotest.(check bool) "TRACE is safe"   (is_safe `TRACE  ) true;
+;;
+
+let test_is_cacheable () =
+  Alcotest.(check bool) "GET is cacheable"     (is_cacheable `GET )    true;
+  Alcotest.(check bool) "HEAD is cacheable"    (is_cacheable `HEAD)    true;
+  Alcotest.(check bool) "POST is cacheable"    (is_cacheable `POST)    true;
+  Alcotest.(check bool) "PUT is cacheable"     (is_cacheable `PUT )    false;
+  Alcotest.(check bool) "DELETE is cacheable"  (is_cacheable `DELETE ) false;
+  Alcotest.(check bool) "CONNECT is cacheable" (is_cacheable `CONNECT) false;
+  Alcotest.(check bool) "OPTIONS is cacheable" (is_cacheable `OPTIONS) false;
+  Alcotest.(check bool) "TRACE is cacheable"   (is_cacheable `TRACE  ) false;
+;;
+
+let test_is_idempotent () =
+  Alcotest.(check bool) "GET is idempotent"     (is_idempotent `GET )    true;
+  Alcotest.(check bool) "HEAD is idempotent"    (is_idempotent `HEAD)    true;
+  Alcotest.(check bool) "POST is idempotent"    (is_idempotent `POST)    false;
+  Alcotest.(check bool) "PUT is idempotent"     (is_idempotent `PUT )    true;
+  Alcotest.(check bool) "DELETE is idempotent"  (is_idempotent `DELETE ) true;
+  Alcotest.(check bool) "CONNECT is idempotent" (is_idempotent `CONNECT) false;
+  Alcotest.(check bool) "OPTIONS is idempotent" (is_idempotent `OPTIONS) true;
+  Alcotest.(check bool) "TRACE is idempotent"   (is_idempotent `TRACE  ) true;
+;;
+
+let tests =
+  [ "is_safe"      , `Quick, test_is_safe
+  ; "is_cacheable" , `Quick, test_is_cacheable
+  ; "is_idempotent", `Quick, test_is_idempotent
+  ]

unikernel/duniverse/httpun/lib_test/test_request.ml

@@ -0,0 +1,104 @@
+open Httpun
+open Request
+open Helpers
+
+let body_length = Alcotest.of_pp Request.Body_length.pp_hum
+
+let check =
+  let alco =
+    Alcotest.result
+      (Alcotest.of_pp pp_hum)
+      Alcotest.string
+  in
+  fun message ~expect input ->
+    let actual =
+      Angstrom.parse_string ~consume:All Httpun_private.Parse.request input
+    in
+    Alcotest.check alco message expect actual
+;;
+
+let test_parse_valid () =
+  check
+    "valid GET without headers"
+    ~expect:(Ok (Request.create `GET "/"))
+    "GET / HTTP/1.1\r\n\r\n";
+  check
+    "valid non-standard method without headers"
+    ~expect:(Ok (Request.create (`Other "some-other-verb") "/"))
+    "some-other-verb / HTTP/1.1\r\n\r\n";
+  check
+    "valid GET with headers"
+    ~expect:(Ok (Request.create ~headers:(Headers.of_list [ "Link", "/path/to/some/website"]) `GET "/"))
+    "GET / HTTP/1.1\r\nLink: /path/to/some/website\r\n\r\n";
+;;
+
+let test_parse_invalid_errors () =
+  check
+    "doesn't end"
+    ~expect:(Error ": not enough input")
+    "GET / HTTP/1.1\r\n";
+  check
+    "invalid version"
+    ~expect:(Error "eol: string")
+    "GET / HTTP/1.22\r\n\r\n";
+  check
+    "malformed header"
+    ~expect:(Error "header: char ':'")
+    "GET / HTTP/1.1\r\nLink : /path/to/some/website\r\n\r\n";
+;;
+
+let test_body_length () =
+  let check message request ~expect =
+    let actual = Request.body_length request in
+    Alcotest.check body_length message expect actual
+  in
+  let req method_ headers = Request.create method_ ~headers "/" in
+  check
+    "no headers"
+    ~expect:(`Fixed 0L)
+    (req `GET Headers.empty);
+  check
+    "single fixed"
+    ~expect:(`Fixed 10L)
+    (req `GET Headers.(encoding_fixed 10));
+  check
+    "negative fixed"
+    ~expect:(`Error `Bad_request)
+    (req `GET Headers.(encoding_fixed (-10)));
+  check
+    "multiple fixed"
+    ~expect:(`Error `Bad_request)
+    (req `GET Headers.(encoding_fixed 10 @ encoding_fixed 20));
+  check
+    "chunked"
+    ~expect:`Chunked
+    (req `GET Headers.encoding_chunked);
+  check
+    "chunked multiple times"
+    ~expect:`Chunked
+    (req `GET Headers.(encoding_chunked @ encoding_chunked));
+  let encoding_gzip = Headers.of_list ["transfer-encoding", "gzip"] in
+  check
+    "non-chunked transfer-encoding"
+    ~expect:(`Error `Bad_request)
+    (req `GET encoding_gzip);
+  check
+    "chunked after non-chunked"
+    ~expect:`Chunked
+    (req `GET Headers.(encoding_gzip @ encoding_chunked));
+  check
+    "chunked before non-chunked"
+    ~expect:(`Error `Bad_request)
+    (req `GET Headers.(encoding_chunked @ encoding_gzip));
+  check
+    "chunked case-insensitive"
+    ~expect:`Chunked
+    (req `GET Headers.(of_list ["transfer-encoding", "CHUNKED"]));
+;;
+
+
+let tests =
+  [ "parse valid"         , `Quick, test_parse_valid
+  ; "parse invalid errors", `Quick, test_parse_invalid_errors
+  ; "body length",          `Quick, test_body_length
+  ]

unikernel/duniverse/httpun/lib_test/test_response.ml

@@ -0,0 +1,115 @@
+open Httpun
+open Response
+open Helpers
+
+let body_length = Alcotest.of_pp Response.Body_length.pp_hum
+
+let check =
+  let alco =
+    Alcotest.result
+      (Alcotest.of_pp pp_hum)
+      Alcotest.string
+  in
+  fun message ~expect input ->
+    let actual =
+      Angstrom.parse_string ~consume:All Httpun_private.Parse.response input
+    in
+    Alcotest.check alco message expect actual
+;;
+
+let test_parse_valid () =
+  check
+    "OK response without headers"
+    ~expect:(Ok (Response.create `OK))
+    "HTTP/1.1 200 OK\r\n\r\n";
+;;
+
+let test_parse_invalid_error () =
+  check
+    "OK response without a status message"
+    ~expect:(Error ": char ' '")
+    "HTTP/1.1 200\r\n\r\n";
+  check
+    "OK response without a status message"
+    ~expect:(Error ": status-code empty")
+    "HTTP/1.1 OK\r\n\r\n";
+  check
+    "OK response without a status message"
+    ~expect:(Error ": status-code too long: \"999999937377999999999200\"")
+    "HTTP/1.1 999999937377999999999200\r\n\r\n";
+;;
+
+let test_body_length () =
+  let check message request_method response ~expect =
+    let actual = Response.body_length response ~request_method in
+    Alcotest.check body_length message expect actual
+  in
+  let res status headers = Response.create status ~headers in
+  check
+    "requested HEAD"
+    ~expect:(`Fixed 0L)
+    `HEAD (res `OK Headers.empty);
+  check
+    "requested CONNECT"
+    ~expect:(`Close_delimited)
+    `CONNECT (res `OK Headers.empty);
+  check
+    "status: informational"
+    ~expect:(`Fixed 0L)
+    `GET (res `Continue Headers.empty);
+  check
+    "status: no content"
+    ~expect:(`Fixed 0L)
+    `GET (res `No_content Headers.empty);
+  check
+    "status: not modified"
+    ~expect:(`Fixed 0L)
+    `GET (res `Not_modified Headers.empty);
+  check
+    "no header"
+    ~expect:(`Close_delimited)
+    `GET (res `OK Headers.empty);
+  check
+    "single fixed"
+    ~expect:(`Fixed 10L)
+    `GET (res `OK Headers.(encoding_fixed 10));
+  check
+    "negative fixed"
+    ~expect:(`Error `Internal_server_error)
+    `GET (res `OK Headers.(encoding_fixed (-10)));
+  check
+    "multiple fixed"
+    ~expect:(`Error `Internal_server_error)
+    `GET (res `OK Headers.(encoding_fixed 10 @ encoding_fixed 20));
+  check
+    "chunked"
+    ~expect:`Chunked
+    `GET (res `OK Headers.encoding_chunked);
+  check
+    "chunked multiple times"
+    ~expect:`Chunked
+    `GET (res `OK Headers.(encoding_chunked @ encoding_chunked));
+  let encoding_gzip = Headers.of_list ["transfer-encoding", "gzip"] in
+  check
+    "non-chunked transfer-encoding"
+    ~expect:`Close_delimited
+    `GET (res `OK encoding_gzip);
+  check
+    "chunked after non-chunked"
+    ~expect:`Chunked
+    `GET (res `OK Headers.(encoding_gzip @ encoding_chunked));
+  check
+    "chunked before non-chunked"
+    ~expect:`Close_delimited
+    `GET (res `OK Headers.(encoding_chunked @ encoding_gzip));
+  check
+    "chunked case-insensitive"
+    ~expect:`Chunked
+    `GET (res `OK Headers.(of_list ["transfer-encoding", "CHUNKED"]));
+;;
+
+let tests =
+  [ "parse valid"        , `Quick, test_parse_valid
+  ; "parse invalid error", `Quick, test_parse_invalid_error
+  ; "body length"        , `Quick, test_body_length
+  ]

unikernel/duniverse/httpun/lib_test/test_version.ml

@@ -0,0 +1,22 @@
+open Httpun
+open Version
+
+let v1_0 = { major = 1; minor = 0 }
+let v1_1 = { major = 1; minor = 1 }
+
+let test_compare () =
+  Alcotest.(check int) "compare v1_1 v1_0" (compare v1_1 v1_0) 1;
+  Alcotest.(check int) "compare v1_1 v1_1" (compare v1_1 v1_1) 0;
+  Alcotest.(check int) "compare v1_0 v1_0" (compare v1_0 v1_0) 0;
+  Alcotest.(check int) "compare v1_0 v1_1" (compare v1_0 v1_1) (-1);
+;;
+
+let test_to_string () =
+  Alcotest.(check string) "to_string v1_1" (to_string v1_1) "HTTP/1.1";
+  Alcotest.(check string) "to_string v1_0" (to_string v1_0) "HTTP/1.0";
+;;
+
+let tests =
+  [ "compare"  , `Quick, test_compare
+  ; "to_string", `Quick, test_to_string
+  ]