Cohttp server example

_tags

true : package(core), package(async), package(cohttp), package(cohttp.async)
true: thread

Server.ml

(* Read this chapter:

  https://realworldocaml.org/v1/en/html/concurrent-programming-with-async.html

  You'll need to understand some of these interfaces:

  - https://github.com/avsm/ocaml-cohttp/tree/master/cohttp
  
  - https://github.com/avsm/ocaml-cohttp/tree/master/async
  
 Install dependencies:
 
    $ opam install cohttp async core

 To build:

    $ ocamlbuild -use-ocamlfind  Server.d.byte 

  To run:

    $ ./Server.d.byte 8080

  From another terminal, ensure the server is running:

    $ curl localhost:8080
    Hello! Post a number to increment

  When you POST a number to the server, it increments:

    $ curl localhost:8080 -X POST -d "125"
    The next number is: 126  
*)  
open Core.Std
open Async.Std

module Request = Cohttp.Request
module Server = Cohttp_async.Server

let handle_body (body : string) : Server.response Deferred.t =
  Server.respond_with_string
    (sprintf "The next number is: %d\n" (1 + Int.of_string body))

(* This shouldn't be necessary, but let's you handle lots of data:

  http://en.wikipedia.org/wiki/Chunked_transfer_encoding *)
let cat_chunks (body : string Pipe.Reader.t) : string Deferred.t =
  Pipe.fold body ~init:"" ~f:(fun x y -> return (x ^ y))

let handle_client ~(body : string Pipe.Reader.t option)
                  (client_addr : Socket.Address.Inet.t)
                  (request : Request.t) : Server.response Deferred.t =
  let open Request in
  match request.meth with
    | `GET -> Server.respond_with_string "Hello! Post a number to increment\n"
    | `POST -> 
      (match body with
         | None -> Server.respond_with_string "missing body" ~code:`Bad_request
         | Some body -> cat_chunks body >>= handle_body)
    | _ -> Server.respond_with_string "" ~code:`Bad_request

let serve port = Server.create (Tcp.on_port port) handle_client

let _ = match Array.to_list Sys.argv with
  | [ _; port] -> 
    let _ = serve (Int.of_string port) in
    never_returns (Scheduler.go ())
  | _ ->
    printf "Invalid arguments.\n%!"; raise Exit