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
    ]
