From 9246082d4c460adfebfe98d9e9b2bcf2d62647bb Mon Sep 17 00:00:00 2001
From: Nicolas Ojeda Bar <n.oje.bar@gmail.com>
Date: Fri, 16 May 2014 18:28:08 +0100
Subject: [PATCH] Allow HTTP methods other than the standard ones.

---
 cohttp/code.ml    | 26 ++++++++++++++++----------
 cohttp/code.mli   |  9 +++++++--
 cohttp/request.ml |  9 ++++-----
 3 files changed, 27 insertions(+), 17 deletions(-)

diff --git a/cohttp/code.ml b/cohttp/code.ml
index eb1e49ecd3..435c5fb2a5 100644
--- a/cohttp/code.ml
+++ b/cohttp/code.ml
@@ -3,7 +3,9 @@
 open Sexplib.Std
 type version = [ `HTTP_1_0 | `HTTP_1_1 ] with sexp
 
-type meth = [ `GET | `POST | `HEAD | `DELETE | `PATCH | `PUT | `OPTIONS ] with sexp
+type standard_meth = [ `GET | `POST | `HEAD | `DELETE | `PATCH | `PUT | `OPTIONS ] with sexp
+
+type meth = [ standard_meth | `Other of string ] with sexp
 
 type informational_status =
   [ `Continue
@@ -116,16 +118,20 @@ let string_of_method: meth -> string = function
   | `PATCH -> "PATCH"
   | `PUT -> "PUT"
   | `OPTIONS -> "OPTIONS"
+  | `Other s -> s
 
-let method_of_string: string -> meth option = function
-  | "GET" -> Some `GET
-  | "POST" -> Some `POST
-  | "HEAD" -> Some `HEAD
-  | "DELETE" -> Some `DELETE
-  | "PATCH" -> Some `PATCH
-  | "PUT" -> Some `PUT
-  | "OPTIONS" -> Some `OPTIONS
-  | _ -> None
+let method_of_string: string -> meth = function
+  | "GET" -> `GET
+  | "POST" -> `POST
+  | "HEAD" -> `HEAD
+  | "DELETE" -> `DELETE
+  | "PATCH" -> `PATCH
+  | "PUT" -> `PUT
+  | "OPTIONS" -> `OPTIONS
+  | _ as s -> `Other s
+
+let compare_method m1 m2 =
+  String.compare (string_of_method m1) (string_of_method m2)
 
 let status_of_code: int -> status_code = function
   | 100 -> `Continue
diff --git a/cohttp/code.mli b/cohttp/code.mli
index 095f49bc24..c64a0ed635 100644
--- a/cohttp/code.mli
+++ b/cohttp/code.mli
@@ -3,7 +3,9 @@
 open Sexplib.Std
 type version = [ `HTTP_1_0 | `HTTP_1_1 ] with sexp
 
-type meth = [ `GET | `POST | `HEAD | `DELETE | `PATCH | `PUT | `OPTIONS ] with sexp
+type standard_meth = [ `GET | `POST | `HEAD | `DELETE | `PATCH | `PUT | `OPTIONS ] with sexp
+
+type meth = [ standard_meth | `Other of string ] with sexp
 
 type informational_status =
   [ `Continue (** Client should continue with request *)
@@ -114,9 +116,12 @@ val version_of_string: string -> version option
 val string_of_method: meth -> string
 (** Convert a method to a string. *)
 
-val method_of_string: string -> meth option
+val method_of_string: string -> meth
 (** Convert a string to a method. Return [None] if the conversion fails. *)
 
+val compare_method : meth -> meth -> int
+(** Compare two methods by name. *)
+
 
 val status_of_code: int -> status_code
 (** Generate status values from int codes. *)
diff --git a/cohttp/request.ml b/cohttp/request.ml
index cf4f29a7d3..32d01a64a3 100644
--- a/cohttp/request.ml
+++ b/cohttp/request.ml
@@ -77,11 +77,10 @@ module Make(IO : S.IO) = struct
     | Some request_line -> begin
       match Stringext.split request_line ~on:' ' with
       | [ meth_raw; path; http_ver_raw ] -> begin
-          match method_of_string meth_raw, version_of_string http_ver_raw with
-          | Some m, Some v -> return (`Ok (m, path, v))
-          | None, Some v -> return (`Invalid ("Malformed request method: " ^ meth_raw))
-          | Some v, None -> return (`Invalid ("Malformed request HTTP version: " ^ http_ver_raw))
-          | None, None -> return (`Invalid ("Malformed request method and version: " ^ request_line))
+          let m = method_of_string meth_raw in
+          match version_of_string http_ver_raw with
+          | Some v -> return (`Ok (m, path, v))
+          | None -> return (`Invalid ("Malformed request HTTP version: " ^ http_ver_raw))
       end
       | _ -> return (`Invalid ("Malformed request header: " ^ request_line))
     end