Move site prefix handling to a middleware

Author: aantron

src/dream.ml

@@ -67,10 +67,9 @@ include Dream_pure.Formats
 (* TODO Restore the ability to test with a prefix and re-enable the
    corresponding tests. *)
 let test ?(prefix = "") handler request =
-  ignore prefix;
   let app =
     content_length
-    @@ chop_site_prefix
+    @@ with_site_prefix prefix
     @@ handler
   in
 

src/dream.mli

@@ -1973,7 +1973,6 @@ val run :
   ?stop:unit promise ->
   ?debug:bool ->
   ?error_handler:error_handler ->
-  ?prefix:string ->
   ?https:bool ->
   ?certificate_file:string ->
   ?key_file:string ->
@@ -2004,8 +2003,6 @@ val run :
       low-level errors. See {!section-errors} and example
       {{:https://github.com/aantron/dream/tree/master/example/9-error#files}
       [9-error]} \[{{:http://dream.as/9-error} playground}\].
-    - [~prefix] is a site prefix for applications that are not running at the
-      root ([/]) of their domain. The default is ["/"], for no prefix.
     - [~https:true] enables HTTPS. You should also specify [~certificate_file]
       and [~key_file]. However, for development, Dream includes an insecure
       compiled-in
@@ -2036,7 +2033,6 @@ val serve :
   ?stop:unit promise ->
   ?debug:bool ->
   ?error_handler:error_handler ->
-  ?prefix:string ->
   ?https:bool ->
   ?certificate_file:string ->
   ?key_file:string ->
@@ -2071,7 +2067,6 @@ val serve :
       @@ Dream.lowercase_headers
       @@ Dream.content_length
       @@ Dream.catch_errors
-      @@ Dream.chop_site_prefix
       @@ my_app
     ]}
 
@@ -2098,10 +2093,15 @@ val catch_errors : middleware
 (** Forwards exceptions, rejections, and [4xx], [5xx] responses from the
     application to the error handler. See {!section-errors}. *)
 
-val chop_site_prefix : middleware
-(** Removes {!Dream.run} [~prefix] from the path in each request, and adds it to
-    the request prefix. Responds with [502 Bad Gateway] if the path does not
-    have the expected prefix. *)
+val with_site_prefix : string -> middleware
+(** Removes the given prefix from the path in each request, and adds it to the
+    request prefix. Responds with [502 Bad Gateway] if the path does not have
+    the expected prefix.
+
+    This is for applications that are not running at the root ([/]) of their
+    domain. The default is ["/"], for no prefix. After [with_site_prefix],
+    routing is done relative to the prefix, and the prefix is also necessary for
+    emitting secure cookies. *)
 
 
 

src/http/http.ml

@@ -651,7 +651,6 @@ let built_in_middleware =
     Dream__middleware.Lowercase_headers.lowercase_headers;
     Dream__middleware.Content_length.content_length;
     Dream__middleware.Catch.catch_errors;
-    Dream__middleware.Site_prefix.chop_site_prefix;
   ]
 
 
@@ -743,27 +742,20 @@ let serve_with_details
 let is_localhost interface =
   interface = "localhost" || interface = "127.0.0.1"
 
-(* TODO Validate the prefix here. *)
 let serve_with_maybe_https
     caller_function_for_error_messages
     ~interface
     ~port
     ~stop
     ?debug
     ~error_handler
-    ~prefix
     ~https
     ?certificate_file ?key_file
     ?certificate_string ?key_string
     ~builtins
     user's_dream_handler =
 
-  let prefix =
-    prefix
-    |> Dream_pure.Formats.from_path
-    |> Dream_pure.Formats.drop_trailing_slash
-  in
-  let app = Dream.new_app (Error_handler.app error_handler) prefix in
+  let app = Dream.new_app (Error_handler.app error_handler) in
 
   try%lwt
     begin match debug with
@@ -915,7 +907,6 @@ let serve
     ?(stop = never)
     ?debug
     ?(error_handler = Error_handler.default)
-    ?(prefix = "")
     ?(https = false)
     ?certificate_file
     ?key_file
@@ -929,7 +920,6 @@ let serve
     ~stop
     ?debug
     ~error_handler
-    ~prefix
     ~https:(if https then `OpenSSL else `No)
     ?certificate_file
     ?key_file
@@ -946,7 +936,6 @@ let run
     ?(stop = never)
     ?debug
     ?(error_handler = Error_handler.default)
-    ?(prefix = "")
     ?(https = false)
     ?certificate_file
     ?key_file
@@ -1025,7 +1014,6 @@ let run
         ~stop
         ?debug
         ~error_handler
-        ~prefix
         ~https:(if https then `OpenSSL else `No)
         ?certificate_file ?key_file
         ?certificate_string:None ?key_string:None

src/middleware/site_prefix.ml

@@ -24,8 +24,13 @@ let rec match_site_prefix prefix path =
 
 
 (* TODO The path and prefix representations and accessors need a cleanup. *)
-let chop_site_prefix next_handler request =
-    let prefix = Dream.site_prefix request in
+let with_site_prefix prefix =
+  let prefix =
+    prefix
+    |> Dream_pure.Formats.from_path
+    |> Dream_pure.Formats.drop_trailing_slash
+  in
+  fun next_handler request ->
     match match_site_prefix prefix (Dream.path request) with
     | None ->
       (* TODO Streams. *)

src/pure/dream_pure.mli

@@ -140,9 +140,6 @@ val prefix : request -> string
 val internal_prefix : request -> string list
 val path : request -> string list
 val version : request -> int * int
-val site_prefix : request -> string list
-(* TODO This will be moved out of dream-pure and become just a server-side
-   middleware.. *)
 val with_client : string -> request -> request
 val with_method_ : [< method_ ] -> request -> request
 val with_prefix : string list -> request -> request
@@ -394,7 +391,7 @@ type error = {
 
 type error_handler = error -> response option promise
 
-val new_app : (error -> response Lwt.t) -> string list -> app
+val new_app : (error -> response Lwt.t) -> app
 val app : request -> app
 val debug : app -> bool
 val set_debug : bool -> app -> unit

src/pure/inmost.ml

@@ -73,7 +73,6 @@ and app = {
   mutable app_debug : bool;
   mutable https : bool;
   error_handler : error -> response Lwt.t;
-  site_prefix : string list;
 }
 
 and error_handler = error -> response option Lwt.t
@@ -129,14 +128,10 @@ let app_error_handler app =
 let set_https https app =
   app.https <- https
 
-let site_prefix request =
-  request.specific.app.site_prefix
-
-let new_app error_handler site_prefix = {
+let new_app error_handler = {
   app_debug = false;
   https = false;
   error_handler;
-  site_prefix;
 }
 
 type 'a promise = 'a Lwt.t
@@ -475,7 +470,7 @@ let request
     specific = {
       (* TODO Is there a better fake error handler? Maybe this function should
          come after the response constructors? *)
-      app = new_app (fun _ -> assert false) [];
+      app = new_app (fun _ -> assert false);
       request_client = client;
       method_;
       target;