diff --git a/docs/src/topic-guides/FormSerialization.purs b/docs/src/topic-guides/FormSerialization.purs index 1390e63..60d4e16 100644 --- a/docs/src/topic-guides/FormSerialization.purs +++ b/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,7 +65,6 @@ onPost => ReadableBody req m String => Response res m b => ResponseWritable b m String - => FromForm Order => Middleware m (Conn req (res StatusLineOpen) c) @@ -71,8 +72,8 @@ onPost Unit -- start snippet onPost onPost = - parseFromForm :>>= - case _ of + parseForm defaultOptions :>>= + (_ >>= parseOrder) >>> case _ of Left err -> writeStatus statusBadRequest :*> closeHeaders diff --git a/docs/src/topic-guides/forms.rst b/docs/src/topic-guides/forms.rst index 1dd7b4b..d19b2ff 100644 --- a/docs/src/topic-guides/forms.rst +++ b/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 diff --git a/src/Hyper/Form.purs b/src/Hyper/Form.purs index bd6b36a..ebcd191 100644 --- a/src/Hyper/Form.purs +++ b/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,12 +61,13 @@ 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 @@ -77,32 +75,8 @@ parseForm = do 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) diff --git a/src/Hyper/Form/Urlencoded.purs b/src/Hyper/Form/Urlencoded.purs index 62cd7ed..05d7222 100644 --- a/src/Hyper/Form/Urlencoded.purs +++ b/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 diff --git a/src/Hyper/Node/Server.purs b/src/Hyper/Node/Server.purs index c4d8797..037c077 100644 --- a/src/Hyper/Node/Server.purs +++ b/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 } diff --git a/src/Hyper/Node/Server/Options.purs b/src/Hyper/Node/Server/Options.purs index 90e4b3b..ce25e4f 100644 --- a/src/Hyper/Node/Server/Options.purs +++ b/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 } diff --git a/src/Hyper/Request.purs b/src/Hyper/Request.purs index 1d7448f..5e15992 100644 --- a/src/Hyper/Request.purs +++ b/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} diff --git a/src/Hyper/Test/TestServer.purs b/src/Hyper/Test/TestServer.purs index 18674c5..ee8eebc 100644 --- a/src/Hyper/Test/TestServer.purs +++ b/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 diff --git a/test/Hyper/FormSpec.purs b/test/Hyper/FormSpec.purs index 7942fd1..a2d010d 100644 --- a/test/Hyper/FormSpec.purs +++ b/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) @@ -26,11 +28,11 @@ spec :: forall e. Spec e Unit spec = describe "Hyper.Form" do it "parses key without value" do - form <- runParseForm "foo" Nothing + form <- runParseForm "foo" id form `shouldEqual` (Form [Tuple "foo" Nothing]) it "parses multiple keys without values" do - form <- runParseForm "foo&foo&bar&foo" Nothing + form <- runParseForm "foo&foo&bar&foo" id form `shouldEqual` (Form [ Tuple "foo" Nothing , Tuple "foo" Nothing , Tuple "bar" Nothing @@ -38,15 +40,19 @@ spec = ]) it "parses key and value" do - form <- runParseForm "foo=bar" Nothing + form <- runParseForm "foo=bar" id form `shouldEqual` (Form [Tuple "foo" (Just "bar")]) it "handles percent-encoding" do - form <- runParseForm "foo=%62%61%72" Nothing + form <- runParseForm "foo=%62%61%72" id form `shouldEqual` (Form [Tuple "foo" (Just "bar")]) + it "handles plus replacing" do + form <- runParseForm "foo=b+r" _{ replacePlus = true } + form `shouldEqual` (Form [Tuple "foo" (Just "b r")]) + it "parses multiple keys and values" do - form <- runParseForm "foo=bar&baz=quux&a=1&b=2" Nothing + form <- runParseForm "foo=bar&baz=quux&a=1&b=2" id form `shouldEqual` (Form [ Tuple "foo" (Just "bar") , Tuple "baz" (Just "quux") , Tuple "a" (Just "1") @@ -54,12 +60,12 @@ spec = ]) it "fails to parse request body as a form when invalid" $ expectError $ - runParseForm "foo=bar=baz" Nothing + runParseForm "foo=bar=baz" id where - runParseForm body contentType = + runParseForm body opts = runMiddleware - parseForm + (parseForm Urlencoded.defaultOptions { replacePlus = replacePlus }) { request: TestRequest { method: Left GET , body: body , url: "" @@ -74,3 +80,5 @@ spec = } # map fst >>= liftEither + where + { replacePlus, contentType } = opts { contentType: Nothing, replacePlus: false } diff --git a/test/Hyper/RequestSpec.purs b/test/Hyper/RequestSpec.purs index fe88953..0e03e59 100644 --- a/test/Hyper/RequestSpec.purs +++ b/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]