OCaml HTTP server example with Piaf

dune

(executable
  (name server)
  (libraries ssl piaf yojson ppx_deriving_yojson.runtime)
  (preprocess (pps ppx_deriving_yojson)))

server.ml

open Lwt.Infix

type response = {
    path : string;
    ip   : string;
}
[@@deriving yojson]

let string_of_method =
  function
  | `GET  -> "GET"
  | `POST -> "POST"
  | _     -> "Unknown"

let string_of_sockaddr sockaddr =
  let open Unix in
  match sockaddr with
  | ADDR_UNIX addr -> addr
  | ADDR_INET (addr, port) ->
    Printf.sprintf "%s:%d" (string_of_inet_addr addr) port

let sockaddr_ip_address sockaddr =
  let open Unix in
  match sockaddr with
  | ADDR_UNIX addr -> addr
  | ADDR_INET (addr, _) -> string_of_inet_addr addr

let log_request source (request: Piaf.Request.t) =
  let meth = string_of_method request.meth in
  let source = string_of_sockaddr source in
  let user_agent =
    Piaf.Headers.get request.headers "User-Agent"
    |> Option.value ~default:"Unknown"
  in
  Printf.printf "%s %s - %s - %s\n"
    meth
    request.target
    source
    user_agent;
  flush stdout

let json_response (ctx: Unix.sockaddr Piaf.Server.ctx) =
  let headers = Piaf.Headers.of_list [ "Content-Type", "application/json" ] in
  let body =
    { path = ctx.request.target;
      ip   = sockaddr_ip_address ctx.ctx }
    |> response_to_yojson
    |> Yojson.Safe.to_string

  in
  Piaf.Response.of_string
    ~headers:headers
    ~body:body
    `OK

let home _ =
  let headers = Piaf.Headers.of_list [ "Content-Type", "text/html" ] in
  let body = "<h1>It works!</h1>" in
  Piaf.Response.of_string
    ~headers:headers
    ~body:body
    `OK

let not_found _ =
  let headers = Piaf.Headers.of_list [ "Content-Type", "text/html" ] in
  let body = "<h1>Not found!</h1>" in
  Piaf.Response.of_string
    ~headers:headers
    ~body:body
    `Not_found

let handler (ctx: Unix.sockaddr Piaf.Server.ctx) =
  log_request ctx.ctx ctx.request;

  let response =
    match ctx.request.target with
    | "/" -> home ctx
    | "/json" -> json_response ctx
    | _ -> not_found ctx
  in
  Lwt.return response

let () =
  let listen_address = Unix.(ADDR_INET (inet_addr_loopback, 9000)) in
  Lwt.async (fun () ->
      Lwt_io.establish_server_with_client_socket
             listen_address
             (Piaf.Server.create handler)
      >|= fun _server ->
      print_endline "Listening...");
  let forever, _ = Lwt.wait () in
  Lwt_main.run forever