hcs / test / test_hcs.ml

(** HCS Test Suite

    This test suite covers:
    - Codec module (identity, string codecs)
    - Stream module (sync and async streams)
    - Http module (request builder DSL)
    - Router module (path parsing, route matching)
    - Property-based tests using QCheck *)

open Alcotest

(* ================================================================== *)
(* Codec Tests *)
(* ================================================================== *)

module Test_codec = struct
  open Hcs.Codec

  let test_identity_codec_encode () =
    let encoder : Cstruct.t Identity_codec.encoder = Fun.id in
    let input = Cstruct.of_string "hello world" in
    match Identity_codec.encode encoder input with
    | Ok result ->
        check string "encode" "hello world" (Cstruct.to_string result)
    | Error e -> fail e

  let test_identity_codec_decode () =
    let decoder : Cstruct.t Identity_codec.decoder = fun cs -> Ok cs in
    let input = Cstruct.of_string "hello world" in
    match Identity_codec.decode decoder input with
    | Ok result ->
        check string "decode" "hello world" (Cstruct.to_string result)
    | Error e -> fail e

  let test_identity_codec_content_type () =
    check string "content_type" "application/octet-stream"
      Identity_codec.content_type

  let test_string_codec_encode () =
    let encoder : string String_codec.encoder = Fun.id in
    match String_codec.encode encoder "hello world" with
    | Ok result ->
        check string "encode" "hello world" (Cstruct.to_string result)
    | Error e -> fail e

  let test_string_codec_decode () =
    let decoder : string String_codec.decoder = fun s -> Ok s in
    let input = Cstruct.of_string "hello world" in
    match String_codec.decode decoder input with
    | Ok result -> check string "decode" "hello world" result
    | Error e -> fail e

  let test_string_codec_content_type () =
    check string "content_type" "text/plain; charset=utf-8"
      String_codec.content_type

  let test_codec_error_to_string () =
    check string "encode_error" "Encode error: test"
      (codec_error_to_string (Encode_error "test"));
    check string "decode_error" "Decode error: test"
      (codec_error_to_string (Decode_error "test"));
    check string "unsupported" "Unsupported body type for codec operation"
      (codec_error_to_string Unsupported_body_type)

  let test_with_codec_encode_body () =
    let module W = With_codec (String_codec) in
    let encoder : string String_codec.encoder = String.uppercase_ascii in
    match W.encode_body encoder "hello" with
    | Ok result -> check string "encode_body" "HELLO" result
    | Error e -> fail (codec_error_to_string e)

  let test_with_codec_decode_body () =
    let module W = With_codec (String_codec) in
    let decoder : string String_codec.decoder =
     fun s -> Ok (String.uppercase_ascii s)
    in
    match W.decode_body decoder "hello" with
    | Ok result -> check string "decode_body" "HELLO" result
    | Error e -> fail (codec_error_to_string e)

  let tests =
    [
      test_case "identity codec encode" `Quick test_identity_codec_encode;
      test_case "identity codec decode" `Quick test_identity_codec_decode;
      test_case "identity codec content_type" `Quick
        test_identity_codec_content_type;
      test_case "string codec encode" `Quick test_string_codec_encode;
      test_case "string codec decode" `Quick test_string_codec_decode;
      test_case "string codec content_type" `Quick
        test_string_codec_content_type;
      test_case "codec error to string" `Quick test_codec_error_to_string;
      test_case "with_codec encode_body" `Quick test_with_codec_encode_body;
      test_case "with_codec decode_body" `Quick test_with_codec_decode_body;
    ]
end

(* ================================================================== *)
(* Stream Tests *)
(* ================================================================== *)

module Test_stream = struct
  open Hcs.Stream

  (* Sync stream tests *)
  let test_sync_empty () =
    let s = Sync.empty in
    check (list int) "empty" [] (Sync.to_list s)

  let test_sync_singleton () =
    let s = Sync.singleton 42 in
    check (list int) "singleton" [ 42 ] (Sync.to_list s)

  let test_sync_of_list () =
    let s = Sync.of_list [ 1; 2; 3 ] in
    check (list int) "of_list" [ 1; 2; 3 ] (Sync.to_list s)

  let test_sync_map () =
    let s = Sync.of_list [ 1; 2; 3 ] |> Sync.map (fun x -> x * 2) in
    check (list int) "map" [ 2; 4; 6 ] (Sync.to_list s)

  let test_sync_filter () =
    let s =
      Sync.of_list [ 1; 2; 3; 4; 5 ] |> Sync.filter (fun x -> x mod 2 = 0)
    in
    check (list int) "filter" [ 2; 4 ] (Sync.to_list s)

  let test_sync_take () =
    let s = Sync.of_list [ 1; 2; 3; 4; 5 ] |> Sync.take 3 in
    check (list int) "take" [ 1; 2; 3 ] (Sync.to_list s)

  let test_sync_drop () =
    let s = Sync.of_list [ 1; 2; 3; 4; 5 ] |> Sync.drop 2 in
    check (list int) "drop" [ 3; 4; 5 ] (Sync.to_list s)

  let test_sync_fold () =
    let result = Sync.of_list [ 1; 2; 3; 4; 5 ] |> Sync.fold ( + ) 0 in
    check int "fold" 15 result

  let test_sync_chunks () =
    let s = Sync.of_list [ 1; 2; 3; 4; 5 ] |> Sync.chunks 2 in
    check
      (list (list int))
      "chunks"
      [ [ 1; 2 ]; [ 3; 4 ]; [ 5 ] ]
      (Sync.to_list s)

  let test_sync_repeat () =
    let s = Sync.repeat 3 "x" in
    check (list string) "repeat" [ "x"; "x"; "x" ] (Sync.to_list s)

  let test_sync_unfold () =
    let s = Sync.unfold (fun n -> if n > 0 then Some (n, n - 1) else None) 3 in
    check (list int) "unfold" [ 3; 2; 1 ] (Sync.to_list s)

  let test_sync_append () =
    let s1 = Sync.of_list [ 1; 2 ] in
    let s2 = Sync.of_list [ 3; 4 ] in
    let s = Sync.append s1 s2 in
    check (list int) "append" [ 1; 2; 3; 4 ] (Sync.to_list s)

  let test_sync_cstructs_to_string () =
    let s =
      Sync.of_list
        [
          Cstruct.of_string "hello";
          Cstruct.of_string " ";
          Cstruct.of_string "world";
        ]
    in
    check string "cstructs_to_string" "hello world" (Sync.cstructs_to_string s)

  let test_sync_string_to_cstructs () =
    let s = Sync.string_to_cstructs ~chunk_size:5 "hello world" in
    let result =
      s |> Sync.map Cstruct.to_string |> Sync.to_list |> String.concat ""
    in
    check string "string_to_cstructs" "hello world" result

  (* Async stream tests *)
  let test_async_empty () =
    let s = Async.empty in
    check (list int) "async empty" [] (Async.to_list s)

  let test_async_singleton () =
    let s = Async.singleton 42 in
    check (list int) "async singleton" [ 42 ] (Async.to_list s)

  let test_async_of_list () =
    let s = Async.of_list [ 1; 2; 3 ] in
    check (list int) "async of_list" [ 1; 2; 3 ] (Async.to_list s)

  let test_async_map () =
    let s = Async.of_list [ 1; 2; 3 ] in
    let mapped = Async.map (fun x -> x * 2) s in
    check (list int) "async map" [ 2; 4; 6 ] (Async.to_list mapped)

  let test_async_filter () =
    let s = Async.of_list [ 1; 2; 3; 4; 5 ] in
    let filtered = Async.filter (fun x -> x mod 2 = 0) s in
    check (list int) "async filter" [ 2; 4 ] (Async.to_list filtered)

  let test_async_take () =
    let s = Async.of_list [ 1; 2; 3; 4; 5 ] in
    let taken = Async.take 3 s in
    check (list int) "async take" [ 1; 2; 3 ] (Async.to_list taken)

  let test_async_fold () =
    let s = Async.of_list [ 1; 2; 3; 4; 5 ] in
    let result = Async.fold ( + ) 0 s in
    check int "async fold" 15 result

  (* Chunked encoding tests *)
  let test_chunked_encode () =
    let chunks = Sync.of_list [ Cstruct.of_string "hello" ] in
    let encoded = Chunked.encode chunks in
    let result = Sync.cstructs_to_string encoded in
    (* 5 in hex is "5", chunk format: "5\r\nhello\r\n" followed by terminator "0\r\n\r\n" *)
    check string "chunked encode" "5\r\nhello\r\n0\r\n\r\n" result

  let test_chunked_content_length () =
    let chunks =
      Sync.of_list [ Cstruct.of_string "hello"; Cstruct.of_string " world" ]
    in
    let len = Chunked.content_length chunks in
    check int "chunked content_length" 11 len

  let tests =
    [
      (* Sync tests *)
      test_case "sync empty" `Quick test_sync_empty;
      test_case "sync singleton" `Quick test_sync_singleton;
      test_case "sync of_list" `Quick test_sync_of_list;
      test_case "sync map" `Quick test_sync_map;
      test_case "sync filter" `Quick test_sync_filter;
      test_case "sync take" `Quick test_sync_take;
      test_case "sync drop" `Quick test_sync_drop;
      test_case "sync fold" `Quick test_sync_fold;
      test_case "sync chunks" `Quick test_sync_chunks;
      test_case "sync repeat" `Quick test_sync_repeat;
      test_case "sync unfold" `Quick test_sync_unfold;
      test_case "sync append" `Quick test_sync_append;
      test_case "sync cstructs_to_string" `Quick test_sync_cstructs_to_string;
      test_case "sync string_to_cstructs" `Quick test_sync_string_to_cstructs;
      (* Async tests *)
      test_case "async empty" `Quick test_async_empty;
      test_case "async singleton" `Quick test_async_singleton;
      test_case "async of_list" `Quick test_async_of_list;
      test_case "async map" `Quick test_async_map;
      test_case "async filter" `Quick test_async_filter;
      test_case "async take" `Quick test_async_take;
      test_case "async fold" `Quick test_async_fold;
      (* Chunked tests *)
      test_case "chunked encode" `Quick test_chunked_encode;
      test_case "chunked content_length" `Quick test_chunked_content_length;
    ]
