unikernel/duniverse/ocaml-h2/lib_test/dune

@@ -0,0 +1,22 @@
+(tests
+ (libraries bigstringaf h2 alcotest test_common)
+ (modules test_h2 test_h2_client test_h2_server test_priority)
+ (names test_h2 test_h2_client test_h2_server test_priority))
+
+(library
+ (name test_common)
+ (libraries base64 bigstringaf hex h2 alcotest)
+ (modules test_common))
+
+(executable
+ (name test_frames)
+ (libraries h2 alcotest yojson hex angstrom test_common)
+ (modules test_frames))
+
+(rule
+ (alias runtest)
+ (deps
+  (:test_exe test_frames.exe)
+  (source_tree "http2-frame-test-case/"))
+ (action
+  (run %{test_exe})))

unikernel/duniverse/ocaml-h2/lib_test/test_common.ml

@@ -0,0 +1,122 @@
+open H2__
+
+module Option = struct
+  let get = function Some x -> x | None -> failwith "Option.get: None"
+  let map f = function Some x -> Some (f x) | None -> None
+end
+
+let read_all path =
+  let file = open_in path in
+  try really_input_string file (in_channel_length file) with
+  | exn ->
+    close_in file;
+    raise exn
+
+let bs_to_string bs =
+  let off = 0 in
+  let len = Bigstringaf.length bs in
+  Bigstringaf.substring ~off ~len bs
+
+let bs_of_string s = Bigstringaf.of_string ~off:0 ~len:(String.length s) s
+let string_of_hex s = Hex.to_string (`Hex s)
+
+let hex_of_string s =
+  let (`Hex hex) = Hex.of_string s in
+  String.uppercase_ascii hex
+
+let make_iovecs bs =
+  [ { Httpun_types.IOVec.buffer = bs; off = 0; len = Bigstringaf.length bs } ]
+
+let write_frame ?padding t { Frame.frame_header; frame_payload } =
+  let open Serialize in
+  let { Frame.flags; stream_id; _ } = frame_header in
+  let info = Writer.make_frame_info ~flags ?padding stream_id in
+  match frame_payload with
+  | Data body -> Writer.schedule_data t info body
+  | Headers (priority, headers_block) ->
+    (* Block already HPACK-encoded. *)
+    write_headers_frame t.encoder info ~priority (make_iovecs headers_block)
+  | Priority p -> Writer.write_priority t info p
+  | RSTStream e -> Writer.write_rst_stream t info e
+  | Settings settings -> Writer.write_settings t info settings
+  | PushPromise (promised_id, header_block) ->
+    write_push_promise_frame
+      t.encoder
+      info
+      ~promised_id
+      (make_iovecs header_block)
+  | Ping payload -> Writer.write_ping t info payload
+  | GoAway (last_stream_id, error, debug_data) ->
+    Writer.write_go_away t info ~debug_data ~last_stream_id error
+  | WindowUpdate window_size -> Writer.write_window_update t info window_size
+  | Continuation header_block ->
+    write_continuation_frame t.encoder info (make_iovecs header_block)
+  | Unknown (code, payload) -> write_unknown_frame t.encoder ~code info payload
+
+let serialize_frame ?padding frame =
+  let open Serialize in
+  let { Frame.payload_length; _ } = frame.Frame.frame_header in
+  let writer = Writer.create payload_length in
+  write_frame ?padding writer frame;
+  Faraday.serialize_to_bigstring (Writer.faraday writer)
+
+let serialize_frame_string ?padding frame =
+  let bs = serialize_frame ?padding frame in
+  bs_to_string bs
+
+let opt_exn = function Some x -> x | None -> failwith "opt_exn: None"
+
+let encode_headers hpack_encoder headers =
+  let f = Faraday.create 0x1000 in
+  Serialize.Writer.encode_headers hpack_encoder f headers;
+  Faraday.serialize_to_bigstring f
+
+let decode_headers decoder bigstring =
+  let parser = Angstrom.Buffered.parse (Hpack.Decoder.decode_headers decoder) in
+  let state = Angstrom.Buffered.feed parser (`Bigstring bigstring) in
+  let state' = Angstrom.Buffered.feed state `Eof in
+  match Angstrom.Buffered.state_to_option state' with
+  | Some (Ok headers) -> headers
+  | Some _ | None -> assert false
+
+let preface =
+  let writer = Serialize.Writer.create 0x400 in
+  Serialize.Writer.write_connection_preface writer [];
+  Faraday.serialize_to_string (Serialize.Writer.faraday writer)
+
+let handle_preface t =
+  let open Parse in
+  let preface_len = String.length preface in
+  ignore
+  @@ Reader.read_with_more
+       t
+       (bs_of_string preface)
+       ~off:0
+       ~len:preface_len
+       Incomplete
+
+let parse_frames_bigstring wire =
+  let open Parse in
+  let frames = ref [] in
+  let handler = function
+    | Ok frame -> frames := frame :: !frames
+    | _ -> Alcotest.fail "Expected frame to parse successfully."
+  in
+  let reader =
+    Reader.server_frames
+      ~max_frame_size:H2.Settings.default.max_frame_size
+      (fun _ -> ignore)
+      handler
+  in
+  handle_preface reader;
+  let _read =
+    Reader.read_with_more
+      reader
+      wire
+      ~off:0
+      ~len:(Bigstringaf.length wire)
+      Incomplete
+  in
+  List.rev !frames
+
+let parse_frames wire = parse_frames_bigstring (bs_of_string wire)

unikernel/duniverse/ocaml-h2/lib_test/test_frames.ml

@@ -0,0 +1,339 @@
+open H2__
+open Test_common
+module Json = Yojson.Basic.Util
+
+let fixtures_dir = "http2-frame-test-case"
+
+let success_fixtures, error_fixtures =
+  fixtures_dir
+  |> Sys.readdir
+  |> Array.to_list
+  |> List.map (fun dir -> dir, Filename.concat fixtures_dir dir)
+  |> List.filter (fun (_, dir) -> Sys.is_directory dir)
+  |> List.map (fun (dir, fullpath) ->
+    let files_in_dir =
+      fullpath
+      |> Sys.readdir
+      |> Array.to_list
+      |> List.map (fun file -> Filename.concat fullpath file)
+      |> List.filter (fun file ->
+        (not (Sys.is_directory file)) && Filename.extension file = ".json")
+    in
+    dir, files_in_dir)
+  |> List.partition (fun (dir, _) -> dir <> "error")
+
+module P = struct
+  open Parse
+
+  let parse_fn wire success_handler error_handler =
+    let handler = function
+      | Ok frame -> success_handler frame
+      | Error e -> error_handler e
+    in
+    let reader =
+      Reader.server_frames
+        ~max_frame_size:Settings.default.max_frame_size
+        (fun _ -> ignore)
+        handler
+    in
+    handle_preface reader;
+    let wire_bs = wire |> string_of_hex |> bs_of_string in
+    let _read =
+      Reader.read_with_more
+        reader
+        wire_bs
+        ~off:0
+        ~len:(Bigstringaf.length wire_bs)
+        Incomplete
+    in
+    reader
+
+  let parse_success wire handler =
+    let reader =
+      parse_fn wire handler (fun _ ->
+        Alcotest.(fail "Expected to have thrown an error parsing frame."))
+    in
+    match Reader.next reader with
+    | `Read -> ()
+    | `Close | `Error _ ->
+      Alcotest.(fail "Expected to have sucessfully parsed frame.")
+
+  let parse_error wire handler =
+    let reader =
+      parse_fn
+        wire
+        (fun _ ->
+           Alcotest.(fail "Expected to have thrown an error parsing frame."))
+        handler
+    in
+    match Reader.next reader with
+    | `Read -> ()
+    | `Close ->
+      Alcotest.(fail "Expected to have thrown an error parsing frame.")
+    | `Error e -> handler e
+
+  let serialize ?padding frame =
+    let output = Test_common.serialize_frame_string ?padding frame in
+    hex_of_string output
+end
+
+let frame_testable =
+  (module struct
+    type t = Frame.t
+
+    let priority_to_yojson priority =
+      if priority != Priority.default_priority
+      then
+        let { Priority.exclusive; stream_dependency; weight } = priority in
+        [ "stream_dependency", `Int (Int32.to_int stream_dependency)
+        ; "weight", `Int weight
+        ; "exclusive", `Bool exclusive
+        ]
+      else [ "stream_dependency", `Null; "weight", `Null; "exclusive", `Null ]
+
+    let bs_to_string bs =
+      let off = 0 in
+      let len = Bigstringaf.length bs in
+      Bigstringaf.substring ~off ~len bs
+
+    let frame_payload_to_json frame_type payload =
+      let others =
+        match payload with
+        | Frame.Data data -> [ "data", `String (bs_to_string data) ]
+        | Headers (priority, fragment) ->
+          ("header_block_fragment", `String (bs_to_string fragment))
+          :: priority_to_yojson priority
+        | Priority priority -> priority_to_yojson priority
+        | RSTStream error_code ->
+          [ "error_code", `Int (Error_code.serialize error_code |> Int32.to_int)
+          ]
+        | Settings settings_list ->
+          [ ( "settings"
+            , `List
+                (List.map
+                   (fun setting ->
+                      `List
+                        [ `Int (Settings.serialize_key setting)
+                        ; `Int
+                            (match setting with
+                            | MaxConcurrentStreams value
+                            | InitialWindowSize value ->
+                              Int32.to_int value
+                            | HeaderTableSize value
+                            | EnablePush value
+                            | MaxFrameSize value
+                            | MaxHeaderListSize value ->
+                              value)
+                        ])
+                   settings_list) )
+          ]
+        | PushPromise (stream_identifier, fragment) ->
+          [ "header_block_fragment", `String (bs_to_string fragment)
+          ; "promised_stream_id", `Int (Int32.to_int stream_identifier)
+          ]
+        | Ping data -> [ "opaque_data", `String (bs_to_string data) ]
+        | GoAway (stream_identifier, error_code, debug_data) ->
+          [ "error_code", `Int (Error_code.serialize error_code |> Int32.to_int)
+          ; "additional_debug_data", `String (bs_to_string debug_data)
+          ; "last_stream_id", `Int (Int32.to_int stream_identifier)
+          ]
+        | WindowUpdate increment ->
+          [ "window_size_increment", `Int (Int32.to_int increment) ]
+        | Continuation fragment ->
+          [ "header_block_fragment", `String (bs_to_string fragment) ]
+        | Unknown (_frame_type, _) -> assert false
+      in
+      `Assoc (("type", `Int (Frame.FrameType.serialize frame_type)) :: others)
+
+    let frame_to_yojson { Frame.frame_header; frame_payload } =
+      let { Frame.payload_length; flags; stream_id; frame_type } =
+        frame_header
+      in
+      `Assoc
+        [ "length", `Int payload_length
+        ; "flags", `Int flags
+        ; "stream_identifier", `Int (Int32.to_int stream_id)
+        ; "frame_payload", frame_payload_to_json frame_type frame_payload
+        ]
+
+    let pp formatter t =
+      Format.pp_print_text
+        formatter
+        (t |> frame_to_yojson |> Yojson.Safe.pretty_to_string)
+
+    let equal = ( = )
+  end : Alcotest.TESTABLE
+    with type t = Frame.t)
+
+let priority_of_json json =
+  let stream_dependency =
+    Json.(json |> member "stream_dependency" |> to_int_option)
+  in
+  let weight = Json.(json |> member "weight" |> to_int_option) in
+  let exclusive = Json.(json |> member "exclusive" |> to_bool_option) in
+  match stream_dependency, weight, exclusive with
+  | Some stream_dependency, Some weight, Some exclusive ->
+    { Priority.exclusive
+    ; stream_dependency = Int32.of_int stream_dependency
+    ; weight
+    }
+  | _ -> Priority.default_priority
+
+let frame_type_of_string = function
+  | "data" -> Frame.FrameType.Data
+  | "headers" -> Headers
+  | "priority" -> Priority
+  | "rst_stream" -> RSTStream
+  | "settings" -> Settings
+  | "push_promise" -> PushPromise
+  | "ping" -> Ping
+  | "goaway" -> GoAway
+  | "window_update" -> WindowUpdate
+  | "continuation" -> Continuation
+  | _ -> assert false
+
+let frame_payload_of_json frame_type json =
+  match frame_type with
+  | Frame.FrameType.Data ->
+    Frame.Data Json.(json |> member "data" |> to_string |> bs_of_string)
+  | Headers ->
+    let priority = priority_of_json json in
+    let fragment =
+      Json.(json |> member "header_block_fragment" |> to_string |> bs_of_string)
+    in
+    Headers (priority, fragment)
+  | Priority -> Priority (priority_of_json json)
+  | RSTStream ->
+    let error_code =
+      Json.(json |> member "error_code" |> to_int |> Int32.of_int)
+    in
+    RSTStream (Error_code.parse error_code)
+  | Settings ->
+    let settings =
+      List.map
+        (fun setting_json ->
+           let setting = Json.to_list setting_json in
+           let key_value = List.nth setting 1 |> Json.to_int in
+           match Json.to_int (List.hd setting) with
+           | 0x1 -> Settings.HeaderTableSize key_value
+           | 0x2 -> EnablePush key_value
+           | 0x3 -> MaxConcurrentStreams (Int32.of_int key_value)
+           | 0x4 -> InitialWindowSize (Int32.of_int key_value)
+           | 0x5 -> MaxFrameSize key_value
+           | 0x6 -> MaxHeaderListSize key_value
+           | _ -> raise (Invalid_argument "settings key id"))
+        Json.(json |> member "settings" |> to_list)
+    in
+    Settings settings
+  | PushPromise ->
+    let fragment =
+      Json.(json |> member "header_block_fragment" |> to_string |> bs_of_string)
+    in
+    let promised_stream_id =
+      Json.(json |> member "promised_stream_id" |> to_int |> Int32.of_int)
+    in
+    PushPromise (promised_stream_id, fragment)
+  | Ping ->
+    let opaque_data =
+      Json.(json |> member "opaque_data" |> to_string |> bs_of_string)
+    in
+    Ping opaque_data
+  | GoAway ->
+    let error_code =
+      Json.(json |> member "error_code" |> to_int |> Int32.of_int)
+    in
+    let last_stream_id =
+      Json.(json |> member "last_stream_id" |> to_int |> Int32.of_int)
+    in
+    let debug_data =
+      Json.(json |> member "additional_debug_data" |> to_string |> bs_of_string)
+    in
+    GoAway (last_stream_id, Error_code.parse error_code, debug_data)
+  | WindowUpdate ->
+    let window_size_increment =
+      Json.(json |> member "window_size_increment" |> to_int) |> Int32.of_int
+    in
+    WindowUpdate window_size_increment
+  | Continuation ->
+    let fragment =
+      Json.(json |> member "header_block_fragment" |> to_string |> bs_of_string)
+    in
+    Continuation fragment
+  | Unknown _ -> assert false
+
+let success_suites =
+  let gen_suite ~frame_type filename =
+    let fixture = read_all filename |> Yojson.Basic.from_string in
+    let test_case_name = Json.(fixture |> member "description" |> to_string) in
+    ( Printf.sprintf "%s: %s" filename test_case_name
+    , `Quick
+    , fun () ->
+        let expected_frame_json = Json.(member "frame" fixture) in
+        let frame_payload_json =
+          Json.(expected_frame_json |> member "frame_payload")
+        in
+        let frame_type = frame_type_of_string frame_type in
+        let expected_frame =
+          { Frame.frame_header =
+              { payload_length =
+                  Json.(expected_frame_json |> member "length" |> to_int)
+              ; flags = Json.(expected_frame_json |> member "flags" |> to_int)
+              ; stream_id =
+                  Json.(
+                    expected_frame_json
+                    |> member "stream_identifier"
+                    |> to_int
+                    |> Int32.of_int)
+              ; frame_type
+              }
+          ; frame_payload = frame_payload_of_json frame_type frame_payload_json
+          }
+        in
+        let wire = Json.(fixture |> member "wire" |> to_string) in
+        P.parse_success wire (fun frame ->
+          Alcotest.check frame_testable "Frames are equal" expected_frame frame;
+          let padding =
+            match
+              Json.(frame_payload_json |> member "padding" |> to_string_option)
+            with
+            | Some padding ->
+              Some
+                Bigstringaf.(
+                  of_string ~off:0 ~len:(String.length padding) padding)
+            | None -> None
+          in
+          let serialized_wire = P.serialize ?padding frame in
+          Alcotest.(
+            check string "Parse / Serialize roundtripping" wire serialized_wire))
+    )
+  in
+  List.map
+    (fun (name, files) ->
+       let suite_name = Printf.sprintf "%s frame" name in
+       suite_name, List.map (gen_suite ~frame_type:name) files)
+    success_fixtures
+
+let error_suites =
+  let gen_suite filename =
+    let fixture = read_all filename |> Yojson.Basic.from_string in
+    let test_case_name = Json.(fixture |> member "description" |> to_string) in
+    ( Printf.sprintf "%s: %s" filename test_case_name
+    , `Quick
+    , fun () ->
+        let possible_errors = Json.(member "error" fixture |> to_list) in
+        let expected_error =
+          possible_errors |> List.hd |> Json.to_int |> Int32.of_int
+        in
+        let wire = Json.(fixture |> member "wire" |> to_string) in
+        P.parse_error wire (function
+            | Error.ConnectionError (e, _) | Error.StreamError (_, e) ->
+            Alcotest.(check int32)
+              "Expected Error Code"
+              expected_error
+              (Error_code.serialize e)) )
+  in
+  List.map
+    (fun (_, files) -> "Error tests", List.map gen_suite files)
+    error_fixtures
+
+let () = Alcotest.run "lambda-runtime" (success_suites @ error_suites)

unikernel/duniverse/ocaml-h2/lib_test/test_h2.ml

@@ -0,0 +1,161 @@
+open H2
+
+module Headers_tests = struct
+  let check = Alcotest.(check (list (pair string string)))
+
+  let test_headers_roundtrip_ordering () =
+    let headers_list = [ "a", "1"; "b", "2"; "c", "3" ] in
+    check
+      "to_list / of_list"
+      Headers.(to_list (of_list headers_list))
+      headers_list;
+    Alcotest.(check (option string))
+      "get / of_list"
+      Headers.(get (of_list [ "k", "v1"; "k", "v2" ]) "k")
+      (Some "v2");
+    Alcotest.(check (option string))
+      "get / of_rev_list"
+      Headers.(get (of_rev_list [ "k", "v1"; "k", "v2" ]) "k")
+      (Some "v1");
+    let headers = Headers.(add_list empty headers_list) in
+    Alcotest.(check (option string))
+      "add / get"
+      Headers.(get (add headers "foo" "bar") "foo")
+      (Some "bar");
+    let hs = Headers.(add (add empty "foo" "bar") "foo" "other") in
+    Alcotest.(check (option string))
+      "add / get"
+      Headers.(get hs "foo")
+      (Some "other")
+
+  let test_remove () =
+    check
+      "remove leading element"
+      [ "c", "d" ]
+      (Headers.remove (Headers.of_list [ "a", "b"; "c", "d" ]) "a"
+      |> Headers.to_list);
+    check
+      "remove trailing element"
+      [ "c", "d" ]
+      (Headers.remove (Headers.of_list [ "c", "d"; "a", "b" ]) "a"
+      |> Headers.to_list);
+    check
+      "remove trailing element"
+      [ "c", "d"; "e", "f" ]
+      (Headers.remove (Headers.of_list [ "c", "d"; "e", "f"; "a", "b" ]) "a"
+      |> Headers.to_list);
+    check
+      "remove trailing element"
+      [ "c", "d"; "e", "f"; "g", "h" ]
+      (Headers.remove
+         (Headers.of_list [ "c", "d"; "e", "f"; "a", "b"; "g", "h" ])
+         "a"
+      |> Headers.to_list)
+
+  let test_replace () =
+    check
+      "replace leading element"
+      [ "a", "x"; "c", "d" ]
+      (Headers.replace (Headers.of_list [ "a", "b"; "c", "d" ]) "a" "x"
+      |> Headers.to_list);
+    check
+      "replace trailing element"
+      [ "c", "d"; "a", "x" ]
+      (Headers.replace (Headers.of_list [ "c", "d"; "a", "b" ]) "a" "x"
+      |> Headers.to_list);
+    check
+      "replace trailing element"
+      [ "c", "d"; "e", "f"; "a", "x" ]
+      (Headers.replace
+         (Headers.of_list [ "c", "d"; "e", "f"; "a", "b" ])
+         "a"
+         "x"
+      |> Headers.to_list);
+    check
+      "replace trailing element"
+      [ "c", "d"; "e", "f"; "a", "x"; "g", "h" ]
+      (Headers.replace
+         (Headers.of_list [ "c", "d"; "e", "f"; "a", "b"; "g", "h" ])
+         "a"
+         "x"
+      |> Headers.to_list);
+    check
+      "replace middle element"
+      [ "e", "f"; "c", "z"; "a", "b" ]
+      (Headers.replace
+         (Headers.of_list [ "e", "f"; "c", "d"; "a", "b" ])
+         "c"
+         "z"
+      |> Headers.to_list)
+
+  let suite =
+    [ "roundtripping", `Quick, test_headers_roundtrip_ordering
+    ; "test remove", `Quick, test_remove
+    ; "test replace", `Quick, test_replace
+    ]
+end
+
+module Body_length_tests = struct
+  let test_request () =
+    let content_length_request =
+      Request.create
+        ~headers:(Headers.of_list [ "content-length", "10" ])
+        ~scheme:"https"
+        `GET
+        "/"
+    in
+    let invalid_content_length_request =
+      Request.create
+        ~headers:(Headers.of_list [ "content-length", "NaN" ])
+        ~scheme:"https"
+        `GET
+        "/"
+    in
+    let no_content_length_request = Request.create ~scheme:"https" `GET "/" in
+    (match Request.body_length content_length_request with
+    | `Fixed 10L -> ()
+    | _ -> Alcotest.fail "Expected `Fixed 10L");
+    (match Request.body_length invalid_content_length_request with
+    | `Error `Bad_request -> ()
+    | _ -> Alcotest.fail "Expected `Error `Bad_request");
+    match Request.body_length no_content_length_request with
+    | `Unknown -> ()
+    | _ -> Alcotest.fail "Expected `Unknown"
+
+  let test_response () =
+    let content_length_response =
+      Response.create ~headers:(Headers.of_list [ "content-length", "10" ]) `OK
+    in
+    let invalid_content_length_response =
+      Response.create ~headers:(Headers.of_list [ "content-length", "NaN" ]) `OK
+    in
+    let no_content_length_response = Response.create `OK in
+    (match
+       Response.body_length ~request_method:`GET content_length_response
+     with
+    | `Fixed 10L -> ()
+    | _ -> Alcotest.fail "Expected `Fixed 10L");
+    (match
+       Response.body_length ~request_method:`HEAD content_length_response
+     with
+    | `Fixed 0L -> ()
+    | _ -> Alcotest.fail "Expected `Fixed 0L");
+    (match
+       Response.body_length ~request_method:`GET invalid_content_length_response
+     with
+    | `Error `Bad_request -> ()
+    | _ -> Alcotest.fail "Expected `Error `Bad_request");
+    match
+      Response.body_length ~request_method:`GET no_content_length_response
+    with
+    | `Unknown -> ()
+    | _ -> Alcotest.fail "Expected `Unknown"
+
+  let suite =
+    [ "request", `Quick, test_request; "response", `Quick, test_response ]
+end
+
+let () =
+  Alcotest.run
+    "ocaml-h2 unit tests"
+    [ "headers", Headers_tests.suite; "body lengths", Body_length_tests.suite ]

unikernel/duniverse/ocaml-h2/lib_test/test_priority.ml

@@ -0,0 +1,352 @@
+open H2__
+open Test_common
+module Scheduler = Server_connection.Scheduler
+
+let pp_priority fmt { Priority.weight; stream_dependency; exclusive } =
+  Format.fprintf
+    fmt
+    "Weight: %d; Parent: %ld; Exclusive: %B"
+    weight
+    stream_dependency
+    exclusive
+
+let priority = Alcotest.of_pp pp_priority
+
+let node =
+  (module struct
+    open Scheduler.PriorityTreeNode
+
+    type t = parent
+
+    let pp formatter (Parent t) =
+      Format.pp_print_text formatter (Scheduler.stream_id t |> Int32.to_string)
+
+    let equal (Parent h1) (Parent h2) =
+      Stream_identifier.(Scheduler.(stream_id h1) === Scheduler.(stream_id h2))
+  end : Alcotest.TESTABLE
+    with type t = Scheduler.PriorityTreeNode.parent)
+
+let default_error_handler ?request:_ _err _handle = ()
+let new_p w = { Priority.exclusive = false; stream_dependency = 0l; weight = w }
+
+let test_reqd stream_id =
+  Stream.create
+    ~max_frame_size:Config.default.read_buffer_size
+    stream_id
+    Serialize.Writer.(create 0x400)
+    default_error_handler
+    (fun ~active:_ _ -> ())
+
+let repeat (Scheduler.PriorityTreeNode.Connection root) queue num =
+  let rec loop q n acc =
+    if n = 0
+    then acc
+    else
+      match Scheduler.PriorityQueue.pop q with
+      | None -> failwith "invalid queue"
+      | Some ((k, (Scheduler.Stream p as p_node)), q') ->
+        (* simulate writing 100 bytes *)
+        root.t_last <- p.t;
+        Scheduler.update_t p_node 100;
+        loop (Scheduler.PriorityQueue.add k p_node q') (n - 1) (k :: acc)
+  in
+  loop queue num []
+
+let add_stream root ?(priority = Priority.default_priority) reqd =
+  ignore
+  @@ Scheduler.add
+       root
+       ~priority
+       ~initial_recv_window_size:Settings.WindowSize.default_initial_window_size
+       ~initial_send_window_size:Settings.WindowSize.default_initial_window_size
+       reqd
+
+let test_priority_queue () =
+  let root = Scheduler.make_root ~capacity:1000 () in
+  add_stream root ~priority:(new_p 201) (test_reqd 1l);
+  add_stream root ~priority:(new_p 101) (test_reqd 3l);
+  add_stream root ~priority:(new_p 1) (test_reqd 5l);
+  let q = Scheduler.children root in
+  Alcotest.(check bool)
+    "Check if empty"
+    false
+    (Scheduler.PriorityQueue.is_empty q);
+  let t = repeat root q 1000 in
+  let count_1 = List.filter (fun x -> x = 1l) t |> List.length in
+  let count_3 = List.filter (fun x -> x = 3l) t |> List.length in
+  let count_5 = List.filter (fun x -> x = 5l) t |> List.length in
+  (* After multiple repetitions, the frequency of 1, 3 and 5 is proportional to
+   * their weight, e.g. 101 * 1000 / 303 *)
+  Alcotest.(check int) "Number of items with weight 201" 663 count_1;
+  Alcotest.(check int) "Number of items with weight 101" 333 count_3;
+  Alcotest.(check int) "Number of items with weight 1" 4 count_5
+
+let test_reprioritize () =
+  let open Scheduler in
+  let root = Scheduler.make_root ~capacity:5 () in
+  add_stream root (test_reqd 1l);
+  add_stream root (test_reqd 3l);
+  add_stream root (test_reqd 5l);
+  (* change the weight of stream 1 *)
+  let new_priority = { Priority.default_priority with weight = 100 } in
+  let (Stream stream1 as stream1_node) =
+    Scheduler.get_node root 1l |> opt_exn
+  in
+  Scheduler.reprioritize_stream root ~priority:new_priority stream1_node;
+  Alcotest.check
+    priority
+    "Stream 1 changed weight"
+    new_priority
+    stream1.priority;
+  let (Stream stream3) = Scheduler.get_node root 3l |> opt_exn in
+  Alcotest.check
+    priority
+    "Stream 3 still has default weight"
+    Priority.default_priority
+    stream3.priority;
+  (* Add stream 7 that depends on 1 *)
+  let stream7 = test_reqd 7l in
+  let stream7_priority =
+    { Priority.default_priority with stream_dependency = 1l }
+  in
+  add_stream root ~priority:stream7_priority stream7;
+  let (Stream stream7) = Scheduler.get_node root 7l |> opt_exn in
+  Alcotest.check
+    priority
+    "Stream 7 depends on stream 1"
+    stream7_priority
+    stream7.priority;
+  Alcotest.check
+    node
+    "Stream 7 depends on stream 1"
+    (Parent stream1_node)
+    stream7.parent;
+  let _, Stream stream1_first_child =
+    stream1.children |> PriorityQueue.to_list |> List.hd
+  in
+  Alcotest.(check bool)
+    "Stream 1 has stream 7 in its children"
+    false
+    (PriorityQueue.is_empty stream1.children);
+  Alcotest.(check int32)
+    "Stream 1 has stream 7 in its children"
+    7l
+    stream1_first_child.descriptor.id;
+  Alcotest.(check int)
+    "Root still has 3 children"
+    3
+    (PriorityQueue.size (Scheduler.children root))
+
+let test_reprioritize_exclusive () =
+  let open Scheduler in
+  let root = Scheduler.make_root ~capacity:5 () in
+  add_stream root (test_reqd 1l);
+  add_stream root (test_reqd 3l);
+  add_stream root (test_reqd 5l);
+  (* Add stream 7 that exclusively depends on 0 *)
+  let stream7 = test_reqd 7l in
+  let stream7_priority =
+    { Priority.default_priority with stream_dependency = 0l; exclusive = true }
+  in
+  add_stream root ~priority:stream7_priority stream7;
+  let (Stream stream7 as stream7_node) =
+    Scheduler.get_node root 7l |> opt_exn
+  in
+  Alcotest.check
+    priority
+    "Stream 7 depends on stream 0"
+    stream7_priority
+    stream7.priority;
+  Alcotest.check
+    node
+    "Stream 7 depends on stream 0"
+    (Parent root)
+    stream7.parent;
+  let root_children = Scheduler.children root |> PriorityQueue.to_list in
+  let _, Stream root_first_child = List.hd root_children in
+  Alcotest.(check int32)
+    "Stream 0 has a single child, stream 7"
+    7l
+    root_first_child.descriptor.id;
+  Alcotest.(check int)
+    "Stream 0 has a single child, stream 7"
+    1
+    (List.length root_children);
+  let (Stream stream1) = Scheduler.get_node root 1l |> opt_exn in
+  Alcotest.check
+    node
+    "Stream 1's parent is now stream 7"
+    (Parent stream7_node)
+    stream1.parent;
+  Alcotest.(check int)
+    "Stream 7 has 3 children"
+    3
+    (PriorityQueue.size stream7.children)
+
+let depend_on stream_id =
+  { Priority.default_priority with stream_dependency = stream_id }
+
+let set_up_dep_tree root =
+  add_stream root (test_reqd 1l);
+  add_stream root ~priority:(depend_on 1l) (test_reqd 3l);
+  add_stream root ~priority:(depend_on 1l) (test_reqd 5l);
+  add_stream root ~priority:(depend_on 5l) (test_reqd 7l);
+  add_stream root ~priority:(depend_on 5l) (test_reqd 9l);
+  add_stream root ~priority:(depend_on 7l) (test_reqd 11l)
+
+(*
+   * This is the tree from: https://tools.ietf.org/html/rfc7540#section-5.3.3
+ *
+ *          1 --> 7
+ *    0                0
+ *    |                |
+ *    1                7
+ *   / \              / \
+ *  3   5     ==>    11  1
+ *     / \              / \
+ *    7   9            3   5
+ *    |                    |
+ *    11                   9
+ *
+ *                (non-exclusive)
+ *)
+let test_reprioritize_to_dependency () =
+  let open Scheduler in
+  let root = Scheduler.make_root ~capacity:6 () in
+  set_up_dep_tree root;
+  let (Stream stream1 as stream1_node) =
+    Scheduler.get_node root 1l |> opt_exn
+  in
+  let stream5_node = Scheduler.get_node root 5l |> opt_exn in
+  let (Stream stream7 as stream7_node) =
+    Scheduler.get_node root 7l |> opt_exn
+  in
+  Alcotest.check
+    node
+    "Stream 7 depends on stream 5"
+    (Parent stream5_node)
+    stream7.parent;
+  let root_children = Scheduler.children root |> PriorityQueue.to_list in
+  let _, Stream root_first_child = List.hd root_children in
+  Alcotest.(check int32)
+    "Stream 0 has a single child, stream 1"
+    1l
+    root_first_child.descriptor.id;
+  Alcotest.(check int)
+    "Stream 0 has a single child, stream 7"
+    1
+    (List.length root_children);
+  (* reprioritize stream 1 to have 7 as the new parent *)
+  reprioritize_stream root ~priority:(depend_on 7l) stream1_node;
+  Alcotest.check
+    node
+    "Stream 1's parent is now stream 7"
+    (Parent stream7_node)
+    stream1.parent;
+  Alcotest.check
+    node
+    "Stream 7's parent is now stream 0"
+    (Parent root)
+    stream7.parent;
+  Alcotest.(check int)
+    "Stream 7 has 2 children"
+    2
+    (PriorityQueue.size stream7.children);
+  Alcotest.(check (list int32))
+    "Stream 7 has 2 children, 11 and 1"
+    [ 1l; 11l ]
+    (stream7.children |> PriorityQueue.to_list |> List.map fst)
+
+(*
+   * This is the tree from: https://tools.ietf.org/html/rfc7540#section-5.3.3
+ *
+ *          1 --> 7
+ *    0                0
+ *    |                |
+ *    1                7
+ *   / \               |
+ *  3   5     ==>      1
+ *     / \            /|\
+ *    7   9          3 5 11
+ *    |                |
+ *    11               9
+ *
+ *                (exclusive)
+ *)
+let test_reprioritize_to_dependency_exclusive () =
+  let open Scheduler in
+  let root = Scheduler.make_root ~capacity:6 () in
+  set_up_dep_tree root;
+  let stream5_node = Scheduler.get_node root 5l |> opt_exn in
+  let (Stream stream7 as stream7_node) =
+    Scheduler.get_node root 7l |> opt_exn
+  in
+  Alcotest.check
+    node
+    "Stream 7 depends on stream 5"
+    (Parent stream5_node)
+    stream7.parent;
+  let root_children = Scheduler.children root |> PriorityQueue.to_list in
+  let _, Stream root_first_child = List.hd root_children in
+  Alcotest.(check int32)
+    "Stream 0 has a single child, stream 1"
+    1l
+    root_first_child.descriptor.id;
+  Alcotest.(check int)
+    "Stream 0 has a single child, stream 7"
+    1
+    (List.length root_children);
+  (* reprioritize stream 1 to have 7 as the new parent with exclusive
+     priority *)
+  let (Stream stream1 as stream1_node) =
+    Scheduler.get_node root 1l |> opt_exn
+  in
+  reprioritize_stream
+    root
+    ~priority:
+      { Priority.default_priority with
+        stream_dependency = 7l
+      ; exclusive = true
+      }
+    stream1_node;
+  Alcotest.check
+    node
+    "Stream 1's parent is now stream 7"
+    (Parent stream7_node)
+    stream1.parent;
+  Alcotest.check
+    node
+    "Stream 7's parent is now stream 0"
+    (Parent root)
+    stream7.parent;
+  Alcotest.(check int)
+    "Stream 7 has a single child"
+    1
+    (PriorityQueue.size stream7.children);
+  Alcotest.(check (list int32))
+    "Stream 7 has a single child 1"
+    [ 1l ]
+    (stream7.children |> PriorityQueue.to_list |> List.map fst);
+  Alcotest.(check (list int32))
+    "Stream 11 is now a child of stream 1"
+    [ 3l; 5l; 11l ]
+    (stream1.children |> PriorityQueue.to_list |> List.map fst)
+
+let priority_queue_tests =
+  [ "Priority queue tests", `Quick, test_priority_queue ]
+
+let reprioritization_tests =
+  [ "Reprioritize simple", `Quick, test_reprioritize
+  ; "Reprioritize simple exclusive", `Quick, test_reprioritize_exclusive
+  ; "Reprioritize to dependency", `Quick, test_reprioritize_to_dependency
+  ; ( "Reprioritize to dependency exclusive"
+    , `Quick
+    , test_reprioritize_to_dependency_exclusive )
+  ]
+
+let () =
+  Alcotest.run
+    "h2 unit tests"
+    [ "Reprioritization tests", reprioritization_tests
+    ; "Priority_Queue_Tests", priority_queue_tests
+    ]