Add an Opium example once more?

[benjamin-thomas]

Hello,

I see that you provided an example of an integration with Opium a while ago, but then removed id.

I've been having issues trying to make my demo work so I'd appreciate if you could provide a little example once more.

Thanks :)

[anuragsoni]

Hello!

I don't use Opium these days so I have fallen behind on updating examples related to it after making some breaking changes within this library.

That said, here's an example that should help you get started! This takes a couple of different handlers from the example shown in Opium's readme, but with routes doing the heavy lifting when it comes to routing. Opium itself doesn't allow customizing which router gets used so one can piggy-back on top of a App.all "**" route which will forward everything to the custom routes based routing layer. Hope this helps!

open Opium

module Person = struct
  type t = { name : string; age : int }

  let yojson_of_t t = `Assoc [ ("name", `String t.name); ("age", `Int t.age) ]

  let t_of_yojson yojson =
    match yojson with
    | `Assoc [ ("name", `String name); ("age", `Int age) ] -> { name; age }
    | _ -> failwith "invalid person json"
end

let print_param_handler name _req =
  Response.of_plain_text (Printf.sprintf "Hello, %s" name) |> Lwt.return

let print_person_handler name age _req =
  { Person.name; age } |> Person.yojson_of_t |> Response.of_json |> Lwt.return

let not_found _req = Response.of_plain_text ~status:`Not_found "" |> Lwt.return

let routed_handler routes =
  let router = Routes.one_of routes in
  fun req ->
    match Routes.match' router ~target:req.Request.target with
    | Routes.NoMatch -> not_found req
    | FullMatch r -> r req
    | MatchWithTrailingSlash r ->
        (* This branch indicates that incoming request's path finishes with a
           trailing slash. If you app needs to distinguish trailing slashes
           (/a/b vs /a/b/), this is where you'd write something to handle the
           use-case *)
        r req

let () =
  App.empty
  |> App.all "**" (fun req ->
         routed_handler
           Routes.
             [
               route (s "hello" / str /? nil) print_param_handler;
               route (s "person" / str / int /? nil) print_person_handler;
             ]
           req)
  |> App.run_command

[benjamin-thomas]

Thanks a lot, your example really helped!

What library do you use to build your HTTP layer? I really like your library so I'd be interested to hear your opinion :)

Usually, my routes define acting on "resources", receiving one or many verbs. Since routes isn't concerned with the HTTP verb, I organized my code this way for now:

type 'a resource = { get : 'a Routes.route; post : 'a Routes.route }

let hello_resource =
  { get = Routes.(route (s "hello" / str /? nil) print_param_handler)
  ; post = Routes.(route (s "hello" / str /? nil) post_stuff)
  }
;;

let () =
  App.empty
  |> App.get "**" (fun req ->
         routed_handler
           Routes.
             [ hello_resource.get
             ; route (s "person" / str / int /? nil) print_person_handler
             ]
           req)
  |> App.post "**" (fun req -> routed_handler [ hello_resource.post ] req)
  |> App.run_command
;;

Please let me know if you can think of a better way :)

Have a great day!

[anuragsoni]

What library do you use to build your HTTP layer? I really like your library so I'd be interested to hear your opinion :)

My preference is to use async when writing concurrent applications. I've been working on https://github.com/anuragsoni/shuttle/tree/main/http which provides a http codec implementation (only HTTP/1.1 for now) and my current preference is to use this when I need to write http services/clients. There are some docs hosted online (https://anuragsoni.github.io/shuttle/shuttle_http/index.html for an intro to writing servers) and https://anuragsoni.github.io/shuttle/shuttle_http/Shuttle_http/Client/index.html has some docs for using clients.

Usually, my routes define acting on "resources", receiving one or many verbs.

This is my preferred approach as well. I handle this slightly different from your example though, and implement the method handling within a handler like so:

let validate_methods methods handler request =
  match methods with
  | [] -> handler request
  | xs ->
      if List.mem request.Request.meth xs then handler request
      else Lwt.return (Response.make ~status:`Method_not_allowed ())

let print_param_handler name =
  validate_methods [ `GET ] (fun _req ->
      (* Dispatch different actions for HTTP verbs if needed *)
      Response.of_plain_text (Printf.sprintf "Hello, %s" name) |> Lwt.return)

I like this as it makes it very clear to me that a handler was invoked because a route "matched", but if it has a http verb that shouldn't be used we exit early and return a HTTP 405. Another potential option to organize this logic could be to create one router per http verb, and dispatch requests like so:

module MethodMap = Map.Make (struct
  type t = Method.t

  let compare a b = compare a b
end)

let routed_handler' routes req =
  match MethodMap.find_opt req.Request.meth routes with
  | None -> Lwt.return (Response.make ~status:`Method_not_allowed ())
  | Some router -> (
      match Routes.match' router ~target:req.Request.target with
      | Routes.NoMatch -> not_found req
      | FullMatch r -> r req
      | MatchWithTrailingSlash r ->
          (* This branch indicates that incoming request's path finishes with a
             trailing slash. If you app needs to distinguish trailing slashes
             (/a/b vs /a/b/), this is where you'd write something to handle the
             use-case *)
          r req)

I tend to not prefer this as it leads to some duplication of route definitions if the same path sequence needs to work with multiple http verbs.

[benjamin-thomas]