end

(* ================================================================== *)
(* HTTP Request Builder Tests *)
(* ================================================================== *)

module Test_http = struct
  open Hcs.Http

  let test_get () =
    let req = get "https://example.com/path" |> build in
    check string "method" "GET" (meth_to_string req.req_meth);
    check string "host" "example.com" (host req);
    check string "path" "/path" (path req);
    check bool "is_https" true (is_https req)

  let test_post () =
    let req = post "http://example.com/api" |> build in
    check string "method" "POST" (meth_to_string req.req_meth);
    check bool "is_https" false (is_https req)

  let test_put () =
    let req = put "http://example.com/resource" |> build in
    check string "method" "PUT" (meth_to_string req.req_meth)

  let test_delete () =
    let req = delete "http://example.com/resource/1" |> build in
    check string "method" "DELETE" (meth_to_string req.req_meth)

  let test_patch () =
    let req = patch "http://example.com/resource/1" |> build in
    check string "method" "PATCH" (meth_to_string req.req_meth)

  let test_head () =
    let req = head "http://example.com/" |> build in
    check string "method" "HEAD" (meth_to_string req.req_meth)

  let test_options () =
    let req = options "http://example.com/" |> build in
    check string "method" "OPTIONS" (meth_to_string req.req_meth)

  let test_header () =
    let req =
      get "http://example.com" |> header "X-Custom" "value"
      |> header "X-Another" "another"
      |> build
    in
    check bool "has X-Custom"
      (List.mem ("X-Custom", "value") req.req_headers)
      true;
    check bool "has X-Another"
      (List.mem ("X-Another", "another") req.req_headers)
      true

  let test_content_type () =
    let req =
      post "http://example.com" |> content_type "application/json" |> build
    in
    check bool "has Content-Type"
      (List.mem ("Content-Type", "application/json") req.req_headers)
      true

  let test_accept () =
    let req = get "http://example.com" |> accept "text/html" |> build in
    check bool "has Accept"
      (List.mem ("Accept", "text/html") req.req_headers)
      true

  let test_user_agent () =
    let req = get "http://example.com" |> user_agent "HCS/1.0" |> build in
    check bool "has User-Agent"
      (List.mem ("User-Agent", "HCS/1.0") req.req_headers)
      true

  let test_bearer () =
    let req = get "http://example.com" |> bearer "token123" |> build in
    check bool "has Authorization"
      (List.mem ("Authorization", "Bearer token123") req.req_headers)
      true

  let test_query () =
    let req =
      get "http://example.com/search"
      |> query "q" "ocaml" |> query "limit" "10" |> build
    in
    let pq = path_and_query req in
    check bool "has q param" (String.length pq > 0) true

  let test_body_string () =
    let req =
      post "http://example.com"
      |> body_string ~content_type:"text/plain" "hello"
      |> build
    in
    check string "body" "hello" (body_to_string req.req_body);
    check bool "has Content-Type"
      (List.mem ("Content-Type", "text/plain") req.req_headers)
      true

  let test_body_json () =
    let req =
      post "http://example.com" |> body_json {|{"key": "value"}|} |> build
    in
    check string "body" {|{"key": "value"}|} (body_to_string req.req_body);
    check bool "has Content-Type"
      (List.mem ("Content-Type", "application/json") req.req_headers)
      true

  let test_form () =
    let req =
      post "http://example.com"
      |> form [ ("name", "Alice"); ("age", "30") ]
      |> build
    in
    let body_str = body_to_string req.req_body in
    check bool "has name" (String.length body_str > 0) true;
    check bool "has Content-Type"
      (List.mem
         ("Content-Type", "application/x-www-form-urlencoded")
         req.req_headers)
      true

  let test_port_default_http () =
    let req = get "http://example.com/" |> build in
    check int "port" 80 (port req)

  let test_port_default_https () =
    let req = get "https://example.com/" |> build in
    check int "port" 443 (port req)

  let test_port_explicit () =
    let req = get "http://example.com:8080/" |> build in
    check int "port" 8080 (port req)

  let test_meth_of_string () =
    check string "GET" "GET" (meth_to_string (meth_of_string "GET"));
    check string "POST" "POST" (meth_to_string (meth_of_string "POST"));
    check string "CUSTOM" "CUSTOM" (meth_to_string (meth_of_string "CUSTOM"))

  let test_body_length () =
    check int "empty body" 0 (body_length Empty);
    check int "string body" 5 (body_length (String "hello"));
    check int "form body" (String.length "a=1&b=2")
      (body_length (Form [ ("a", "1"); ("b", "2") ]))

  let test_cookie () =
    let req = get "http://example.com" |> cookie "session" "abc123" |> build in
    check bool "has Cookie"
      (List.exists
         (fun (n, v) -> n = "Cookie" && String.length v > 0)
         req.req_headers)
      true

  let test_cookies_multiple () =
    let req =
      get "http://example.com" |> cookie "a" "1" |> cookie "b" "2" |> build
    in
    let cookie_header =
      List.find_opt (fun (n, _) -> n = "Cookie") req.req_headers
    in
    match cookie_header with
    | Some (_, v) -> check bool "has a" (String.length v > 0) true
    | None -> fail "no Cookie header"

  let tests =
    [
      test_case "get" `Quick test_get;
      test_case "post" `Quick test_post;
      test_case "put" `Quick test_put;
      test_case "delete" `Quick test_delete;
      test_case "patch" `Quick test_patch;
      test_case "head" `Quick test_head;
      test_case "options" `Quick test_options;
      test_case "header" `Quick test_header;
      test_case "content_type" `Quick test_content_type;
      test_case "accept" `Quick test_accept;
      test_case "user_agent" `Quick test_user_agent;
      test_case "bearer" `Quick test_bearer;
      test_case "query" `Quick test_query;
      test_case "body_string" `Quick test_body_string;
      test_case "body_json" `Quick test_body_json;
      test_case "form" `Quick test_form;
      test_case "port default http" `Quick test_port_default_http;
      test_case "port default https" `Quick test_port_default_https;
      test_case "port explicit" `Quick test_port_explicit;
      test_case "meth_of_string" `Quick test_meth_of_string;
      test_case "body_length" `Quick test_body_length;
      test_case "cookie" `Quick test_cookie;
      test_case "cookies multiple" `Quick test_cookies_multiple;
    ]
end

module Test_pipeline = struct
  open Hcs.Pipeline

  let test_empty () = check int "empty length" 0 (length empty)

  let test_create () =
    let p = create [ Fun.id; Fun.id ] in
    check int "create length" 2 (length p)

  let test_plug () =
    let p = empty |> fun t -> plug t Fun.id in
    check int "plug length" 1 (length p)

  let test_plug_first () =
    let p = empty |> fun t -> plug_first t Fun.id in
    check int "plug_first length" 1 (length p)

  let test_compose () =
    let p1 = create [ Fun.id ] in
    let p2 = create [ Fun.id; Fun.id ] in
    let combined = compose p1 p2 in
    check int "compose length" 3 (length combined)

  let test_is_empty () =
    check bool "empty is empty" true (is_empty empty);
    check bool "non-empty not empty" false (is_empty (create [ Fun.id ]))

  let test_apply () =
    let called = ref false in
    let mark_plug : Hcs.Plug.t =
     fun handler req ->
      called := true;
      handler req
    in
    let p = create [ mark_plug ] in
    let dummy_req : Hcs.Server.request =
      { meth = `GET; target = "/"; headers = []; body = ""; version = HTTP_1_1 }
    in
    let handler _req = Hcs.Server.respond "ok" in
    let wrapped = apply p handler in
    let _ = wrapped dummy_req in
    check bool "plug was called" true !called

  let tests =
    [
      test_case "empty" `Quick test_empty;
      test_case "create" `Quick test_create;
      test_case "plug" `Quick test_plug;
      test_case "plug_first" `Quick test_plug_first;
      test_case "compose" `Quick test_compose;
      test_case "is_empty" `Quick test_is_empty;
      test_case "apply" `Quick test_apply;
    ]
end

module Test_router = struct
  open Hcs.Router

  let test_parse_path_empty () =
    check (list string) "empty" []
      (List.map
         (function Literal s -> s | Param s -> ":" ^ s | Wildcard -> "*")
         (parse_path ""))

  let test_parse_path_root () =
    check (list string) "root" []
      (List.map
         (function Literal s -> s | Param s -> ":" ^ s | Wildcard -> "*")
         (parse_path "/"))

  let test_parse_path_simple () =
    let segments = parse_path "/users/list" in
    check int "length" 2 (List.length segments);
    match segments with
    | [ Literal "users"; Literal "list" ] -> ()
    | _ -> fail "unexpected segments"

  let test_parse_path_with_params () =
    let segments = parse_path "/users/:id/posts/:post_id" in
    check int "length" 4 (List.length segments);
    match segments with
    | [ Literal "users"; Param "id"; Literal "posts"; Param "post_id" ] -> ()
    | _ -> fail "unexpected segments"

  let test_parse_path_with_wildcard () =
    let segments = parse_path "/files/*" in
    check int "length" 2 (List.length segments);
    match segments with
    | [ Literal "files"; Wildcard ] -> ()
    | _ -> fail "unexpected segments"

  let test_router_literal_match () =
    let router = empty () in
    add_route router ~method_:(Some `GET) ~path:"/users"
      ~handler:"users_handler" ~plugs:[];
    match lookup router ~method_:`GET ~path:"/users" with
    | Some { handler; _ } -> check string "handler" "users_handler" handler
    | None -> fail "no match"

  let test_router_param_match () =
    let router = empty () in
    add_route router ~method_:(Some `GET) ~path:"/users/:id"
      ~handler:"user_handler" ~plugs:[];
    match lookup router ~method_:`GET ~path:"/users/123" with
    | Some { handler; params; _ } ->
        check string "handler" "user_handler" handler;
        check (option string) "id param" (Some "123") (param "id" params)
    | None -> fail "no match"

  let test_router_multiple_params () =
    let router = empty () in
    add_route router ~method_:(Some `GET) ~path:"/users/:user_id/posts/:post_id"
      ~handler:"post_handler" ~plugs:[];
    match lookup router ~method_:`GET ~path:"/users/42/posts/100" with
    | Some { handler; params; _ } ->
        check string "handler" "post_handler" handler;
        check (option string) "user_id" (Some "42") (param "user_id" params);
        check (option string) "post_id" (Some "100") (param "post_id" params)
    | None -> fail "no match"

  let test_router_wildcard_match () =
    let router = empty () in
    add_route router ~method_:(Some `GET) ~path:"/files/*"
      ~handler:"files_handler" ~plugs:[];
    match lookup router ~method_:`GET ~path:"/files/path/to/file.txt" with
    | Some { handler; params; _ } ->
        check string "handler" "files_handler" handler;
        check (option string) "wildcard" (Some "path/to/file.txt")
          (param "*" params)
    | None -> fail "no match"

  let test_router_method_match () =
    let router = empty () in
    add_route router ~method_:(Some `GET) ~path:"/users" ~handler:"get_handler"
      ~plugs:[];
    add_route router ~method_:(Some `POST) ~path:"/users"
      ~handler:"post_handler" ~plugs:[];
    (match lookup router ~method_:`GET ~path:"/users" with
    | Some { handler; _ } -> check string "GET handler" "get_handler" handler
    | None -> fail "no GET match");
    match lookup router ~method_:`POST ~path:"/users" with
    | Some { handler; _ } -> check string "POST handler" "post_handler" handler
    | None -> fail "no POST match"

  let test_router_any_method () =
    let router = empty () in
    add_route router ~method_:None ~path:"/health" ~handler:"health_handler"
      ~plugs:[];
    (match lookup router ~method_:`GET ~path:"/health" with
    | Some { handler; _ } -> check string "GET" "health_handler" handler
    | None -> fail "no GET match");
    match lookup router ~method_:`POST ~path:"/health" with
    | Some { handler; _ } -> check string "POST" "health_handler" handler
    | None -> fail "no POST match"

  let test_router_no_match () =
    let router = empty () in
    add_route router ~method_:(Some `GET) ~path:"/users" ~handler:"handler"
      ~plugs:[];
    match lookup router ~method_:`GET ~path:"/posts" with
    | Some _ -> fail "unexpected match"
    | None -> ()

  let test_router_compile () =
    let routes =
      [
        Route.get "/users" "list_users";
        Route.post "/users" "create_user";
        Route.get "/users/:id" "get_user";
        Route.delete "/users/:id" "delete_user";
      ]
    in
    let router = compile routes in
    (match lookup router ~method_:`GET ~path:"/users" with
    | Some { handler; _ } -> check string "list" "list_users" handler
    | None -> fail "no list match");
    match lookup router ~method_:`GET ~path:"/users/42" with
    | Some { handler; params; _ } ->
        check string "get" "get_user" handler;
        check (option string) "id" (Some "42") (param "id" params)
    | None -> fail "no get match"

  let test_param_helpers () =
    let params = [ ("id", "42"); ("name", "alice") ] in
    check (option string) "param" (Some "42") (param "id" params);
    check (option string) "param missing" None (param "foo" params);
    check string "param_or" "default" (param_or "foo" ~default:"default" params);
    check (option int) "param_int" (Some 42) (param_int "id" params);
    check int "param_int_or" 0 (param_int_or "foo" ~default:0 params)

  let test_scope_prefix () =
    let routes = scope "/api" [ Route.get "/users" "list_users" ] in
    let router = compile routes in
    match lookup router ~method_:`GET ~path:"/api/users" with
    | Some { handler; _ } -> check string "scoped handler" "list_users" handler
    | None -> fail "no match for scoped route"

  let test_scope_root_prefix () =
    let routes = scope "/" [ Route.get "/users" "list_users" ] in
    let router = compile routes in
    match lookup router ~method_:`GET ~path:"/users" with
    | Some { handler; _ } -> check string "root scope" "list_users" handler
    | None -> fail "no match"

  let test_scope_nested_path () =
    let routes = scope "/api/v1" [ Route.get "/users/:id" "get_user" ] in
    let router = compile routes in
    match lookup router ~method_:`GET ~path:"/api/v1/users/42" with
    | Some { handler; params; _ } ->
        check string "nested scope" "get_user" handler;
        check (option string) "id param" (Some "42") (param "id" params)
    | None -> fail "no match"

  let test_compile_scopes () =
    let api_routes = scope "/api" [ Route.get "/posts" "list_posts" ] in
    let web_routes = scope "/" [ Route.get "/" "home" ] in
    let router = compile_scopes [ api_routes; web_routes ] in
    (match lookup router ~method_:`GET ~path:"/api/posts" with
    | Some { handler; _ } -> check string "api route" "list_posts" handler
    | None -> fail "no api match");
    match lookup router ~method_:`GET ~path:"/" with
    | Some { handler; _ } -> check string "web route" "home" handler
    | None -> fail "no web match"

  let test_route_with_plug () =
    let dummy_plug : Hcs.Plug.t = fun handler -> handler in
    let base_route = Route.get "/admin" "admin_handler" in
    let route = Route.plug dummy_plug base_route in
    let router = compile [ route ] in
    match lookup router ~method_:`GET ~path:"/admin" with
    | Some { handler; plugs; _ } ->
        check string "handler" "admin_handler" handler;
        check int "has plugs" 1 (List.length plugs)
    | None -> fail "no match"

  let tests =
    [
      test_case "parse_path empty" `Quick test_parse_path_empty;
      test_case "parse_path root" `Quick test_parse_path_root;
      test_case "parse_path simple" `Quick test_parse_path_simple;
      test_case "parse_path with params" `Quick test_parse_path_with_params;
      test_case "parse_path with wildcard" `Quick test_parse_path_with_wildcard;
      test_case "router literal match" `Quick test_router_literal_match;
      test_case "router param match" `Quick test_router_param_match;
      test_case "router multiple params" `Quick test_router_multiple_params;
      test_case "router wildcard match" `Quick test_router_wildcard_match;
      test_case "router method match" `Quick test_router_method_match;
      test_case "router any method" `Quick test_router_any_method;
      test_case "router no match" `Quick test_router_no_match;
      test_case "router compile" `Quick test_router_compile;
      test_case "param helpers" `Quick test_param_helpers;
      test_case "scope prefix" `Quick test_scope_prefix;
      test_case "scope root prefix" `Quick test_scope_root_prefix;
      test_case "scope nested path" `Quick test_scope_nested_path;
      test_case "compile scopes" `Quick test_compile_scopes;
      test_case "route with plug" `Quick test_route_with_plug;
    ]
