Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Renaming.

  • Loading branch information...
commit 1299216031d1cf8ef84f942fc669903f2db72a15 1 parent 31ac7b7
@yallop yallop authored
View
14 cohttp/client.ml
@@ -27,13 +27,13 @@ module Make
>>= function
|None -> failure
|Some res -> begin
- response res >>
+ response res >>= fun () ->
match Response.has_body res with
|false ->
body_end
|true ->
- Response.read_body res body ic >>
- body_end >>
+ Response.read_body res body ic >>= fun () ->
+ body_end >>= fun () ->
put `Complete
end
@@ -46,13 +46,13 @@ module Make
|None ->
let encoding = Transfer.Fixed 0 in
let req = Request.make ~meth ~encoding ?headers ~body uri in
- Request.write req (fun _ -> None) oc >>
+ Request.write' req (fun () -> None) oc >>= fun () ->
run_response (read_response signal ic)
|Some body -> begin
match chunked with
|true ->
let req = Request.make ~meth ?headers ~body uri in
- Request.write req body oc >>
+ Request.write' req (fun () -> None) oc >>= fun () ->
run_response (read_response signal ic)
|false ->
(* If chunked is not allowed, then call [body_fn] once insert length header *)
@@ -60,13 +60,13 @@ module Make
|None ->
let encoding = Transfer.Fixed 0 in
let req = Request.make ~meth ~encoding ?headers ~body uri in
- Request.write req body oc >>
+ Request.write' req body oc >>= fun () ->
run_response (read_response signal ic)
|Some buf ->
let clen = String.length buf in
let encoding = Transfer.Fixed clen in
let req = Request.make ~meth ~encoding ?headers ~body uri in
- Request.write req body oc >>
+ Request.write' req body oc >>= fun () ->
run_response (read_response signal ic)
end
View
18 cohttp/request.ml
@@ -47,8 +47,8 @@ module type S = sig
val write_header : t -> IO.oc -> unit IO.t
val write_body : t -> IO.oc -> string -> unit IO.t
val write_footer : t -> IO.oc -> unit IO.t
- val write : t -> (unit -> string option) -> IO.oc -> unit IO.t
- val write' : (t -> IO.oc -> unit IO.t) -> t -> IO.oc -> unit IO.t
+ val write' : t -> (unit -> string option) -> IO.oc -> unit IO.t
+ val write : (t -> IO.oc -> unit IO.t) -> t -> IO.oc -> unit IO.t
val is_form: t -> bool
val read_form : t -> IO.ic -> (string * string list) list IO.t
@@ -132,7 +132,7 @@ module Make(IO : IO.S) = struct
match Header.get_content_range headers with
|Some clen -> Transfer.Fixed clen
|None -> begin
- match body with
+ match body with
|None -> Transfer.Fixed 0
|Some _ -> Transfer.Chunked
end
@@ -160,17 +160,15 @@ module Make(IO : IO.S) = struct
IO.write oc "0\r\n\r\n"
|Transfer.Fixed _ | Transfer.Unknown -> return ()
- let write req fn oc =
- write_header req oc >>= fun _ ->
- Body_IO.write req.encoding fn oc >>= fun () ->
- write_footer req oc
-
(* TODO: remove either write' or write *)
- let write' fn req oc =
+ let write write_body req oc =
write_header req oc >>= fun () ->
- fn req oc >>= fun () ->
+ write_body req oc >>= fun () ->
write_footer req oc
+ let write' req fn oc =
+ write (fun req oc -> Body_IO.write req.encoding fn oc) req oc
+
let is_form req = Header.is_form req.headers
let read_form req ic = Header_IO.parse_form req.headers ic
end
View
4 cohttp/request.mli
@@ -47,8 +47,8 @@ module type S = sig
val write_header : t -> IO.oc -> unit IO.t
val write_body : t -> IO.oc -> string -> unit IO.t
val write_footer : t -> IO.oc -> unit IO.t
- val write : t -> (unit -> string option) -> IO.oc -> unit IO.t
- val write' : (t -> IO.oc -> unit IO.t) -> t -> IO.oc -> unit IO.t
+ val write' : t -> (unit -> string option) -> IO.oc -> unit IO.t
+ val write : (t -> IO.oc -> unit IO.t) -> t -> IO.oc -> unit IO.t
val is_form: t -> bool
val read_form : t -> IO.ic -> (string * string list) list IO.t
View
11 cohttp/response.ml
@@ -41,8 +41,7 @@ module type S = sig
val write_header : t -> IO.oc -> unit IO.t
val write_body : t -> IO.oc -> string -> unit IO.t
val write_footer : t -> IO.oc -> unit IO.t
- val write : t -> (unit -> string option) -> IO.oc -> unit IO.t
- val write' : (t -> IO.oc -> unit IO.t) -> t -> IO.oc -> unit IO.t
+ val write : (t -> IO.oc -> unit IO.t) -> t -> IO.oc -> unit IO.t
end
module Make(IO : IO.S) = struct
@@ -115,13 +114,7 @@ module Make(IO : IO.S) = struct
IO.write oc "0\r\n\r\n"
|Transfer.Fixed _ | Transfer.Unknown -> return ()
- let write req fn oc =
- write_header req oc >>= fun () ->
- Body_IO.write req.encoding fn oc >>= fun () ->
- write_footer req oc
-
- (* TODO: remove either write' or write *)
- let write' fn req oc =
+ let write fn req oc =
write_header req oc >>= fun () ->
fn req oc >>= fun () ->
write_footer req oc
View
3  cohttp/response.mli
@@ -41,8 +41,7 @@ module type S = sig
val write_header : t -> IO.oc -> unit IO.t
val write_body : t -> IO.oc -> string -> unit IO.t
val write_footer : t -> IO.oc -> unit IO.t
- val write : t -> (unit -> string option) -> IO.oc -> unit IO.t
- val write' : (t -> IO.oc -> unit IO.t) -> t -> IO.oc -> unit IO.t
+ val write : (t -> IO.oc -> unit IO.t) -> t -> IO.oc -> unit IO.t
end
module Make(IO : IO.S) : S with module IO = IO
View
6 lib_test/test_net_lwt_client_and_server.ml
@@ -57,14 +57,14 @@ let not_none_s n t fn =
let client () =
(* Do a set of single calls first *)
for_lwt i = 0 to 1 do
- not_none "get 1" (Client.get url) (fun (r,b) -> assert(b = None)) >>
+ not_none "get 1" (Client.get url) (fun (r,b) -> assert(b = None)) >>= fun () ->
not_none_s "post 1" (Client.post ?body:(Body.body_of_string "foobar") url)
(fun (r,b) ->
lwt b = Body.string_of_body b in
assert (b = "foobar");
return ()
)
- done >>
+ done >>= fun () ->
(* Do a callv *)
let body () = Body.body_of_string "foobar" in
let body1 = body () in
@@ -79,7 +79,7 @@ let client () =
lwt body = Body.string_of_body body in
assert(body="foobar");
return ()
- ) resp >>
+ ) resp >>= fun () ->
lwt _ = Client.get url_shutdown in
return (exit 1)
View
2  lib_test/test_net_mirage_server.ml
@@ -37,7 +37,7 @@ let make_server () =
let spec = { Server.callback; conn_closed } in
Net.Manager.create (fun mgr interface id ->
let src = None, 8081 in
- Net.Manager.configure interface (`IPv4 ip) >>
+ Net.Manager.configure interface (`IPv4 ip) >>= fun () ->
listen mgr src spec
)
View
8 lib_test/test_parser.ml
@@ -229,7 +229,7 @@ let make_simple_req () =
let oc = oc_of_buffer buf in
let body = Body.body_of_string "foobar" in
let req = Request.make ~headers:(Header.init_with "foo" "bar") (Uri.of_string "/foo/bar") ?body in
- Request.write' (fun req oc ->
+ Request.write (fun req oc ->
Body.write_body (Request.write_body req oc) body
) req oc >>= fun () ->
assert_equal expected (get_substring oc buf);
@@ -237,7 +237,7 @@ let make_simple_req () =
* by re-using it *)
let buf = Lwt_bytes.create 4096 in
let oc = oc_of_buffer buf in
- Request.write' (fun req oc -> Request.write_body req oc "foobar") req oc >>= fun () ->
+ Request.write (fun req oc -> Request.write_body req oc "foobar") req oc >>= fun () ->
assert_equal expected (get_substring oc buf);
return ()
@@ -250,7 +250,7 @@ let make_simple_res () =
let oc = oc_of_buffer buf in
let res = Response.make ~headers:(Header.of_list [("foo","bar")]) () in
let body = Body.body_of_string "foobar" in
- Response.write' (fun res oc ->
+ Response.write (fun res oc ->
Body.write_body (Response.write_body res oc) body
) res oc >>= fun () ->
assert_equal expected (get_substring oc buf);
@@ -258,7 +258,7 @@ let make_simple_res () =
* by re-using it *)
let buf = Lwt_bytes.create 4096 in
let oc = oc_of_buffer buf in
- Response.write' (fun req oc -> Response.write_body req oc "foobar") res oc >>= fun () ->
+ Response.write (fun req oc -> Response.write_body req oc "foobar") res oc >>= fun () ->
assert_equal expected (get_substring oc buf);
return ()
View
6 lwt/cohttp_lwt.ml
@@ -52,7 +52,7 @@ module Client(IO:Cohttp.IO.S with type 'a t = 'a Lwt.t)
|Some h -> Header.(add_transfer_encoding h (Transfer.Fixed clen)) in
return (Request.make ~meth ~headers ~body uri)
in
- Request.write' (fun req oc ->
+ Request.write (fun req oc ->
Cohttp_lwt_body.write_body (Request.write_body req oc) body) req oc >>= fun () ->
read_response ~closefn ic oc
@@ -75,7 +75,7 @@ module Client(IO:Cohttp.IO.S with type 'a t = 'a Lwt.t)
lwt (ic, oc) = Net.connect ~ssl host port in
(* Serialise the requests out to the wire *)
let _ = Lwt_stream.iter_s (fun (req,body) ->
- Request.write' (fun req oc ->
+ Request.write (fun req oc ->
Cohttp_lwt_body.write_body (Request.write_body req oc) body) req oc)
reqs in
(* Read the responses. For each response, ensure that the previous response
@@ -183,7 +183,7 @@ module Server(IO:Cohttp.IO.S with type 'a t = 'a Lwt.t)
Lwt_stream.on_terminate res_stream (spec.conn_closed conn_id);
(* Transmit the responses *)
for_lwt (res,body) in res_stream do
- Response.write' (fun res oc ->
+ Response.write (fun res oc ->
Cohttp_lwt_body.write_body (Response.write_body res oc) body
) res oc
done
View
4 lwt/cohttp_lwt_unix_io.ml
@@ -55,11 +55,11 @@ let read =
let read_exactly =
check_debug
(fun (ic : ic) buf off len ->
- try_lwt Lwt_io.read_into_exactly ic buf off len >> return true
+ try_lwt Lwt_io.read_into_exactly ic buf off len >>= fun () -> return true
with End_of_file -> return false)
(fun ic buf off len ->
lwt rd =
- try_lwt Lwt_io.read_into_exactly ic buf off len >> return true
+ try_lwt Lwt_io.read_into_exactly ic buf off len >>= fun () -> return true
with End_of_file -> return false in
(match rd with
|true -> Printf.eprintf "%4d <<< %S" (Unix.getpid ()) (String.sub buf off len)
Please sign in to comment.
Something went wrong with that request. Please try again.