Code used to benchmark httpaf GPR-53 and GPR-54.

bench_httpaf_pr53.ml

open Lwt.Infix
open Unprime_list
open Printf

let rates = [
  1000.0;
  2000.0;
  5000.0;
  10_000.0;
  20_000.0;
  50_000.0;
  100_000.0;
  200_000.0;
  500_000.0;
]

module Wrkout = struct
  type t = {
    latency: float * float * float;
    requestrate: float * float * float;
    transfer_per_sec: float;
    requests_per_sec: float;
  }

  let split_uom = function%pcre
   | {|^(?<v>[0-9.]+)(?<m>[a-z]*)$|} -> (v, m)
   | s -> ksprintf failwith "invalid measurable %s" s

  let scan_second s =
    let v, uom = split_uom s in
    let scale =
      (match uom with
       | "s" -> 1.0 | "ms" -> 1e-3 | "us" -> 1e-6 | "ns" -> 1e-9
       | "m" -> 60.0 | "h" -> 3600.0
       | _ -> ksprintf failwith "unknown unit %ss" uom) in
    float_of_string v *. scale

  let scan_dimless s =
    let v, uom = split_uom s in
    let scale =
      (match uom with
       | "" -> 1.0 | "k" -> 1e3 | "M" -> 1e6 | "G" -> 1e9
       | _ -> ksprintf failwith "unknown unit %ss" uom) in
    float_of_string v *. scale

  let extract fn =
    let latency = ref None in
    let requestrate = ref None in
    let transfer_per_sec = ref None in
    let requests_per_sec = ref None in
    Lwt_io.lines_of_file fn |> Lwt_stream.iter begin function%pcre
     | {|^\s*Latency\s+(?<avg>[^ ]+)\s+(?<sdv>[^ ]+)\s+(?<max>[^ ]+)\s+.*%|} ->
        latency := Some (scan_second avg, scan_second sdv, scan_second max)
     | {|^\s*Req/Sec\s+(?<avg>[^ ]+)\s+(?<sdv>[^ ]+)\s+(?<max>[^ ]+)\s+.*%|} ->
        requestrate := Some (scan_dimless avg, scan_dimless sdv, scan_dimless max)
     | {|^Requests/sec:\s*(?<s>.*)\s*$|} ->
        requests_per_sec := Some (float_of_string s)
     | {|^Transfer/sec:\s*(?<s>.*)MB\s*$|} ->
        transfer_per_sec := Some (float_of_string s *. 1e6)
     | _ -> ()
    end >|= fun () ->
    let latency = Prime_option.get !latency in
    let requestrate = Prime_option.get !requestrate in
    let requests_per_sec = Prime_option.get !requests_per_sec in
    let transfer_per_sec = Prime_option.get !transfer_per_sec in
    {latency; requestrate; requests_per_sec; transfer_per_sec}

    let requestrate_avg {requestrate = (x, _, _); _} = x
    let requestrate_sdv {requestrate = (_, x, _); _} = x
    let requestrate_max {requestrate = (_, _, x); _} = x
    let latency_avg {latency = (x, _, _); _} = x
    let latency_sdv {latency = (_, x, _); _} = x
    let latency_max {latency = (_, _, x); _} = x
    let requests_per_sec bo = bo.requests_per_sec
    let transfer_per_sec bo = bo.transfer_per_sec
end

let extract variant rate =
  Wrkout.extract (Printf.sprintf "data/%s-%.0f-1000.wrkout" variant rate)

module A = Archimedes

let () = Lwt_main.run begin
  let%lwt res_lwt54 = Lwt_list.map_s (extract "lwt54") rates in
  let%lwt res_lwt53 = Lwt_list.map_s (extract "lwt53") rates in
  let%lwt res_async = Lwt_list.map_s (extract "async") rates in

  let results = [
    "async", res_async, A.Color.blue;
    "lwt53", res_lwt53, A.Color.green;
    "lwt54", res_lwt54, A.Color.red;
  ] in

  let plot ?(ylog = false) ?ytics name ylabel yprojs =
    let vp = A.init ["Cairo"; "PNG"; name ^ ".png"] in
    A.Axes.x vp ~tics:(A.Tics.(Fixed (Number 3, rates)));
    A.Axes.y vp ?tics:ytics;
    A.Viewport.set_xlog vp true;
    A.Viewport.set_ylog vp ylog;
    A.Viewport.xlabel vp "rate (Hz)";
    A.Viewport.ylabel vp ylabel;

    let xmin = max_float |> List.fold min rates in
    let xmax = 0.0 |> List.fold max rates in
    A.xrange vp xmin (1.05 *. xmax);

    let ylim init f = init
      |> List.fold
          (fun yproj -> List.fold (fun (_, wrkout, _) -> List.fold f (List.map yproj wrkout)) results)
          yprojs in
    let ymax = ylim 0.0 max in
    let ymin = ylim max_float min in
    Printf.printf "%s: ymax = %g\n" name ymax;
    A.yrange vp (if ylog then 1e-4 else min 0.0 ymin) (1.05 *. ymax);

    results |> List.iter begin fun (_name, res, color) ->
      A.set_color vp color;
      yprojs |> List.iter begin fun yproj ->
        A.List.xy ~style:(`Linesmarkers "o") vp rates (List.map yproj res);
      end
    end;

    A.close vp
  in

  plot "requests" "request rate (Hz)" [Wrkout.requests_per_sec];
  plot "transfer" "transfer rate (MB/s)" [Wrkout.transfer_per_sec];

  let yhigh wrkout = Wrkout.latency_avg wrkout +. Wrkout.latency_sdv wrkout in
  let ytics = A.Tics.(Fixed (Number 3, [1e-3; 1e-2; 1e-1; 1.0; 10.0; 20.0])) in
  plot ~ylog:true ~ytics "latency" "latency (s)" [Wrkout.latency_avg; yhigh; Wrkout.latency_max];

  let yhigh wrkout = Wrkout.requestrate_avg wrkout +. Wrkout.requestrate_sdv wrkout in
  plot "requestrate" "request rate (Hz)" [Wrkout.requestrate_avg; yhigh; Wrkout.requestrate_max];

  Lwt.return_unit
end

jbuild

(executable
 ((name bench_httpaf_pr53)
  (preprocess (pps (lwt_ppx ppx_regexp)))
  (libraries (archimedes lwt lwt.unix prime re))))

run.sh

#! /bin/bash

conn=1000

prog_async=../httpaf/_build/default/benchmarks/wrk_async_benchmark.exe
prog_lwt53=../httpaf/_build/default/benchmarks/wrk_lwt_unix_benchmark.exe
prog_lwt54=../httpaf-aantron/_build/default/benchmarks/wrk_lwt_benchmark.exe
wrk=../wrk2/wrk

ulimit -n 11000

run_benchmark()
{
    local prog="$1"
    local name="$2"
    local rate="$3"
    local conn="$4"
    local output="data/$name-$rate-$conn.wrkout"
    if [ -e "$output" ]; then
	return
    fi
    echo "$name rate=$rate conn=$conn"
    $prog &
    sleep 1
    local pid=$!
    $wrk --rate $rate --connections $conn --timeout 5m --duration 1m --threads 4 \
	--latency -H 'Connection: keep-alive' http://127.0.0.1:8080 >"$output"
    kill $pid
    sleep 1
}

for rate in 1000 2000 5000 10000 20000 50000 100000 200000 500000; do
    run_benchmark $prog_async "async" $rate $conn
    run_benchmark $prog_lwt53 "lwt53" $rate $conn
    run_benchmark $prog_lwt54 "lwt54" $rate $conn
done