(** Logging module for HCS HTTP library.

    Provides structured logging for HTTP events including requests, responses,
    connections, and errors. The module is runtime-agnostic and uses a
    callback-based approach for flexibility.

    {1 Usage}

    {[
      (* Use built-in stderr logger *)
      let logger = Hcs.Log.stderr ()

      (* Use null logger (no output) *)
      let logger = Hcs.Log.null

      (* Use custom logger *)
      let logger =
        Hcs.Log.custom (fun level msg ->
            match level with
            | Hcs.Log.Error -> Printf.eprintf "[ERROR] %s\n%!" msg
            | _ ->
                Printf.printf "[%s] %s\n%!" (Hcs.Log.level_to_string level) msg)
    ]} *)

(** {1 Types} *)

(** Log levels *)
type level =
  | Debug  (** Detailed debugging information *)
  | Info  (** General information about operations *)
  | Warn  (** Warning conditions *)
  | Error  (** Error conditions *)

(** HTTP method for logging (simplified) *)
type http_method =
  | GET
  | POST
  | PUT
  | DELETE
  | PATCH
  | HEAD
  | OPTIONS
  | CONNECT
  | TRACE
  | Other of string

(** Log events - structured events that can be logged *)
type event =
  | Request_start of {
      id : string;
      meth : http_method;
      uri : string;
      headers : (string * string) list;
    }  (** Request started *)
  | Request_end of {
      id : string;
      status : int;
      duration_ms : float;
      body_size : int option;
    }  (** Request completed *)
  | Connection_open of {
      host : string;
      port : int;
      protocol : string;  (** "http/1.1" or "h2" *)
    }  (** Connection opened *)
  | Connection_close of { host : string; port : int; reason : string }
      (** Connection closed *)
  | Connection_reuse of { host : string; port : int }
      (** Connection reused from pool *)
  | Tls_handshake of {
      host : string;
      protocol : string;  (** TLS version *)
      cipher : string option;
    }  (** TLS handshake completed *)
  | Retry of {
      id : string;
      attempt : int;
      reason : string;
      delay_ms : float option;
    }  (** Request retry *)
  | Redirect of {
      id : string;
      from_uri : string;
      to_uri : string;
      status : int;
    }  (** Following redirect *)
  | Error of { id : string option; error : string; context : string option }
      (** Error occurred *)
  | Custom of { name : string; data : (string * string) list }
      (** Custom event *)

type logger = level -> event -> unit
(** Logger function type *)

(** {1 Level operations} *)

(** Convert level to string *)
let level_to_string = function
  | Debug -> "DEBUG"
  | Info -> "INFO"
  | Warn -> "WARN"
  | Error -> "ERROR"

(** Parse level from string *)
let level_of_string = function
  | "DEBUG" | "debug" -> Some Debug
  | "INFO" | "info" -> Some Info
  | "WARN" | "warn" | "WARNING" | "warning" -> Some Warn
  | "ERROR" | "error" -> Some Error
  | _ -> None

(** Compare log levels (for filtering) *)
let level_to_int = function Debug -> 0 | Info -> 1 | Warn -> 2 | Error -> 3

let level_gte l1 l2 = level_to_int l1 >= level_to_int l2

(** {1 HTTP method operations} *)

let method_to_string = function
  | GET -> "GET"
  | POST -> "POST"
  | PUT -> "PUT"
  | DELETE -> "DELETE"
  | PATCH -> "PATCH"
  | HEAD -> "HEAD"
  | OPTIONS -> "OPTIONS"
  | CONNECT -> "CONNECT"
  | TRACE -> "TRACE"
  | Other s -> s

