hardcode curly

.gitmodules

@@ -1,3 +0,0 @@
-[submodule "vendor/curly"]
-	path = vendor/curly
-	url = https://github.com/rgrinberg/curly.git

src/bin/curly.ml

@@ -1 +0,0 @@
-../../vendor/curly/src/curly.ml

src/bin/curly.ml

@@ -0,0 +1,237 @@
+module Result = struct
+  include Result
+  let (>>=)
+    : type a b e. (a, e) result -> (a -> (b, e) result) -> (b, e) result
+    = fun r f ->
+      match r with
+      | Ok x -> f x
+      | (Error _) as e -> e
+end
+
+open Result
+
+module Meth = struct
+  type t =
+    [ `GET
+    | `POST
+    | `HEAD
+    | `PUT
+    | `DELETE
+    | `OPTIONS
+    | `TRACE
+    | `CONNECT
+    | `PATCH
+    | `Other of string
+    ]
+
+  let to_string = function
+    | `GET -> "GET"
+    | `POST -> "POST"
+    | `HEAD -> "HEAD"
+    | `PUT -> "PUT"
+    | `DELETE -> "DELETE"
+    | `OPTIONS -> "OPTIONS"
+    | `TRACE -> "TRACE"
+    | `CONNECT -> "CONNECT"
+    | `PATCH -> "PATCH"
+    | `Other s -> s
+
+  let pp fmt t = Format.fprintf fmt "%s" (to_string t)
+end
+
+module Header = struct
+  type t = (string * string) list
+
+  let empty = []
+
+  let to_cmd t =
+    t
+    |> List.map (fun (k, v) -> ["-H"; Printf.sprintf "%s: %s" k v])
+    |> List.concat
+
+  let pp fmt t =
+    Format.pp_print_list
+      ~pp_sep:Format.pp_print_newline
+      (fun fmt (k ,v) -> Format.fprintf fmt "%s: %s\n" k v)
+      fmt t
+end
+
+module Response = struct
+  type t = Http.response =
+    { code: int
+    ; headers: Header.t
+    ; body: string
+    }
+
+  let default =
+    { code = 0
+    ; headers = []
+    ; body = "" }
+
+  let of_stdout s =
+    let lexbuf = Lexing.from_string s in
+    try Ok (Http.response default lexbuf)
+    with e -> Error e
+
+  let pp fmt t =
+    Format.fprintf fmt "{code=%d;@ headers=%a;@ body=\"%s\"}"
+      t.code Header.pp t.headers t.body
+end
+
+module Process_result = struct
+  type t =
+    { status: Unix.process_status
+    ; stderr: string
+    ; stdout: string
+    }
+
+  let pp_process_status fmt = function
+    | Unix.WEXITED n -> Format.fprintf fmt "Exit code %d" n
+    | Unix.WSIGNALED n -> Format.fprintf fmt "Signal %d" n
+    | Unix.WSTOPPED n -> Format.fprintf fmt "Stopped %d" n
+
+  let pp fmt t =
+    Format.fprintf fmt "{status=%a;@ stderr=\"%s\";@ stdout=\"%s\"}"
+      pp_process_status t.status t.stderr t.stdout
+end
+
+module Error = struct
+  type t =
+    | Invalid_request of string
+    | Bad_exit of Process_result.t
+    | Failed_to_read_response of exn * Process_result.t
+    | Exn of exn
+
+  let pp fmt = function
+    | Bad_exit p ->
+      Format.fprintf fmt "Non 0 exit code %a@.%a"
+        Process_result.pp_process_status p.Process_result.status
+        Process_result.pp p
+    | Failed_to_read_response (e, _)  ->
+      Format.fprintf fmt "Couldn't read response:@ %s" (Printexc.to_string e)
+    | Invalid_request r -> Format.fprintf fmt "Invalid request: %s" r
+    | Exn e -> Format.fprintf fmt "Exception: %s" (Printexc.to_string e)
+end
+
+module Request = struct
+  type t =
+    { meth: Meth.t
+    ; url: string
+    ; headers: Header.t
+    ; body: string
+    }
+
+  let make ?(headers=Header.empty) ?(body="") ~url ~meth () =
+    { meth
+    ; url
+    ; headers
+    ; body }
+
+  let has_body t = String.length t.body > 0
+
+  let validate t =
+    if has_body t && List.mem t.meth [`GET; `HEAD] then
+      Error (Error.Invalid_request "No body is allowed with GET/HEAD methods")
+    else
+      Ok t
+
+  let to_cmd_args t =
+    List.concat
+      [ ["-X"; Meth.to_string t.meth]
+      ; Header.to_cmd t.headers
+      ; [t.url]
+      ; (if has_body t then
+           ["--data-binary"; "@-"]
+         else
+           [])
+      ]
+
+  let pp fmt t =
+    Format.fprintf fmt
+      "{@ meth=%a;@ url=\"%s\";@ headers=\"%a\";@ body=\"%s\"@ }"
+      Meth.pp t.meth t.url Header.pp t.headers t.body
+end
+
+let result_of_process_result t =
+  match t.Process_result.status with
+  | Unix.WEXITED 0 -> Ok t
+  | _ -> Error (Error.Bad_exit  t)
+
+let run prog args stdin_str =
+  let (stdout, stdin, stderr) =
+    let prog =
+      prog :: (List.map Filename.quote args)
+      |> String.concat " " in
+    Unix.open_process_full prog [||] in
+  if String.length stdin_str > 0 then (
+    output_string stdin stdin_str
+  );
+  begin
+    try close_out stdin;
+    with _ -> ()
+  end;
+  let stdout_fd = Unix.descr_of_in_channel stdout in
+  let stderr_fd = Unix.descr_of_in_channel stderr in
+  let (in_buf, err_buf) = Buffer.(create 128, create 128) in
+  let read_buf_len = 512 in
+  let read_buf = Bytes.create read_buf_len in
+  let input ch =
+    match input ch read_buf 0 read_buf_len with
+    | 0 -> Error `Eof
+    | s -> Ok s in
+  let rec loop = function
+    | [] -> ()
+    | read_list ->
+      let can_read, _, _ = Unix.select read_list [] [] 1.0 in
+      let to_remove =
+        List.fold_left (fun to_remove fh ->
+            let (rr, buf) =
+              if fh = stderr_fd then (
+                (input stderr, err_buf)
+              ) else (
+                (input stdout, in_buf)
+              ) in
+            begin match rr with
+              | Ok len ->
+                Buffer.add_subbytes buf read_buf 0 len;
+                to_remove
+              | Error `Eof ->
+                fh :: to_remove
+            end
+          ) [] can_read in
+      read_list
+      |> List.filter (fun fh -> not (List.mem fh to_remove))
+      |> loop
+  in
+  ignore (loop [ stdout_fd ; stderr_fd ]);
+  let status = Unix.close_process_full (stdout, stdin, stderr) in
+  { Process_result.
+    status
+  ; stdout = Buffer.contents in_buf
+  ; stderr = Buffer.contents err_buf
+  }
+
+let run ?(exe="curl") ?(args=[]) req =
+  Request.validate req >>= fun req ->
+  let args = "-si" :: (Request.to_cmd_args req) @ args in
+  let res =
+    try
+      result_of_process_result (run exe args req.Request.body)
+    with e ->
+      Error (Error.Exn e)
+  in
+  res >>= fun res ->
+  match Response.of_stdout res.Process_result.stdout with
+  | Ok r -> Ok r
+  | Error e -> Error (Error.Failed_to_read_response (e, res))
+
+let get ?exe ?args ?headers url =
+  run ?exe ?args (Request.make ?headers ~url ~meth:`GET ())
+let head ?exe ?args ?headers url =
+  run ?exe ?args (Request.make ?headers ~url ~meth:`HEAD ())
+let delete ?exe ?args ?headers url =
+  run ?exe ?args (Request.make ?headers ~url ~meth:`DELETE ())
+let post ?exe ?args ?headers ?body url =
+  run ?exe ?args (Request.make ?body ?headers ~url ~meth:`POST ())
+let put ?exe ?args ?headers ?body url =
+  run ?exe ?args (Request.make ?body ?headers ~url ~meth:`PUT ())

src/bin/curly.mli

@@ -1 +0,0 @@
-../../vendor/curly/src/curly.mli

src/bin/curly.mli

@@ -0,0 +1,125 @@
+module Meth : sig
+  type t =
+    [ `GET
+    | `POST
+    | `HEAD
+    | `PUT
+    | `DELETE
+    | `OPTIONS
+    | `TRACE
+    | `CONNECT
+    | `PATCH
+    | `Other of string ]
+
+  val pp : Format.formatter -> t -> unit
+end
+
+module Header : sig
+  type t = (string * string) list
+
+  val pp : Format.formatter -> t -> unit
+end
+
+module Response : sig
+  type t =
+    { code: int
+    ; headers: Header.t
+    ; body:string
+    }
+
+  val pp : Format.formatter -> t -> unit
+end
+
+module Request : sig
+  type t =
+    { meth: Meth.t
+    ; url:string
+    ; headers: Header.t
+    ; body:string
+    }
+
+  val make
+    : ?headers:Header.t
+    -> ?body:string
+    -> url:string
+    -> meth:Meth.t
+    -> unit
+    -> t
+
+  val to_cmd_args : t -> string list
+
+  val pp : Format.formatter -> t -> unit
+end
+
+module Process_result : sig
+  type t =
+    { status: Unix.process_status
+    ; stderr:string
+    ; stdout:string
+    }
+
+  val pp : Format.formatter -> t -> unit
+end
+
+module Error : sig
+  type t =
+    | Invalid_request of string
+    | Bad_exit of Process_result.t
+    | Failed_to_read_response of exn * Process_result.t
+    | Exn of exn
+
+  val pp : Format.formatter -> t -> unit
+end
+
+val run
+  : ?exe:string
+  -> ?args:string list
+  -> Request.t
+  -> (Response.t, Error.t) Result.result
+
+val get
+  : ?exe:string
+  -> ?args:string list
+  -> ?headers:Header.t
+  -> string
+  -> (Response.t, Error.t) Result.result
+(** Specialized version of {!run} for method [`GET]
+    @since 0.2.0 *)
+
+val head
+  : ?exe:string
+  -> ?args:string list
+  -> ?headers:Header.t
+  -> string
+  -> (Response.t, Error.t) Result.result
+(** Specialized version of {!run} for method [`HEAD]
+    @since 0.2.0 *)
+
+val delete
+  : ?exe:string
+  -> ?args:string list
+  -> ?headers:Header.t
+  -> string
+  -> (Response.t, Error.t) Result.result
+(** Specialized version of {!run} for method [`DELETE]
+    @since 0.2.0 *)
+
+val post 
+  : ?exe:string
+  -> ?args:string list
+  -> ?headers:Header.t
+  -> ?body:string
+  -> string
+  -> (Response.t, Error.t) Result.result
+(** Specialized version of {!run} for method [`POST]
+    @since 0.2.0 *)
+
+val put
+  : ?exe:string
+  -> ?args:string list
+  -> ?headers:Header.t
+  -> ?body:string
+  -> string
+  -> (Response.t, Error.t) Result.result
+(** Specialized version of {!run} for method [`PUT]
+    @since 0.2.0 *)

