Add replacePlus to parseUrlencoded and drop FromForm and ToForm classes

Author: paluh

src/Hyper/Form.purs

@@ -3,16 +3,11 @@ module Hyper.Form
        , optional
        , required
        , parseForm
-       , fromForm
-       , toForm
-       , class FromForm
-       , class ToForm
-       , parseFromForm
        ) where
 
 import Prelude
-import Data.Tuple as Tuple
-import Control.IxMonad (ibind, ipure, (:>>=))
+
+import Control.IxMonad (ibind, ipure)
 import Control.Monad.Error.Class (throwError)
 import Data.Array (head)
 import Data.Either (Either(..))
@@ -25,7 +20,9 @@ import Data.Newtype (class Newtype, unwrap)
 import Data.StrMap (lookup)
 import Data.String (Pattern(Pattern), split)
 import Data.Tuple (Tuple)
+import Data.Tuple as Tuple
 import Hyper.Conn (Conn)
+import Hyper.Form.Urlencoded (Options) as Urlencoded
 import Hyper.Form.Urlencoded (parseUrlencoded)
 import Hyper.Middleware (Middleware)
 import Hyper.Middleware.Class (getConn)
@@ -64,45 +61,22 @@ parseForm ∷ forall m req res c
   .  Monad m
   => Request req m
   => ReadableBody req m String
-  => Middleware
+  => Urlencoded.Options
+  -> Middleware
       m
       (Conn req res c)
       (Conn req res c)
       (Either String Form)
-parseForm = do
+parseForm opts = do
   conn <- getConn
   { headers } <- getRequestData
   body <- readBody
   case lookup "content-type" headers >>= parseContentMediaType of
     Nothing ->
       ipure (Left "Missing or invalid content-type header.")
     Just mediaType | mediaType == applicationFormURLEncoded ->
-      ipure (Form <$> parseUrlencoded body)
+      ipure (Form <$> parseUrlencoded opts body)
     Just mediaType ->
       ipure (Left ("Cannot parse media of type: " <> show mediaType))
   where bind = ibind
 
-
-class ToForm a where
-  toForm ∷ a → Form
-
-
-class FromForm a where
-  fromForm ∷ Form → Either String a
-
-
-parseFromForm ∷ forall m req res c a
-  .  Monad m
-  => Request req m
-  => ReadableBody req m String
-  => FromForm a
-  => Middleware
-     m
-     (Conn req res c)
-     (Conn req res c)
-     (Either String a)
-parseFromForm =
-  parseForm :>>=
-  case _ of
-    Left err -> ipure (Left err)
-    Right form -> ipure (fromForm form)

src/Hyper/Form/Urlencoded.purs

@@ -1,33 +1,48 @@
 -- | Parser for the `application/x-www-form-urlencoded` format, commonly used
 -- | for query strings and POST request bodies.
 module Hyper.Form.Urlencoded
