This is the 2nd in a series of posts where we implement a continuous integration and deployment server as a micro-webservice codenamed cid.

In this post we prepare a minimal server, that only serves the about resource identifying the software running the server to its client. When the server runs on port localhost:8080 that resource can be queried like this:

% curl -H"Accept:application/json" http://localhost:8080/about/
{SoftwarePackage:"cid",SoftwareVersion:"0.1.0-current"}

% curl -H"Accept:text/plain" http://localhost:8080/about/
Software Package: cid
Software Version: 0.1.0-current

The webmachine module

The Webmachine is a functor that needs to be instantiated using a module implementing parts of the HTTP protocol as a parameter. When doing so, it is customary to add the Rd module to the instantiated module, so we do not have to go reaching into multiple modules to access request-related information.

(* Cid_Webmachine.ml *)
module Rd = Webmachine.Rd
include Webmachine.Make(Cohttp_lwt_unix_io)

Modules implementing resources in the code usually use the alias module Wm = Cid_Webmachine to access the module using a short name. Generally speaking, using abbreviations aliases tends to obfuscate the code, but it is here a well established convention, and we decided to stick to it.

The about resource

The about resource is, as usual, implemented by inheriting from Wm.resource and defining or overwriting the appropriate methods. The hello resource defined in the examples found in the webmachine source code can be used as an example.

(* Cid_About.ml *)
module Wm = Cid_Webmachine

class about =
object(self)
  inherit [Cohttp_lwt_body.t] Wm.resource
  (* … *)
end

The about resource is a read-only resource, and we therefore only allow GET requests on this resource and do not to accept any kind of content type.

method allowed_methods rd =
  Wm.continue [`GET] rd

method content_types_accepted rd =
  Wm.continue [] rd

The about resource can be read in several formats, the text/html format is useful for manual control while text/plain and application/json are easy to process automatically. The alist appearing here maps a request handler to each content type:

method content_types_provided rd =
  Wm.continue [
    "text/html"       , self#to_html;
    "text/plain"      , self#to_text;
    "application/json", self#to_json;
  ] rd

We only give basic details through the about resource, the name of the software package “cid” and the software version. The actual values are derived from the project’s Makefile at configuration time by the configure script and stored as variables in the Cid_Configuration module. The private methods to_text converts this list into a sequence of one-line records that is passed in the response. The methods to_json and to_html are similarly implemented.

method private description =
  let open Cid_Configuration in [
    "Software Package", ac_package;
    "Software Version", ac_version;
  ]

method private to_text rd =
  let text =
    String.concat ""
      (List.map (fun (k, v) -> sprintf "%s: %s\n" k v) self#description)
  in
  Wm.continue (`String text) rd

Establishing the server

We write the server as a Gasoline application. The Gasoline library defines software components as an abstraction used to initialise the application and retrieve configuration values from several sources. Using Gasoline we can take advantage of a powerful initialisation system while focussing on writing the main function of our application.

The server is one of these fancy software components. It is a bit larger as previous bits of code we reviewed, so we highlight its overall structure before we go to the details:

module Application =
  Gasoline_Plain_UserTool

module Wm = Cid_Webmachine

module Component_Server =
struct
  let comp = Application.Component.make
      ~name:"server"
      ~description:"Server"
      ()

  module Configuration =
  struct
    (* We register the configuration parameters of the server *)
  end

  module Log =
  struct
    (* We define logging functions. *)
  end

  let establish routes =
    (* The function establishing the server, using Log and Configuration. *)
end

The configuration parameters are pretty limited now, we only set the listening port. In later posts, when adding SSL, we will add paths to certificates as parameters.

module Configuration =
struct
  open Application.Configuration

  let port =
    make_int comp ~flag:'p'
      "port" 8080
      "The port where to bind to"

  let insecuremode () =
    `TCP(`Port(port()))
end

This defines Configuration.port a function unit → int retrieving the actual value from the program configuration, either from the server.port key read from ~/.cid written in a classical INI format, or using the -p flag to pass the value.

In Gasoline software components have the exclusive responsability of logging. It is a good idea to regroup logging functions in a module, this makes logging code less intrusive in the code and also makes the logging code easier to maintain. The Cid_Log.info function used here is an easy derivative of printf decorating its output with a timestamp, the name of the program, the pid of the program running it and a message level Info.

module Log =
struct
  open Cid_Log

  let connection_closed (ch, conn) =
    info "Server [Connection Closed] [%s]"
      (Sexplib.Sexp.to_string_hum (Conduit_lwt_unix.sexp_of_flow ch))

  let establish_server port =
    info "Server [Establish] 0.0.0.0:%d" port

  let server_response status method_ uri_request =
    info "Server [Response] %d %s %s" status method_ uri_request
end

We finally arrive at the main function establishing the server, it is parametrised by the routes, an alist of URL paths and webmachine resources:

let establish routes =
  let callback (ch, conn) request body =
    let open Cohttp in
    Wm.dispatch' routes ~body ~request
    >|= begin function
      | None        -> (`Not_found, Header.init (), `String "Not found", [])
      | Some result -> result
    end
    >>= fun (status, headers, body, path) ->
    Log.server_response
      (Code.code_of_status status)
      (Code.string_of_method (Request.meth request))
      (Uri.path (Request.uri request));
    Server.respond ~headers ~body ~status ()
  in
  let conn_closed ((ch,conn) as a) =
    Log.connection_closed a;
    (* Nothing to do. *)
  in
  let config =
    Server.make ~callback ~conn_closed ()
  in
  Log.establish_server (Configuration.port());
  Server.create ~mode:(Configuration.insecuremode()) config

Starting the server

Finally we can put this alltogether, definining our routes, the main function of our application, and let Application.run determine the actual application configuration, initialise components (which does nothing now but will be important later), and run the main function.

let routes = [
  ("/about"      , fun () -> new Cid_About.about);
]

let main _ =
  Lwt_main.run (Component_Server.establish routes)

let configfile packagename =
  Filename.concat
    (try Sys.getenv "HOME" with Not_found -> "/")
    ("."^Cid_Configuration.ac_package)

let () =
  let open Application.Configuration in
  Application.run Cid_Configuration.ac_package
    "[-p port]"
    "Continuous integration and deployment server"
    ~user_configuration:(configfile Cid_Configuration.ac_package)
    main

We can try it with the queries from the introduction:

% (cd /Users/michael/Workshop/cid; /Users/michael/obj/Workshop/cid/src/cid)
2016-06-01T16:20:13Z Info cid 52898 Server [Establish] 0.0.0.0:8080
2016-06-01T16:20:15Z Info cid 52898 Server [Response] 200 GET /about/
2016-06-01T16:20:15Z Info cid 52898 Server [Connection Closed] [(TCP ((fd <opaque>) (ip (V4 127.0.0.1)) (port 51504)))]
2016-06-01T16:20:37Z Info cid 52898 Server [Response] 200 GET /about/
2016-06-01T16:20:37Z Info cid 52898 Server [Connection Closed] [(TCP ((fd <opaque>) (ip (V4 127.0.0.1)) (port 51511)))]

Conclusion

The preparation of a minimal server is a bit dry and the result might not seem very spectacular. We however learned to:

  • Define webmachine components delivering constant content under several formats, as required by the client.

  • Use a powerful application framework to easily initialise our application.

We also can a have a little bit of fun with our server, like firing 1000000 concurrent requests as fast as the shell can do it:

(jot 1000000 | while read _ ; do curl -H"Accept:text/plain" http://localhost:8080/about/ &;  done; wait)

Our work is the commit 81da4f1.

Your questions and remarks are welcome!