let method_of_h1 (m : Httpun_types.Method.t) : http_method =
  match m with
  | `GET -> GET
  | `POST -> POST
  | `PUT -> PUT
  | `DELETE -> DELETE
  | `HEAD -> HEAD
  | `OPTIONS -> OPTIONS
  | `CONNECT -> CONNECT
  | `TRACE -> TRACE
  | `Other s -> Other s

(** {1 Event formatting} *)

(** Format event as a human-readable string *)
let event_to_string = function
  | Request_start { id; meth; uri; headers = _ } ->
      Buf.build64 (fun b ->
          Buf.string b "Request[";
          Buf.string b id;
          Buf.string b "] ";
          Buf.string b (method_to_string meth);
          Buf.char b ' ';
          Buf.string b uri)
  | Request_end { id; status; duration_ms; body_size } ->
      Buf.build64 (fun b ->
          Buf.string b "Request[";
          Buf.string b id;
          Buf.string b "] completed: status=";
          Buf.int b status;
          Buf.string b ", duration=";
          Buf.float2 b duration_ms;
          Buf.string b "ms";
          match body_size with
          | Some s ->
              Buf.string b ", ";
              Buf.int b s;
              Buf.string b " bytes"
          | None -> ())
  | Connection_open { host; port; protocol } ->
      Buf.build64 (fun b ->
          Buf.string b "Connection opened: ";
          Buf.string b host;
          Buf.char b ':';
          Buf.int b port;
          Buf.string b " (";
          Buf.string b protocol;
          Buf.char b ')')
  | Connection_close { host; port; reason } ->
      Buf.build64 (fun b ->
          Buf.string b "Connection closed: ";
          Buf.string b host;
          Buf.char b ':';
          Buf.int b port;
          Buf.string b " (";
          Buf.string b reason;
          Buf.char b ')')
  | Connection_reuse { host; port } ->
      Buf.build64 (fun b ->
          Buf.string b "Connection reused: ";
          Buf.string b host;
          Buf.char b ':';
          Buf.int b port)
  | Tls_handshake { host; protocol; cipher } ->
      Buf.build64 (fun b ->
          Buf.string b "TLS handshake: ";
          Buf.string b host;
          Buf.string b " (";
          Buf.string b protocol;
          (match cipher with
          | Some c ->
              Buf.string b ", cipher=";
              Buf.string b c
          | None -> ());
          Buf.char b ')')
  | Retry { id; attempt; reason; delay_ms } ->
      Buf.build64 (fun b ->
          Buf.string b "Request[";
          Buf.string b id;
          Buf.string b "] retry #";
          Buf.int b attempt;
          Buf.string b ": ";
          Buf.string b reason;
          match delay_ms with
          | Some d ->
              Buf.string b ", delay=";
              Buf.float0 b d;
              Buf.string b "ms"
          | None -> ())
  | Redirect { id; from_uri; to_uri; status } ->
      Buf.build64 (fun b ->
          Buf.string b "Request[";
          Buf.string b id;
          Buf.string b "] redirect ";
          Buf.int b status;
          Buf.string b ": ";
          Buf.string b from_uri;
          Buf.string b " -> ";
          Buf.string b to_uri)
  | Error { id; error; context } ->
      Buf.build64 (fun b ->
          Buf.string b "Error";
          (match id with
          | Some i ->
              Buf.char b '[';
              Buf.string b i;
              Buf.string b "] "
          | None -> ());
          Buf.string b ": ";
          Buf.string b error;
          match context with
          | Some c ->
              Buf.string b " (";
              Buf.string b c;
              Buf.char b ')'
          | None -> ())
  | Custom { name; data } ->
      Buf.build64 (fun b ->
          Buf.string b "Custom[";
          Buf.string b name;
          Buf.string b "]: ";
          let first = ref true in
          List.iter
            (fun (k, v) ->
              if !first then first := false else Buf.string b ", ";
              Buf.string b k;
              Buf.char b '=';
              Buf.string b v)
            data)

(** Format event as JSON string *)
let event_to_json = function
  | Request_start { id; meth; uri; headers } ->
      Buf.build64 (fun b ->
          Buf.string b {|{"event":"request_start","id":|};
          Buf.json_string_quoted b id;
          Buf.string b {|,"method":|};
          Buf.json_string_quoted b (method_to_string meth);
          Buf.string b {|,"uri":|};
          Buf.json_string_quoted b uri;
          Buf.string b {|,"headers":{|};
          let first = ref true in
          List.iter
            (fun (k, v) ->
              if !first then first := false else Buf.char b ',';
              Buf.json_string_quoted b k;
              Buf.char b ':';
              Buf.json_string_quoted b v)
            headers;
          Buf.string b "}}")
  | Request_end { id; status; duration_ms; body_size } ->
      Buf.build64 (fun b ->
          Buf.string b {|{"event":"request_end","id":|};
          Buf.json_string_quoted b id;
          Buf.string b {|,"status":|};
          Buf.int b status;
          Buf.string b {|,"duration_ms":|};
          Buf.float2 b duration_ms;
          (match body_size with
          | Some s ->
              Buf.string b {|,"body_size":|};
              Buf.int b s
          | None -> ());
          Buf.char b '}')
  | Connection_open { host; port; protocol } ->
      Buf.build64 (fun b ->
          Buf.string b {|{"event":"connection_open","host":|};
          Buf.json_string_quoted b host;
          Buf.string b {|,"port":|};
          Buf.int b port;
          Buf.string b {|,"protocol":|};
          Buf.json_string_quoted b protocol;
          Buf.char b '}')
  | Connection_close { host; port; reason } ->
      Buf.build64 (fun b ->
          Buf.string b {|{"event":"connection_close","host":|};
          Buf.json_string_quoted b host;
          Buf.string b {|,"port":|};
          Buf.int b port;
          Buf.string b {|,"reason":|};
          Buf.json_string_quoted b reason;
          Buf.char b '}')
  | Connection_reuse { host; port } ->
      Buf.build64 (fun b ->
          Buf.string b {|{"event":"connection_reuse","host":|};
          Buf.json_string_quoted b host;
          Buf.string b {|,"port":|};
          Buf.int b port;
          Buf.char b '}')
  | Tls_handshake { host; protocol; cipher } ->
      Buf.build64 (fun b ->
          Buf.string b {|{"event":"tls_handshake","host":|};
          Buf.json_string_quoted b host;
          Buf.string b {|,"protocol":|};
          Buf.json_string_quoted b protocol;
          (match cipher with
          | Some c ->
              Buf.string b {|,"cipher":|};
              Buf.json_string_quoted b c
          | None -> ());
          Buf.char b '}')
  | Retry { id; attempt; reason; delay_ms } ->
      Buf.build64 (fun b ->
          Buf.string b {|{"event":"retry","id":|};
          Buf.json_string_quoted b id;
          Buf.string b {|,"attempt":|};
          Buf.int b attempt;
          Buf.string b {|,"reason":|};
          Buf.json_string_quoted b reason;
          (match delay_ms with
          | Some d ->
              Buf.string b {|,"delay_ms":|};
              Buf.float0 b d
          | None -> ());
          Buf.char b '}')
  | Redirect { id; from_uri; to_uri; status } ->
      Buf.build64 (fun b ->
          Buf.string b {|{"event":"redirect","id":|};
          Buf.json_string_quoted b id;
          Buf.string b {|,"from":|};
          Buf.json_string_quoted b from_uri;
          Buf.string b {|,"to":|};
          Buf.json_string_quoted b to_uri;
          Buf.string b {|,"status":|};
          Buf.int b status;
          Buf.char b '}')
  | Error { id; error; context } ->
      Buf.build64 (fun b ->
          Buf.string b {|{"event":"error"|};
          (match id with
          | Some i ->
              Buf.string b {|,"id":|};
              Buf.json_string_quoted b i
          | None -> ());
          Buf.string b {|,"error":|};
          Buf.json_string_quoted b error;
          (match context with
          | Some c ->
              Buf.string b {|,"context":|};
              Buf.json_string_quoted b c
          | None -> ());
          Buf.char b '}')
  | Custom { name; data } ->
      Buf.build64 (fun b ->
          Buf.string b {|{"event":"custom","name":|};
          Buf.json_string_quoted b name;
          Buf.string b {|,"data":{|};
          let first = ref true in
          List.iter
            (fun (k, v) ->
              if !first then first := false else Buf.char b ',';
              Buf.json_string_quoted b k;
              Buf.char b ':';
              Buf.json_string_quoted b v)
            data;
          Buf.string b "}}")

(** {1 Built-in Loggers} *)

(** Null logger - discards all events *)
let null : logger = fun _ _ -> ()

(** Stderr logger with optional minimum level filter *)
let stderr ?(min_level = Debug) ?(json = false) () : logger =
 fun level event ->
  if level_gte level min_level then
    let formatted =
      if json then event_to_json event else event_to_string event
    in
    Printf.eprintf "[%s] %s\n%!" (level_to_string level) formatted

(** Stdout logger with optional minimum level filter *)
let stdout ?(min_level = Debug) ?(json = false) () : logger =
 fun level event ->
  if level_gte level min_level then
    let formatted =
      if json then event_to_json event else event_to_string event
    in
    Printf.printf "[%s] %s\n%!" (level_to_string level) formatted

(** Custom logger from a simple callback *)
let custom (f : level -> string -> unit) : logger =
 fun level event -> f level (event_to_string event)

(** Custom logger with JSON output *)
let custom_json (f : level -> string -> unit) : logger =
 fun level event -> f level (event_to_json event)

(** Combine multiple loggers *)
let combine (loggers : logger list) : logger =
 fun level event -> List.iter (fun logger -> logger level event) loggers

(** Filter logger by minimum level *)
let with_min_level (min_level : level) (logger : logger) : logger =
 fun level event -> if level_gte level min_level then logger level event

(** {1 Request ID generation} *)

(** Counter for unique request IDs *)
let request_id_counter = ref 0

(** Generate a unique request ID *)
let generate_request_id () =
  incr request_id_counter;
  let random = Random.int 0xFFFF in
  let buf = Buffer.create 32 in
  Buffer.add_string buf "req-";
  let n = !request_id_counter in
  let s = string_of_int n in
  for _ = 1 to 6 - String.length s do
    Buffer.add_char buf '0'
  done;
  Buffer.add_string buf s;
  Buffer.add_char buf '-';
  let hex_buf = Buffer.create 8 in
  Buf.hex hex_buf random;
  let hx = Buffer.contents hex_buf in
  for _ = 1 to 4 - String.length hx do
    Buffer.add_char buf '0'
  done;
  Buffer.add_string buf hx;
  Buffer.contents buf