(** JSON API Helpers for Requests *)

(** {1 Response Helpers} *)

let read_body response = Requests.Response.body response |> Eio.Flow.read_all

let check_2xx response =
  let status = Requests.Response.status_code response in
  let body = read_body response in
  if status >= 200 && status < 300 then Ok body
  else Error (status, body)

let check_ok response =
  let status = Requests.Response.status_code response in
  let body = read_body response in
  if status = 200 then Ok body
  else Error (status, body)

(** {1 Request Helpers with Status Checking} *)

let get_result session url =
  try
    let response = Requests.get session url in
    check_2xx response
  with exn ->
    Error (0, Printexc.to_string exn)

(** {1 JSON Helpers} *)

let parse_json decoder body_str =
  match Jsont_bytesrw.decode_string' decoder body_str with
  | Ok v -> v
  | Error e -> failwith (Fmt.str "JSON parse error: %s" (Jsont.Error.to_string e))

let parse_json_result decoder body_str =
  match Jsont_bytesrw.decode_string' decoder body_str with
  | Ok v -> Ok v
  | Error e -> Error (Jsont.Error.to_string e)

let get_json_exn session url decoder =
  let response = Requests.get session url in
  let status = Requests.Response.status_code response in
  if status < 200 || status >= 300 then
    failwith (Printf.sprintf "HTTP %d" status);
  read_body response |> parse_json decoder

let get_json session url decoder =
  match get_result session url with
  | Ok body ->
      (match parse_json_result decoder body with
       | Ok result -> Ok result
       | Error msg -> Error (`Json_error msg))
  | Error (status, body) -> Error (`Http (status, body))

let post_json session url jsont_codec value =
  let body_str = match Jsont_bytesrw.encode_string' jsont_codec value with
    | Ok s -> s
    | Error e -> failwith (Fmt.str "JSON encoding error: %s" (Jsont.Error.to_string e))
  in
  let body = Requests.Body.of_string Requests.Mime.json body_str in
  Requests.post session url ~body

let post_json_exn session url jsont_codec value =
  let response = post_json session url jsont_codec value in
  let status = Requests.Response.status_code response in
  if status < 200 || status >= 300 then
    failwith (Printf.sprintf "HTTP %d" status);
  read_body response

let post_json_result session url jsont_codec value =
  try
    let response = post_json session url jsont_codec value in
    check_2xx response
  with exn ->
    Error (0, Printexc.to_string exn)

let post_json_decode_exn session url ~req req_value ~resp =
  let response = post_json session url req req_value in
  let status = Requests.Response.status_code response in
  if status < 200 || status >= 300 then
    failwith (Printf.sprintf "HTTP %d" status);
  read_body response |> parse_json resp

let post_json_decode session url ~req req_value ~resp =
  try
    let response = post_json session url req req_value in
    match check_2xx response with
    | Ok body ->
        (match parse_json_result resp body with
         | Ok result -> Ok result
         | Error msg -> Error (`Json_error msg))
    | Error (status, body) -> Error (`Http (status, body))
  with exn ->
    Error (`Http (0, Printexc.to_string exn))

let put_json_exn session url jsont_codec value =
  let body_str = match Jsont_bytesrw.encode_string' jsont_codec value with
    | Ok s -> s
    | Error e -> failwith (Fmt.str "JSON encoding error: %s" (Jsont.Error.to_string e))
  in
  let body = Requests.Body.of_string Requests.Mime.json body_str in
  let response = Requests.put session url ~body in
  let status = Requests.Response.status_code response in
  if status < 200 || status >= 300 then
    failwith (Printf.sprintf "HTTP %d" status);
  read_body response

let put_json_decode_exn session url ~req req_value ~resp =
  let body_str = match Jsont_bytesrw.encode_string' req req_value with
    | Ok s -> s
    | Error e -> failwith (Fmt.str "JSON encoding error: %s" (Jsont.Error.to_string e))
  in
  let body = Requests.Body.of_string Requests.Mime.json body_str in
  let response = Requests.put session url ~body in
  let status = Requests.Response.status_code response in
  if status < 200 || status >= 300 then
    failwith (Printf.sprintf "HTTP %d" status);
  read_body response |> parse_json resp

let patch_json_exn session url jsont_codec value =
  let body_str = match Jsont_bytesrw.encode_string' jsont_codec value with
    | Ok s -> s
    | Error e -> failwith (Fmt.str "JSON encoding error: %s" (Jsont.Error.to_string e))
  in
  let body = Requests.Body.of_string Requests.Mime.json body_str in
  let response = Requests.patch session url ~body in
  let status = Requests.Response.status_code response in
  if status < 200 || status >= 300 then
    failwith (Printf.sprintf "HTTP %d" status);
  read_body response

let delete_json_exn session url =
  let response = Requests.delete session url in
  let status = Requests.Response.status_code response in
  if status < 200 || status >= 300 then
    failwith (Printf.sprintf "HTTP %d" status);
  read_body response

(** {1 URL Helpers} *)

let ( / ) base path =
  (* Handle trailing slash in base and leading slash in path *)
  let base = if String.ends_with ~suffix:"/" base then String.sub base 0 (String.length base - 1) else base in
  let path = if String.starts_with ~prefix:"/" path then String.sub path 1 (String.length path - 1) else path in
  base ^ "/" ^ path

let make_url = ( / )

(** {1 Let Syntax for Composition} *)

module Syntax = struct
  let ( let* ) x f = Result.bind x f
  let ( let+ ) x f = Result.map f x
  let ( and* ) a b = match a, b with
    | Ok a, Ok b -> Ok (a, b)
    | Error e, _ | _, Error e -> Error e
  let ( and+ ) = ( and* )
end

(** {1 Convenience Combinators} *)

let or_fail = function
  | Ok x -> x
  | Error (`Http (code, msg)) ->
      failwith (Printf.sprintf "HTTP %d: %s" code msg)
  | Error (`Json_error msg) ->
      failwith (Printf.sprintf "JSON error: %s" msg)

let or_fail_with prefix = function
  | Ok x -> x
  | Error (`Http (code, msg)) ->
      failwith (Printf.sprintf "%s: HTTP %d: %s" prefix code msg)
  | Error (`Json_error msg) ->
      failwith (Printf.sprintf "%s: JSON error: %s" prefix msg)