Cohttp is an OCaml library for creating HTTP daemons. It has a portable HTTP parser, and implementations using various asynchronous programming libraries:
Httpprovides essential type definitions used in Cohttp and an extremely fast http parser. It is designed to have no dependencies and make it easy for other packages to easily interoperate with Cohttp.Cohttp_lwt_unixuses the Lwt library, and specifically the UNIX bindings. It uses ocaml-tls as the TLS implementation to handle HTTPS connections.Cohttp_asyncuses the Async library andasync_sslto handle HTTPS connections.Cohttp_lwtexposes an OS-independent Lwt interface, which is used by the Mirage interface to generate standalone microkernels (use the cohttp-mirage subpackage).Cohttp_lwt_jsoocompiles to a JavaScript module that maps the Cohttp calls to XMLHTTPRequests. This is used to compile OCaml libraries like the GitHub bindings to JavaScript and still run efficiently.Cohttp_curluseslibcurl, viaocurl, as backend. It also comes with lwt (Cohttp_curl_lwt) and async backends (Cohttp_curl_async).Cohttp_eiouseseioto leverage new features from multicore ocaml 5.0.Cohttp_server_lwt_unixuses lwt to implement a more efficient web server with a minimal interface.
You can implement other targets using the parser very easily. Look at the IO
signature in lib/s.mli and implement that in the desired backend.
You can find help from cohttp users and maintainers at the discuss.ocaml.org forum or on the OCaml discord server.
- Installation
- Client Tutorial
- Dealing with timeouts
- Managing sessions
- Multipart form data
- Creating custom resolver: a Docker Socket Client example
- Dealing with redirects
- Basic Server Tutorial
- Installed Binaries
- Debugging
- Important Links
Latest stable version should be obtained from opam. Make sure to install the
specific backends you want as well. E.g.
$ opam install cohttp-lwt-unix cohttp-async
You can also obtain the development release:
$ opam pin add cohttp --dev-repo
Cohttp provides clients for Async, Lwt, and Js_of_ocaml (Lwt based). In this tutorial, we will use the lwt client but the example should be easily translatable to Async.
To create a simple request, use one of the methods in Cohttp_lwt_unix.Client.
call is the most general, there are also http method specialized such as
get, post, etc.
For example downloading the reddit frontpage:
open Lwt
open Cohttp
open Cohttp_lwt_unix
let body =
Client.get (Uri.of_string "https://www.reddit.com/") >>= fun (resp, body) ->
let code = resp |> Response.status |> Code.code_of_status in
Printf.printf "Response code: %d\n" code;
Printf.printf "Headers: %s\n" (resp |> Response.headers |> Header.to_string);
body |> Cohttp_lwt.Body.to_string >|= fun body ->
Printf.printf "Body of length: %d\n" (String.length body);
body
let () =
let body = Lwt_main.run body in
print_endline ("Received body\n" ^ body)There are a few things to notice:
- We open 2 modules.
Cohttpcontains the backend independent modules andCohttp_lwt_unixthe lwt + unix specific ones. Client.getaccepts aUri.tand makes an http request.Client.getalso accepts optional arguments for things like header information.- The http response is returned in a tuple. The first element of the tuple contains the response's status code, headers, http version, etc. The second element contains the body.
- The body is then converted to a string and is returned (after the length is
printed). Note that
Cohttp_lwt.Body.to_stringhence it's up to us to keep a reference to the result. - We must trigger lwt's event loop for the request to run.
Lwt_main.runwill run the event loop and return with final value ofbodywhich we then print.
Note that Cohttp_lwt_unix/Cohttp_async are able to request an HTTPS page
by default. For Cohttp_lwt_unix users can use ocaml-tls by installing tls-lwt or ocaml-ssl by installing lwt_ssl. The latter is the default if both are installed but it is possible to force the selection of tls with the environment variable CONDUIT_TLS=native. For Cohttp_async the default is to use
async_ssl (but users are able to use ocaml-tls with some modifications).
Consult the following modules for reference:
The full documentation for the latest published version of the library is available on the repository github pages.
Create this dune file
cat - > dune <<EOF
(executable
(public_name client_example)
(name client_example)
(libraries cohttp-lwt-unix))
EOF
then build and execute the example with
$ dune exec ./client_example.exe
You can use Lwt.pick to set a timeout
on the execution of a thread. For example, say that you want to set a timeout on
the Client.get thread in the example above, then you could modify the get call
as follows
let compute ~time ~f =
Lwt.pick
[
(f () >|= fun v -> `Done v)
; (Lwt_unix.sleep time >|= fun () -> `Timeout)
]
let body =
let get () = Client.get (Uri.of_string "https://www.reddit.com/") in
compute ~time:0.1 ~f:get >>= function
| `Timeout -> Lwt.fail_with "Timeout expired"
| `Done (resp, body) -> Lwt.return (resp, body)Executing the code, which you can actually try by calling
$ dune exec examples/lwt_unix_doc/client_lwt_timeout.exe
the call will most likely fail with the following output
Fatal error: exception (Failure "Timeout expired")
Similarly, in the case of cohttp-async you can directly use Async's
with_timeout function.
For example,
let get_body ~uri ~timeout =
let%bind _, body = Cohttp_async.Client.get ~interrupt:(after (sec timeout)) uri in
Body.to_string body
let body =
let uri = Uri.of_string "https://www.reddit.com/" in
let timeout = 0.1 in
Clock.with_timeout (sec timeout) (get_body ~uri ~timeout)
>>| function
| `Result body -> Log.debug logger "body: %s" body
| `Timeout -> Log.debug logger "Timeout with url:%s" urlManaging sessions and saving cookies across requests is not directly supported by
cohttp. It is not hard to roll out a custom solution, but an alternative is
to use the session library,
which is compatible with cohttp.
Multipart form data is not supported out of the box but is provided by external libraries:
multipart_formwhich has bounded memory consumption even when transferring large amount of datamultipart-form-datahttp-multipart-formdatawhich however does not support streaming
Cohttp provides a lot of utilities out of the box, but does not prevent the users to dig in and customise it for their needs. The following is an example of a unix socket client to communicate with Docker.
open Lwt.Infix
open Cohttp
let ctx =
let resolver =
let h = Hashtbl.create 1 in
Hashtbl.add h "docker" (`Unix_domain_socket "/var/run/docker.sock");
Resolver_lwt_unix.static h
in
Cohttp_lwt_unix.Client.custom_ctx ~resolver ()
let t =
Cohttp_lwt_unix.Client.get ~ctx (Uri.of_string "http://docker/version")
>>= fun (resp, body) ->
let open Cohttp in
let code = resp |> Response.status |> Code.code_of_status in
Printf.printf "Response code: %d\n" code;
Printf.printf "Headers: %s\n" (resp |> Response.headers |> Header.to_string);
body |> Cohttp_lwt.Body.to_string >|= fun body ->
Printf.printf "Body of length: %d\n" (String.length body);
print_endline ("Received body\n" ^ body)
let _ = Lwt_main.run tThe main issue there is there no way to resolve a socket address, so you need to create a custom resolver to map a hostname to the Unix domain socket.
To build and execute with dune, first create the following dune file
$ cat - > dune <<EOF
(executable
(public_name docker_example)
(name docker_example)
(libraries cohttp-lwt-unix conduit-lwt))
EOF
then run the example with
$ dune exec ./docker_example.exe
Even though conduit is transitively there, for this example we are explicitly mentioning it to emphasize that we are creating a new Conduit resolver. Refer to conduit's README for examples of use and links to up-to-date conduit documentation.
This examples has been adapted from a script on the ocaml.org website, and shows an explicit way to deal with redirects in cohttp-lwt-unix.
let rec http_get_and_follow ~max_redirects uri =
let open Lwt.Syntax in
let* ans = Cohttp_lwt_unix.Client.get uri in
follow_redirect ~max_redirects uri ans
and follow_redirect ~max_redirects request_uri (response, body) =
let open Lwt.Syntax in
let status = Http.Response.status response in
(* The unconsumed body would otherwise leak memory *)
let* () =
if status <> `OK then Cohttp_lwt.Body.drain_body body else Lwt.return_unit
in
match status with
| `OK -> Lwt.return (response, body)
| `Permanent_redirect | `Moved_permanently ->
handle_redirect ~permanent:true ~max_redirects request_uri response
| `Found | `Temporary_redirect ->
handle_redirect ~permanent:false ~max_redirects request_uri response
| `Not_found | `Gone -> Lwt.fail_with "Not found"
| status ->
Lwt.fail_with
(Printf.sprintf "Unhandled status: %s"
(Cohttp.Code.string_of_status status))
and handle_redirect ~permanent ~max_redirects request_uri response =
if max_redirects <= 0 then Lwt.fail_with "Too many redirects"
else
let headers = Http.Response.headers response in
let location = Http.Header.get headers "location" in
match location with
| None -> Lwt.fail_with "Redirection without Location header"
| Some url ->
let open Lwt.Syntax in
let uri = Uri.of_string url in
let* () =
if permanent then
Logs_lwt.warn (fun m ->
m "Permanent redirection from %s to %s"
(Uri.to_string request_uri)
url)
else Lwt.return_unit
in
http_get_and_follow uri ~max_redirects:(max_redirects - 1)The following example, adapted from blue-http, does a similar thing with cohttp-async (and ppx_let).
open Core_kernel
open Async_kernel
let with_redirects ~max_redirects uri f =
let seen_uris = Hash_set.create (module String) in
let rec loop ~max_redirects uri =
Hash_set.add seen_uris (Uri.to_string uri);
let%bind ((response, response_body) as res) = f uri in
let status_code =
Cohttp.(Response.status response |> Code.code_of_status)
in
if Cohttp.Code.is_redirection status_code then (
match Cohttp.(Response.headers response |> Header.get_location) with
| Some new_uri when Uri.to_string new_uri |> Hash_set.mem seen_uris ->
return res
| Some new_uri ->
if max_redirects > 0 then
(* Cohttp leaks connections if we don't drain the response body *)
Cohttp_async.Body.drain response_body >>= fun () ->
loop ~max_redirects:(max_redirects - 1) new_uri
else (
Log.Global.debug ~tags:[]
"Ignoring %d redirect from %s to %s: redirect limit exceeded"
status_code (Uri.to_string uri) (Uri.to_string new_uri);
return res)
| None ->
Log.Global.debug ~tags:[]
"Ignoring %d redirect from %s: there is no Location header"
status_code (Uri.to_string uri);
return res)
else return res
in
loop ~max_redirects uriYou can read a bit more on the rationale behind the absence of this functionality in the API here.
Implementing a server in cohttp using the Lwt backend (for Async is very similar) is mostly equivalent to implementing a function of type :
conn -> Http.Request.t -> Cohttp_lwt.Body.t -> (Http.Response.t * Cohttp_lwt.Body.t) Lwt.t
The parameters are self explanatory but we'll summarize them quickly here:
conn- contains connection informationHttp.Request.t- Request information such as method, uri, headers, etc.Cohttp_lwt.Body.t- Contains the request body. You must manually decode the request body into json, form encoded pairs, etc. For cohttp, the body is simply binary data.
Here's an example of a simple cohttp server that outputs back request information.
open Lwt
open Cohttp
open Cohttp_lwt_unix
let server =
let callback _conn req body =
let uri = req |> Request.uri |> Uri.to_string in
let meth = req |> Request.meth |> Code.string_of_method in
let headers = req |> Request.headers |> Header.to_string in
( body |> Cohttp_lwt.Body.to_string >|= fun body ->
Printf.sprintf "Uri: %s\nMethod: %s\nHeaders\nHeaders: %s\nBody: %s" uri
meth headers body )
>>= fun body -> Server.respond_string ~status:`OK ~body ()
in
Server.create ~mode:(`TCP (`Port 8000)) (Server.make ~callback ())
let () = ignore (Lwt_main.run server)Create this dune file
cat - > dune <<EOF
(executable
(public_name server_example)
(name server_example)
(libraries cohttp-lwt-unix conduit-lwt))
EOF
then build and execute the example with
$ dune exec ./server_example.exe
As in the previous example, here we are explicitly mentioning conduit-lwt to emphasize that we are relying on Conduit to specify the protocols and the services. Refer to conduit's README for examples of use and links to up-to-date conduit documentation.
Cohttp comes with a few simple binaries that are handy, useful also to test cohttp itself, and can serve as examples of how to use the library. All binaries come in two flavours - Async and Lwt.
$ cohttp-curl-{lwt,async}
This is a simple curl utility implemented using cohttp. An example of an invocation is:
$ cohttp-curl-lwt -v -X GET "https://www.reddit.com/"
$ cohttp-server-{lwt,async}
This binary acts in a similar fashion to the Python SimpleHTTPServer. Just
run cohttp-server-async in a directory and it will open up a local port and
serve the files over HTTP.
$ cohttp-server-async
Assuming that the server is running in cohttp's source directory:
$ cohttp-curl-lwt 'http://0.0.0.0:8080/README.md'
Other examples using the async api are available in the cohttp-async/examples folder in the sources.
You can activate some runtime debugging for the servers by setting COHTTP_DEBUG to any value different from 0 or false, and it will set a default debug-level logger on stdout.
Since both Cohttp and Conduit use Logs for debugging output, you can enable custom debugging in your code (if needed). For example, if you intend to make use of the COHTTP_DEBUG env variable, you could simply use
let () =
if not @@ Debug.debug_active () then (
Fmt_tty.setup_std_outputs ();
Logs.set_level ~all:true level;
Logs.set_reporter Debug.default_reporter);Of course you are free to completely override it and use your own reporters, for example by adding something like the following to your code (courtesy of @dinosaure).
let reporter ppf =
let report src level ~over k msgf =
let k _ =
over () ;
k () in
let with_metadata header _tags k ppf fmt =
Format.kfprintf k ppf
("%a[%a]: " ^^ fmt ^^ "\n%!")
Logs_fmt.pp_header (level, header)
Fmt.(styled `Magenta string)
(Logs.Src.name src) in
msgf @@ fun ?header ?tags fmt -> with_metadata header tags k ppf fmt in
{ Logs.report }
let () =
Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ();
Logs.set_reporter (reporter Fmt.stderr);
Logs.set_level ~all:true (Some Logs.Debug)Note that you can selectively filter out the logs produced by cohttp-lwt and cohttp-lwt-unix internals as follows.
let () =
(* Set log level v for all loggers, this does also affect cohttp internal loggers *)
Logs.set_level ~all:true level;
(* Disable all cohttp-lwt and cohttp-lwt-unix logs *)
List.iter (fun src ->
match Logs.Src.name src with
| "cohttp.lwt.io" | "cohttp.lwt.server" -> Logs.Src.set_level src None
| _ -> ())
@@ Logs.Src.list ()
React
Typescript
Django
Laravel
Facebook
Microsoft
Google
Alibaba
D3
Tencent