end

(* ================================================================== *)
(* Log Tests *)
(* ================================================================== *)

module Test_log = struct
  open Hcs.Log

  let test_level_to_string () =
    check string "debug" "DEBUG" (level_to_string Debug);
    check string "info" "INFO" (level_to_string Info);
    check string "warn" "WARN" (level_to_string Warn);
    check string "error" "ERROR" (level_to_string Error)

  let test_level_of_string () =
    check bool "DEBUG" true (level_of_string "DEBUG" = Some Debug);
    check bool "debug" true (level_of_string "debug" = Some Debug);
    check bool "INFO" true (level_of_string "INFO" = Some Info);
    check bool "WARN" true (level_of_string "WARN" = Some Warn);
    check bool "unknown" true (level_of_string "unknown" = None)

  let test_level_gte () =
    check bool "error >= debug" true (level_gte Error Debug);
    check bool "error >= error" true (level_gte Error Error);
    check bool "debug >= error" false (level_gte Debug Error);
    check bool "warn >= info" true (level_gte Warn Info)

  let test_method_to_string () =
    check string "GET" "GET" (method_to_string GET);
    check string "POST" "POST" (method_to_string POST);
    check string "Other" "CUSTOM" (method_to_string (Other "CUSTOM"))

  let test_event_to_string_request_start () =
    let e =
      Request_start { id = "req-1"; meth = GET; uri = "/test"; headers = [] }
    in
    let s = event_to_string e in
    check bool "contains id" (String.length s > 0) true;
    check bool "contains GET" true (String.length s > 0)

  let test_event_to_string_request_end () =
    let e =
      Request_end
        {
          id = "req-1";
          status = 200;
          duration_ms = 42.5;
          body_size = Some 1024;
        }
    in
    let s = event_to_string e in
    check bool "contains status" (String.length s > 0) true

  let test_event_to_string_error () =
    let e =
      Error
        { id = Some "req-1"; error = "connection failed"; context = Some "TLS" }
    in
    let s = event_to_string e in
    check bool "contains error" (String.length s > 0) true

  let test_event_to_json_request_start () =
    let e =
      Request_start { id = "req-1"; meth = GET; uri = "/test"; headers = [] }
    in
    let j = event_to_json e in
    check bool "is json" true (String.sub j 0 1 = "{");
    check bool "contains event" true (String.length j > 10)

  let test_event_to_json_custom () =
    let e = Custom { name = "test_event"; data = [ ("key", "value") ] } in
    let j = event_to_json e in
    check bool "is json" true (String.sub j 0 1 = "{");
    check bool "contains name" true (String.length j > 10)

  let test_null_logger () =
    (* Should not raise *)
    null Info
      (Request_start { id = "req-1"; meth = GET; uri = "/"; headers = [] });
    null Error (Error { id = None; error = "test"; context = None })

  let test_custom_logger () =
    let logged = ref [] in
    let logger = custom (fun level msg -> logged := (level, msg) :: !logged) in
    logger Info
      (Request_start { id = "req-1"; meth = GET; uri = "/"; headers = [] });
    check int "logged count" 1 (List.length !logged)

  let test_combine_loggers () =
    let count1 = ref 0 in
    let count2 = ref 0 in
    let logger1 = custom (fun _ _ -> incr count1) in
    let logger2 = custom (fun _ _ -> incr count2) in
    let combined = combine [ logger1; logger2 ] in
    combined Info (Custom { name = "test"; data = [] });
    check int "logger1 count" 1 !count1;
    check int "logger2 count" 1 !count2

  let test_with_min_level () =
    let logged = ref [] in
    let base = custom (fun level msg -> logged := (level, msg) :: !logged) in
    let filtered = with_min_level Warn base in
    filtered Debug (Custom { name = "debug"; data = [] });
    filtered Info (Custom { name = "info"; data = [] });
    filtered Warn (Custom { name = "warn"; data = [] });
    filtered Error (Custom { name = "error"; data = [] });
    check int "logged count" 2 (List.length !logged)

  let test_generate_request_id () =
    let id1 = generate_request_id () in
    let id2 = generate_request_id () in
    check bool "starts with req-" true (String.sub id1 0 4 = "req-");
    check bool "unique" true (id1 <> id2)

  let tests =
    [
      test_case "level_to_string" `Quick test_level_to_string;
      test_case "level_of_string" `Quick test_level_of_string;
      test_case "level_gte" `Quick test_level_gte;
      test_case "method_to_string" `Quick test_method_to_string;
      test_case "event_to_string request_start" `Quick
        test_event_to_string_request_start;
      test_case "event_to_string request_end" `Quick
        test_event_to_string_request_end;
      test_case "event_to_string error" `Quick test_event_to_string_error;
      test_case "event_to_json request_start" `Quick
        test_event_to_json_request_start;
      test_case "event_to_json custom" `Quick test_event_to_json_custom;
      test_case "null logger" `Quick test_null_logger;
      test_case "custom logger" `Quick test_custom_logger;
      test_case "combine loggers" `Quick test_combine_loggers;
      test_case "with_min_level" `Quick test_with_min_level;
      test_case "generate_request_id" `Quick test_generate_request_id;
    ]