Thank you very much for your valuable feedback @anuragsoni! You gave me juts enough information to get over my initial hurdle (as an newcomer to OCaml, hadn't looked at Maps yet)

Below is what I managed to do as a working demo, I'm fairly happy with the result. I'll probably shuffle stuff around but it's a good start :)

I'm open to any suggestions by any experienced users obviously.

I'll keep an eye on your shuffle library :)

Have a great week!

(*

  Quickly test the endpoints by copy/pasting the following:

  for PATH_ in dog cat "dog/1" "cat/1";do curl -w " => %{http_code}\\n" localhost:3000/$PATH_;done
  for VERB in GET POST PUT DELETE;do curl -w " => %{http_code}\\n" -X $VERB localhost:3000/dog/1;done
*)

open Opium

let not_found _req = Response.of_plain_text ~status:`Not_found "" |> Lwt.return

module MethodMap = Map.Make (struct
  type t = Method.t

  let compare a b = compare a b
end)

let routed_handler
    (routes : (Request.t -> Response.t Lwt.t) Routes.router MethodMap.t)
    (req : Request.t) =
  match MethodMap.find_opt req.Request.meth routes with
  | None -> Lwt.return (Response.make ~status:`Method_not_allowed ())
  | Some router -> (
      match Routes.match' router ~target:req.Request.target with
      | Routes.NoMatch -> not_found req
      | FullMatch r -> r req
      | MatchWithTrailingSlash r ->
          (* Tcats branch indicates that incoming request's path finishes with a
             trailing slash. If you app needs to distinguish trailing slashes
             (/a/b vs /a/b/), tcats is where you'd write something to handle the
             use-case *)
          r req)
;;

let get_many_dogs () : ('a -> Response.t Lwt.t) Routes.route =
  Routes.route
    Routes.(s "dog" /? nil)
    (fun _ -> Lwt.return @@ Response.of_plain_text "GET many dogs")
;;

let get_one_dog () : (Request.t -> Response.t Lwt.t) Routes.route =
  Routes.route
    Routes.(s "dog" / int /? nil)
    (fun id _req ->
      Lwt.return
      @@ Response.of_plain_text
      @@ Printf.sprintf "GET one dog (ID=%d)" id)
;;

let post_one_dog () : (Request.t -> Response.t Lwt.t) Routes.route =
  Routes.route
    Routes.(s "dog" / int /? nil)
    (fun id _req ->
      Lwt.return
      @@ Response.of_plain_text
      @@ Printf.sprintf "POST one dog (ID=%d)" id)
;;

let put_one_dog () : (Request.t -> Response.t Lwt.t) Routes.route =
  Routes.route
    Routes.(s "dog" / int /? nil)
    (fun id _req ->
      Lwt.return
      @@ Response.of_plain_text
      @@ Printf.sprintf "PUT one dog (ID=%d)" id)
;;

let delete_one_dog () : 'a Routes.route =
  Routes.route
    Routes.(s "dog" / int /? nil)
    (fun id _req ->
      Lwt.return
      @@ Response.of_plain_text
      @@ Printf.sprintf "DELETE one dog (ID=%d)" id)
;;

let delete_many_dog () : 'a Routes.route =
  Routes.route
    Routes.(s "dog" /? nil)
    (fun _ -> Lwt.return @@ Response.of_plain_text "DELETE many dogs")
;;

let get_many_cats () : 'a Routes.route =
  Routes.route
    Routes.(s "cat" /? nil)
    (fun _ -> Lwt.return @@ Response.of_plain_text "GET many cats")
;;

let get_one_cat () : 'a Routes.route =
  Routes.route
    Routes.(s "cat" / int /? nil)
    (fun id _req ->
      Lwt.return
      @@ Response.of_plain_text
      @@ Printf.sprintf "GET one cat (ID=%d)" id)
;;

let dog_routes : (Method.t * ('a Routes.route) list) list =
  [ (`GET,    [ get_many_dogs ()
              ; get_one_dog ()
              ]
    )
  ; (`POST,   [ post_one_dog () ])
  ; (`PUT,    [ put_one_dog (); put_one_dog () ])
  ; (`DELETE, [ delete_many_dog (); delete_one_dog () ])
  ] [@@ocamlformat "disable"]

let cat_routes : (Method.t * ('a Routes.route) list) list =
  [ (`GET,    [ get_many_cats ()
              ; get_one_cat ()
              ]
    )
  ; (`POST,   [])
  ; (`PUT,    [])
  ; (`DELETE, [])
  ] [@@ocamlformat "disable"]

let merge_routes (lst : (Method.t * 'a Routes.route list) list list) :
    (Method.t * 'a Routes.route list) list =
  List.fold_left
    (fun acc routes ->
      List.fold_left
        (fun acc (meth, routes) ->
          let curr_routes =
            try List.assoc meth acc with
            | Not_found -> []
          in
          (meth, routes @ curr_routes) :: List.remove_assoc meth acc)
        acc routes)
    [] lst
;;

let build_router =
  List.fold_left
    (fun meth_map (meth, handlers) ->
      MethodMap.add meth (Routes.one_of handlers) meth_map)
    MethodMap.empty
;;

let all_resource_routes : (Method.t * 'a Routes.route list) list =
  merge_routes [ dog_routes; cat_routes ]
;;

let handle_routes req = routed_handler (build_router @@ all_resource_routes) req
let () = App.empty |> App.all "**" handle_routes |> App.run_command

[anuragsoni]

I'll keep an eye on your shuffle library :)

The http library that's part of shuttle is available on opam now! https://ocaml.org/p/shuttle_http/0.9.1/doc/index.html

Below is what I managed to do as a working demo, I'm fairly happy with the result. I'll probably shuffle stuff around but it's a good start :)

This looks like an excellent start!