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

In this pose we implement the repository subscription functionality, which populates the database with references to repositories providing the products we need to test and to deploy.

The execution monad

Many computations rely on a database handle and possibly other values bundled together into an “execution environment.” These computations are conveniently performed inside a custom monad, that we call the execution monad implemented as Cid_Monad and commonly aliased to Monad in our code, see Cid_Aliases.

Readers non-familiar with monads can think about the execution monad using the following properties:

  • Monadic values 'a Monad.t can be transformed to functions mapping an environment to an outcome value indicating success or error of the operation. This transformation is implemented by the run function.

  • The monad defines a bind operation aliased to the infix opertor ( »= ) that allows to apply functions on monadic values before “running” them. Roughly speaking using the bind operation and then the run operation is essentially equivalent to using the run operation and then applying the function on the resulting value.

The execution monad is a combination of the reader and success monads and is easily built using Lemonade. Besides the standard monadic operations provided by Lemonade, it defines the following special operations:

(* Module Cid_Monad *)

val read : environment t
(** Access the current environment. *)

val run : environment -> 'a t -> 'a outcome
(** Perform a computation in the given environment. *)

val local : (environment -> environment) -> 'a t -> 'a t
(** Execute a computation in a modified environment. *)

val access : (environment -> 'a) -> 'a t
(** Access to a component of the current environment. *)

val error : error -> 'a t
(** Fail with the given error. *)

val errorf : string -> ('a, unit, string, 'b t) format4 -> 'a
(** [errorf label fmt] fail with error built from [label] and the
    printf-like format [fmt]. *)

val recover : 'a t -> (error -> 'a t) -> 'a t
(** [recover m handler] is a monad containing the same value as [m]
    and thrown errors are interepreted by the [handler]. *)

It might be tempting to embed this monad in the Lwt monad, but doing so would be a subtle design error: each call to a Lwt-ish function introduces a cooperation point between threads but we rather want to avoid introducing more cooperation points as needed, since it saves us from the need of protecting the database with a mutex.

The repository index collection

The Repository_Index exposes functions to handle the index or repositories. A record in the index holds a modest amount of information about repositories providing the products we test and deploy. Discovering the contents of these repositories is a distinct functionality that we will cover in later posts.

(* Module Repository_Index *)

type t = {
  name: string;
  description: string;
  kind: kind;
  url: string;
}
(** The type of repository index information. *)

(** The type of SCM kinds. *)
and kind =
  | Git

The name is a unique identifier used throughout the system to identify the repository, it is accompanied by an informative description and more importantly a url and a kind. For now the kind is limited to git but we should be able to talk to any popular system in the future.

(* Module Repository_Index *)

val add : t -> unit Cid_Monad.t
(** [add repo] is a monad that adds the given repository in the index. *)

val list : t list Cid_Monad.t
(** A monad enumerating known repositories. *)

val find : string -> t Cid_Monad.t
(** Get a repository by its name. *)

val mem : string -> bool Cid_Monad.t
(** Predicate recognising names of registered repositories. *)

val remove : string -> unit Cid_Monad.t
(** Remove a repository by its name. *)

We can look at the implementation of the mem function as it is representative of the remaining code:

let mem name =
  let open Database in
  let program =
    binding_apply
      (statement "SELECT (COUNT(name) > 0) FROM repository_index WHERE name = $name")
      [
        "$name", TEXT(name);
      ]
  in
  let of_row = function
    | [| INT(0L); |] -> return false
    | [| INT(1L); |] -> return true
    | _ -> error ("Repository_Index.mem", "Protocol mismatch.")
  in
  lift begin fun handle ->
    let open Database.Infix in
    query program handle
    |> one
    >>= of_row
  end

As usual when reading OCaml we need to skip the let bindings to find where the logic of the outer procedure is exposed:

lift begin fun handle ->
  let open Database.Infix in
  query program handle
  |> one
  >>= of_row
end

We see that a SQL program is executed in the Database monad, its output is a stream of rows which is converted to a singleton by one and ultimately to a boolean by of_row. The various combinators essentially express the composition at various degrees of monadicity.

The SQL program simply counts the number of available records with the given name:

let program =
  binding_apply
    (statement "SELECT (COUNT(name) > 0) FROM repository_index WHERE name = $name")
    [
      "$name", TEXT(name);
    ]

and one_row interprets the output rows as a boolean, signaling unexpected rows as a Protocol Mismatch.

let of_row = function
  | [| INT(0L); |] -> return false
  | [| INT(1L); |] -> return true
  | _ -> error ("Repository_Index.mem", "Protocol mismatch.")

The other database-related functions implemented in this module are handled very similarly.

Besides the collection management by itself, we use serialization function provided Martin Jambon’s YoJSon. These functions are used as part of JSON/HTTP mechanism we implement.

(* Module Repository_Index *)

(** {6 Serialisation} *)

val of_yojson : Yojson.Safe.json -> [ `Error of string | `Ok of t ]
val to_yojson : t -> Yojson.Safe.json

Last, we declare the repository index database schema, which is used by a small utility program cid_dbinit that will create the appropriate tables, see 2f8f29e.

(* Module Repository_Index *)

(** {6 Database schema} *)

val database_schema : string
(** The schema used to initialise the database. *)

The repository resources

The repository resource is a straightforward adaptation of the CRUD example shipped with Webmachine. We will therefore only emphasis that logging methods are gathered in their own module, as it should be for software components or webmachine resources. This makes it easy to ensure consistency, do not clutter the code with layout details and eases moving to a more sophisticated log management easy.

Stress testing

While our program does as little as it can, there is enough abilities in order to be tested and even stress-tested. We ran 100 parallel threads each firing sequentially 100 requests to the server with very satisfying results. The server could handle all requests, but the host firing them reached its limits in memory and maximum number of running processes, and about 10% of the requests could not be sent.

Next week, we will discuss the stress testing program itself. It is a simple but interesting shell script.

The work described in this post is the commit 3008077 and a few previous commits.

Your questions and remarks are welcome!