(*---------------------------------------------------------------------------
  Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
  SPDX-License-Identifier: ISC
 ---------------------------------------------------------------------------*)

(** Centralized error handling for the Requests library using Eio.Io exceptions *)

let src = Logs.Src.create "requests.error" ~doc:"HTTP Request Errors"
module Log = (val Logs.src_log src : Logs.LOG)

(** {1 Error Type}

    Following the Eio.Io exception pattern for structured error handling.
    Each variant contains a record with contextual information. *)

type error =
  (* Timeout errors *)
  | Timeout of { operation: string; duration: float option }

  (* Redirect errors *)
  | Too_many_redirects of { url: string; count: int; max: int }
  | Invalid_redirect of { url: string; reason: string }

  (* HTTP response errors *)
  (* Note: headers stored as list to avoid dependency cycle with Headers module *)
  | Http_error of {
      url: string;
      status: int;
      reason: string;
      body_preview: string option;
      headers: (string * string) list
    }

  (* Authentication errors *)
  | Authentication_failed of { url: string; reason: string }

  (* Connection errors - granular breakdown per Recommendation #17 *)
  | Dns_resolution_failed of { hostname: string }
  | Tcp_connect_failed of { host: string; port: int; reason: string }
  | Tls_handshake_failed of { host: string; reason: string }

  (* Security-related errors *)
  | Invalid_header of { name: string; reason: string }
  | Body_too_large of { limit: int64; actual: int64 option }
  | Headers_too_large of { limit: int; actual: int }
  | Decompression_bomb of { limit: int64; ratio: float }
  | Content_length_mismatch of { expected: int64; actual: int64 }
  | Insecure_auth of { url: string; auth_type: string }
      (** Per RFC 7617 Section 4 and RFC 6750 Section 5.1:
          Basic, Bearer, and Digest authentication over unencrypted HTTP
          exposes credentials to eavesdropping. *)

  (* JSON errors *)
  | Json_parse_error of { body_preview: string; reason: string }
  | Json_encode_error of { reason: string }

  (* Other errors *)
  | Proxy_error of { host: string; reason: string }
  | Encoding_error of { encoding: string; reason: string }
  | Invalid_url of { url: string; reason: string }
  | Invalid_request of { reason: string }

(** {1 URL and Credential Sanitization}

    Per Recommendation #20: Remove sensitive info from error messages *)

let sanitize_url url =
  try
    let uri = Uri.of_string url in
    let sanitized = Uri.with_userinfo uri None in
    Uri.to_string sanitized
  with _ -> url  (* If parsing fails, return original *)

(** List of header names considered sensitive (lowercase) *)
let sensitive_header_names =
  ["authorization"; "cookie"; "proxy-authorization"; "x-api-key"; "api-key"; "set-cookie"]

(** Check if a header name is sensitive (case-insensitive) *)
let is_sensitive_header name =
  List.mem (String.lowercase_ascii name) sensitive_header_names

(** Sanitize a header list by redacting sensitive values *)
let sanitize_headers headers =
  List.map (fun (name, value) ->
    if is_sensitive_header name then (name, "[REDACTED]")
    else (name, value)
  ) headers

(** {1 Pretty Printing} *)

let pp_error ppf = function
  | Timeout { operation; duration } ->
      (match duration with
       | Some d -> Format.fprintf ppf "Timeout during %s after %.2fs" operation d
       | None -> Format.fprintf ppf "Timeout during %s" operation)

  | Too_many_redirects { url; count; max } ->
      Format.fprintf ppf "Too many redirects (%d/%d) for URL: %s" count max (sanitize_url url)

  | Invalid_redirect { url; reason } ->
      Format.fprintf ppf "Invalid redirect to %s: %s" (sanitize_url url) reason

  | Http_error { url; status; reason; body_preview; headers = _ } ->
      Format.fprintf ppf "@[<v>HTTP %d %s@ URL: %s" status reason (sanitize_url url);
      Option.iter (fun body ->
        let preview = if String.length body > 200
          then String.sub body 0 200 ^ "..."
          else body in
        Format.fprintf ppf "@ Body: %s" preview
      ) body_preview;
      Format.fprintf ppf "@]"

  | Authentication_failed { url; reason } ->
      Format.fprintf ppf "Authentication failed for %s: %s" (sanitize_url url) reason

  | Dns_resolution_failed { hostname } ->
      Format.fprintf ppf "DNS resolution failed for hostname: %s" hostname

  | Tcp_connect_failed { host; port; reason } ->
      Format.fprintf ppf "TCP connection to %s:%d failed: %s" host port reason

  | Tls_handshake_failed { host; reason } ->
      Format.fprintf ppf "TLS handshake with %s failed: %s" host reason

  | Invalid_header { name; reason } ->
      Format.fprintf ppf "Invalid header '%s': %s" name reason

  | Body_too_large { limit; actual } ->
      (match actual with
       | Some a -> Format.fprintf ppf "Response body too large: %Ld bytes (limit: %Ld)" a limit
       | None -> Format.fprintf ppf "Response body exceeds limit of %Ld bytes" limit)

  | Headers_too_large { limit; actual } ->
      Format.fprintf ppf "Response headers too large: %d (limit: %d)" actual limit

  | Decompression_bomb { limit; ratio } ->
      Format.fprintf ppf "Decompression bomb detected: ratio %.1f:1 exceeds limit, max size %Ld bytes"
        ratio limit

  | Content_length_mismatch { expected; actual } ->
      Format.fprintf ppf "Content-Length mismatch: expected %Ld bytes, received %Ld bytes"
        expected actual

  | Insecure_auth { url; auth_type } ->
      Format.fprintf ppf "%s authentication over unencrypted HTTP rejected for %s. \
        Use HTTPS or set allow_insecure_auth=true (not recommended)"
        auth_type (sanitize_url url)

  | Json_parse_error { body_preview; reason } ->
      let preview = if String.length body_preview > 100
        then String.sub body_preview 0 100 ^ "..."
        else body_preview in
      Format.fprintf ppf "@[<v>JSON parse error: %s@ Body preview: %s@]" reason preview

  | Json_encode_error { reason } ->
      Format.fprintf ppf "JSON encode error: %s" reason

  | Proxy_error { host; reason } ->
      Format.fprintf ppf "Proxy error for %s: %s" host reason

  | Encoding_error { encoding; reason } ->
      Format.fprintf ppf "Encoding error (%s): %s" encoding reason

  | Invalid_url { url; reason } ->
      Format.fprintf ppf "Invalid URL '%s': %s" (sanitize_url url) reason

  | Invalid_request { reason } ->
      Format.fprintf ppf "Invalid request: %s" reason

(** {1 Eio.Exn Integration}

    Following the pattern from ocaml-conpool for structured Eio exceptions *)

type Eio.Exn.err += E of error

let err e = Eio.Exn.create (E e)

let () =
  Eio.Exn.register_pp (fun f -> function
    | E e ->
        Format.fprintf f "Requests: ";
        pp_error f e;
        true
    | _ -> false)

(** {1 Query Functions}

    Per Recommendation #17: Enable smarter retry logic and error handling *)

let is_timeout = function
  | Timeout _ -> true
  | _ -> false

let is_dns = function
  | Dns_resolution_failed _ -> true
  | _ -> false

let is_tls = function
  | Tls_handshake_failed _ -> true
  | _ -> false

let is_connection = function
  | Dns_resolution_failed _ -> true
  | Tcp_connect_failed _ -> true
  | Tls_handshake_failed _ -> true
  | _ -> false

let is_http_error = function
  | Http_error _ -> true
  | _ -> false

let is_client_error = function
  | Http_error { status; _ } -> status >= 400 && status < 500
  | Authentication_failed _ -> true
  | Invalid_url _ -> true
  | Invalid_request _ -> true
  | Invalid_header _ -> true
  | _ -> false

let is_server_error = function
  | Http_error { status; _ } -> status >= 500 && status < 600
  | _ -> false

let is_retryable = function
  | Timeout _ -> true
  | Dns_resolution_failed _ -> true
  | Tcp_connect_failed _ -> true
  | Tls_handshake_failed _ -> true
  | Http_error { status; _ } ->
      (* Retryable status codes: 408, 429, 500, 502, 503, 504 *)
      List.mem status [408; 429; 500; 502; 503; 504]
  | Proxy_error _ -> true
  | _ -> false

let is_security_error = function
  | Invalid_header _ -> true
  | Body_too_large _ -> true
  | Headers_too_large _ -> true
  | Decompression_bomb _ -> true
  | Invalid_redirect _ -> true
  | Insecure_auth _ -> true
  | _ -> false

let is_json_error = function
  | Json_parse_error _ -> true
  | Json_encode_error _ -> true
  | _ -> false

(** {1 Error Extraction}

    Extract error from Eio.Io exception *)

let of_eio_exn = function
  | Eio.Io (E e, _) -> Some e
  | _ -> None

(** {1 HTTP Status Helpers} *)

let get_http_status = function
  | Http_error { status; _ } -> Some status
  | _ -> None

let get_url = function
  | Too_many_redirects { url; _ } -> Some url
  | Invalid_redirect { url; _ } -> Some url
  | Http_error { url; _ } -> Some url
  | Authentication_failed { url; _ } -> Some url
  | Invalid_url { url; _ } -> Some url
  | _ -> None

(** {1 String Conversion} *)

let to_string e =
  Format.asprintf "%a" pp_error e