{# #}

let author = “Rudi Grinberg”

type content = [ `ocaml | `haskell | `python | `random ]

Type Safe Routing - Baby Steps

| Comments

Type safe routing means different things to different people. So let’s start by clarifying the intended meaning in this post. There are 2 widely used definitions:

  • The first refers to the case where the type system is used to maintain hyper links in your web app so that there are no dangling links. This static checking also extends to the parameters accepted by the hyper links.

  • The second definition is processing URL’s in a way that assigns types to the values extracted.

The first definition is much stronger and is mostly useful for complete web apps. The second definition pertains to API’s exposed over HTTP and will be the subject of this blog post. I am not an expert on this subject and this post only documents my first steps as to how to solve this problem. The end solution that I propose is not quite satisfying but is elegant in its own right. Let’s begin.

The Problem

Let’s take a sample opium handler:

1
2
3
4
5
6
let h =
  put "/hello/:x/from/:y" begin fun req ->
    let (x,y) = (param req "x", param req "y") in
    let msg = sprintf "Hello %s! from %s." x y in
    `String msg |> respond |> return
  end

There is something very unsatisfying in the code above. We are attaching a function to a URL that contains 2 parameters x and y. We know in the body of the function that the parameters are always there (otherwise our handler would not be executed) and yet we don’t express this deduction statically.

Can we do better? Yes, and I’ll show you how. Let’s start by pretending that a solution exists:

1
2
3
4
5
let x =
  put (s "/hello" </> str </> s "from" </> str) begin fun x y ->
    let msg = sprintf "Hello %s! from %s." x y in
    `String msg |> respond |> return
  end

This is much better. The function that we are binding to the route is now typed. The combinators used to specify the routes should be familiar, but a brief explanation is in order. s x will consume a portion of the url defined by x. </> concatenates 2 routes sequentially. str specifies a string parameter that ends with a "/".

The advantages of this approach include:

  • We don’t have to extract the parameters manually out of the request or even name the parameters. Although, we can imagine adding support for that if it proves useful.

  • The compiler will warn us if we haven’t used an argument.

  • We can now specify the types of the parameters we accept. We can imagine using int to specify a numerical parameter. In fact, we can probably think of a host of combinators to add various functionality.

The advantages are obvious, but how can we implement it?

Aspiring OCaml hackers might want give this a problem a crack themselves. To specify the problem a little better, and perhaps give a hint to the solution this is interface which we will be implementing:

1
2
3
4
5
6
7
8
9
10
11
type ('a, 'b) t

val s : string -> ('a, 'a) t

val (</>) : ('b, 'c) t -> ('a, 'b) t -> ('a, 'c) t

val str : ('a, string -> 'a) t

val int : ('a, int -> 'a) t

val match_url : ('a, 'b) t -> string -> 'b -> 'a option

The Solution

If you have a hard problem related to static typing, a good rule of thumb is to check if Oleg has already solved it. Indeed, the problem above falls under that category but under a different context. Typed Formatting attempts to define an EDSL for specifying a type safe printf/scanf. Our problem of type safe routes is just a subset of that since we only need scanf. Oleg’s solution in Haskell involves GADT’s, which have almost have worn off the novelty for me in OCaml.

We will also need a generic parser type ('a Parser.t is a parser that yields a value of type 'a). A simple monadic parser will do. Since it’s not particularly interesting, I will link my own implementation in the end. Here’s the signature for the parser (Although I don’t think we will need all of these operations).

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
open Core.Std
(* A Substring.t is analgous to a string * int * int
   The parser return None on failure. Some with the result and the rest
   of the substring on success. *)
type 'a t = Substring.t -> ('a * Substring.t) option
val return : 'a -> 'a t
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
(* validate/map input with f. If f returns none then the parser fails.
   If f return Some x then x is the result returned *)
val filter_map : 'a t -> f:('a -> 'b option) -> 'b t
(* run the parser against the string and return None if parsing fails. On
   success Some (x, rest) where x is the result and rest is the remaining
   string that needs to be parsed *)
val run : 'a t -> Substring.t -> ('a * Substring.t) option
(* little helpers *)
val drop_prefix : string -> unit t
val drop_while  : (char -> bool) -> unit t
val take_while  : (char -> bool) -> string t

Finally, here’s the type representing our DSL:

1
2
3
4
type (_, _) t =
  | Try_parse : unit Parser.t -> ('a, 'a) t
  | Parse     : 'b Parser.t -> ('a, 'b -> 'a) t
  | Concat    : ('b, 'c) t * ('a, 'b) t -> ('a, 'c) t

Enumerating the constructors:

  • Try_parse represents a parser whose result we discard. Hence we use (). It will be useful to implement s.

  • Parse represents a parser whose result we retain. It will be useful to implement typed parameters

  • Concat will be used to sequence routes. It will be useful to implement </>

The key to the whole solution is one simple function interpreting our DSL:

