Merge pull request #200 from SuaveIO/feature/parse-post-data-by-default

[BREAKING] (again) parse post data by default

examples/Example/Program.fs

@@ -89,15 +89,15 @@ let app =
     GET >>= dir' //show directory listing
     HEAD >>= url "/head" >>= sleep 100 "Nice sleep .."
     POST >>= url "/upload" >>= OK "Upload successful."
-    PUT >>= url "/upload2" >>= ParsingAndControl.parse_post_data
+    PUT >>= url "/upload2"
       >>= request (fun x ->
          let files =
            x.files
            |> Seq.fold
              (fun x y -> x + "<br/>" + (sprintf "(%s, %s, %s)" y.file_name y.mime_type y.temp_file_path))
              ""
          OK (sprintf "Upload successful.<br>POST data: %A<br>Uploaded files (%d): %s" x.multipart_fields (List.length x.files) files))
-    POST >>= ParsingAndControl.parse_post_data >>= request (fun x -> OK (sprintf "POST data: %s" (ASCII.to_string' x.raw_form)))
+    POST >>= request (fun x -> OK (sprintf "POST data: %s" (ASCII.to_string' x.raw_form)))
     GET
       >>= url "/custom_header"
       >>= set_header "X-Doge-Location" "http://www.elregalista.com/wp-content/uploads/2014/02/46263312.jpg"

src/Suave.Tests/HttpVerbs.fs

@@ -48,11 +48,10 @@ let posts =
   let run_with' = run_with default_config
 
   let webId =
-    ParsingAndControl.parse_post_data >>=
     request (fun x -> OK (x.raw_form |> Text.Encoding.UTF8.GetString))
 
   let getFormValue name =
-    ParsingAndControl.parse_post_data >>= request (fun x -> let q = HttpRequest.form x in OK <| Option.get (q ^^ name))
+    request (fun x -> let q = HttpRequest.form x in OK <| Option.get (q ^^ name))
 
   let assertion = "eyJhbGciOiJSUzI1NiJ9.eyJwdWJsaWMta2V5Ijp7ImFsZ29yaXRobSI6IkR"+
                   "TIiwieSI6Ijc1MDMyNGRmYzQwNGI0OGQ3ZDg0MDdlOTI0NWMxNGVkZmVlZTY"+

src/Suave.Tests/Model.fs

@@ -26,7 +26,6 @@ let tests =
   let post_data3 = read_text "request-2.txt"
 
   let test_url_encoded_form field_name : WebPart =
-    ParsingAndControl.parse_post_data >>=
     Binding.bind_req (Binding.form field_name Choice1Of2) OK BAD_REQUEST
 
   testList "Suave.Model" [

src/Suave.Tests/Parsing.fs

@@ -28,14 +28,12 @@ let parsing_multipart =
   let post_data3 = read_text "request-2.txt"
 
   let test_url_encoded_form field_name =
-    ParsingAndControl.parse_post_data >>=
     request (fun r ->
       match (HttpRequest.form r) ^^ field_name  with
       | Some str -> OK str
       | None -> OK "field-does-not-exists")
 
   let test_multipart_form =
-    ParsingAndControl.parse_post_data >>=
     request (fun r ->
       match get_first r.multipart_fields "From" with
       | Some str -> OK str

src/Suave.Tests/Perf.fs

@@ -38,7 +38,6 @@ let perf_tests =
   let server_factory = SuavePerfHarness("default config", run_with default_config)
 
   let getFormValue name =
-    ParsingAndControl.parse_post_data >>=
     request (fun x -> OK (HttpRequest.form x ^^ name |> Option.get))
 
   let longData = String.replicate 1815 "A"

src/Suave/Json.fs

@@ -29,7 +29,6 @@ open Suave.Http
 open Suave.Web
 
 let map_json f =
-  ParsingAndControl.parse_post_data >>=
   Types.request(fun r ->
       f (from_json(r.raw_form)) 
       |> to_json

src/Suave/Proxy.fs

@@ -121,7 +121,7 @@ let proxy_server_async (config : SuaveConfig) resolver =
       tcp_ip_server (config.buffer_size, config.max_ops)
                     config.logger
                     (ParsingAndControl.request_loop
-                      (SuaveConfig.to_runtime config home_folder compression_folder binding)
+                      (SuaveConfig.to_runtime config home_folder compression_folder false binding )
                       (SocketPart (proxy resolver)))
                     binding.socket_binding)
       config.bindings

src/Suave/Types.fs

@@ -1,3 +1,4 @@
+
 module Suave.Types
 
 open System
@@ -632,7 +633,8 @@ type HttpRuntime =
     home_directory     : string
     compression_folder : string
     logger             : Logger
-    matched_binding    : HttpBinding }
+    matched_binding    : HttpBinding
+    parse_post_data    : bool }
 
 /// The HttpContext is the container of the request, runtime, user-state and
 /// response.
@@ -674,17 +676,19 @@ module HttpRuntime =
       home_directory     = "."
       compression_folder = "."
       logger             = Loggers.sane_defaults_for LogLevel.Debug
-      matched_binding    = HttpBinding.defaults }
+      matched_binding    = HttpBinding.defaults
+      parse_post_data    = false }
 
   /// make a new HttpRuntime from the given parameters
-  let mk server_key error_handler mime_types home_directory compression_folder logger binding =
+  let mk server_key error_handler mime_types home_directory compression_folder logger parse_post_data binding =
     { server_key         = server_key
       error_handler      = error_handler
       mime_types_map     = mime_types
       home_directory     = home_directory
       compression_folder = compression_folder
       logger             = logger
-      matched_binding    = binding }
+      matched_binding    = binding
+      parse_post_data    = parse_post_data }
 
   let server_key x = x.server_key
 
@@ -728,6 +732,12 @@ module HttpRuntime =
     (fun x -> x.matched_binding),
     fun v x -> { x with matched_binding = v }
 
+  let parse_post_data x = x.parse_post_data
+
+  let parse_post_data_ =
+    (fun x -> x.parse_post_data),
+    fun v x -> { x with parse_post_data = v }
+
 /// A module that provides functions to create a new HttpContext.
 [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
 module HttpContext =
@@ -814,13 +824,14 @@ type SuaveConfig =
 [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
 module SuaveConfig =
 
-  let to_runtime config content_folder compression_folder =
+  let to_runtime config content_folder compression_folder parse_post_data =
     HttpRuntime.mk config.server_key
                    config.error_handler
                    config.mime_types_map
                    content_folder
                    compression_folder
                    config.logger
+                   parse_post_data
 
   let bindings x = x.bindings
 

src/Suave/Web.fs

@@ -273,7 +273,7 @@ module ParsingAndControl =
     | None ->  return Some ctx
     }
 
-  let parse_post_data = to_async <| parse_post_data'
+  let private parse_post_data = to_async <| parse_post_data'
 
   /// Process the request, reading as it goes from the incoming 'stream', yielding a HttpRequest
   /// when done
@@ -306,8 +306,10 @@ module ParsingAndControl =
                      runtime.matched_binding.scheme.secure
                      connection''.ipaddr
 
-    return Some { ctx with request    = request
-                           connection = connection'' }
+    if runtime.parse_post_data then
+      return! parse_post_data' { ctx with request = request; connection = connection'' }
+    else
+      return Some { ctx with request = request; connection = connection'' }
   }
 
   open System.Net
@@ -510,7 +512,7 @@ let web_server_async (config : SuaveConfig) (webpart : WebPart) =
     ParsingAndControl.resolve_directory config.home_folder,
     Path.Combine(ParsingAndControl.resolve_directory config.compressed_files_folder, "_temporary_compressed_files")
   let servers = // spawn tcp listeners/web workers
-    List.map (SuaveConfig.to_runtime config home_folder compression_folder
+    List.map (SuaveConfig.to_runtime config home_folder compression_folder true
               >> ParsingAndControl.web_worker (config.buffer_size, config.max_ops) webpart)
               config.bindings
   let listening = servers |> Seq.map fst |> Async.Parallel