end

module Test_tls_config = struct
  open Hcs.Tls_config

  let test_alpn_constants () =
    check string "h2" "h2" alpn_h2;
    check string "http/1.1" "http/1.1" alpn_http11;
    check string "h2c" "h2c" alpn_h2c

  let test_protocol_of_alpn () =
    check (option string) "h2 -> HTTP_2" (Some "HTTP_2")
      (Option.map
         (function HTTP_2 -> "HTTP_2" | HTTP_1_1 -> "HTTP_1_1")
         (protocol_of_alpn "h2"));
    check (option string) "http/1.1 -> HTTP_1_1" (Some "HTTP_1_1")
      (Option.map
         (function HTTP_2 -> "HTTP_2" | HTTP_1_1 -> "HTTP_1_1")
         (protocol_of_alpn "http/1.1"));
    check (option string) "unknown -> None" None
      (Option.map
         (function HTTP_2 -> "HTTP_2" | HTTP_1_1 -> "HTTP_1_1")
         (protocol_of_alpn "unknown"))

  let test_alpn_of_protocol () =
    check string "HTTP_2 -> h2" "h2" (alpn_of_protocol HTTP_2);
    check string "HTTP_1_1 -> http/1.1" "http/1.1" (alpn_of_protocol HTTP_1_1)

  let test_client_configs () =
    check
      (option (list string))
      "default has http/1.1" (Some [ "http/1.1" ]) Client.default.alpn_protocols;
    check
      (option (list string))
      "h2 has h2" (Some [ "h2" ]) Client.h2.alpn_protocols;
    check
      (option (list string))
      "h2_or_http11 has both"
      (Some [ "h2"; "http/1.1" ])
      Client.h2_or_http11.alpn_protocols

  let tests =
    [
      test_case "alpn constants" `Quick test_alpn_constants;
      test_case "protocol_of_alpn" `Quick test_protocol_of_alpn;
      test_case "alpn_of_protocol" `Quick test_alpn_of_protocol;
      test_case "client configs" `Quick test_client_configs;
    ]
end

(* ================================================================== *)
(* Request Tests *)
(* ================================================================== *)

module Test_request = struct
  open Hcs

  let make_request ?(body = "") target : Server.request =
    { meth = `GET; target; headers = []; body; version = Server.HTTP_1_1 }

  let test_query_basic () =
    let req = make_request "/search?q=ocaml&limit=10" in
    check (option string) "q" (Some "ocaml") (Request.query req "q");
    check (option string) "limit" (Some "10") (Request.query req "limit");
    check (option string) "missing" None (Request.query req "missing")

  let test_query_or () =
    let req = make_request "/search?q=ocaml" in
    check string "existing" "ocaml" (Request.query_or ~default:"" req "q");
    check string "missing" "default"
      (Request.query_or ~default:"default" req "x")

  let test_query_int () =
    let req = make_request "/page?num=42&bad=abc" in
    check (option int) "valid int" (Some 42) (Request.query_int req "num");
    check (option int) "invalid int" None (Request.query_int req "bad");
    check (option int) "missing" None (Request.query_int req "missing")

  let test_query_int_or () =
    let req = make_request "/page?num=42" in
    check int "existing" 42 (Request.query_int_or ~default:0 req "num");
    check int "missing" 1 (Request.query_int_or ~default:1 req "page")

  let test_query_bool () =
    let req =
      make_request "/flags?a=true&b=1&c=yes&d=on&e=false&f=0&g=no&h=off&i=bad"
    in
    check (option bool) "true" (Some true) (Request.query_bool req "a");
    check (option bool) "1" (Some true) (Request.query_bool req "b");
    check (option bool) "yes" (Some true) (Request.query_bool req "c");
    check (option bool) "on" (Some true) (Request.query_bool req "d");
    check (option bool) "false" (Some false) (Request.query_bool req "e");
    check (option bool) "0" (Some false) (Request.query_bool req "f");
    check (option bool) "no" (Some false) (Request.query_bool req "g");
    check (option bool) "off" (Some false) (Request.query_bool req "h");
    check (option bool) "bad" None (Request.query_bool req "i")

  let test_query_float () =
    let req = make_request "/calc?x=3.14&y=-2.5&bad=abc" in
    check
      (option (float 0.001))
      "valid float" (Some 3.14)
      (Request.query_float req "x");
    check
      (option (float 0.001))
      "negative" (Some (-2.5))
      (Request.query_float req "y");
    check (option (float 0.001)) "invalid" None (Request.query_float req "bad")

  let test_query_all () =
    let req = make_request "/tags?t=a&t=b&t=c" in
    check (list string) "all values" [ "a"; "b"; "c" ]
      (Request.query_all req "t")

  let test_query_url_decode () =
    let req = make_request "/search?q=hello%20world&name=foo%2Bbar" in
    check (option string) "space" (Some "hello world") (Request.query req "q");
    check (option string) "plus encoded" (Some "foo+bar")
      (Request.query req "name")

  let test_query_empty () =
    let req = make_request "/path" in
    check (option string) "no query string" None (Request.query req "q");
    check
      (list (pair string string))
      "empty params" []
      (Request.query_params_from_target "/path")

  let test_form_field_basic () =
    let req = make_request ~body:"name=alice&age=30" "/" in
    check (option string) "name" (Some "alice") (Request.form_field req "name");
    check (option string) "age" (Some "30") (Request.form_field req "age");
    check (option string) "missing" None (Request.form_field req "missing")

  let test_form_field_or () =
    let req = make_request ~body:"name=bob" "/" in
    check string "existing" "bob" (Request.form_field_or ~default:"" req "name");
    check string "missing" "unknown"
      (Request.form_field_or ~default:"unknown" req "email")

  let test_form_int () =
    let req = make_request ~body:"count=42&bad=xyz" "/" in
    check (option int) "valid" (Some 42) (Request.form_int req "count");
    check (option int) "invalid" None (Request.form_int req "bad");
    check int "with default" 0 (Request.form_int_or ~default:0 req "missing")

  let test_form_plus_as_space () =
    let req = make_request ~body:"msg=hello+world&name=foo%2Bbar" "/" in
    check (option string) "plus becomes space" (Some "hello world")
      (Request.form_field req "msg");
    check (option string) "encoded plus" (Some "foo+bar")
      (Request.form_field req "name")

  let test_form_url_decode () =
    let req = make_request ~body:"text=hello%20world&special=%26%3D%3F" "/" in
    check (option string) "percent space" (Some "hello world")
      (Request.form_field req "text");
    check (option string) "special chars" (Some "&=?")
      (Request.form_field req "special")

  let test_form_empty_body () =
    let req = make_request ~body:"" "/" in
    check (option string) "empty body" None (Request.form_field req "anything");
    check
      (list (pair string string))
      "empty form_data" []
      (Request.form_data_from_body "")

  let tests =
    [
      test_case "query basic" `Quick test_query_basic;
      test_case "query_or" `Quick test_query_or;
      test_case "query_int" `Quick test_query_int;
      test_case "query_int_or" `Quick test_query_int_or;
      test_case "query_bool" `Quick test_query_bool;
      test_case "query_float" `Quick test_query_float;
      test_case "query_all" `Quick test_query_all;
      test_case "query url decode" `Quick test_query_url_decode;
      test_case "query empty" `Quick test_query_empty;
      test_case "form_field basic" `Quick test_form_field_basic;
      test_case "form_field_or" `Quick test_form_field_or;
      test_case "form_int" `Quick test_form_int;
      test_case "form plus as space" `Quick test_form_plus_as_space;
      test_case "form url decode" `Quick test_form_url_decode;
      test_case "form empty body" `Quick test_form_empty_body;
    ]