-       ( parseUrlencoded
+       ( defaultOptions
+       , Options
+       , parseUrlencoded
        ) where
 
 import Prelude
+
 import Control.Monad.Error.Class (throwError)
 import Data.Array as Array
 import Data.Either (Either)
 import Data.Maybe (Maybe(Just, Nothing))
-import Data.String (split, joinWith, Pattern(Pattern))
+import Data.String (Pattern(..), Replacement(..), joinWith, replaceAll, split)
 import Data.Traversable (sequence)
 import Data.Tuple (Tuple(Tuple))
 import Global (decodeURIComponent)
 
-toTuple :: Array String -> Either String (Tuple String (Maybe String))
-toTuple kv =
+toTuple :: Options -> Array String -> Either String (Tuple String (Maybe String))
+toTuple opts kv =
   case kv of
     [key] ->
       pure (Tuple (decodeURIComponent key) Nothing)
     [key, value] ->
-      pure (Tuple (decodeURIComponent key) (Just (decodeURIComponent value)))
+      let
+        value' =
+          if opts.replacePlus
+            then
+              replaceAll (Pattern "+") (Replacement " ") value
+            else
+              value
+      in
+        pure (Tuple (decodeURIComponent key) (Just (decodeURIComponent value')))
     parts ->
       throwError ("Invalid form key-value pair: " <> joinWith " " parts)
 
+type Options = { replacePlus :: Boolean }
+
+defaultOptions :: Options
+defaultOptions = { replacePlus: true }
 
-parseUrlencoded :: String → Either String (Array (Tuple String (Maybe String)))
-parseUrlencoded = split (Pattern "&")
+parseUrlencoded :: Options -> String -> Either String (Array (Tuple String (Maybe String)))
+parseUrlencoded opts = split (Pattern "&")
                   >>> Array.filter (_ /= "")
                   >>> map (split (Pattern "="))
-                  >>> map toTuple
+                  >>> map (toTuple opts)
                   >>> sequence

src/Hyper/Node/Server.purs

@@ -28,6 +28,7 @@ import Data.Newtype (unwrap)
 import Data.StrMap as StrMap
 import Data.Tuple (Tuple(..))
 import Hyper.Conn (Conn)
+import Hyper.Form.Urlencoded (Options) as Urlencoded
 import Hyper.Middleware (Middleware, evalMiddleware, lift')
 import Hyper.Middleware.Class (getConn, modifyConn)
 import Hyper.Node.Server.Options (Options)
@@ -210,14 +211,14 @@ instance responseWriterHttpResponse :: MonadAff (http ∷ HTTP | e) m
       :*> modifyConn (_ { response = HttpResponse r })
 
 
-mkHttpRequest :: HTTP.Request -> HttpRequest
-mkHttpRequest request =
+mkHttpRequest :: Urlencoded.Options -> HTTP.Request -> HttpRequest
+mkHttpRequest opts request =
   HttpRequest request requestData
   where
     headers = HTTP.requestHeaders request
     requestData =
       { url: HTTP.requestURL request
-      , parsedUrl: defer \_ -> parseUrl (HTTP.requestURL request)
+      , parsedUrl: defer \_ -> parseUrl opts (HTTP.requestURL request)
       , headers: headers
       , method: Method.fromString (HTTP.requestMethod request)
       , contentLength: StrMap.lookup "content-length" headers
@@ -247,7 +248,7 @@ runServer' options components runM middleware = do
   where
     onRequest ∷ HTTP.Request → HTTP.Response → Eff (http :: HTTP | e) Unit
     onRequest request response =
-      let conn = { request: mkHttpRequest request
+      let conn = { request: mkHttpRequest {replacePlus: options.replacePlus} request
                  , response: HttpResponse response
                  , components: components
                  }

src/Hyper/Node/Server/Options.purs

@@ -24,6 +24,7 @@ type Options e =
   , port :: Port
   , onListening :: Hostname -> Port -> Eff (http :: HTTP | e) Unit
   , onRequestError :: Error -> Eff (http :: HTTP | e) Unit
+  , replacePlus :: Boolean
   }
 
 
@@ -33,6 +34,7 @@ defaultOptions =
   , port: Port 3000
   , onListening: const (const (pure unit))
   , onRequestError: const (pure unit)
+  , replacePlus: true
   }
 
 

src/Hyper/Request.purs

@@ -12,16 +12,18 @@ module Hyper.Request
   ) where
 
 import Prelude
+
 import Data.Array as Array
-import Data.String as String
 import Data.Bifunctor (lmap)
 import Data.Either (Either)
 import Data.HTTP.Method (CustomMethod, Method)
 import Data.Lazy (Lazy)
 import Data.Maybe (Maybe, fromMaybe)
 import Data.StrMap (StrMap)
+import Data.String as String
 import Data.Tuple (Tuple)
 import Hyper.Conn (Conn)
+import Hyper.Form.Urlencoded (Options) as Urlencoded
 import Hyper.Form.Urlencoded (parseUrlencoded)
 import Hyper.Middleware (Middleware)
 
@@ -38,14 +40,14 @@ type ParsedUrl =
   , query :: Either String (Array (Tuple String (Maybe String)))
   }
 
-parseUrl :: String -> ParsedUrl
-parseUrl url =
+parseUrl :: Urlencoded.Options -> String -> ParsedUrl
+parseUrl opts url =
   let
     idx = fromMaybe (String.length url) $ String.indexOf (String.Pattern "?") url
     rawPath = String.take idx url
     rawQuery = String.drop (idx + 1) url
     path = Array.filter (_ /= "") $ String.split (String.Pattern "/") rawPath
-    query = lmap (const rawQuery) $ parseUrlencoded rawQuery
+    query = lmap (const rawQuery) $ parseUrlencoded opts rawQuery
   in
     {path, query}
 

src/Hyper/Test/TestServer.purs

@@ -1,7 +1,5 @@
 module Hyper.Test.TestServer where
 
-import Data.String as String
-import Data.StrMap as StrMap
 import Control.Alt ((<|>))
 import Control.Applicative (pure)
 import Control.IxMonad (ipure, (:*>), (:>>=))
@@ -19,7 +17,10 @@ import Data.Monoid (mempty, class Monoid)
 import Data.Newtype (class Newtype, unwrap)
 import Data.Semigroup (class Semigroup, (<>))
 import Data.StrMap (StrMap)
+import Data.StrMap as StrMap
+import Data.String as String
 import Hyper.Conn (Conn)
+import Hyper.Form.Urlencoded (defaultOptions) as Urlencoded
 import Hyper.Header (Header)
 import Hyper.Middleware (lift')
 import Hyper.Middleware.Class (getConn, modifyConn)
@@ -56,7 +57,7 @@ instance requestTestRequest :: Monad m => Request TestRequest m where
   getRequestData =
     getConn :>>= \{ request: TestRequest r } ->
     ipure { url: r.url
-          , parsedUrl: defer \_ -> parseUrl r.url
+          , parsedUrl: defer \_ -> parseUrl Urlencoded.defaultOptions r.url
           , contentLength: Just (String.length r.body)
           , method: r.method
           , headers: r.headers

test/Hyper/FormSpec.purs

@@ -1,6 +1,7 @@
 module Hyper.FormSpec where
 
 import Prelude
+
 import Control.Monad.Aff (Aff)
 import Control.Monad.Eff.Exception (error)
 import Control.Monad.Error.Class (throwError)
@@ -10,6 +11,7 @@ import Data.Maybe (Maybe(..), fromMaybe)
 import Data.StrMap (singleton)
 import Data.Tuple (Tuple(Tuple), fst)
 import Hyper.Form (Form(Form), parseForm)
+import Hyper.Form.Urlencoded (defaultOptions) as Urlencoded
 import Hyper.Middleware (runMiddleware)
 import Hyper.Test.TestServer (TestRequest(TestRequest))
 import Test.Spec (Spec, it, describe)
@@ -59,7 +61,7 @@ spec =
   where
     runParseForm body contentType =
       runMiddleware
-      parseForm
+      (parseForm Urlencoded.defaultOptions)
       { request: TestRequest { method: Left GET
                              , body: body
                              , url: ""

test/Hyper/RequestSpec.purs

@@ -1,9 +1,11 @@
 module Hyper.RequestSpec where
 
 import Prelude
+
 import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
 import Data.Tuple.Nested ((/\))
+import Hyper.Form.Urlencoded (defaultOptions) as Urlencoded
 import Hyper.Request (parseUrl)
 import Test.Spec (Spec, it, describe)
 import Test.Spec.Assertions (shouldEqual)
@@ -12,21 +14,21 @@ spec :: forall e. Spec e Unit
 spec =
   describe "Hyper.Request" do
     it "parses the root URL" do
-      let result = parseUrl "/"
+      let result = parseUrl Urlencoded.defaultOptions "/"
       result.path `shouldEqual` []
       result.query `shouldEqual` Right []
 
     it "parses non-root URLs" do
-      let result = parseUrl "/foo/bar"
+      let result = parseUrl Urlencoded.defaultOptions "/foo/bar"
       result.path `shouldEqual` ["foo", "bar"]
       result.query `shouldEqual` Right []
 
     it "parses URLs with query strings" do
-      let result = parseUrl "/foo/bar?abc=def=ghi"
+      let result = parseUrl Urlencoded.defaultOptions "/foo/bar?abc=def=ghi"
       result.path `shouldEqual` ["foo", "bar"]
       result.query `shouldEqual` Left "abc=def=ghi"
 
     it "parses URLs with formatted query strings" do
-      let result = parseUrl "/foo/bar?abc=def&ghi"
+      let result = parseUrl Urlencoded.defaultOptions "/foo/bar?abc=def&ghi"
       result.path `shouldEqual` ["foo", "bar"]
       result.query `shouldEqual` Right ["abc" /\ Just "def", "ghi" /\ Nothing]