OCaml backend for REST API and JSON data

Question

I want to create a backend for a simple REST API in OCaml. For this I use the libs httpaf and yojson. I have something that works but I would like some reviews.

Here is the structure of my little server:

bin/
  | - backend.ml
  | - lib.ml
  | - dune

dune:

(executable
 (name backend)
 (libraries httpaf httpaf-lwt-unix base stdio lwt lwt.unix yojson)
)

backend.ml

open Base
open Lwt.Infix
open Httpaf_lwt_unix

module String = Caml.String
module Arg = Caml.Arg

let request_handler (_: Unix.sockaddr) = Lib.request_handler
let error_handler (_ : Unix.sockaddr) = Lib.error_handler

let main port =
  let listen_address = Unix.(ADDR_INET (inet_addr_loopback, port)) in
  Lwt.async (fun () ->
    Lwt_io.establish_server_with_client_socket
      listen_address
      (Server.create_connection_handler ~request_handler ~error_handler)
    >|= fun _server ->
      Stdio.printf "Starting server and listening at http://localhost:%d\n\n%!" port);
  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
    "Echoes POST requests. Runs forever.";
  main !port

lib.ml

open Httpaf
open Base

module String = Caml.String

let invalid_request reqd status body =
  let headers = Headers.of_list [ "Connection", "close" ] in
  Reqd.respond_with_string reqd (Response.create ~headers status) body

let request_handler reqd =
  let { Request.meth; target; headers; _ } = Reqd.request reqd in
  let build_headers response_body =
        Headers.of_list
          [ "Content-length", Int.to_string (String.length response_body);
            "Content-Type", "application/json";
            "connection", "close"]
  in
  match meth with
  | `GET -> let json_values =
              `List [
                `Assoc
                [
                    ("id", `String "1");
                    ("name", `String "todo 1");
                    ( "description", `String "do this, do that");
                ];
                `Assoc
                [
                    ("id", `String "2");
                    ("name", `String "todo 2");
                    ( "description", `String "do this again, do that again");
                ]
              ]
    in
    let response_body = Yojson.Basic.to_string json_values in
    let resp_headers = build_headers response_body in
    Reqd.respond_with_string reqd (Response.create ~headers:resp_headers `OK) response_body
  | `POST | `PUT ->
    let request_body  = Reqd.request_body reqd in
    let data = Buffer.create 1024 in
    let rec on_read buffer ~off ~len =
      let str = Bigstringaf.substring buffer ~off ~len in
      let () = Buffer.add_string data str in
      Body.schedule_read request_body ~on_eof ~on_read;
    and on_eof () =
      let json = (Buffer.sub data 0 (Buffer.length data)) |> Bytes.to_string  |> Yojson.Basic.from_string in
      let () = Stdio.print_endline (Yojson.Basic.pretty_to_string json) in
      let response_body = Printf.sprintf "%s request on url %s\n" (Method.to_string meth) target in
      let resp_headers = build_headers response_body in
      Reqd.respond_with_string reqd (Response.create ~headers:resp_headers `OK) response_body
    in
    Body.schedule_read request_body ~on_eof ~on_read
  | `DELETE ->
    let response_body = Printf.sprintf "%s request on url %s\n" (Method.to_string meth) target in
    let resp_headers = build_headers response_body in
    Reqd.respond_with_string reqd (Response.create ~headers:resp_headers `OK) response_body
  | meth ->
    let response_body =
      Printf.sprintf "%s is not an allowed method\n" (Method.to_string meth)
    in
    invalid_request reqd `Method_not_allowed response_body

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

I build build, run and test my server with:

dune build bin/backend.exe --profile=release 
dune exec bin/backend.exe --profile=release
curl -i -X GET localhost:8080/toto
curl -i -X POST -H "Content-Type: application/json" -d some_random_json localhost:8080/toto

In the lib.ml file, for the POST and PUT request, I read the data from the request body and transform it in json, is it the right way to do it?

How can I improve this ?

Brendan Long · Accepted Answer · 2021-03-14 00:21:23Z

In your request handler, you have:

          [ "Content-length", Int.to_string (String.length response_body);
            "Content-Type", "application/json";
            "connection", "close"]

Httpaf seems to require either a Content-Length or connection close, but I think unconditionally closing the connection is probably undesirable (connection reuse makes HTTP faster). I'd recommend:

          [ "Content-length", Int.to_string (String.length response_body);
            "Content-Type", "application/json"]

I could go either way for invalid_request, but you could consider leaving that connection open as well and passing a Content-Length.

In on_eof, you do:

     let json = (Buffer.sub data 0 (Buffer.length data)) |> Bytes.to_string  |> Yojson.Basic.from_string in

But Base.Buffer has a built-in contents function for this:

     let json = Buffer.contents data |> Yojson.Basic.from_string in

If you expand this code more, you might want to factor out functions for things like adding the content-length header and reading the request body. I used your code as an example when I was learning Httpaf, but I ended up factoring out these two functions:

let with_body ?(buffer_size = 1024) reqd f =
  let request_body = Reqd.request_body reqd in
  let data = Buffer.create buffer_size in
  let rec on_read buffer ~off ~len =
    Buffer.add_string data (Bigstringaf.substring buffer ~off ~len);
    Body.schedule_read request_body ~on_eof ~on_read
  and on_eof () = f (Buffer.contents data) in
  Body.schedule_read request_body ~on_eof ~on_read
;;

let respond ?(headers = Headers.empty) reqd status body =
  let headers =
    Headers.add headers "Content-length" (Int.to_string (String.length body))
  in
  Reqd.respond_with_string reqd (Response.create ~headers status) body
;;

And in your code you could use these like:

let respond_json ?(headers = Headers.empty) reqd status body =
  let headers = Headers.add headers "Content-Type" "application/json" in
  respond ~headers reqd status (Yojson.Basic.to_string body)
;;

let request_handler reqd =
  let { Request.meth; target; _ } = Reqd.request reqd in
  match meth with
  | `GET ->
    let json_values =
      `List
        [ `Assoc
            [ "id", `String "1"
            ; "name", `String "todo 1"
            ; "description", `String "do this, do that"
            ]
        ; `Assoc
            [ "id", `String "2"
            ; "name", `String "todo 2"
            ; "description", `String "do this again, do that again"
            ]
        ]
    in
    respond_json reqd `OK json_values
  | `POST | `PUT ->
    with_body reqd
    @@ fun data ->
    let json = Yojson.Basic.from_string data in
    let () = Stdio.print_endline (Yojson.Basic.pretty_to_string json) in
    let response_body =
      Printf.sprintf "%s request on url %s\n" (Method.to_string meth) target
    in
    respond reqd `OK response_body
  | `DELETE ->
    let response_body =
      Printf.sprintf "%s request on url %s\n" (Method.to_string meth) target
    in
    respond reqd `OK response_body
  | meth ->
    let response_body =
      Printf.sprintf "%s is not an allowed method\n" (Method.to_string meth)
    in
    respond reqd `Method_not_allowed response_body
;;

In my opinion, this makes the code more readable because a lot of low-level details are moved out of the request_handler function, and the remaining code is easier to follow as a result.

One other thing you might want to do is break out individual functions for your GET, POST/PUT and DELETE functions and just call them from your big function, which would make it easier for someone scanning the code to find the part they're looking for (if they only want to look at the GET code for example).

Stack Exchange Network

OCaml backend for REST API and JSON data

1 Answer 1

You must log in to answer this question.

Hot Network Questions

OCaml backend for REST API and JSON data

1 Answer 1

You must log in to answer this question.

Related

Hot Network Questions