Optionally replace + in parseUrlencoded

docs/src/topic-guides/FormSerialization.purs

@@ -1,7 +1,7 @@
 module FormSerialization where
 
 import Prelude
-import Data.Int as Int
+
 import Control.IxMonad ((:>>=), (:*>))
 import Control.Monad.Aff.AVar (AVAR)
 import Control.Monad.Eff (Eff)
@@ -13,9 +13,11 @@ import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Eq (genericEq)
 import Data.Generic.Rep.Show (genericShow)
 import Data.HTTP.Method (Method(..))
+import Data.Int as Int
 import Data.Maybe (maybe)
 import Hyper.Conn (Conn)
-import Hyper.Form (class FromForm, parseFromForm, required)
+import Hyper.Form (Form(..), parseForm, required)
+import Hyper.Form.Urlencoded (defaultOptions)
 import Hyper.Middleware (Middleware)
 import Hyper.Node.Server (defaultOptionsWithLogging, runServer)
 import Hyper.Request (class ReadableBody, class Request, getRequestData)
@@ -35,25 +37,25 @@ newtype Order = Order { beers :: Int, meal :: MealType }
 -- end snippet datatypes
 
 -- start snippet parsing
-instance fromFormOrder :: FromForm Order where
-  fromForm form = do
-    beers <- required "beers" form >>= parseBeers
-    meal <- required "meal" form >>= parseMealType
-    pure (Order { beers: beers, meal: meal })
-    where
-      parseBeers s =
-        maybe
-        (throwError ("Invalid number: " <> s))
-        pure
-        (Int.fromString s)
+parseOrder :: Form -> Either String Order
+parseOrder form = do
+  beers <- required "beers" form >>= parseBeers
+  meal <- required "meal" form >>= parseMealType
+  pure (Order { beers: beers, meal: meal })
+  where
+    parseBeers s =
+      maybe
+      (throwError ("Invalid number: " <> s))
+      pure
+      (Int.fromString s)
 
-      parseMealType =
-        case _ of
-          "Vegan" -> pure Vegan
-          "Vegetarian" -> pure Vegetarian
-          "Omnivore" -> pure Omnivore
-          "Carnivore" -> pure Carnivore
-          s -> throwError ("Invalid meal type: " <> s)
+    parseMealType =
+      case _ of
+        "Vegan" -> pure Vegan
+        "Vegetarian" -> pure Vegetarian
+        "Omnivore" -> pure Omnivore
+        "Carnivore" -> pure Carnivore
+        s -> throwError ("Invalid meal type: " <> s)
 -- end snippet parsing
 
 onPost
@@ -63,16 +65,15 @@ onPost
   => ReadableBody req m String
   => Response res m b
   => ResponseWritable b m String
-  => FromForm Order
   => Middleware
      m
      (Conn req (res StatusLineOpen) c)
      (Conn req (res ResponseEnded) c)
      Unit
 -- start snippet onPost
 onPost =
-  parseFromForm :>>=
-  case _ of
+  parseForm defaultOptions :>>=
+  (_ >>= parseOrder) >>> case _ of
     Left err ->
       writeStatus statusBadRequest
       :*> closeHeaders

docs/src/topic-guides/forms.rst

@@ -1,11 +1,13 @@
 *****
-Forms
+Parsing incomming data
 *****
 
-When working with form data, we often want to serialize and deserialize
-forms as custom data types, instead of working with the key-value pairs
-directly. The ``ToForm`` and ``FromForm`` type classes abstracts
-serialization and deserialization to form data, respectively.
+Hyper doesn't provide any built in validation framework, but it makes
+it quite easy for you to do the job by providing simple data type `Hyper.Form.Form`
+which represent incomming `GET` or `POST` data. There is also some plumbing
+implemented for parsing incomming urlencoded data into `Form` value.
+
+Let's look at simple example in which we are going to do some simple validation of incoming data.
 
 We first declare our data types, and some instance which we will need
 later.
@@ -15,18 +17,19 @@ later.
    :start-after: start snippet datatypes
    :end-before: end snippet datatypes
 
-In this example we will only deserialize forms, and thus we only need
-the ``FromForm`` instance.
+In this example we use really simple approach to validation which only reports first encountered
+error:
 
 .. literalinclude:: FormSerialization.purs
    :language: haskell
    :start-after: start snippet parsing
    :end-before: end snippet parsing
 
-Now we are ready to write our handler. We use ``parseFromForm`` to get a
-value of type ``Either String Order``, where the ``String`` explains
-parsing errors. By pattern matching using record field puns, we extract
-the ``beers`` and ``meal`` values, and respond based on those values.
+Now we are ready to write our handler. We use ``parseOrder`` to get a
+value of type ``Either String Order`` from ``Either String Form``,
+where the ``String`` explains parsing errors. By pattern matching using
+record field puns, we extract the ``beers`` and ``meal`` values, and respond
+based on those values.
 
 .. literalinclude:: FormSerialization.purs
    :language: haskell

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