Benchmark Cohttp http/af

cohttp.ml

open Cohttp_lwt_unix

let handler _ req _ =
  let uri = Cohttp.Request.uri req in
  match Uri.path uri with
  | "/" ->
     let%lwt () = Lwt_unix.yield() in
     Server.respond_string ~status:`OK ~body:"CHAPTER I. Down the Rabbit-Hole  Alice was beginning to get very tired of sitting by her sister on the bank, and of having nothing to do: once or twice she had peeped into the book her sister was reading, but it had no pictures or conversations in it, <and what is the use of a book,> thought Alice <without pictures or conversations?> So she was considering in her own mind (as well as she could, for the hot day made her feel very sleepy and stupid), whether the pleasure of making a daisy-chain would be worth the trouble of getting up and picking the daisies, when suddenly a White Rabbit with pink eyes ran close by her. There was nothing so very remarkable in that; nor did Alice think it so very much out of the way to hear the Rabbit say to itself, <Oh dear! Oh dear! I shall be late!> (when she thought it over afterwards, it occurred to her that she ought to have wondered at this, but at the time it all seemed quite natural); but when the Rabbit actually took a watch out of its waistcoat-pocket, and looked at it, and then hurried on, Alice started to her feet, for it flashed across her mind that she had never before seen a rabbit with either a waistcoat-pocket, or a watch to take out of it, and burning with curiosity, she ran across the field after it, and fortunately was just in time to see it pop down a large rabbit-hole under the hedge. In another moment down went Alice after it, never once considering how in the world she was to get out again. The rabbit-hole went straight on like a tunnel for some way, and then dipped suddenly down, so suddenly that Alice had not a moment to think about stopping herself before she found herself falling down a very deep well. Either the well was very deep, or she fell very slowly, for she had plenty of time as she went down to look about her and to wonder what was going to happen next. First, she tried to look down and make out what she was coming to, but it was too dark to see anything; then she looked at the sides of the well, and noticed that they were filled with cupboards......" ()
  | _ -> Server.respond_string ~status:`Not_found ~body:"Route not found" ()

let start_server port =
  Format.eprintf "Listening for HTTP on port %d\n" port;
  Format.eprintf "Try 'curl http://localhost:%d/'\n%!" port;
  Server.create
    ~ctx:(Cohttp_lwt_unix.Net.init ())
    ~mode:(`TCP (`Port port))
    (Server.make ~callback:handler ())

let () =
  let port = ref 8080 in
  Arg.parse
    ["-p", Arg.Set_int port, "INT Listening port number (8080 by default)"]
    ignore
    "Start a hello world Lwt server";
  Lwt_main.run (start_server !port)

dune

(executable (name cohttp)
       (modules cohttp)
       (preprocess (pps lwt_ppx))
       (libraries cohttp-lwt-unix))

(executable (name httpaf)
       (modules httpaf)
       (preprocess (pps lwt_ppx))
       (libraries base httpaf-lwt-unix))

httpaf.ml

open Base
open Httpaf_lwt_unix
module Arg = Caml.Arg
open Httpaf

let text = "CHAPTER I. Down the Rabbit-Hole  Alice was beginning to get very tired of sitting by her sister on the bank, and of having nothing to do: once or twice she had peeped into the book her sister was reading, but it had no pictures or conversations in it, <and what is the use of a book,> thought Alice <without pictures or conversations?> So she was considering in her own mind (as well as she could, for the hot day made her feel very sleepy and stupid), whether the pleasure of making a daisy-chain would be worth the trouble of getting up and picking the daisies, when suddenly a White Rabbit with pink eyes ran close by her. There was nothing so very remarkable in that; nor did Alice think it so very much out of the way to hear the Rabbit say to itself, <Oh dear! Oh dear! I shall be late!> (when she thought it over afterwards, it occurred to her that she ought to have wondered at this, but at the time it all seemed quite natural); but when the Rabbit actually took a watch out of its waistcoat-pocket, and looked at it, and then hurried on, Alice started to her feet, for it flashed across her mind that she had never before seen a rabbit with either a waistcoat-pocket, or a watch to take out of it, and burning with curiosity, she ran across the field after it, and fortunately was just in time to see it pop down a large rabbit-hole under the hedge. In another moment down went Alice after it, never once considering how in the world she was to get out again. The rabbit-hole went straight on like a tunnel for some way, and then dipped suddenly down, so suddenly that Alice had not a moment to think about stopping herself before she found herself falling down a very deep well. Either the well was very deep, or she fell very slowly, for she had plenty of time as she went down to look about her and to wonder what was going to happen next. First, she tried to look down and make out what she was coming to, but it was too dark to see anything; then she looked at the sides of the well, and noticed that they were filled with cupboards......"

let text = Bigstringaf.of_string ~off:0 ~len:(String.length text) text

let benchmark =
  let headers = Headers.of_list ["content-length", Int.to_string (Bigstringaf.length text)] in
  let handler reqd =
    let { Request.target; _ } = Reqd.request reqd in
    let request_body          = Reqd.request_body reqd in
    Body.close_reader request_body;
    Lwt.async @@ fun () ->
    let%lwt () = Lwt_unix.yield () in
    (match target with
     | "/" -> Reqd.respond_with_bigstring reqd (Response.create ~headers `OK) text;
     | _   -> Reqd.respond_with_string    reqd (Response.create `Not_found) "Route not found");
    Lwt.return_unit
  in
  handler

let error_handler ?request:_ error start_response =
  let response_body = start_response Headers.empty in
  begin match error with
  | `Exn exn ->
     Body.write_string response_body (Exn.to_string exn);
     Body.write_string response_body "\n";
  | #Status.standard as error ->
     Body.write_string response_body (Status.default_reason_phrase error)
  end;
  Body.close_writer response_body

let main port =
  let open Lwt.Infix in
  let listen_address = Unix.(ADDR_INET (inet_addr_loopback, port)) in
  let request_handler _ = benchmark in
  let error_handler _ = error_handler in
  Lwt.async begin fun () ->
    Lwt_io.establish_server_with_client_socket
      ~backlog:11_000
      listen_address
      (Server.create_connection_handler ~request_handler ~error_handler)
    >>= fun _server -> Lwt.return_unit
  end;
  let forever, _ = Lwt.wait () in
  Lwt_main.run forever
;;

let () =
  let port = ref 8080 in
  Arg.parse
    ["-p", Arg.Set_int port, " Listening port number (8080 by default)"]
    ignore
    "Responds to requests with a fixed string for benchmarking purposes.";
  main !port