Source file bizowie_api.ml

open Lwt.Infix

type response = {
  data : Yojson.Safe.t;
  success : bool;
}

type transport =
  uri:Uri.t ->
  headers:Cohttp.Header.t ->
  body:string ->
  (Cohttp.Code.status_code * string) Lwt.t

type t = {
  api_key : string;
  secret_key : string;
  site : string;
  v2 : bool;
  api_version : string;
  debug : bool;
  transport : transport;
}

exception Bizowie_error of string

let default_transport ~uri ~headers ~body =
  Cohttp_lwt_unix.Client.post
    ~headers
    ~body:(Cohttp_lwt.Body.of_string body)
    uri
  >>= fun (resp, body) ->
  Cohttp_lwt.Body.to_string body >|= fun body_str ->
  (Cohttp.Response.status resp, body_str)

let create
    ?(v2 = false)
    ?(api_version = "1.00")
    ?(debug = false)
    ?(transport = default_transport)
    ~api_key
    ~secret_key
    ~site
    () =
  if site = "" then raise (Bizowie_error "site not specified");
  if api_key = "" then raise (Bizowie_error "api_key not specified");
  if secret_key = "" then raise (Bizowie_error "secret_key not specified");
  { api_key; secret_key; site; v2; api_version; debug; transport }

let random_initialized = ref false

let random_boundary () =
  if not !random_initialized then begin
    Random.self_init ();
    random_initialized := true
  end;
  let buf = Buffer.create 40 in
  Buffer.add_string buf "----BizowieAPI";
  for _ = 1 to 24 do
    let n = Random.int 36 in
    if n < 10 then Buffer.add_char buf (Char.chr (Char.code '0' + n))
    else Buffer.add_char buf (Char.chr (Char.code 'a' + n - 10))
  done;
  Buffer.contents buf

let build_multipart boundary fields =
  let buf = Buffer.create 1024 in
  List.iter (fun (name, value) ->
    Buffer.add_string buf "--";
    Buffer.add_string buf boundary;
    Buffer.add_string buf "\r\n";
    Buffer.add_string buf (Printf.sprintf
      "Content-Disposition: form-data; name=\"%s\"\r\n\r\n" name);
    Buffer.add_string buf value;
    Buffer.add_string buf "\r\n"
  ) fields;
  Buffer.add_string buf "--";
  Buffer.add_string buf boundary;
  Buffer.add_string buf "--\r\n";
  Buffer.contents buf

let normalize_params = function
  | `Assoc l -> l
  | `Null -> []
  | _ -> raise (Bizowie_error "params must be a JSON object")

let is_truthy = function
  | `Bool b -> b
  | `Int n -> n <> 0
  | `Float f -> f <> 0.0
  | `String s ->
    s <> "" && s <> "0" && String.lowercase_ascii s <> "false"
  | `Null -> false
  | _ -> true

let parse_response ~debug body_str =
  match Yojson.Safe.from_string body_str with
  | exception _ ->
    if debug then prerr_endline ("[Bizowie::API] " ^ body_str);
    { data = `Assoc [("unprocessed", `Int 1)]; success = false }
  | `Assoc fields ->
    let success_field = List.assoc_opt "success" fields in
    let rest = List.filter (fun (k, _) -> k <> "success") fields in
    let success =
      match success_field with
      | Some v -> is_truthy v
      | None -> false
    in
    { data = `Assoc rest; success }
  | other ->
    { data = other; success = false }

let post t ~url ~content_type ~body =
  let headers = Cohttp.Header.of_list [
    "Content-Type", content_type;
    "User-Agent", "Bizowie::API";
  ] in
  t.transport ~uri:url ~headers ~body
  >|= fun (_status, body_str) ->
  parse_response ~debug:t.debug body_str

let call_v1 t method_ params =
  let url =
    Uri.of_string (Printf.sprintf "https://%s/bz/api/%s" t.site method_)
  in
  let request_json =
    Yojson.Safe.to_string (`Assoc (normalize_params params))
  in
  let boundary = random_boundary () in
  let body = build_multipart boundary [
    "api_key", t.api_key;
    "secret_key", t.secret_key;
    "site", t.site;
    "request", request_json;
  ] in
  let content_type = "multipart/form-data; boundary=" ^ boundary in
  post t ~url ~content_type ~body

let call_v2 t method_ params =
  let url =
    Uri.of_string (Printf.sprintf "https://%s/bz/apiv2/call/%s" t.site method_)
  in
  let assoc = normalize_params params in
  let assoc =
    List.filter (fun (k, _) -> k <> "api_key" && k <> "secret_key") assoc
  in
  let assoc = assoc @ [
    "api_key", `String t.api_key;
    "secret_key", `String t.secret_key;
  ] in
  let assoc =
    if List.mem_assoc "api_version" assoc then assoc
    else assoc @ ["api_version", `String t.api_version]
  in
  let body = Yojson.Safe.to_string (`Assoc assoc) in
  post t ~url ~content_type:"form-data" ~body

let call t method_ params =
  if method_ = "" then
    raise (Bizowie_error "[Bizowie::API] fatal error: no method given");
  if t.v2 then call_v2 t method_ params
  else call_v1 t method_ params

let call_sync t method_ params =
  Lwt_main.run (call t method_ params)