feat: add lwt wrapper

ezcurl-lwt.opam

@@ -0,0 +1,27 @@
+opam-version: "2.0"
+name: "ezcurl-lwt"
+version: "0.1"
+authors: ["Simon Cruanes"]
+maintainer: "simon.cruanes.2007@m4x.org"
+license: "MIT"
+synopsis: "Friendly wrapper around OCurl, Lwt version"
+build: [
+  ["dune" "build" "@install" "-p" name "-j" jobs]
+  ["dune" "build" "@doc" "-p" name] {with-doc}
+  ["dune" "runtest" "-p" name] {with-test}
+]
+depends: [
+  "base-bytes"
+  "result"
+  "ocurl"
+  "ezcurl"
+  "lwt"
+  "dune" {build}
+  "odoc" {with-doc}
+  "ocaml" { >= "4.03.0" }
+]
+tags: [ "curl" "web" "http" "client" "lwt" ]
+homepage: "https://github.com/c-cube/ezcurl/"
+doc: "https://c-cube.github.io/ezcurl/doc/1.2"
+bug-reports: "https://github.com/c-cube/ezcurl/issues"
+dev-repo: "git+https://github.com/c-cube/ezcurl.git"

src/Ezcurl.mli

@@ -1,67 +0,0 @@
-
-module Config : sig
-  type t
-  val default : t
-  val verbose : bool -> t -> t
-  val authmethod : Curl.curlAuth list -> t -> t
-  val max_redirects : int -> t -> t
-  val follow_location : bool -> t -> t
-  val username : string -> t -> t
-  val password : string -> t -> t
-end
-
-type t
-
-val make :
-  ?set_opts:(Curl.t -> unit) ->
-  unit -> t
-
-val delete : t -> unit
-
-val with_client :
-  ?set_opts:(Curl.t -> unit) ->
-  (t -> 'a) -> 'a
-(** Make a temporary client, call the function with it, then cleanup *)
-
-(* TODO: duphandle is deprecated, how do we iterate on options?
-val copy : t -> t
-   *)
-
-type response_info = {
-  ri_response_time: float;
-  ri_redirect_count: int;
-}
-
-type response = {
-  code: int;
-  headers: (string * string) list;
-  body: string;
-  info: response_info;
-}
-
-type meth =
-  | GET
-  | POST of Curl.curlHTTPPost list
-  | PUT
-
-val string_of_meth : meth -> string
-
-val http :
-  ?tries:int ->
-  ?client:t ->
-  ?config:Config.t ->
-  ?headers:(string*string) list ->
-  url:string ->
-  meth:meth ->
-  unit ->
-  (response, Curl.curlCode * string) result
-
-val get :
-  ?tries:int ->
-  ?client:t ->
-  ?config:Config.t ->
-  ?headers:(string*string) list ->
-  url:string ->
-  unit ->
-  (response, Curl.curlCode * string) result
-

src/core/Ezcurl_core.ml

@@ -1,5 +1,4 @@
 
-let opt_map ~f = function None -> None | Some x -> Some (f x)
 let opt_iter ~f = function None -> () | Some x -> f x
 
 module Config = struct
@@ -88,6 +87,48 @@ type response = {
   info: response_info;
 }
 
+type meth =
+  | GET
+  | POST of Curl.curlHTTPPost list
+  | PUT
+
+let string_of_meth = function
+  | GET -> "GET"
+  | POST _ -> "POST"
+  | PUT -> "PUT"
+
+module type IO = sig
+  type 'a t
+  val return : 'a -> 'a t
+  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+  val (>|=) : 'a t -> ('a -> 'b) -> 'b t
+  val fail : exn -> 'a t
+  val perform : Curl.t -> Curl.curlCode t
+end
+
+module type S = sig
+  type 'a io
+
+  val http :
+    ?tries:int ->
+    ?client:t ->
+    ?config:Config.t ->
+    ?headers:(string*string) list ->
+    url:string ->
+    meth:meth ->
+    unit ->
+    (response, Curl.curlCode * string) result io
+
+  val get :
+    ?tries:int ->
+    ?client:t ->
+    ?config:Config.t ->
+    ?headers:(string*string) list ->
+    url:string ->
+    unit ->
+    (response, Curl.curlCode * string) result io
+end
+
 exception Parse_error of Curl.curlCode * string
 
 let mk_res (self:t) headers body : (response,_) result =
@@ -114,77 +155,74 @@ let mk_res (self:t) headers body : (response,_) result =
   with Parse_error (e, msg) ->
     Error (e, Curl.strerror e ^ ": " ^ msg)
 
-type meth =
+module Make(IO : IO)
-  | GET
+(*   : S with module IO = IO  *)
-  | POST of Curl.curlHTTPPost list
+= struct
-  | PUT
+  open IO
 
-let string_of_meth = function
+  type 'a io = 'a IO.t
-  | GET -> "GET"
-  | POST _ -> "POST"
-  | PUT -> "PUT"
 
-let http
+  let http
-    ?(tries=1) ?client ?(config=Config.default) ?(headers=[]) ~url ~meth ()
+      ?(tries=1) ?client ?(config=Config.default) ?(headers=[]) ~url ~meth ()
-  : _ result =
+    : _ result io =
-  let do_cleanup, self = match client with
+    let do_cleanup, self = match client with
-    | None -> true, make()
+      | None -> true, make()
-    | Some c ->
+      | Some c ->
-      Curl.reset c;
+        Curl.reset c;
-      false, c
+        false, c
-  in
+    in
-  _apply_config self config;
+    _apply_config self config;
-  (* 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 = ref "" in  
+    let body = ref "" 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
+    begin match meth with
-    | POST l -> Curl.set_httppost self l;
+      | POST l -> Curl.set_httppost self l;
-    | GET -> Curl.set_httpget self true;
+      | GET -> Curl.set_httpget self true;
-    | PUT -> Curl.set_put self true;
+      | PUT -> Curl.set_put self true;
-  end;
+    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; 
          );
-         
+         String.length s0);
-         resp_headers := s :: !resp_headers; 
+    Curl.set_writefunction self
-       );
+      (fun s ->
-       String.length s0);
+         body := (if !body = "" then s else !body ^ s);
-  Curl.set_writefunction self
+         String.length s);
-    (fun s ->
+    let rec loop i =
-       body := (if !body = "" then s else !body ^ s);
+      IO.perform self >>= function
-       String.length s);
+      | Curl.CURLE_OK ->
-  let rec loop i =
+        let r = mk_res self (List.rev !resp_headers) !body in
-    match Curl.perform self with
+        if do_cleanup then Curl.cleanup self;
-    | () ->
+        return r
-      let r = mk_res self (List.rev !resp_headers) !body in
+      | Curl.CURLE_AGAIN when i > 1 ->
-      if do_cleanup then Curl.cleanup self;
+        loop (i-1) (* try again *)
-      r
+      | c ->
-    | exception Curl.CurlException (Curl.CURLE_AGAIN, _, _) when i > 1 ->
+        if do_cleanup then Curl.cleanup self;
-      (* another try *)
+        return (Error (c, Curl.strerror c))
-      loop (i-1)
+    in
-    | exception Curl.CurlException (c, _, _) ->
+    loop tries
-      if do_cleanup then Curl.cleanup self;
-      Error (c, Curl.strerror c)
-  in
-  loop tries
 
