simon/ezcurl
1
0
Fork 0
mirror of https://github.com/c-cube/ezcurl.git synced 2025-12-06 03:05:31 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

ocamlformat

Browse source
This commit is contained in:
Simon Cruanes 2023-06-09 21:06:20 -04:00
parent 73899acdf2
commit be03f25cc0
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
6 changed files with 207 additions and 185 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
.ocamlformat Normal file
View file

@ -0,0 +1,15 @@
version = 0.24.1
profile=conventional
margin=80
if-then-else=k-r
parens-ite=true
parens-tuple=multi-line-only
sequence-style=terminator
type-decl=sparse
break-cases=toplevel
cases-exp-indent=2
field-space=tight-decl
leading-nested-match-parens=true
module-item-spacing=compact
quiet=true
ocaml-version=4.08.0

173
src/core/Ezcurl_core.ml
View file

@ -1,4 +1,6 @@
let opt_iter ~f = function None -> () | Some x -> f x let opt_iter ~f = function
| None -> ()
| Some x -> f x
module Config = struct module Config = struct
type t = { type t = {
@ -11,7 +13,8 @@ module Config = struct
user_agent: string option; user_agent: string option;
} }
let default : t = { let default : t =
{
verbose = false; verbose = false;
max_redirects = 50; max_redirects = 50;
follow_location = true; follow_location = true;
@ -42,27 +45,35 @@ module Config = struct
let pp out (self : t) = let pp out (self : t) =
let { let {
verbose; authmethod; max_redirects; follow_location; verbose;
username; password; user_agent authmethod;
} = self in max_redirects;
follow_location;
username;
password;
user_agent;
} =
self
in
Format.fprintf out Format.fprintf out
"{@[verbose=%B;@ max_redirects=%d;@ follow_location=%B;@ \ "{@[verbose=%B;@ max_redirects=%d;@ follow_location=%B;@ username=%s;@ \
username=%s;@ password=%s;@ authmethod=%s;@ user_agent=%s@]}" password=%s;@ authmethod=%s;@ user_agent=%s@]}"
verbose max_redirects follow_location verbose max_redirects follow_location (str_of_str_opt username)
(str_of_str_opt username) (str_of_str_opt password) (str_of_str_opt password)
(match authmethod with (match authmethod with
| None -> "none" | None -> "none"
| Some l -> List.map string_of_authmethod l |> String.concat ",") (str_of_str_opt user_agent) | Some l -> List.map string_of_authmethod l |> String.concat ",")
(str_of_str_opt user_agent)
let to_string s = Format.asprintf "%a" pp s let to_string s = Format.asprintf "%a" pp s
end end
type t = Curl.t type t = Curl.t
let _init = lazy ( let _init =
Curl.global_init Curl.CURLINIT_GLOBALALL; lazy
at_exit Curl.global_cleanup; (Curl.global_init Curl.CURLINIT_GLOBALALL;
) at_exit Curl.global_cleanup)
let make ?(set_opts = fun _ -> ()) () : t = let make ?(set_opts = fun _ -> ()) () : t =
Lazy.force _init; Lazy.force _init;
@ -76,9 +87,16 @@ let delete = Curl.cleanup
(* set options *) (* set options *)
let _apply_config (self : t) (config : Config.t) : unit = let _apply_config (self : t) (config : Config.t) : unit =
let { let {
Config.verbose; max_redirects; follow_location; authmethod; Config.verbose;
username; password; user_agent max_redirects;
} = config in follow_location;
authmethod;
username;
password;
user_agent;
} =
config
in
Curl.set_verbose self verbose; Curl.set_verbose self verbose;
Curl.set_maxredirs self max_redirects; Curl.set_maxredirs self max_redirects;
Curl.set_followlocation self follow_location; Curl.set_followlocation self follow_location;
@ -89,9 +107,7 @@ let _apply_config (self:t) (config:Config.t) : unit =
() ()
let _set_headers (self : t) (headers : _ list) : unit = let _set_headers (self : t) (headers : _ list) : unit =
let headers = let headers = List.map (fun (k, v) -> k ^ ": " ^ v) headers in
List.map (fun (k,v) -> k ^ ": " ^ v) headers
in
Curl.set_httpheader self headers; Curl.set_httpheader self headers;
() ()
@ -125,17 +141,13 @@ type response = {
} }
let pp_response out r = let pp_response out r =
let pp_header out (s1,s2) = let pp_header out (s1, s2) = Format.fprintf out "@[<2>%s:@ %s@]" s1 s2 in
Format.fprintf out "@[<2>%s:@ %s@]" s1 s2
in
let pp_headers out l = let pp_headers out l =
Format.fprintf out "@[<v>%a@]" (Format.pp_print_list pp_header) l Format.fprintf out "@[<v>%a@]" (Format.pp_print_list pp_header) l
in in
let {code; body; headers; info; } = r in let { code; body; headers; info } = r in
Format.fprintf out "{@[code=%d;@ headers=@[%a@];@ info=%a;@ body=@[%a@]@]}" Format.fprintf out "{@[code=%d;@ headers=@[%a@];@ info=%a;@ body=@[%a@]@]}"
code pp_headers headers pp_response_info info code pp_headers headers pp_response_info info Format.pp_print_text body
Format.pp_print_text body
let string_of_response s = Format.asprintf "%a" pp_response s let string_of_response s = Format.asprintf "%a" pp_response s
@ -165,6 +177,7 @@ let pp_meth out m = Format.pp_print_string out (string_of_meth m)
module type IO = sig module type IO = sig
type 'a t type 'a t
val return : 'a -> 'a t val return : 'a -> 'a t
val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t
@ -180,7 +193,7 @@ module type S = sig
?client:t -> ?client:t ->
?config:Config.t -> ?config:Config.t ->
?range:string -> ?range:string ->
?content:[`String of string | `Write of (bytes -> int -> int)] -> ?content:[ `String of string | `Write of bytes -> int -> int ] ->
?headers:(string * string) list -> ?headers:(string * string) list ->
url:string -> url:string ->
meth:meth -> meth:meth ->
@ -225,7 +238,7 @@ module type S = sig
?config:Config.t -> ?config:Config.t ->
?headers:(string * string) list -> ?headers:(string * string) list ->
url:string -> url:string ->
content:[`String of string | `Write of (bytes -> int -> int)] -> content:[ `String of string | `Write of bytes -> int -> int ] ->
unit -> unit ->
(response, Curl.curlCode * string) result io (response, Curl.curlCode * string) result io
(** Shortcut for [http ~meth:PUT] (** Shortcut for [http ~meth:PUT]
@ -237,7 +250,7 @@ module type S = sig
?client:t -> ?client:t ->
?config:Config.t -> ?config:Config.t ->
?headers:(string * string) list -> ?headers:(string * string) list ->
?content:[`String of string | `Write of (bytes -> int -> int)] -> ?content:[ `String of string | `Write of bytes -> int -> int ] ->
params:Curl.curlHTTPPost list -> params:Curl.curlHTTPPost list ->
url:string -> url:string ->
unit -> unit ->
@ -253,29 +266,30 @@ let mk_res (self:t) headers body : (response,_) result =
let split_colon s = let split_colon s =
match String.index s ':' with match String.index s ':' with
| exception Not_found -> | exception Not_found ->
raise (Parse_error (Curl.CURLE_CONV_FAILED, "header line without a ':': " ^ s)) raise
(Parse_error (Curl.CURLE_CONV_FAILED, "header line without a ':': " ^ s))
| i -> | i ->
String.sub s 0 i, ( String.sub s 0 i,
String.trim (String.sub s (i+1) (String.length s-i-1)) String.trim (String.sub s (i + 1) (String.length s - i - 1)) )
in in
try try
let code = Curl.get_httpcode self in let code = Curl.get_httpcode self in
let headers = let headers =
match headers with match headers with
| [] -> [] | [] -> []
| _ :: tl -> List.map split_colon tl (* first one is "http1.1 NNN <descr>" *) | _ :: tl ->
List.map split_colon tl (* first one is "http1.1 NNN <descr>" *)
in in
let info = { let info =
{
ri_redirect_count = Curl.get_redirectcount self; ri_redirect_count = Curl.get_redirectcount self;
ri_response_time = Curl.get_totaltime self; ri_response_time = Curl.get_totaltime self;
} in }
in
Ok { headers; code; body; info } Ok { headers; code; body; info }
with Parse_error (e, msg) -> with Parse_error (e, msg) -> Error (e, Curl.strerror e ^ ": " ^ msg)
Error (e, Curl.strerror e ^ ": " ^ msg)
module Make(IO : IO) module Make (IO : IO) : S with type 'a io = 'a IO.t = struct
: S with type 'a io = 'a IO.t
= struct
open IO open IO
type 'a io = 'a IO.t type 'a io = 'a IO.t
@ -284,90 +298,83 @@ module Make(IO : IO)
match content with match content with
| `String s -> | `String s ->
let n = ref 0 in let n = ref 0 in
(fun i -> fun i ->
let len = min i (String.length s - !n) in let len = min i (String.length s - !n) in
let r = String.sub s !n len in let r = String.sub s !n len in
n := !n + len; n := !n + len;
r) r
| `Write f -> | `Write f ->
let buf = Bytes.create 1024 in let buf = Bytes.create 1024 in
(fun i -> fun i ->
let len = min i (Bytes.length buf) in let len = min i (Bytes.length buf) in
let n = f buf len in let n = f buf len in
Bytes.sub_string buf i n) Bytes.sub_string buf i n
let content_size_ = function let content_size_ = function
| `String s -> Some (String.length s) | `String s -> Some (String.length s)
| `Write _ -> None | `Write _ -> None
let http let http ?(tries = 1) ?client ?(config = Config.default) ?range ?content
?(tries=1) ?client ?(config=Config.default) ?range ?content ?(headers=[]) ~url ~meth () ?(headers = []) ~url ~meth () : _ result io =
: _ result io =
let headers = ref headers in let headers = ref headers in
let do_cleanup, self = match client with let do_cleanup, self =
match client with
| None -> true, make () | None -> true, make ()
| Some c -> | Some c -> false, c
false, c
in in
_apply_config self config; _apply_config self config;
opt_iter range ~f:(fun s -> Curl.set_range self s); opt_iter range ~f:(fun s -> Curl.set_range self s);
(* TODO: ability to make content a stream with a `read` function *) (* TODO: ability to make content a stream with a `read` function *)
opt_iter content opt_iter content ~f:(fun content ->
~f:(fun content ->
Curl.set_readfunction self (content_read_fun_ content); Curl.set_readfunction self (content_read_fun_ content);
(* also set size if known *) (* also set size if known *)
match content_size_ content, meth with match content_size_ content, meth with
| None, _ -> | None, _ ->
headers := ("expect", "") :: ("transfer-encoding", "chunked") :: !headers headers :=
| Some size , POST _ -> ("expect", "") :: ("transfer-encoding", "chunked") :: !headers
Curl.set_postfieldsize self size; | Some size, POST _ -> Curl.set_postfieldsize self size
| Some size, _ -> | Some size, _ -> Curl.set_infilesize self size);
Curl.set_infilesize self size
);
(* local state *) (* local state *)
let tries = max tries 1 in (* at least one attempt *) let tries = max tries 1 in
(* at least one attempt *)
let body = Buffer.create 64 in let body = Buffer.create 64 in
let resp_headers = ref [] in let resp_headers = ref [] in
let resp_headers_done = ref false in (* once we get "\r\n" header line *) let resp_headers_done = ref false in
(* once we get "\r\n" header line *)
Curl.set_url self url; Curl.set_url self url;
begin match meth with (match meth with
| POST [] when (content <> None) -> | POST [] when content <> None -> Curl.set_post self true
Curl.set_post self true | POST l -> Curl.set_httppost self l
| POST l -> | GET -> Curl.set_httpget self true
Curl.set_httppost self l;
| GET -> Curl.set_httpget self true;
| PUT -> | PUT ->
Curl.set_customrequest self "PUT"; Curl.set_customrequest self "PUT";
Curl.set_upload self true; Curl.set_upload self true
| DELETE -> Curl.set_customrequest self "DELETE"; | DELETE -> Curl.set_customrequest self "DELETE"
| HEAD -> Curl.set_customrequest self "HEAD" | HEAD -> Curl.set_customrequest self "HEAD"
| CONNECT -> Curl.set_customrequest self "CONNECT" | CONNECT -> Curl.set_customrequest self "CONNECT"
| OPTIONS -> Curl.set_customrequest self "OPTIONS" | OPTIONS -> Curl.set_customrequest self "OPTIONS"
| TRACE -> Curl.set_customrequest self "TRACE" | TRACE -> Curl.set_customrequest self "TRACE"
| PATCH -> Curl.set_customrequest self "PATCH" | PATCH -> Curl.set_customrequest self "PATCH");
end;
_set_headers self !headers; _set_headers self !headers;
Curl.set_headerfunction self Curl.set_headerfunction self (fun s0 ->
(fun s0 ->
let s = String.trim s0 in let s = String.trim s0 in
(* Printf.printf "got header %S\n%!" s0; *) (* Printf.printf "got header %S\n%!" s0; *)
if s0 = "\r\n" then ( if s0 = "\r\n" then
resp_headers_done := true; resp_headers_done := true
) else ( else (
(* redirection: drop previous headers *) (* redirection: drop previous headers *)
if !resp_headers_done then ( if !resp_headers_done then (
resp_headers_done := false; resp_headers_done := false;
resp_headers := []; resp_headers := []
); );
resp_headers := s :: !resp_headers; resp_headers := s :: !resp_headers
); );
String.length s0); String.length s0);
Curl.set_writefunction self Curl.set_writefunction self (fun s ->
(fun s ->
Buffer.add_string body s; Buffer.add_string body s;
String.length s); String.length s);
let rec loop i = let rec loop i =
@ -376,8 +383,7 @@ module Make(IO : IO)
let r = mk_res self (List.rev !resp_headers) (Buffer.contents body) in let r = mk_res self (List.rev !resp_headers) (Buffer.contents body) in
if do_cleanup then Curl.cleanup self; if do_cleanup then Curl.cleanup self;
return r return r
| Curl.CURLE_AGAIN when i > 1 -> | Curl.CURLE_AGAIN when i > 1 -> loop (i - 1) (* try again *)
loop (i-1) (* try again *)
| c -> | c ->
if do_cleanup then Curl.cleanup self; if do_cleanup then Curl.cleanup self;
return (Error (c, Curl.strerror c)) return (Error (c, Curl.strerror c))
@ -387,7 +393,8 @@ module Make(IO : IO)
let get ?tries ?client ?config ?range ?headers ~url () : _ result io = let get ?tries ?client ?config ?range ?headers ~url () : _ result io =
http ?tries ?client ?config ?range ?headers ~url ~meth:GET () http ?tries ?client ?config ?range ?headers ~url ~meth:GET ()
let post ?tries ?client ?config ?headers ?content ~params ~url () : _ result io = let post ?tries ?client ?config ?headers ?content ~params ~url () :
_ result io =
http ?tries ?client ?config ?headers ?content ~url ~meth:(POST params) () http ?tries ?client ?config ?headers ?content ~url ~meth:(POST params) ()
let put ?tries ?client ?config ?headers ~url ~content () : _ result io = let put ?tries ?client ?config ?headers ~url ~content () : _ result io =

27
src/core/Ezcurl_core.mli
View file

@ -1,9 +1,9 @@
(** Core signatures and implementation *) (** Core signatures and implementation *)
(** Configuration for the client. *) (** Configuration for the client. *)
module Config : sig module Config : sig
type t type t
val default : t val default : t
val verbose : bool -> t -> t val verbose : bool -> t -> t
val authmethod : Curl.curlAuth list -> t -> t val authmethod : Curl.curlAuth list -> t -> t
@ -11,7 +11,6 @@ module Config : sig
val follow_location : bool -> t -> t val follow_location : bool -> t -> t
val username : string -> t -> t val username : string -> t -> t
val password : string -> t -> t val password : string -> t -> t
val pp : Format.formatter -> t -> unit val pp : Format.formatter -> t -> unit
val to_string : t -> string val to_string : t -> string
end end
@ -19,18 +18,14 @@ end
type t = Curl.t type t = Curl.t
(** A client, i.e. a cURL instance. *) (** A client, i.e. a cURL instance. *)
val make : val make : ?set_opts:(t -> unit) -> unit -> t
?set_opts:(t -> unit) ->
unit -> t
(** Create a new client. (** Create a new client.
@param set_opts called before returning the client, to set options *) @param set_opts called before returning the client, to set options *)
val delete : t -> unit val delete : t -> unit
(** Delete the client. It cannot be used anymore. *) (** Delete the client. It cannot be used anymore. *)
val with_client : val with_client : ?set_opts:(t -> unit) -> (t -> 'a) -> 'a
?set_opts:(t -> unit) ->
(t -> 'a) -> 'a
(** Make a temporary client, call the function with it, then cleanup. *) (** Make a temporary client, call the function with it, then cleanup. *)
(* TODO: duphandle is deprecated, how do we iterate on options? (* TODO: duphandle is deprecated, how do we iterate on options?
@ -53,12 +48,9 @@ val string_of_response_info : response_info -> string
type response = { type response = {
code: int; code: int;
(** Response code. See https://developer.mozilla.org/en-US/docs/Web/HTTP/Status *) (** Response code. See https://developer.mozilla.org/en-US/docs/Web/HTTP/Status *)
headers: (string * string) list; headers: (string * string) list; (** Response headers *)
(** Response headers *) body: string; (** Response body, or [""] *)
body: string; info: response_info; (** Information about the response *)
(** Response body, or [""] *)
info: response_info;
(** Information about the response *)
} }
(** Response for a given request. *) (** Response for a given request. *)
@ -84,6 +76,7 @@ val string_of_meth : meth -> string
(** {2 Underlying IO Monad} *) (** {2 Underlying IO Monad} *)
module type IO = sig module type IO = sig
type 'a t type 'a t
val return : 'a -> 'a t val return : 'a -> 'a t
val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t
@ -100,7 +93,7 @@ module type S = sig
?client:t -> ?client:t ->
?config:Config.t -> ?config:Config.t ->
?range:string -> ?range:string ->
?content:[`String of string | `Write of (bytes -> int -> int)] -> ?content:[ `String of string | `Write of bytes -> int -> int ] ->
?headers:(string * string) list -> ?headers:(string * string) list ->
url:string -> url:string ->
meth:meth -> meth:meth ->
@ -145,7 +138,7 @@ module type S = sig
?config:Config.t -> ?config:Config.t ->
?headers:(string * string) list -> ?headers:(string * string) list ->
url:string -> url:string ->
content:[`String of string | `Write of (bytes -> int -> int)] -> content:[ `String of string | `Write of bytes -> int -> int ] ->
unit -> unit ->
(response, Curl.curlCode * string) result io (response, Curl.curlCode * string) result io
(** Shortcut for [http ~meth:PUT] (** Shortcut for [http ~meth:PUT]
@ -157,7 +150,7 @@ module type S = sig
?client:t -> ?client:t ->
?config:Config.t -> ?config:Config.t ->
?headers:(string * string) list -> ?headers:(string * string) list ->
?content:[`String of string | `Write of (bytes -> int -> int)] -> ?content:[ `String of string | `Write of bytes -> int -> int ] ->
params:Curl.curlHTTPPost list -> params:Curl.curlHTTPPost list ->
url:string -> url:string ->
unit -> unit ->

2
src/lwt/Ezcurl_lwt.ml
View file

@ -1,7 +1,7 @@
include Ezcurl_core include Ezcurl_core
include Make (struct include Make (struct
include Lwt include Lwt
let perform = Curl_lwt.perform let perform = Curl_lwt.perform
end) end)

7
src/sync/Ezcurl.ml
View file

@ -1,16 +1,19 @@
(** {1 Synchronous API} *) (** {1 Synchronous API} *)
include Ezcurl_core include Ezcurl_core
include Ezcurl_core.Make (struct include Ezcurl_core.Make (struct
type 'a t = 'a type 'a t = 'a
let return x = x let return x = x
let ( >>= ) x f = f x let ( >>= ) x f = f x
let ( >|= ) x f = f x let ( >|= ) x f = f x
let fail e = raise e let fail e = raise e
let perform c = let perform c =
try Curl.perform c; Curl.CURLE_OK try
Curl.perform c;
Curl.CURLE_OK
with Curl.CurlException (c, _, _) -> c with Curl.CurlException (c, _, _) -> c
end) end)

10
test/basic_test.ml
View file

@ -1,6 +1,10 @@
let () = let () =
match Ezcurl.get ~url:"https://archive.softwareheritage.org/api/1/content/sha1_git:7bdf38d4468c114206c9b6ebd9cf1176e085d346/" () with match
Ezcurl.get
~url:
"https://archive.softwareheritage.org/api/1/content/sha1_git:7bdf38d4468c114206c9b6ebd9cf1176e085d346/"
()
with
| Error (code, msg) -> | Error (code, msg) ->
Format.eprintf "curl error: code `%s` (%s)@." (Curl.strerror code) msg Format.eprintf "curl error: code `%s` (%s)@." (Curl.strerror code) msg
| Ok _response -> | Ok _response -> Format.printf "OK@."
Format.printf "OK@."