expose Cohttp_mirage_io, Cohttp_mirage.Server and Cohttp_mirage.Client

.travis.yml

@@ -1,5 +1,6 @@
 language: c
-script: bash -ex .travis-ci.sh
+install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-opam.sh
+script: bash -ex .travis-opam.sh
 env:
-  - OCAML_VERSION=4.02.1 OPAM_VERSION=1.2.0
-  - OCAML_VERSION=4.01.0 OPAM_VERSION=1.2.0
+  - OCAML_VERSION=4.01
+  - OCAML_VERSION=latest

_oasis

@@ -11,7 +11,6 @@ Library "mirage-http"
   CompiledObject:     best
   Path:               lib
   Findlibname:        mirage-http
-  Modules:            HTTP
-  InternalModules:    HTTP_IO
-  BuildDepends:       cohttp.lwt-core, tcpip.channel, lwt.syntax, conduit.mirage, sexplib.syntax
+  Modules:            Cohttp_mirage, Cohttp_mirage_io
+  BuildDepends:       cohttp.lwt-core, tcpip.channel, conduit.mirage, sexplib.syntax
   XMETARequires:      cohttp.lwt-core, tcpip.channel, lwt, conduit.mirage, sexplib

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 2d08264567e82eedcc9f4cfaa49a19d8)
+# DO NOT EDIT (digest: c99ec3268548ab3194e3e2947e8caea1)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -18,7 +18,6 @@ true: annot, bin_annot
 "lib/mirage-http.cmxs": use_mirage-http
 <lib/*.ml{,i,y}>: pkg_cohttp.lwt-core
 <lib/*.ml{,i,y}>: pkg_conduit.mirage
-<lib/*.ml{,i,y}>: pkg_lwt.syntax
 <lib/*.ml{,i,y}>: pkg_sexplib.syntax
 <lib/*.ml{,i,y}>: pkg_tcpip.channel
 # OASIS_STOP

lib/HTTP.ml → lib/cohttp_mirage.ml

@@ -19,10 +19,10 @@
 open Lwt
 open Sexplib.Conv
 
-module Make(Conduit:Conduit_mirage.S) = struct
+module Client (Conduit:Conduit_mirage.S) = struct
 
   module Channel = Channel.Make(Conduit.Flow)
-  module HTTP_IO = HTTP_IO.Make(Channel)
+  module HTTP_IO = Cohttp_mirage_io.Make(Channel)
 
   module Net_IO = struct
 
@@ -32,13 +32,13 @@ module Make(Conduit:Conduit_mirage.S) = struct
     type ic = Channel.t
     type oc = Channel.t
     type flow = Conduit.flow
-    
+
     type ctx = {
       resolver: Resolver_lwt.t;
       ctx: Conduit.ctx;
     } with sexp_of
 
-    let default_ctx = 
+    let default_ctx =
       { resolver = Resolver_mirage.localhost;
         ctx = Conduit.default_ctx }
 
@@ -57,20 +57,24 @@ module Make(Conduit:Conduit_mirage.S) = struct
     let close ic oc = ignore_result (Channel.close ic)
 
   end
-
+  let ctx resolver ctx = { Net_IO.resolver; ctx }
   (* Build all the core modules from the [Cohttp_lwt] functors *)
-  module Request = Cohttp_lwt.Make_request(HTTP_IO)
-  module Response = Cohttp_lwt.Make_response(HTTP_IO)
-  module Client = Cohttp_lwt.Make_client(HTTP_IO)(Request)(Response)(Net_IO)
-  module Server_core = Cohttp_lwt.Make_server(HTTP_IO)(Request)(Response)(Net_IO)
+  module XRequest = Cohttp_lwt.Make_request(HTTP_IO)
+  module XResponse = Cohttp_lwt.Make_response(HTTP_IO)
+  include Cohttp_lwt.Make_client(HTTP_IO)(XRequest)(XResponse)(Net_IO)
 
-  (* Extend the [Server_core] module with the Mirage-specific
-     listen function. *)
-  module Server = struct
-    include Server_core
+end
+
+module Server (Flow: V1_LWT.FLOW) = struct
+
+  module Channel = Channel.Make(Flow)
+  module HTTP_IO = Cohttp_mirage_io.Make(Channel)
+  module XRequest = Cohttp_lwt.Make_request(HTTP_IO)
+  module XResponse = Cohttp_lwt.Make_response(HTTP_IO)
+  include Cohttp_lwt.Make_server(HTTP_IO)(XRequest)(XResponse)
+
+  let listen spec flow ic oc =
+    let ch = Channel.create flow in
+    callback spec flow ch ch
 
-    let listen spec flow ic oc =
-      let ch = Channel.create flow in
-      Server_core.callback spec flow ch ch
-  end
 end

lib/cohttp_mirage.mli

@@ -0,0 +1,28 @@
+(*
+ * Copyright (c) 2012-2014 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2013 Thomas Gazagnaire <thomas@gazazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *
+ *)
+
+(** Cohttp implementation for mirage *)
+
+module Client (Conduit:Conduit_mirage.S): sig
+  include Cohttp_lwt.Client
+  val ctx: Resolver_lwt.t -> Conduit.ctx -> ctx
+end
+(** HTTP client. *)
+
+module Server (Flow: V1_LWT.FLOW): Cohttp_lwt.Server
+(** HTTP server *)

lib/HTTP_IO.ml → lib/cohttp_mirage_io.ml

@@ -29,32 +29,33 @@ module Make(Channel:V1_LWT.CHANNEL) = struct
   let iter fn x = Lwt_list.iter_s fn x
 
   let read_line ic =
-    match_lwt Channel.read_line ic with
+    Channel.read_line ic >>= function
     | [] -> return None
     | bufs -> return (Some (Cstruct.copyv bufs))
 
   let read ic len =
-    try_lwt
-      lwt iop = Channel.read_some ~len ic in
-      return (Cstruct.to_string iop)
-    with End_of_file -> return ""
+    Lwt.catch
+      (fun () ->
+         Channel.read_some ~len ic >>= fun iop ->
+         return (Cstruct.to_string iop))
+      (function End_of_file -> return "" | e -> Lwt.fail e)
 
   let read_exactly ic buf off len =
     let rec read acc left =
       match left with
       | 0   -> return (List.rev acc)
       | len ->
-        lwt iop = Channel.read_some ~len ic in
+        Channel.read_some ~len ic >>= fun iop ->
         read (iop::acc) (left - (Cstruct.len iop))
     in
-    lwt iov = read [] len in
+    read [] len >>= fun iov ->
     (* XXX TODO this is hyper slow! *)
     let srcbuf = Cstruct.copyv iov in
-    String.blit srcbuf 0 buf off (String.length srcbuf);
+    Bytes.blit srcbuf 0 buf off (String.length srcbuf);
     return true
 
   let read_exactly ic len =
-    let buf = String.create len in
+    let buf = Bytes.create len in
     read_exactly ic buf 0 len >>= function
     | true -> return (Some buf)
     | false -> return None

lib/mirage-http.mldylib

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 120e4679a5100613b6b5c6a9d33858c7)
-HTTP
-HTTP_IO
+# DO NOT EDIT (digest: 726b0ca0d5a2997c48cba3a0fb4e184a)
+Cohttp_mirage
+Cohttp_mirage_io
 # OASIS_STOP

lib/mirage-http.mllib

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 120e4679a5100613b6b5c6a9d33858c7)
-HTTP
-HTTP_IO
+# DO NOT EDIT (digest: 726b0ca0d5a2997c48cba3a0fb4e184a)
+Cohttp_mirage
+Cohttp_mirage_io
 # OASIS_STOP

opam

@@ -1,17 +1,20 @@
-opam-version: "1"
-maintainer: "anil@recoil.org"
-build: [
-  [make]
-  [make "install"]
-]
-remove: [[make "uninstall"]]
+opam-version: "1.2"
+maintainer:   "anil@recoil.org"
+authors:      ["Anil Madhavapeddy" "Thomas Gazagnaire"]
+homepage:     "https://github.com/mirage/mirage-http"
+bug-reports:  "https://github.com/mirage/mirage-http/issues/"
+dev-repo:     "https://github.com/mirage/mirage-http.git"
+
+build:    [make]
+install: [make "install"]
+remove:  ["ocamlfind" "remove" "mirage-http"]
 depends: [
-  "ocamlfind"
+  "ocamlfind" {build}
   "mirage-types-lwt" {>= "2.0.0"}
   "mirage-conduit"
   "lwt" {>= "2.4.3"}
   "cohttp" {>= "0.12.0"}
   "camlp4"
   "sexplib"
 ]
-ocaml-version: [>= "4.00.0"]
+available: [ocaml-version >= "4.00.0"]

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.3.0 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 153416fa6a3ed67f8c776294e894abbf) *)
+(* DO NOT EDIT (digest: 82042b175bf7b1e23519bad59ff4cf62) *)
 (*
    Regenerated by OASIS v0.4.5
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -6741,7 +6741,6 @@ let setup_t =
                         [
                            FindlibPackage ("cohttp.lwt-core", None);
                            FindlibPackage ("tcpip.channel", None);
-                           FindlibPackage ("lwt.syntax", None);
                            FindlibPackage ("conduit.mirage", None);
                            FindlibPackage ("sexplib.syntax", None)
                         ];
@@ -6756,9 +6755,9 @@ let setup_t =
                       bs_nativeopt = [(OASISExpr.EBool true, [])]
                    },
                    {
-                      lib_modules = ["HTTP"];
+                      lib_modules = ["Cohttp_mirage"; "Cohttp_mirage_io"];
                       lib_pack = false;
-                      lib_internal_modules = ["HTTP_IO"];
+                      lib_internal_modules = [];
                       lib_findlib_parent = None;
                       lib_findlib_name = Some "mirage-http";
                       lib_findlib_containers = []
@@ -6771,14 +6770,14 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.5";
-     oasis_digest = Some "u4 �7ݹ�\012�\152y?�y";
+     oasis_digest = Some "���Q\031fA�?����.\135I";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
   };;
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 6783 "setup.ml"
+# 6782 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;