src/bin/http.mli

@@ -1 +0,0 @@
-../../vendor/curly/src/http.mli

src/bin/http.mli

@@ -0,0 +1,9 @@
+(* The purpose of this module isn't to be a full blown http parser but rather to
+   only parse whatever curl otputs *)
+type response =
+  { code: int
+  ; headers: (string * string) list
+  ; body: string
+  }
+
+val response : response -> Lexing.lexbuf -> response

src/bin/http.mll

@@ -1 +0,0 @@
-../../vendor/curly/src/http.mll

src/bin/http.mll

@@ -0,0 +1,52 @@
+{
+
+type response =
+  { code: int
+  ; headers: (string * string) list
+  ; body: string
+  }
+
+let add_code t code =
+  { t with code = int_of_string code }
+
+let add_header t key val_ =
+  { t with headers = (key, (String.trim val_)) :: t.headers }
+
+let add_body t b = { t with body=Buffer.contents b }
+
+let set_lexeme_length buf n =
+  let open Lexing in
+  if n < 0 then
+    invalid_arg "set_lexeme_length: offset should be positive";
+  if n > buf.lex_curr_pos - buf.lex_start_pos then
+    invalid_arg "set_lexeme_length: offset larger than lexeme";
+  buf.lex_curr_pos <- buf.lex_start_pos + n;
+  buf.lex_curr_p <- {
+    buf.lex_start_p
+    with pos_cnum = buf.lex_abs_pos + buf.lex_curr_pos
+  }
+}
+
+let space = [' ' '\t']
+
+rule response resp = parse
+  | [^ ' ']+ { code resp lexbuf }
+and code resp = parse
+  | space+ (['0' - '9']+ as code) { status (add_code resp code) lexbuf }
+and status resp = parse
+  | space+  { status resp lexbuf }
+  | [^ '\n']+ '\n' { header_start resp lexbuf }
+and header_start resp = parse
+  | "\r\n" { body resp (Buffer.create 128) lexbuf }
+  | space+ { header_start resp lexbuf }
+  | _ {
+      set_lexeme_length lexbuf 0;
+      header_key resp lexbuf
+    }
+and header_key resp = parse
+  | space* ([^ ':']+ as key) space* ':' space* { header_val resp key lexbuf }
+and header_val resp key = parse
+  | ([^ '\n']+ as v) '\n' { header_start (add_header resp key v) lexbuf }
+and body resp b = parse
+  | eof { add_body resp b }
+  | _ as c { Buffer.add_char b c; body resp b lexbuf }

vendor/curly

@@ -1 +0,0 @@
-Subproject commit 9417bd97fdf293f469c38e726c169583638d5aa1