1
2
3
4
5
6
7
8
9
let rec ints : type a b . (a, b) t -> b -> a Parser.t =
  let open Option.Monad_infix in
  fun t f inp ->
    match t with
    | Try_parse p -> Parser.run p inp >>| fun ((), inp') -> (f, inp')
    | Parse p -> Parser.run p inp >>| fun (v, s) -> (f v, s)
    | Concat (a, b) ->
      ints a f inp >>= fun (vb, inp') ->
      ints b vb inp'

This function takes a typed route and a function corresponding to a handler and returns a parser that returns the result of our handler on success.

We just need a bit more massaging to fit our proposed interface:

1
2
3
4
5
6
7
8
9
let match_url t s cb =
  let s = Substring.of_string s in
  match ints t cb s with
  | None -> None
  | Some (x, subs) ->
    if subs |> Substring.to_string |> String.is_empty then
      Some x
    else (* we did not consume the whole string so no match *)
      None

The rest is a small matter of programming the combinators:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
(* a little helper to make sure our params are not empty *)
let non_empty = Parser.filter_map ~f:(fun x ->
  if String.is_empty x
  then None
  else Some x)

let int = Parse (fun x ->
  (Char.is_digit
   |> Parser.take_while
   |> non_empty
   |> Parser.map ~f:Int.of_string) x)

let s x = Try_parse (Parser.drop_prefix x)

let (</>) x1 x2 =
  let lead_slash x = Concat (s "/", x) in
  Concat (x1, lead_slash x2)

let str = Parse (fun x -> (Parser.take_while ((<>) '/') |> non_empty) x)

A little test using oUnit:

1
2
3
4
5
6
7
8
9
let it_works _ =
  let test_path = "/user/johndoe/comment/123" in
  let p = s "/user" </> str </> s "comment" </> int in
  match match_url p test_path (fun user id ->
    assert_equal ~printer "johndoe" user;
    assert_equal 123 id
  ) with
  | None -> assert_failure "Failed to match url"
  | Some _ -> print_endling "tada"

Conclusion

I have a prototype of Opium using these routes but it’s not for public consumption. I’d like to totally revamp routes from a scalability standpoint first before I improve the API for routing. There are also many other approaches to this problem (mostly from the land of Haskell). Here’s some great resources:

  • Happstack - The “pioneer” of type safe routing

  • The most recent and promising servant. However, it covers a whole lot more than just routing.

  • Spock is a tiny Haskell web framework that is most similar to my approach, although it uses type families under the hood.

At the end, I’m not sure which approach is the best for OCaml so I’m not ready to commit to anything in Opium yet. However, one thing is for certain: I definitely intend to the have the current untyped approach as an option.

Here’s a gist of a working version of my library. You’re welcome to fork and experiment, please let me know if you find any bugs.

One last thing. My implementation above can be called an “initial encoding” of the EDSL. You can actually implement the EDSL as a “final encoding” without GADT’s. I don’t see the advantage in either approach so I went with the initial encoding. I reached for it first and it gives me an excuse to play with GADT’s. A solution that uses a final encoding will be left as an exercise to the reader. (Who else has fond memories of this phrase from back in college?)

Abandoning Async

| Comments

There is an old and great schism in the OCaml community. The schism is between two concurrency libraries - Async and Lwt. As usual for these things, the two are very similar, and outsiders would wonder what the big deal is about. The fundamental problem of course is that they’re mutually incompatible. The result of this is a split OCaml world with almost no interoperability, and duplication of efforts.

The purpose of this post is not to compare the two from a technical perspective, but rather to describe my own experiences and the sentiment of the community. In the end, my conclusion is that disputes like this are rarely resolved on the basis of technical merits.

Splitting Hairs

Since I know (wish) there’s an influx of newcomers in the OCaml community. This is partly due to the great book Real World OCaml. I’ll spend a brief moment describing the fundamental differences between the 2 libraries. I assume that an informed beginner has read RWO. A basic understanding of Async and monadic concurrency will be needed to follow along.

The most noticeable between Async and Lwt is the approach towards error handling. Lwt’s analog to Async’s Deferred.t - Lwt.t, allows for an exception to be raised that would prevent an asynchronous value from being computed. Modelling this in Async we could get:

1
2
3
4
5
6
(* This is core's Result.t *)
type ('ok, 'error) result =
  | Ok of 'ok
  | Error of 'error

type Lwt.t = ('a, exn) Result.t Deferred.t

Another way of stating that is Lwt.t “inlines” the Either monad. How does Async deal with errors then? Two ways:

  • You can copy Lwt’s approach. But you must opt in to do it. See: Deferred.Or_error.t.

  • Construct monitor hierarchies that are responsible for handling exceptions raised in their context. Monitors either bubble exceptions up the monitor tree or swallow them, possibly handling them along the way.

Both of these approaches are covered in RWO.

At a first glance, Async’s approach is more elegant. When we look at the Haskell parallel universe we are reminded of the monad’s “fail” epic failure. A similar case of grafting unnecessary “features” where it does not belong in the name of error handling. Users of Lwt will quickly remind you that there are syntax extensions (both camlp4 and ppx!) to make up for this defficiency. Personally, I don’t find that satisfactory.

The second important difference between Async and Lwt that I’d like to highlight is the behavior of the most essential and primitive operation in any monadic concurrency library. The bind - >>=. async >>= f schedules the computation f using the value of async once it’s determined. However, there’s a slight twist in each library.

  • Lwt - if async is already determined when binding then f will run instantly. In effect, Lwt is always “eager” to execute as much as it can.

  • Async - attempts to help reasoning about code using the invariant “code between binds cannot be interrupted”. For example:

1
2
3
m >>= fun x ->
...
>>= fun y ->

You are guaranteed not to have scheduler context switch to another job in the .... The supposed benefits of this is the easier reasoning about race conditions. YMMV.

That will be it for technical details from me. There are more differences between Async and Lwt that I urge you to explore in more depth. Two great sources are:

Although I’ve tried to make the comparison above “fair and balanced”. It’s probably obvious from a purely technical perspective that I prefer Async. In fact, almost all of my concurrent programming in OCaml has been done in Async. Isn’t the decision obvious then?

A Bucket of Cold Water

First let’s quickly survey the community’s stance on Async vs. Lwt:

  • Lwt had at least 1700 downloads this month and 117 direct reverse dependencies.

  • Async had at least 400 downloads this month and 31 direct reverse dependencies. This includes Jane Street’s stuff, which is a huge chunk of it.

From the figures above and my own personal experience as a member in the community, clearly the OCaml community vastly prefers Lwt over Async. That means that if you’re an OCaml programmer that’s starting a potential project and thinking of using either concurrency library, Lwt is by far the most community friendly choice. Potential users will usually be more familiar with it and if your project is a library it will be far more interoperable. If you have any interest in being an active participant in the community then justifying using only Async will be very difficult.

What about supporting both? You have a choice between:

  • The problem space your code is trying to solve is simple enough that you can write a small core that is independent of any particular concurrency library. Daniel Bunzli’s Jsonm comes to mind.

  • You will have to functorize your library over an async monad.

As usual for these things, you cannot have your cake and eat it too.

The first option is great and is fully recommended in the odd case when it’s available. It’s certainly not free as I believe it adds complexity to the implementation. However, the cost is justified since your attempt to support both async/lwt also supports users of neither library and keeps your dependency profile low.

The second option is at first very natural. Deferred.t and Lwt.t are both monads aren’t they? Don’t we have some operations that are generic over those things? Unfortunately, this eureka moment is spoiled by a death by a thousand cuts. Be prepared to spend considerable time:

  • Learning the ins and outs of Async’s and Lwt’s idioms if you are to expose a good interface to either backend.

  • Using only the common subset of features of Async and Lwt. A painful waste of time as you end up slowly having to reimplement a concurrency library of your own as part of your software.

  • The amount of libraries available to you is much smaller. You are limited to libraries that support both Async and Lwt.

  • Tackling the considerable complexity added by supporting multiple backends in your build systems, messing around with a plethora of module signatures and sharing constraints, and worst of all - testing both backends.

  • Worst of all, consumers of your library will have to do all of this shit as well if they are to support both Async and Lwt.

All in all, it’s not same as doing 2x the work; it’s even worse! I’ve witnessed (and even participated) in seeing this churn unfold in cohttp and I can say the only reason it has been worth it is because we ended up having JS backend as well. In any case, I cannot in clear conscience recommend this path to anybody enthusiastic about using OCaml. It’s an unreasonable amount of work. The conclusion here is that it’s very unlikely that we’ll ever have an Async and Lwt compatible kumbaya in the OCaml world.

The Case for Lwt

I’ve already hinted at Lwt’s massive advantage over Async: the fact that the community has pretty much settled on using it. However, suppose that you’re some sort counter cultural hipster that writes software in a vacuum. Is there anything else Lwt offers you? Three words. Portability, portability, portability. More seriously, OCaml actually has AT LEAST 3 more platforms that Lwt supports and Async doesn’t.

  • js_of_ocaml - A very mature and downright awesome OCaml bytecode to JS compiler. While you’re at it check out the ocsigen project as well. A mature and complete (client + server) web framework for OCaml that is Lwt only.

  • mirage - Who wants to compile their server into a unikernel? I do. What’s stopping me? Async’s C dependencies. Also at this point, a considerable amount of software under mirage’s umbrella is using Lwt. Even if Async ever ends up working on mirage, it would be unwelcome as it would introduce its fragmentation there as well

  • Windows - People still use it I kid you not. In all honesty I don’t care about this one but I’m sure some of you will. Take note.

  • OCaml-Java - I’ve said at least 3 because I’m not sure if Lwt runs on this new and exciting target for OCaml. At least I’m sure of what doesn’t run on OCaml-Java. [1]

Suppose that portability is not so important. Let’s compare Async and Lwt purely as open source projects. On one hand we have a healthy active community. On the other, we have crickets. I cannot pretend to to understand why this is so, as I’ve never attempted to contribute to either project. I can tell you that only one of these projects gives me confidence that it serves the needs of its users (at least those who aren’t paid to use it).

Finally, the icing on the cake. Despite the excellent introduction to Async in RWO. Lwt remains vastly better documented than Async. Whether it’s the automatically generated reference, the numerous blog posts, or the mountains of examples everywhere. It remains that it’s much easier to get your Lwt questions answered faster.

What Now?

Naturally, I can only answer this question for myself. I will port all of my software from Async to Lwt. My minimalistic web framework Opium for one. With an eye towards running it on mirage. I will recommend everyone else who is looking to program in OCaml to use Lwt as well.

What about Core? (Or core_kernel rather)

My bearishness on Async luckily doesn’t translate to core. The core of core - core_kernel, is far more interoperable and portable. Its problems of slow compilation times and bloated executables are either solvable in the future, irrelevant, or far less severe than Async’s.

[1] I’ve been informed that Lwt doesn’t run on ocamljava

Introducing Humane-re

| Comments

Regular Expressions in OCaml

OCaml is my favorite language, but one area where it (its tools rather) often falls short in practice is common string handling tasks where regular expressions are often involved. The kind of stuff that Awk and and scripting languages often get praised for. In other words, not getting in the way and allowing to get the job done with minimal boilerplate.

The story for trying to accomplish the same thing in OCaml is not nearly as short. First, one usually looks at the String module and after a quick scroll realizes that there’s no solution there. Second, the Str library is checked out. Realize that the interface is not user friendly nor thread safe. If you’re a beginner, then you also start wandering what kind of a functional language OCaml really is.

Luckily, now that we have OPAM, it’s much easier to look for solutions beyond. If your string handling needs are simple enough then core’s or batteries’ String module. If you’re lucky, your search ends there. Even if you’re not, you still have plenty of good options:

  • pcre-ocaml Markus Mottl has written excellent bindings to the most popular flavor of regular expressions. In fact, I’d recommend these to anyone first if they’re writing an application or an internal library.

  • re2 Janestreet’s bindings to Google’s re2. The interface is quite nice but there’s a gajillion dependencies. Nevertheless, this is probably your best option if you’re looking for speed. As always, profile your code first.

  • ocaml-re This is the most interesting regex library because it’s written in OCaml. Its coolest feature is that it supports various regex syntaxes. Including: pcre, str, posix, glob, etc. In fact, it even has a drop in replacement for the builtin Str. Unfortunately, re’s interface is rather prickly, especially for beginners. Fixing that problem is going to be the meat of this blog post. Nevertheless, this is what I’d recommend if you’re going to publish a library for others to use. It doesn’t force any non-ocaml dependencies on users.

Humane-re

Realizing that it’s too hard for users to do the right thing and use ocaml-re, I’ve created a little wrapper called Humane-re around ocaml-re that makes it easier to accomplish the common tasks. The goal is to cover 90% of the use cases with minimal incidental complexity.

For now, Humane-re is still an experiment so the interface isn’t stable yet. I haven’t fleshed out the interface for replacement either, and currently I’m only supporting the Str flavor of regular expressions. Even with these limitations it’s already been useful for me. I’ll do a few brief examples of how to do some common tasks.

To follow along, install humane-re with:

1
$ opam install humane-re

and load it in utop:

1
2
3
$ utop
# require "humane_re";;
# open Humane_re;;

Super Naive Email Validation

1
2
3
4
let is_valid_email =
  let email_re = Str.regexp ".+@.+" in
  let open Str.Infix in fun email ->
  email =~ email_re

Extract all words

1
let extract_words = Str.(find_matches (regexp "\\b\\([A-Za-z]+\\)\\b"))

Parsing HTTP Header Like Value

1
2
3
4
5
6
let parse_header =
  let re = Str.regexp ":[ \t]*" in
  fun header ->
    match Str.split ~max:2 re header with
    | [name; value] -> Some (name, value)
    | _ -> None

I’ll admit, for these simple (but not contrived!) examples there’s no great improvement in readibility over Str. At least we’re not relying on any global variables. However, humane-re pulls ahead of Str in readability when groups are involved. I’ll show how to use groups in the next example.

Extracting Links Matching a Predicate

Where the predicate here is links to a certain website (e.g. imgur). Don’t ever use regular expressions to parse HTML in practice. This is only for demonstration purposes:

1
2
3
4
5
6
7
8
9
10
11
12
13
let extract_imgur_links page =
  let is_imgur s =
    let open Str.Infix in
    s =~ (Str.regexp ".+\\bimgur\\.com.+")
  in
  let re = Str.regexp "<a href=\"\\([^\"]+\\)\">\\([^<>]+\\)</a>" in
  page
  |> Str.fold_left_groups re ~init:[]
       ~f:(fun acc g ->
         match Str.Group.all g with
         | [href; text] when is_imgur href -> (href, text)::acc
         | _ -> acc)
  |> List.rev

The whole interface is contained in S.mli. I could reproduce it here but it will just go out of date. The ocamldoc isn’t there yet but the interface should be straight forward enough. Once again, send me suggestions, questions, critique, etc.

What’s next?

At this point I’m trying to collect as much feedback as possible about the interface because providing a nice interface is the first goal of this library. In particular, an interface for substitution would be very welcome.

The second goal is to support the different ways ocaml-re allows you to construct regular expressions. I’m not very fond of Str’s regex syntax, but it does have the practical purpose of allowing me to port old Str code. The third and lofty goal is to implement humane-re’s interface with other backends. There’s probably some value in not having to commit to code to any particular regex implementation (aside from benchmarking purposes ;D).

Middleware in Opium

| Comments

In my previous post I’ve introduced opium in a beginner friendly way, while in this post I’ll try to show something that’s a little more interesting to experienced OCaml programmers or those are well versed with protocols such as Rack, WSGI, Ring, from Ruby, Python, Clojure respectively.

Traditional Middleware

First, let’s start with some history. I’ll be recounting from memory so I apologize for any inaccuracies. Back in the stone ages of web application development, a big problem was (still is) creating reusable stand alone components. For example, caching, authentication, static pages. One solution to this problem was invented by the python community, (WSGI) and popularized by the Ruby community (Rack). Since then, it caught on like wild fire and has been ported to almost every other langauge. I attribute Rack’s success to its extreme simplicity. In Rack, an application is an object that takes an environment, an all-encompassing dictionary that includes the http request among other things, usually called env and returns a tuple of three elements, the status code, the headers, and the body of the response. Translating this to OCaml, a rack application is just:

1
2
3
4
5
6
7
8
9
10
type env = (string, string) Hashtbl.t
(* In ruby, the env hash is not restricted to string values course. They can be
any values. Ignore this restriction for now. Or pretend that we're doing some
gross Obj.magic hack. Ruby does the same anyway ;) *)
type body = string
type header = (string, string) Hashtbl.t
type application = env -> status * header * body

(* Actually I'm simplfiying. In reality, body in Rack is more similar to: *)
type body = (string -> unit) -> unit

Accepting Rack’s proposition that applications are simply functions that return that 3 element tuple, how do we create reusable components? In Rack the solution was to create so called “middleware”. Middleware is an object with a call method (of type application) and is constructed by passing the next application down the middleware chain. A very literal translation of a typical rack middleware to OCaml gives:

1
2
3
4
5
6
7
class my_middleware app =
  object
    method call env =
       if go_down_chain_condition
       then app#call env
       else (failwith "fix", failwith "me", failwith "please")
  end

One can imagine chaining multiple middleware to provide various functionality. For example checking credentials in the header of the request (found in env) to decide whether to authenticate the user to proceed with the next step or to return a not authorized status.

Middleware in Opium

Of course, nobody sane writes code like that in OCaml. So if we get rid of the classes and store state using closures instead of instance variables (if necessary) we’d get just a function of type:

1
2
3
type middleware = application -> env -> status * header * body
(* which can be simplified to *)
type middleware = application -> application

In this viewpoint, middleware is simply a higher order function that transforms an application to another.

OK, so is this good enough for OCaml? No. Putting back my statically typed functional programming hat on I can poke a couple of holes in this approach.

  • env is mutable. In fact, middleware is encouraged to treat it as request local storage and pass information between middleware. This means that env may not be the same before and after calling a middleware.

  • env offers no encapsulation. Middleware can easily pry at each other’s internals. Sometimes this is necessary, but many times it’s not. Ring in clojure offers namespaced keywords as the keys to the env hash, but this is only a gentleman’s agreement.

  • env offers no type safety. In rack, doing env[‘xxx’] is like trying to pull a rabbit out of hat. There’s no guarantee that the value obtained will of a certain type.

Universal Maps

All of this points us towards using something other than an untyped hash table for the environment hash. But what do we use in OCaml if we want, an openly extensible, heteregoneus, immutable map? We use core’s Univ_map. I won’t go into the details of how it works but I’ll say that a univ map supports the following two operations:

1
2
val find : Univ_map.t -> 'a Univ_map.Key.t -> 'a option
val add : Univ_map.t -> 'a Univ_map.Key.t -> 'a -> Univ_map.t

In addition to the creation of new Univ_map.Key.t that are associated with the types a key would extract.

1
val create: name:string -> ('a -> Sexp.t) -> 'a Univ_map.Key.t

If you’d like to know more I recommend the following resource [2], [3], [4].

In Opium, we throw away Rack’s env and simply put everything under the same umbrella and call it a Request. Similarly, an opium response will subsume the 3 element response tuple. env will then be the extensible part of a request/response. Which gives us:

1
2
3
4
5
6
7
8
9
10
11
type request = {
  request: Cohttp.Request.t;
  env: Univ_map.t;
}

type response = {
  code: Code.status_code;
  headers: Cohttp.Header.t;
  body: Cohttp_async.Body.t;
  env: Univ_map.t;
}

Now middleware is able to:

  • store stuff in env and always know the type of a value pulled out of env.

  • middleware can encapsulate its private data by not exposing its env keys in the public interface

And of course, there’s no sight of side effects anywhere.

Examples

Enough theory crafting, let’s build some middleware. Let’s start with a trivial example. First of all, our middleware need not even use env at all. For example here’s a middleware that uppercases the body:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
open Core.Std
open Async.Std
open Opium.Std

let uppercase =
  let filter handler req =
    handler req >>| fun response ->
    response
    |> Response.body
    (* this trick is only available with the latest cohttp. 
       you can manually unpack to a string and then repack however *)
    |> Cohttp_async.Body.map ~f:String.uppercase
    |> Field.fset Response.Fields.body response
  in
  Rock.Middleware.create ~name:(Info.of_string "uppercaser") ~filter

let _ = App.empty
        |> middleware uppercase
        |> get "/hello" (fun req -> `String ("Hello World") |> respond')
        |> App.cmd_name "Uppercaser"
        |> App.command
        |> Command.run

As you can tell, a middleware knows of 2 bits of information:

  • handler : Request.t -> Response.t Deferred.t. This is the application request handler.

  • req : Request.t. The current request.

In our example, the middleware runs the handler and returns a response with the uppercased body. But of course a general middleware doesn’t have to run handler at all, it can change the request before feeding the handler, or it can simple add a logging message and let the handler proceeed with the request.

You can tell that middleware is flexible, but to make it do something more interesting, you must be able to store stuff along the request/response. As I’ve mentioned before, the env bag is the perfect place for that.

Here’s another common use case. Suppose we’d like our webapp to automatically authenticate users that provide their credentials using the HTTP Basic scheme. For example, we can export a export function like:

1
val user : Request.t -> user option

Here’s how we could implement that:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
open Core.Std
open Async.Std
open Opium.Std

type user = {
  username: string;
  (* ... *)
} with sexp

(* My convention is to stick the keys inside an Env sub module. By
   not exposing this module in the mli we are preventing the user or other
   middleware from meddling with our values by not using our interface *)
module Env = struct
  let key : user Univ_map.Key.t = Univ_map.Key.create "user" <:sexp_of<user>>
end

(*
   Usually middleware gets its own module so the middleware constructor function
   is usually shortened to m. For example, [Auth.m] is obvious enough.

   The auth param (auth : username:string -> password:string -> user option)
   would represent our database model. E.g. it would do some lookup in the db
   and fetch the user.
*)
let m auth =
  let filter handler req =
    match req |> Request.headers |> Cohttp.Header.get_authorization with
    | None ->
      (* could redirect here, but we return user as an option type *)
      handler req
    | Some (Cohttp.Auth.Basic (username, password)) ->
      match auth ~username ~password with
      | None -> failwith "TODO: bad username/password pair"
      | Some user -> (* we have a user. let's add him to req *)
        let env = Univ_map.add_exn (Request.env req) Env.key user in
        let req = Field.fset Request.Fields.env req env in
        handler req
  in
  Rock.Middleware.create ~name:(Info.of_string "http basic auth") ~filter

let user req = Univ_map.find (Request.env req) Env.key

The middleware above might be basic as well but it should give you an idea on how to create a wide variety of middleware. For example, serving static pages, caching, throttling, routing, etc.

There are of course downsides however that I’ve yet to solve in Opium. The main downside is that middleware does not commute. This means that it must be executed in serial for every request. Much more worse however is that middleware order will affect application behaviour. In fact, a common source of bugs in Rack is executing middleware in the wrong order. One obvious solution to this is to explictly specify dependencies between middleware. Unfortunately it’s pretty ugly and heavyweight and it makes middleware less composable.

Final Note: After writing the first version of Opium I realized I was copying the core of twitter’s finnagle/finatra. I don’t mention them here however since finnagle is a lot more general and I don’t know much about it other than this excellent paper. I did end up borrowing their terminology for the lower level plumbing though.

[1] Rack Spec.

[2] Ring Spec. A huge improvement of Rack in my opinion. Rock could be thought of as a typed Ring.

[3] If you’re coming from the haskell WAI world I believe env would be called the vault. In fact, the way Rock is designed should be very similar to the old WAI (< 3.0). Except that WAI use IO instead of Deferred.t.

[4] mixtbl An implementation without core. It’s also a hashtable instead of a map.

[5] Haskell Vault. Same concept but implemented in the Haskell world.

[6] Univeral Type. If you’d like to dig deeper to see how the basic for such a map can be implemented.

Introducing Opium

| Comments

One itch that I usually need to scratch is setting up quick and dirty REST API’s - preferably in OCaml. OCaml does have a few options for web development but I found them to be not so great fits for my needs. To summarize:

  • Ocsigen - Is an innovative web framework but it’s too heavyweight for my common and simple use case; all of the client side stuff is immediately useless when all I want is just to throw some json over a POST request. Plus, I also prefer Async to Lwt and Ocsigen is much too big to port.

  • Ocamlnet - Mature and stable and from the sounds of it, pretty fast as well. However, by the looks of it, it’s too low level. Also it does not use cooperative threads for concurrency (Async or Lwt), and that’s a deal breaker for me.

To OCaml programmers coming from other languages, I’ll re-iterate all of the above very briefly: What I want is a Sinatra clone written in OCaml.

Without further ado, I’d like to introduce Opium, my own stab at this problem and I’m ready to declare it at a state where it’s not embarassing to show around. The project’s readme already contains high level documentation and a few examples. Instead of repeating that here I’ll quickly describe the project and do a little tutorial that’s a little more beginner friendly.

Getting Started

Opium has been available on OPAM for a while now and can be installed with:

1
$ opam install opium

From the dependencies that opium we can immediately see that opium is written on top of the async backend of cohttp, a pure OCaml http library for Lwt + Async. Cohttp is a great library but it’s a little too low level for the kind of code I’d like to write.

If you’ve installed everything correctly, the following simple example:

1
2
3
4
5
6
7
8
9
10
11
12
13
open Core.Std
open Async.Std
open Opium.Std

let app =
  App.empty |> (get "/" begin fun req ->
  `String "Hello World" |> respond'
  end)

let () =
  app
  |> App.command
  |> Command.run

Should compile after:

1
$ corebuild -pkg opium hello_opium.native

What do we get out of this? Run ./hello_opium.native -h and see. Opium generates a convenient executable for you with a few common options. For example to run a specific port and print debug information to stdout we can:

1
$ ./hello_opium.native -p 9000 -d

Now we can test our little server with:

1
$ curl 127.0.0.1:9000

Basics

Routing

The most basic functionality that opium provides is a simple interface for binding http requests to functions. It uses a simple glob like routing for url paths and normally binds one function to an http method. Parameters can also be specified. Here’s a couple examples:

1
2
3
4
5
6
7
8
9
10
11
(* Named parameters, only get request *)
let e1 = get "/hello/:name" (fun req ->
  let name = param req "name" in
  `String ("hello " ^ name) |> respond')

(* Splat paramteres *)
let e2 = get "/splat/*/anything" (fun req -> (`String "*") |> respond')

(* Multiple http methods *)
let f _ = `String "testing" |> respond'
let both = Fn.compose (get f) (put f)

Some sort of type safety would of course be ideal but I’m still in the process of figuring out some of the approaches to this problem.

Response helpers

Opium provides a few conveniences for generating common responses such as Json, Html, etc. and sets the response headers for you appropriately.

1
2
3
4
5
6
let e3 = get "/xxx/:x/:y" begin fun req ->
  let x = "x" |> param req |> Int.of_string in
  let y = "y" |> param req |> Int.of_string in
  let sum = Float.of_int (x + y) in
  `Json (Cow.Json.Float sum) |> respond'
end

By the way, respond' is simply respond wrapped with Deferred.return.

Debugging

Try hitting the following endpoint after you run your application in debug mode (-d flag). Make sure to compile with debugging as well.

1
2
3
let throws = get "/throw" (fun req ->
  Log.Global.info "Crashing...";
  failwith "expected failure!")

You get a nice stack trace and the requested that caused it:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
((request
  ((headers
    ((accept
      "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8")
     (accept-encoding gzip,deflate,sdch)
     (accept-language "en-GB,en;q=0.8,en-US;q=0.6,ru;q=0.4")
     (connection keep-alive)
     (host localhost:3000)
     (user-agent
      "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_9_2) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/33.0.1750.152 Safari/537.36")))
   (meth GET)
   (uri
    ((scheme http) (host localhost) (port 3000) (path (/ yyy)) (query ())))
   (version HTTP_1_1) (encoding Unknown)))
 (env ()))
(lib/monitor.ml.Error_
  ((exn (Failure "expected failure!"))
    (backtrace
      ("Raised at file \"pervasives.ml\", line 20, characters 22-33"
        "Called from file \"opium/cookie.ml\", line 60, characters 4-15"
        "Called from file \"lib/monitor.ml\", line 169, characters 25-32"
        "Called from file \"lib/jobs.ml\", line 214, characters 10-13" ""))
    (monitor
      (((name try_with) (here ()) (id 220) (has_seen_error true)
         (someone_is_listening true) (kill_index 0))))))

OK I admit, nice might be pushing it.

Going deeper

Opium is an extremely simple toolkit (I’m careful not to call it a framework on purpose). At its heart there are only 4 basic types:

  • {Request,Response} - Wrappers around cohttp’s {request,response}
  • Handler - Request.t -> Response.t Deferred.t
  • Middleware - Handler.t -> Handler.t

A handler is a full blown opium on its own (even though we usually have multiple handlers we dispatch to with routing). For example if we expand out the type signature for the familiar get function we get:

1
val get : string -> Handler.t -> builder

We see that the function parameter we pass to get is nothing more than a simple handler.

Middleware on the ojther hand is the main building block of reusable components. In fact all of opium is built in terms of such middleware, Router, Debugging, Static pages, etc. The low level layer that knows what to do with them is called Rock (Kind of like Rack in ruby, or WSGI in python). For something that’s pretty flexible, middleware is extremely simple, all it does is transform handlers. To give you a small taste, here’s a simple middleware that will randomly reject based on their user agent. Also available in the readme.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
open Core.Std
open Async.Std
open Opium.Std

let is_substring ~substring s = Pcre.pmatch ~pat:(".*" ^ substring ^ ".*") s

let reject_ua ~f =
  let filter handler req =
    match Cohttp.Header.get (Request.headers req) "user-agent" with
    | Some ua when f ua ->
      Log.Global.info "Rejecting %s" ua;
      `String ("Please upgrade your browser") |> respond'
    | _ -> handler req in
  Rock.Middleware.create ~filter ~name:(Info.of_string "reject_ua")

let app = App.empty
          |> get "/" (fun req -> `String ("Hello World") |> respond')
          |> middleware @@ reject_ua ~f:(is_substring ~substring:"MSIE")

let _ =
  Command.run (App.command ~summary:"Reject UA" app)
1
$ corebuild -pkg opium,pcre middleware_ua.native

Actually I’ve lied a little bit as you can tell from the example above. A middleware is not just a Handler.t -> Handler.t. That is only it’s filter component. Middleware is also named, it is mainly useful for debugging.

The Future

Until 1.0.0 is mostly suitable for me and brave beta testers. This means that opium still has some potentially embarrassing bugs, and interface breakges are to be expected But I still invite all users and potential contributors to help me improve Opium.

At this moment I’m most interested in bug reports and suggestions to the interface. More features are of course to be expected, such as support for sessions, whether cookie based or in memory. One big feature that will probably not make it into 1.0 is Lwt support. I’d love to have it but 2 backends would be a little much for me to maintain on my own.

Finally, stick around because I have more posts about Opium planned.

Omegle Clone in Flask + Gevent + WebSockets

| Comments

Python ranks fairly high when it comes getting things done without too much ceremony in the programming community. I briefly had some doubts of this assertion of until I finally found Flask-Sockets. This small library makes it very natural to serve WebSockets in Flask/gevent. You can consider this blog post as an advertisement for this small but extremely useful library.

In this post, I will show how to create an extremely simple omegle POC using the Gevent/Flask/Flask-Sockets combo. The end result is that the javascript client is comparable in code size to the server. Here’s the code for the server (the client is ugly and uninteresting but you can see it in the repo):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
#!/usr/bin/env python2
import gevent.monkey
gevent.monkey.patch_all()

import flask
from flask import Flask
from flask_sockets import Sockets
import gevent
import gevent.queue
from gevent import pywsgi
from geventwebsocket.handler import WebSocketHandler

app = Flask(__name__, static_url_path='')

sockets = Sockets(app)
seekers = gevent.queue.Queue()


def relay(from_, to):
    """route messges from_ -> to"""
    try:
        while True:
            to.send(from_.receive())
    except:
        # Notify to about disconnection - unless to disconnected
        try: to.send("Peer disconnected.")
        except: pass


def session(ws1, ws2):
    for ws in [ws1, ws2]:
        ws.send("/Found a person. Say hello")
    gevent.joinall([
        gevent.spawn(relay, ws1, ws2),
        gevent.spawn(relay, ws2, ws1)
    ])


def matcher(seekers):
    while True:
        gevent.spawn(session, seekers.get(), seekers.get())

gevent.spawn(matcher, seekers)

@sockets.route('/ws')
def websocket(ws):
    seekers.put(ws)
    ws.send("/Welcome. Seeking a partner")
    while True:  # hack to keep the greenlet alive
        gevent.sleep(0.5)


@app.route('/')
def index():
    return app.send_static_file('index.html')


if __name__ == '__main__':
    pywsgi.WSGIServer(('', 8000), app, handler_class=WebSocketHandler) \
          .serve_forever()

The implementation is very naive but I still wonder how well it would perform. Many further improvements are possible as well:

  • Limit the number of concurrent sessions
  • Create a pool for matchers to make sure that seekers empties fast enough
  • Allow clients to advertise names

You can see the full code here.

Benchmarking OCaml Json Libraries

| Comments

OCaml & Json

According to opam OCaml has 2 popular libraries for parsing json:

At the time of writing, Yojson is actually the 6th most popular OCaml library overall!

All things being equal we’d like to use the fastest json library. Unfortunately for us, things aren’t equal. In fact, Jsonm strives to be extremely minimalist and low level and the API that it provides non-blocking encoding and decoding.

Therefore, we will instead be benchmarking Yojson against Ezjsonm. Ezjsonm is a wrapper library designed provide a user friendly API on top of Jsonm. With this wrapper, serialization/deserialization code looks almost identical with both libraries. In my benchmarks I test the speed in which I read/write the following datatype:

1
2
3
4
5
6
7
8
9
10
11
12
13
module Event_type = struct
  type t =
    | Login
    | Purchase
    | Logout
    | Cancel
end
type event = {
  username: string;
  date: int;
  event_type: Event_type.t;
  payload: string;
}

This is a simple data type, however it’s representative of at least some of the applications json is used for.

Results

In my benchmarks I’ve opted for 2 simple tests:

  • How fast can a list of a 1000 event types be transformed to a big json list written to an array

  • How fast can a json string of a 1000 events be transformed into event list

The tests are done using the excellent Core_bench library and here is the “pretty” output for the first test:

1
2
3
4
5
6
 ─────────────────────────┬──────────┬────────────┬──────────┬──────────┬────────────┐
 Name                     Time/Run     mWd/Run  mjWd/Run  Prom/Run  Percentage 
├─────────────────────────┼──────────┼────────────┼──────────┼──────────┼────────────┤
 ezjsonm write              2.67ms  1_668.16kw  124.34kw   41.75kw     100.00% 
 yojson write               1.24ms     61.27kw   86.60kw    4.27kw      46.35% 
└─────────────────────────┴──────────┴────────────┴──────────┴──────────┴────────────┘

For the second test:

1
2
3
4
5
6
┌──────────────┬──────────┬────────────┬──────────┬──────────┬────────────┐
 Name          Time/Run     mWd/Run  mjWd/Run  Prom/Run  Percentage 
├──────────────┼──────────┼────────────┼──────────┼──────────┼────────────┤
 ezjsonm read    5.47ms  1_857.55kw   67.00kw   67.00kw     100.00% 
 yojson read     2.04ms    155.36kw   39.14kw   22.10kw      37.30% 
└──────────────┴──────────┴────────────┴──────────┴──────────┴────────────┘

The verdict is: Yojson is at least twice as fast as Ezjsonm in both benchmarks.

Of course, recall that benchmarks often lie (on behalf of their author) and it’s entirely possible that this difference can be attributed to my code. Therefore, I welcome you to go over my code here and draw your own conclusions.

Even in the case where I did not make a mistake in benchmarking, don’t let me turn you off from using Jsonm, which allows you to write json parsers at a very low level. I’m certain that a specialized reader/writer in Jsonm will easily beat Yojson.

Future work

This set of tests is not enough to draw any conclusions just yet. Here’s what I’d like to do in the future:

  • OCaml has more implementations of the json serialization format. They are uncommonly used, however it would still be nice to include them: yajl, tiny_json.

  • Test serializers/deserializer that are automatically generated from type definitions: atdgen, cow, deriving-yojson

  • See how well a hand rolled Jsonm reader/writer fairs.

  • Add more tests for different use cases, data types, write to channels, not just strings.

Document Search Using Cosine Similarity in Haskell Using Linear

| Comments

Reading OCharles’ excellent series about 24 days of hackage, in particular the post about Linear, I’ve been inspired to revisit some old code I wrote. The code is a document search engine that uses cosine similarity to rank matches. I like the following two articles if you’re not familiar with this technique:

Without further ado, here is the tiny piece of code that demonstrates this technique:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
{-# LANGUAGE OverloadedStrings #-}
import Linear
import Data.List (sortBy)
import qualified Data.Map as Map
import qualified Data.ByteString.Lazy as B
import Data.ByteString.Lazy (ByteString)
import Text.Regex.Posix

type Vector = Map.Map ByteString Float

toVector :: ByteString -> Vector
toVector b = foldl (\m s -> Map.insertWith (+) s (1.0 :: Float) m) Map.empty tokenized
  where tokenized = map head $ b =~ ("[A-Za-z]+" :: ByteString)

mostSimilar :: Vector -> [Vector] -> [Vector]
mostSimilar v = sortBy (\x y -> compare (cosTheta y) (cosTheta x))
  where cosTheta x = dot x v / norm v * norm x

Linear allows me to shave off all the code defining norms/inner products for Map String Float and condense a proof of concept of the technique in very little code (More than half is imports!). The snippet is obviously not as efficient as it could be (toVector is slow for example) but we can get the n most similar documents for “free” thanks to laziness even if we write code the naive way.

Btw, the snippet above has a (not so subtle) bug, can you spot it? ;)

Hint: Quickcheck!

Lru Cache With a Memcache-Like Interface

| Comments

Lately, I’ve been messing around with Janestreet’s core and async libraries by reimplementing an old interview question that has been posed to me before. The problem statement itself is from my memory alone so this isn’t 100% what I’ve been asked but it should be extremely close.

Problem

Implement a simple memcache like TCP interface to an Lru cache. All commands in the server are of the form:

1
2
3
QUIT\r\n
GET key\r\n
SET key value\r\n

where key, value must not contain spaces.

Responses are of the form:

1
2
3
INSERTED\r\n
OK\r\nvalue\r\n
NOT_FOUND\r\n

It should be obvious enough to see the request-response correspondence.

Solution

First we’d like to separate the protocol from any particular server implementation by defining a Protocol module encapsulating the definitions above.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
module Protocol = struct
  module Client_message = struct
    type t =
      | Get of string
      | Set of string * string
      | Quit with sexp
    let of_string s =
      Option.try_with @@ fun () ->
        match String.split ~on:' ' s with
        | "QUIT"::[] -> Quit
        | "GET"::k::[] -> Get k
        | "SET"::k::v::[] -> Set (k,v)
        | _ -> failwith "bad command"
  end
  module Server_message = struct
    type t =
      | Ok of string
      | Inserted
      | Not_found with sexp
    let to_string = function
      | Inserted -> "INSERTED\r\n"
      | Ok m -> "OK\r\n" ^ m ^ "\r\n"
      | Not_found -> "NOT_FOUND\r\n"
  end
end

the particular of the cache itself is immaterial so there’s no reason why our server should depend on it. The only real restrictions we’d like to have is that the cache must have have a bounded number of elements so that our server doesn’t run out of memory (Note that to achieve this we’d need restrict the size of the keys and values as well but we’ll skip it). We could functorize our server over the protocol as well if we include quitting as a return type for of_string for example. The following interface is satisfactory:

1
2
3
4
5
6
module type BoundedCache = sig
  type t
  val create : size:int -> t
  val get : t -> key:string -> string option
  val set : t -> key:string -> data:string -> unit
end

The Cache.Lru module in the core_extended package does not quite fit our interface but can be very simply adapted with:

1
2
3
4
5
6
7
module Lru = struct
  module L = Cache.Lru
  type t = (string, string) L.t
  let create ~size = L.create None size
  let get t ~key = L.find t key
  let set = L.add
end

Of course, I’m aware that original intent of the interview question was not to test how well you put together ready made lego blocks to solve the problem but more of designing the data structure for the Lru cache. The aim of this blogpost is more to show how well the lego blocks in core/async fit together.

Finally we can start writing our Cache server module functorized over the cache signature. We will start with the function process which simply processes a request into a response in the context of the server’s state - the cache in our case. We’d expect a type signature such as:

1
2
module P = Protocol
val process : Cache.t -> P.Client_message.t -> P.Server_message.t

Functions of this sort are very concisely expressed with OCaml’s pattern matching:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
module CacheServer (Cache : BoundedCache) = struct
  open Protocol
  let process t req =
    let open Client_message in
    match req with
    | Get key ->
      Server_message.(match Cache.get t ~key with
          | None -> Not_found
          | Some x -> Ok x)
    | Set (key, data) ->
      Cache.set t ~key ~data;
      Server_message.Inserted
    | Quit -> assert false
end

The server runs by simply binding to an address and passing input to the function above in the main loop. The only special handling we need is for the quit message and bad input (which we just ignore).

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
let run_server ~host ~port ~size =
    let cache = Cache.create ~size in
    Tcp.Server.create (Tcp.on_port port) @@ fun _ reader writer ->
      Deferred.create (fun finished ->
          let rec loop () =
            Reader.read_line reader >>> function
            | `Ok query ->
              (match Client_message.of_string query with
               | None -> loop ()
               | Some Client_message.Quit -> Ivar.fill finished ()
               | Some req ->
                 let resp = process cache req in
                 resp |> Server_message.to_string |> Writer.write writer;
                 loop ())
            | `Eof -> Ivar.fill finished ()
          in loop ())

Finally, to run the server we must instantiate our functor and run the async scheduler.

1
2
3
4
5
let server =
  let module CS = CacheServer(Lru) in
  CS.run_server ~host:"127.0.0.1" ~port:12345 ~size:100

let () = Scheduler.go () |> never_returns

Later versions of core include a wrapper around ocamlbuild called corebuild which makes compiling the code much easier. Assuming your source is named tinycache.ml

1
$ corebuild tinycache.native -pkg core_extended

Full source as a gist.