How can I get the HTTP or HTTPS scheme using cohttp?

Learning
1

I am trying out cohttp.
I am writing the following code based on the server-side code in the README-basic-server-tutorial, but the scheme is always None.

htttp_server.ml

let server =
  let open Lwt in
  let callback _conn req body =
    (* Scheme is always None... *)  
    let scheme = req |> Cohttp.Request.scheme |> (fun s -> match s with | Some x -> x | None -> "") in
    let uri = req |> Cohttp.Request.uri |> Uri.to_string in
    let meth = req |> Cohttp.Request.meth |> Cohttp.Code.string_of_method in
    let headers = req |> Cohttp.Request.headers |> Cohttp.Header.to_string in
    let version = req |> Cohttp.Request.version |> Cohttp.Code.string_of_version in
    match (uri, meth) with
      (_, _) -> body |> Cohttp_lwt.Body.to_string >|= (fun body ->
        Printf.sprintf "Uri: %s:%s\nMethod: %s\nVersion: %s\nHeaders:---\n%s\nBody:---\n%s\n"
          scheme uri meth version headers body)
      >>= fun body -> Cohttp_lwt_unix.Server.respond_string ~status:`OK ~body ()
  in
  Cohttp_lwt_unix.Server.create ~mode:(`TCP (`Port 8080)) (Cohttp_lwt_unix.Server.make ~callback ())

let () = ignore (Lwt_main.run server)

Build:

ocamlfind ocamlopt -package cohttp-lwt-unix -linkpkg -thread http_server.ml

Run the server:

./a.out

Request:

curl http://localhost:8080

Result: (Missing scheme)

Uri: ://localhost:8080/
Method: GET
Version: HTTP/1.1
Headers:---
accept: */*
host: localhost:8080
user-agent: curl/7.68.0


Body:---

Environment:

# OCaml version
ocaml --version
The OCaml toplevel, version 4.12.0

# OS
cat /etc/issue
Linux Mint 20.2 Uma \n \l

What is the correct way to get a scheme please?

2

I don’t think you can, at least not the way Cohttp is right now. When the server parses the request, it seems to discard the scheme: ocaml-cohttp/request.ml at 524674e453c5eeb3be156e5046bc2fdaf5b50779 · mirage/ocaml-cohttp · GitHub

(`Ok { headers; meth; scheme = None; resource; version; encoding })

My advice, check out Dream, a more recent web framework with Sinatra-style abstractions. Dream has tons of documentation and is in my opinion more user-friendly. Accessing the scheme is trivial: Dream — Tidy, feature-complete web framework

E.g.,

let header_to_string (name, value) = name ^ ": " ^ value

let print_req req =
  let open Lwt.Syntax in
  let+ req_body = Dream.body req in
  Dream.response @@ Printf.sprintf
    "Target: http%s://%s%s
Method: %s
Version: HTTP/%s
Headers:---
%s
Body:---
%s
"
    (if Dream.https req then "s" else "")
    (Option.get @@ Dream.header "host" req)
    (Dream.target req)
    (Dream.method_to_string @@ Dream.method_ req)
    (match Dream.version req with 1, 1 -> "1.1" | 2, 0 -> "2.0" | _ -> "?")
    (String.concat "\n" @@ List.map header_to_string @@ Dream.all_headers req)
    req_body

let () =
  Dream.run
  @@ Dream.logger
  @@ Dream.router [
    Dream.get "/" print_req;
  ]
  @@ Dream.not_found
2 Likes
3

Thank you very much!
I understood why sheme is always None.

Dream looks really good!
I’ll try it.

1 Like
4

I created an HTTP server with Dream referring to your advice.

Thank you very much.

1 Like