-let get ?tries ?client ?config ?headers ~url () : _ result =
+  let get ?tries ?client ?config ?headers ~url () : _ result io =
-  http ?tries ?client ?config ?headers  ~url ~meth:GET ()
+    http ?tries ?client ?config ?headers  ~url ~meth:GET ()
 
-(* TODO
+  (* TODO
-let post ?verbose ?tries ?client ?auth ?username ?password ~url () : _ result =
+  let post ?verbose ?tries ?client ?auth ?username ?password ~url () : _ result =
-  call ?verbose ?tries ?client ?auth ?username ?password ~url ~meth:GET ()
+    call ?verbose ?tries ?client ?auth ?username ?password ~url ~meth:GET ()
-   *)
+     *)
+end

src/core/Ezcurl_core.mli

@@ -0,0 +1,85 @@
+
+(** {1 Core signatures and implementation} *)
+
+module Config : sig
+  type t
+  val default : t
+  val verbose : bool -> t -> t
+  val authmethod : Curl.curlAuth list -> t -> t
+  val max_redirects : int -> t -> t
+  val follow_location : bool -> t -> t
+  val username : string -> t -> t
+  val password : string -> t -> t
+end
+
+type t = Curl.t
+
+val make :
+  ?set_opts:(t -> unit) ->
+  unit -> t
+
+val delete : t -> unit
+
+val with_client :
+  ?set_opts:(t -> unit) ->
+  (t -> 'a) -> 'a
+(** Make a temporary client, call the function with it, then cleanup *)
+
+(* TODO: duphandle is deprecated, how do we iterate on options?
+val copy : t -> t
+   *)
+
+type response_info = {
+  ri_response_time: float;
+  ri_redirect_count: int;
+}
+
+type response = {
+  code: int;
+  headers: (string * string) list;
+  body: string;
+  info: response_info;
+}
+
+type meth =
+  | GET
+  | POST of Curl.curlHTTPPost list
+  | PUT
+
+val string_of_meth : meth -> string
+
+(** {2 Underlying IO Monad} *)
+module type IO = sig
+  type 'a t
+  val return : 'a -> 'a t
+  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+  val (>|=) : 'a t -> ('a -> 'b) -> 'b t
+  val fail : exn -> 'a t
+  val perform : Curl.t -> Curl.curlCode t
+end
+
+(** {2 Main Signature} *)
+module type S = sig
+  type 'a io
+
+  val http :
+    ?tries:int ->
+    ?client:t ->
+    ?config:Config.t ->
+    ?headers:(string*string) list ->
+    url:string ->
+    meth:meth ->
+    unit ->
+    (response, Curl.curlCode * string) result io
+
+  val get :
+    ?tries:int ->
+    ?client:t ->
+    ?config:Config.t ->
+    ?headers:(string*string) list ->
+    url:string ->
+    unit ->
+    (response, Curl.curlCode * string) result io
+end
+
+module Make(IO : IO) : S with type 'a io = 'a IO.t

src/core/dune

@@ -0,0 +1,6 @@
+
+(library
+ (name ezcurl_core)
+ (public_name ezcurl.core)
+ (flags :standard -warn-error -32)
+ (libraries curl))

src/lwt/Ezcurl_lwt.ml

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

src/lwt/dune

@@ -0,0 +1,6 @@
+
+(library
+ (name ezcurl_lwt)
+ (public_name ezcurl-lwt)
+ (flags :standard -warn-error -32)
+ (libraries curl.lwt ezcurl.core))

src/sync/Ezcurl.ml

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

src/sync/dune

@@ -1,4 +1,4 @@
 (library
  (name ezcurl)
  (flags :standard -warn-error -32)
- (libraries curl))
+ (libraries curl ezcurl.core))