end

(* ================================================================== *)
(* Property-Based Tests (QCheck) *)
(* ================================================================== *)

module Test_properties = struct
  (* Stream properties *)
  let prop_sync_map_identity =
    QCheck.Test.make ~name:"sync map identity" ~count:100
      QCheck.(list int)
      (fun l ->
        let open Hcs.Stream.Sync in
        let s = of_list l in
        to_list (map Fun.id s) = l)

  let prop_sync_map_composition =
    QCheck.Test.make ~name:"sync map composition" ~count:100
      QCheck.(list nat_small)
      (fun l ->
        let open Hcs.Stream.Sync in
        let f x = x + 1 in
        let g x = x * 2 in
        let s = of_list l in
        to_list (map (fun x -> g (f x)) s) = to_list (map g (map f (of_list l))))

  let prop_sync_filter_all =
    QCheck.Test.make ~name:"sync filter true keeps all" ~count:100
      QCheck.(list int)
      (fun l ->
        let open Hcs.Stream.Sync in
        to_list (filter (fun _ -> true) (of_list l)) = l)

  let prop_sync_filter_none =
    QCheck.Test.make ~name:"sync filter false removes all" ~count:100
      QCheck.(list int)
      (fun l ->
        let open Hcs.Stream.Sync in
        to_list (filter (fun _ -> false) (of_list l)) = [])

  let prop_sync_take_drop =
    QCheck.Test.make ~name:"sync take n ++ drop n = original" ~count:100
      QCheck.(pair (list int) nat_small)
      (fun (l, n) ->
        let open Hcs.Stream.Sync in
        let s1 = of_list l in
        let s2 = of_list l in
        let taken = to_list (take n s1) in
        let dropped = to_list (drop n s2) in
        taken @ dropped = l)

  let prop_sync_fold_sum =
    QCheck.Test.make ~name:"sync fold sum = List.fold_left sum" ~count:100
      QCheck.(list nat_small)
      (fun l ->
        let open Hcs.Stream.Sync in
        fold ( + ) 0 (of_list l) = List.fold_left ( + ) 0 l)

  (* Router properties *)
  let prop_router_param_extraction =
    QCheck.Test.make ~name:"router extracts all params" ~count:100
      QCheck.(pair string_small string_small)
      (fun (id, name) ->
        (* Skip edge cases: empty strings or strings containing / *)
        if
          id = "" || name = "" || String.contains id '/'
          || String.contains name '/'
        then true (* vacuously true for invalid inputs *)
        else
          let open Hcs.Router in
          let router = empty () in
          add_route router ~method_:(Some `GET) ~path:"/users/:id/items/:name"
            ~handler:"handler" ~plugs:[];
          match
            lookup router ~method_:`GET
              ~path:(Printf.sprintf "/users/%s/items/%s" id name)
          with
          | Some { params; _ } ->
              param "id" params = Some id && param "name" params = Some name
          | None -> false)

  (* HTTP builder properties *)
  let prop_http_method_roundtrip =
    QCheck.Test.make ~name:"http method roundtrip" ~count:20
      QCheck.(
        make
          Gen.(
            oneof
              [
                return "GET";
                return "POST";
                return "PUT";
                return "DELETE";
                return "PATCH";
                return "HEAD";
                return "OPTIONS";
              ]))
      (fun m ->
        let open Hcs.Http in
        meth_to_string (meth_of_string m) = m)

  let tests =
    List.map QCheck_alcotest.to_alcotest
      [
        prop_sync_map_identity;
        prop_sync_map_composition;
        prop_sync_filter_all;
        prop_sync_filter_none;
        prop_sync_take_drop;
        prop_sync_fold_sum;
        prop_router_param_extraction;
        prop_http_method_roundtrip;
      ]
end

(* ================================================================== *)
(* Main *)
(* ================================================================== *)

let () =
  run "HCS"
    [
      ("Codec", Test_codec.tests);
      ("Stream", Test_stream.tests);
      ("Http", Test_http.tests);
      ("Pipeline", Test_pipeline.tests);
      ("Router", Test_router.tests);
      ("Log", Test_log.tests);
      ("Tls_config", Test_tls_config.tests);
      ("Request", Test_request.tests);
      ("Properties", Test_properties.tests);
    ]