mirror of
https://github.com/c-cube/ezcurl.git
synced 2025-12-06 11:15:44 -05:00
ocamlformat
This commit is contained in:
parent
73899acdf2
commit
be03f25cc0
6 changed files with 207 additions and 185 deletions
15
.ocamlformat
Normal file
15
.ocamlformat
Normal 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
|
||||||
|
|
@ -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,22 +13,23 @@ 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;
|
||||||
authmethod=None;
|
authmethod = None;
|
||||||
username=None;
|
username = None;
|
||||||
password=None;
|
password = None;
|
||||||
user_agent=Some "curl";
|
user_agent = Some "curl";
|
||||||
}
|
}
|
||||||
|
|
||||||
let password x self = {self with password=Some x}
|
let password x self = { self with password = Some x }
|
||||||
let username x self = {self with username=Some x}
|
let username x self = { self with username = Some x }
|
||||||
let verbose x self = { self with verbose=x}
|
let verbose x self = { self with verbose = x }
|
||||||
let follow_location x self = {self with follow_location=x}
|
let follow_location x self = { self with follow_location = x }
|
||||||
let max_redirects x self = {self with max_redirects=max 1 x}
|
let max_redirects x self = { self with max_redirects = max 1 x }
|
||||||
let authmethod x self = {self with authmethod=Some x}
|
let authmethod x self = { self with authmethod = Some x }
|
||||||
|
|
||||||
let string_of_authmethod = function
|
let string_of_authmethod = function
|
||||||
| Curl.CURLAUTH_ANY -> "any"
|
| Curl.CURLAUTH_ANY -> "any"
|
||||||
|
|
@ -40,31 +43,39 @@ module Config = struct
|
||||||
| None -> "<none>"
|
| None -> "<none>"
|
||||||
| Some s -> s
|
| Some s -> s
|
||||||
|
|
||||||
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;
|
||||||
let c = Curl.init () in
|
let c = Curl.init () in
|
||||||
Gc.finalise Curl.cleanup c;
|
Gc.finalise Curl.cleanup c;
|
||||||
|
|
@ -74,11 +85,18 @@ let make ?(set_opts=fun _ -> ()) () : t =
|
||||||
let delete = Curl.cleanup
|
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;
|
||||||
|
|
@ -88,10 +106,8 @@ let _apply_config (self:t) (config:Config.t) : unit =
|
||||||
opt_iter password ~f:(Curl.set_password self);
|
opt_iter password ~f:(Curl.set_password self);
|
||||||
()
|
()
|
||||||
|
|
||||||
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;
|
||||||
()
|
()
|
||||||
|
|
||||||
|
|
@ -111,7 +127,7 @@ type response_info = {
|
||||||
}
|
}
|
||||||
|
|
||||||
let pp_response_info out r =
|
let pp_response_info out r =
|
||||||
let {ri_response_time; ri_redirect_count} = r in
|
let { ri_response_time; ri_redirect_count } = r in
|
||||||
Format.fprintf out "{@[response_time=%.3fs;@ redirect_count=%d@]}"
|
Format.fprintf out "{@[response_time=%.3fs;@ redirect_count=%d@]}"
|
||||||
ri_response_time ri_redirect_count
|
ri_response_time ri_redirect_count
|
||||||
|
|
||||||
|
|
@ -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,9 +177,10 @@ 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
|
||||||
val fail : exn -> 'a t
|
val fail : exn -> 'a t
|
||||||
val perform : Curl.t -> Curl.curlCode t
|
val perform : Curl.t -> Curl.curlCode t
|
||||||
end
|
end
|
||||||
|
|
@ -180,8 +193,8 @@ 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 ->
|
||||||
unit ->
|
unit ->
|
||||||
|
|
@ -211,7 +224,7 @@ module type S = sig
|
||||||
?client:t ->
|
?client:t ->
|
||||||
?config:Config.t ->
|
?config:Config.t ->
|
||||||
?range:string ->
|
?range:string ->
|
||||||
?headers:(string*string) list ->
|
?headers:(string * string) list ->
|
||||||
url:string ->
|
url:string ->
|
||||||
unit ->
|
unit ->
|
||||||
(response, Curl.curlCode * string) result io
|
(response, Curl.curlCode * string) result io
|
||||||
|
|
@ -223,9 +236,9 @@ module type S = sig
|
||||||
?tries:int ->
|
?tries:int ->
|
||||||
?client:t ->
|
?client:t ->
|
||||||
?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]
|
||||||
|
|
@ -236,8 +249,8 @@ module type S = sig
|
||||||
?tries:int ->
|
?tries:int ->
|
||||||
?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 ->
|
||||||
|
|
@ -249,33 +262,34 @@ end
|
||||||
|
|
||||||
exception Parse_error of Curl.curlCode * string
|
exception Parse_error of Curl.curlCode * string
|
||||||
|
|
||||||
let mk_res (self:t) headers body : (response,_) result =
|
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_response_time=Curl.get_totaltime self;
|
ri_redirect_count = Curl.get_redirectcount self;
|
||||||
} in
|
ri_response_time = Curl.get_totaltime self;
|
||||||
Ok {headers; code; body; info}
|
}
|
||||||
with Parse_error (e, msg) ->
|
in
|
||||||
Error (e, Curl.strerror e ^ ": " ^ msg)
|
Ok { headers; code; body; info }
|
||||||
|
with Parse_error (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 =
|
||||||
| None -> true, make()
|
match client with
|
||||||
| Some c ->
|
| None -> true, make ()
|
||||||
false, c
|
| Some 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 =
|
||||||
|
|
|
||||||
|
|
@ -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,23 +18,19 @@ 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) ->
|
(** Create a new client.
|
||||||
unit -> t
|
|
||||||
(** 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?
|
||||||
val copy : t -> t
|
val copy : t -> t
|
||||||
*)
|
*)
|
||||||
|
|
||||||
type response_info = {
|
type response_info = {
|
||||||
ri_response_time: float;
|
ri_response_time: float;
|
||||||
|
|
@ -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,9 +76,10 @@ 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
|
||||||
val fail : exn -> 'a t
|
val fail : exn -> 'a t
|
||||||
val perform : Curl.t -> Curl.curlCode t
|
val perform : Curl.t -> Curl.curlCode t
|
||||||
end
|
end
|
||||||
|
|
@ -100,8 +93,8 @@ 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 ->
|
||||||
unit ->
|
unit ->
|
||||||
|
|
@ -131,7 +124,7 @@ module type S = sig
|
||||||
?client:t ->
|
?client:t ->
|
||||||
?config:Config.t ->
|
?config:Config.t ->
|
||||||
?range:string ->
|
?range:string ->
|
||||||
?headers:(string*string) list ->
|
?headers:(string * string) list ->
|
||||||
url:string ->
|
url:string ->
|
||||||
unit ->
|
unit ->
|
||||||
(response, Curl.curlCode * string) result io
|
(response, Curl.curlCode * string) result io
|
||||||
|
|
@ -143,9 +136,9 @@ module type S = sig
|
||||||
?tries:int ->
|
?tries:int ->
|
||||||
?client:t ->
|
?client:t ->
|
||||||
?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]
|
||||||
|
|
@ -156,8 +149,8 @@ module type S = sig
|
||||||
?tries:int ->
|
?tries:int ->
|
||||||
?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 ->
|
||||||
|
|
@ -167,4 +160,4 @@ module type S = sig
|
||||||
*)
|
*)
|
||||||
end
|
end
|
||||||
|
|
||||||
module Make(IO : IO) : S with type 'a io = 'a IO.t
|
module Make (IO : IO) : S with type 'a io = 'a IO.t
|
||||||
|
|
|
||||||
|
|
@ -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)
|
||||||
|
|
|
||||||
|
|
@ -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 (>>=) x f = f x
|
let return x = x
|
||||||
let (>|=) x f = f x
|
let ( >>= ) x f = f x
|
||||||
let fail e = raise e
|
let ( >|= ) x f = f x
|
||||||
let perform c =
|
let fail e = raise e
|
||||||
try Curl.perform c; Curl.CURLE_OK
|
|
||||||
with Curl.CurlException (c, _, _) -> c
|
let perform c =
|
||||||
end)
|
try
|
||||||
|
Curl.perform c;
|
||||||
|
Curl.CURLE_OK
|
||||||
|
with Curl.CurlException (c, _, _) -> c
|
||||||
|
end)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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@."
|
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue