(** Low-level HTTP/1.1 client over raw TCP connections for connection pooling *)

let src = Logs.Src.create "requests.http_client" ~doc:"Low-level HTTP client"
module Log = (val Logs.src_log src : Logs.LOG)

(** Build HTTP/1.1 request as a string *)
let build_request ~method_ ~uri ~headers ~body_str =
  let path = Uri.path uri in
  let path = if path = "" then "/" else path in
  let query = Uri.query uri in
  let path_with_query =
    if query = [] then path
    else path ^ "?" ^ (Uri.encoded_of_query query)
  in

  let host = match Uri.host uri with
    | Some h -> h
    | None -> failwith "URI must have a host"
  in

  let port = match Uri.port uri with
    | Some p -> ":" ^ string_of_int p
    | None ->
        match Uri.scheme uri with
        | Some "https" -> ":443"
        | Some "http" -> ":80"
        | _ -> ""
  in

  (* Build request line *)
  let request_line = Printf.sprintf "%s %s HTTP/1.1\r\n" method_ path_with_query in

  (* Ensure Host header is present *)
  let headers = if not (Headers.mem "host" headers) then
    Headers.add "host" (host ^ port) headers
  else headers in

  (* Ensure Connection header for keep-alive *)
  let headers = if not (Headers.mem "connection" headers) then
    Headers.add "connection" "keep-alive" headers
  else headers in

  (* Add Content-Length if we have a body *)
  let headers =
    if body_str <> "" && not (Headers.mem "content-length" headers) then
      let len = String.length body_str in
      Headers.add "content-length" (string_of_int len) headers
    else headers
  in

  (* Build headers section *)
  let headers_str =
    Headers.to_list headers
    |> List.map (fun (k, v) -> Printf.sprintf "%s: %s\r\n" k v)
    |> String.concat ""
  in

  request_line ^ headers_str ^ "\r\n" ^ body_str

(** Parse HTTP response status line *)
let parse_status_line line =
  match String.split_on_char ' ' line with
  | "HTTP/1.1" :: code :: _ | "HTTP/1.0" :: code :: _ ->
      (try int_of_string code
       with _ -> failwith ("Invalid status code: " ^ code))
  | _ -> failwith ("Invalid status line: " ^ line)

(** Parse HTTP headers from buffer reader *)
let parse_headers buf_read =
  let rec read_headers acc =
    let line = Eio.Buf_read.line buf_read in
    if line = "" then List.rev acc
    else begin
      match String.index_opt line ':' with
      | None -> read_headers acc
      | Some idx ->
          let name = String.sub line 0 idx |> String.trim |> String.lowercase_ascii in
          let value = String.sub line (idx + 1) (String.length line - idx - 1) |> String.trim in
          read_headers ((name, value) :: acc)
    end
  in
  read_headers [] |> Headers.of_list

(** Read body with Content-Length *)
let read_fixed_body buf_read length =
  let buf = Buffer.create (Int64.to_int length) in
  let rec read_n remaining =
    if remaining > 0L then begin
      let to_read = min 8192 (Int64.to_int remaining) in
      let chunk = Eio.Buf_read.take to_read buf_read in
      Buffer.add_string buf chunk;
      read_n (Int64.sub remaining (Int64.of_int (String.length chunk)))
    end
  in
  read_n length;
  Buffer.contents buf

(** Read chunked body *)
let read_chunked_body buf_read =
  let buf = Buffer.create 4096 in
  let rec read_chunks () =
    let size_line = Eio.Buf_read.line buf_read in
    (* Parse hex chunk size, ignore extensions after ';' *)
    let size_str = match String.index_opt size_line ';' with
      | Some idx -> String.sub size_line 0 idx
      | None -> size_line
    in
    let chunk_size = int_of_string ("0x" ^ size_str) in
    if chunk_size = 0 then begin
      (* Read trailing headers (if any) until empty line *)
      let rec skip_trailers () =
        let line = Eio.Buf_read.line buf_read in
        if line <> "" then skip_trailers ()
      in
      skip_trailers ()
    end else begin
      let chunk = Eio.Buf_read.take chunk_size buf_read in
      Buffer.add_string buf chunk;
      let _crlf = Eio.Buf_read.line buf_read in (* Read trailing CRLF *)
      read_chunks ()
    end
  in
  read_chunks ();
  Buffer.contents buf

(** Make HTTP request over a pooled connection *)
let make_request ~method_ ~uri ~headers ~body_str flow =
  Log.debug (fun m -> m "Making %s request to %s" method_ (Uri.to_string uri));

  (* Build and send request *)
  let request_str = build_request ~method_ ~uri ~headers ~body_str in
  Eio.Flow.copy_string request_str flow;

  (* Read and parse response *)
  let buf_read = Eio.Buf_read.of_flow flow ~max_size:max_int in

  (* Parse status line *)
  let status_line = Eio.Buf_read.line buf_read in
  let status = parse_status_line status_line in

  Log.debug (fun m -> m "Received response status: %d" status);

  (* Parse headers *)
  let resp_headers = parse_headers buf_read in

  (* Determine how to read body *)
  let transfer_encoding = Headers.get "transfer-encoding" resp_headers in
  let content_length = Headers.get "content-length" resp_headers |> Option.map Int64.of_string in

  let body_str = match transfer_encoding, content_length with
    | Some te, _ when String.lowercase_ascii te |> String.trim = "chunked" ->
        Log.debug (fun m -> m "Reading chunked response body");
        read_chunked_body buf_read
    | _, Some len ->
        Log.debug (fun m -> m "Reading fixed-length response body (%Ld bytes)" len);
        read_fixed_body buf_read len
    | Some other_te, None ->
        Log.warn (fun m -> m "Unsupported transfer-encoding: %s, assuming no body" other_te);
        ""
    | None, None ->
        Log.debug (fun m -> m "No body indicated");
        ""
  in

  (status, resp_headers, body_str)