From 8aee0b366a22a1515a4ab4e59dddc08628b471cd Mon Sep 17 00:00:00 2001 From: Nickolay Kudasov Date: Tue, 30 Jan 2018 13:26:49 +0300 Subject: [PATCH 1/6] Introduce urlEncodeParams and urlDecodeParams --- src/Web/Internal/FormUrlEncoded.hs | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/src/Web/Internal/FormUrlEncoded.hs b/src/Web/Internal/FormUrlEncoded.hs index 90d4e06..19598f8 100644 --- a/src/Web/Internal/FormUrlEncoded.hs +++ b/src/Web/Internal/FormUrlEncoded.hs @@ -508,14 +508,19 @@ instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where -- >>> urlEncodeForm [("fullname", "Andres Löh")] -- "fullname=Andres%20L%C3%B6h" urlEncodeForm :: Form -> BSL.ByteString -urlEncodeForm = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair . toList +urlEncodeForm = urlEncodeParams . toList + +-- | Encode a list of key-value pairs to an @application/x-www-form-urlencoded@ 'BSL.ByteString'. +-- +-- See also 'urlEncodeForm'. +urlEncodeParams :: [(Text, Text)] -> BSL.ByteString +urlEncodeParams = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair where escape = urlEncodeQuery . Text.encodeUtf8 encodePair (k, "") = escape k encodePair (k, v) = escape k <> shortByteString "=" <> escape v - -- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a 'Form'. -- -- Key-value pairs get decoded normally: @@ -548,7 +553,13 @@ urlEncodeForm = toLazyByteString . mconcat . intersperse (shortByteString "&") . -- >>> urlDecodeForm "this=has=too=many=equals" -- Left "not a valid pair: this=has=too=many=equals" urlDecodeForm :: BSL.ByteString -> Either Text Form -urlDecodeForm bs = toForm <$> traverse parsePair pairs +urlDecodeForm = fmap toForm . urlDecodeParams + +-- | Decode an @application/x-www-form-urlencoded@ 'BSL.ByteString' to a list of key-value pairs. +-- +-- See also 'urlDecodeForm'. +urlDecodeParams :: BSL.ByteString -> Either Text [(Text, Text)] +urlDecodeParams bs = traverse parsePair pairs where pairs = map (BSL8.split '=') (BSL8.split '&' bs) @@ -560,6 +571,7 @@ urlDecodeForm bs = toForm <$> traverse parsePair pairs [k] -> return (k, "") xs -> Left $ "not a valid pair: " <> Text.intercalate "=" xs + -- | This is a convenience function for decoding a -- @application/x-www-form-urlencoded@ 'BSL.ByteString' directly to a datatype -- that has an instance of 'FromForm'. From d8d314e23c1de91ee99bf049f64c97ded242ec32 Mon Sep 17 00:00:00 2001 From: Nickolay Kudasov Date: Tue, 30 Jan 2018 13:27:40 +0300 Subject: [PATCH 2/6] Expose urlEncodeParams/urlDecodeParams helpers --- src/Web/FormUrlEncoded.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Web/FormUrlEncoded.hs b/src/Web/FormUrlEncoded.hs index e4e2eb1..75491ad 100644 --- a/src/Web/FormUrlEncoded.hs +++ b/src/Web/FormUrlEncoded.hs @@ -38,6 +38,9 @@ module Web.FormUrlEncoded ( parseAll, parseMaybe, parseUnique, + + urlEncodeParams, + urlDecodeParams, ) where import Web.Internal.FormUrlEncoded From 60458a0b6516fcc7e8390d55004f9e69abfc5cf0 Mon Sep 17 00:00:00 2001 From: Nickolay Kudasov Date: Tue, 30 Jan 2018 13:48:15 +0300 Subject: [PATCH 3/6] Introduce urlEncodeAsFormStable and use stable encoding for doctests --- src/Web/FormUrlEncoded.hs | 2 ++ src/Web/Internal/FormUrlEncoded.hs | 50 +++++++++++++++++++++--------- 2 files changed, 37 insertions(+), 15 deletions(-) diff --git a/src/Web/FormUrlEncoded.hs b/src/Web/FormUrlEncoded.hs index 75491ad..f6780be 100644 --- a/src/Web/FormUrlEncoded.hs +++ b/src/Web/FormUrlEncoded.hs @@ -14,9 +14,11 @@ module Web.FormUrlEncoded ( -- * Encoding and decoding @'Form'@s urlEncodeAsForm, + urlEncodeAsFormStable, urlDecodeAsForm, urlEncodeForm, + urlEncodeFormStable, urlDecodeForm, -- * 'Generic's diff --git a/src/Web/Internal/FormUrlEncoded.hs b/src/Web/Internal/FormUrlEncoded.hs index 19598f8..22a25b4 100644 --- a/src/Web/Internal/FormUrlEncoded.hs +++ b/src/Web/Internal/FormUrlEncoded.hs @@ -35,7 +35,7 @@ import qualified Data.HashMap.Strict as HashMap import Data.Int import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap -import Data.List (intersperse) +import Data.List (intersperse, sortOn) import Data.Map (Map) import qualified Data.Map as Map import Data.Monoid @@ -303,7 +303,7 @@ type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint -- instance 'ToForm' Post -- @ -- --- >>> urlEncodeAsForm Post { title = "Test", subtitle = Nothing, comments = ["Nice post!", "+1"] } +-- >>> urlEncodeAsFormStable Post { title = "Test", subtitle = Nothing, comments = ["Nice post!", "+1"] } -- "comments=Nice%20post%21&comments=%2B1&title=Test" genericToForm :: forall a. (Generic a, GToForm a (Rep a)) => FormOptions -> a -> Form genericToForm opts = gToForm (Proxy :: Proxy a) opts . from @@ -482,37 +482,46 @@ instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where -- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'. -- +-- _NOTE:_ this encoding is unstable and may change the order of keys +-- (but not values). For a stable encoding see 'urlEncodeFormStable'. +urlEncodeForm :: Form -> BSL.ByteString +urlEncodeForm = urlEncodeParams . toList + +-- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'. +-- +-- For an unstable (but faster) encoding see 'urlEncodeForm'. +-- -- Key-value pairs get encoded to @key=value@ and separated by @&@: -- --- >>> urlEncodeForm [("name", "Julian"), ("lastname", "Arni")] +-- >>> urlEncodeFormStable [("name", "Julian"), ("lastname", "Arni")] -- "lastname=Arni&name=Julian" -- -- Keys with empty values get encoded to just @key@ (without the @=@ sign): -- --- >>> urlEncodeForm [("is_test", "")] +-- >>> urlEncodeFormStable [("is_test", "")] -- "is_test" -- -- Empty keys are allowed too: -- --- >>> urlEncodeForm [("", "foobar")] +-- >>> urlEncodeFormStable [("", "foobar")] -- "=foobar" -- --- However, if not key and value are empty, the key-value pair is ignored. --- (This prevents @'urlDecodeForm' . 'urlEncodeForm'@ from being a true isomorphism). +-- However, if both key and value are empty, the key-value pair is ignored. +-- (This prevents @'urlDecodeForm' . 'urlEncodeFormStable'@ from being a true isomorphism). -- --- >>> urlEncodeForm [("", "")] +-- >>> urlEncodeFormStable [("", "")] -- "" -- -- Everything is escaped with @'escapeURIString' 'isUnreserved'@: -- --- >>> urlEncodeForm [("fullname", "Andres Löh")] +-- >>> urlEncodeFormStable [("fullname", "Andres Löh")] -- "fullname=Andres%20L%C3%B6h" -urlEncodeForm :: Form -> BSL.ByteString -urlEncodeForm = urlEncodeParams . toList +urlEncodeFormStable :: Form -> BSL.ByteString +urlEncodeFormStable = urlEncodeParams . sortOn fst . toList -- | Encode a list of key-value pairs to an @application/x-www-form-urlencoded@ 'BSL.ByteString'. -- --- See also 'urlEncodeForm'. +-- See also 'urlEncodeFormStable'. urlEncodeParams :: [(Text, Text)] -> BSL.ByteString urlEncodeParams = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair where @@ -589,11 +598,22 @@ urlDecodeAsForm = fromForm <=< urlDecodeForm -- -- This is effectively @'urlEncodeForm' . 'toForm'@. -- --- >>> urlEncodeAsForm Person {name = "Dennis", age = 22} --- "age=22&name=Dennis" +-- _NOTE:_ this encoding is unstable and may change the order of keys +-- (but not values). For a stable encoding see 'urlEncodeAsFormStable'. urlEncodeAsForm :: ToForm a => a -> BSL.ByteString urlEncodeAsForm = urlEncodeForm . toForm +-- | This is a convenience function for encoding a datatype that has instance +-- of 'ToForm' directly to a @application/x-www-form-urlencoded@ +-- 'BSL.ByteString'. +-- +-- This is effectively @'urlEncodeFormStable' . 'toForm'@. +-- +-- >>> urlEncodeAsFormStable Person {name = "Dennis", age = 22} +-- "age=22&name=Dennis" +urlEncodeAsFormStable :: ToForm a => a -> BSL.ByteString +urlEncodeAsFormStable = urlEncodeFormStable . toForm + -- | Find all values corresponding to a given key in a 'Form'. -- -- >>> lookupAll "name" [] @@ -704,7 +724,7 @@ parseUnique key form = lookupUnique key form >>= parseQueryParam -- 'fromForm' = 'genericFromForm' myOptions -- @ -- --- >>> urlEncodeAsForm Project { projectName = "http-api-data", projectSize = 172 } +-- >>> urlEncodeAsFormStable Project { projectName = "http-api-data", projectSize = 172 } -- "size=172&name=http-api-data" -- >>> urlDecodeAsForm "name=http-api-data&size=172" :: Either Text Project -- Right (Project {projectName = "http-api-data", projectSize = 172}) From bfe6794b09024285f84262af4546e20c9d36948b Mon Sep 17 00:00:00 2001 From: Nickolay Kudasov Date: Tue, 30 Jan 2018 13:58:51 +0300 Subject: [PATCH 4/6] Fix parameter order for one doctest --- src/Web/Internal/FormUrlEncoded.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Web/Internal/FormUrlEncoded.hs b/src/Web/Internal/FormUrlEncoded.hs index 22a25b4..b7d403e 100644 --- a/src/Web/Internal/FormUrlEncoded.hs +++ b/src/Web/Internal/FormUrlEncoded.hs @@ -725,7 +725,7 @@ parseUnique key form = lookupUnique key form >>= parseQueryParam -- @ -- -- >>> urlEncodeAsFormStable Project { projectName = "http-api-data", projectSize = 172 } --- "size=172&name=http-api-data" +-- "name=http-api-data&size=172" -- >>> urlDecodeAsForm "name=http-api-data&size=172" :: Either Text Project -- Right (Project {projectName = "http-api-data", projectSize = 172}) data FormOptions = FormOptions From 56fcb0c450ee051204a85774a99f9e4d277596ad Mon Sep 17 00:00:00 2001 From: Nickolay Kudasov Date: Tue, 30 Jan 2018 15:31:02 +0300 Subject: [PATCH 5/6] Add toEntriesByKeyStable and toListStable --- src/Web/FormUrlEncoded.hs | 2 ++ src/Web/Internal/FormUrlEncoded.hs | 26 +++++++++++++++++++++----- 2 files changed, 23 insertions(+), 5 deletions(-) diff --git a/src/Web/FormUrlEncoded.hs b/src/Web/FormUrlEncoded.hs index f6780be..235db65 100644 --- a/src/Web/FormUrlEncoded.hs +++ b/src/Web/FormUrlEncoded.hs @@ -30,7 +30,9 @@ module Web.FormUrlEncoded ( defaultFormOptions, -- * Helpers + toListStable, toEntriesByKey, + toEntriesByKeyStable, fromEntriesByKey, lookupAll, diff --git a/src/Web/Internal/FormUrlEncoded.hs b/src/Web/Internal/FormUrlEncoded.hs index b7d403e..c105a9b 100644 --- a/src/Web/Internal/FormUrlEncoded.hs +++ b/src/Web/Internal/FormUrlEncoded.hs @@ -186,13 +186,19 @@ newtype Form = Form { unForm :: HashMap Text [Text] } instance Show Form where showsPrec d form = showParen (d > 10) $ - showString "fromList " . shows (toList form) + showString "fromList " . shows (toListStable form) +-- | _NOTE:_ 'toList' is unstable and may result in different key order (but not values). +-- For a stable conversion use 'toListStable'. instance IsList Form where type Item Form = (Text, Text) fromList = Form . HashMap.fromListWith (flip (<>)) . fmap (\(k, v) -> (k, [v])) toList = concatMap (\(k, vs) -> map ((,) k) vs) . HashMap.toList . unForm +-- | A stable version of 'toList'. +toListStable :: Form -> [(Text, Text)] +toListStable = sortOn fst . toList + -- | Convert a value into 'Form'. -- -- An example type and instance: @@ -388,6 +394,7 @@ class FromForm a where instance FromForm Form where fromForm = pure +-- | _NOTE:_ this conversion is unstable and may result in different key order (but not values). instance (FromFormKey k, FromHttpApiData v) => FromForm [(k, v)] where fromForm = fmap (concatMap (\(k, vs) -> map ((,) k) vs)) . toEntriesByKey @@ -402,13 +409,22 @@ instance FromHttpApiData v => FromForm (IntMap [v]) where -- | Parse a 'Form' into a list of entries groupped by key. -- --- >>> toEntriesByKey [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])] --- Right [("color",["red","white"]),("name",["Nick"])] +-- _NOTE:_ this conversion is unstable and may result in different key order +-- (but not values). For a stable encoding see 'toEntriesByKeyStable'. toEntriesByKey :: (FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])] toEntriesByKey = traverse parseGroup . HashMap.toList . unForm where parseGroup (k, vs) = (,) <$> parseFormKey k <*> traverse parseQueryParam vs +-- | Parse a 'Form' into a list of entries groupped by key. +-- +-- >>> toEntriesByKeyStable [("name", "Nick"), ("color", "red"), ("color", "white")] :: Either Text [(Text, [Text])] +-- Right [("color",["red","white"]),("name",["Nick"])] +-- +-- For an unstable (but faster) conversion see 'toEntriesByKey'. +toEntriesByKeyStable :: (Ord k, FromFormKey k, FromHttpApiData v) => Form -> Either Text [(k, [v])] +toEntriesByKeyStable = fmap (sortOn fst) . toEntriesByKey + -- | A 'Generic'-based implementation of 'fromForm'. -- This is used as a default implementation in 'FromForm'. -- @@ -482,7 +498,7 @@ instance NotSupported FromForm t "is a sum type" => GFromForm t (f :+: g) where -- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'. -- --- _NOTE:_ this encoding is unstable and may change the order of keys +-- _NOTE:_ this encoding is unstable and may result in different key order -- (but not values). For a stable encoding see 'urlEncodeFormStable'. urlEncodeForm :: Form -> BSL.ByteString urlEncodeForm = urlEncodeParams . toList @@ -598,7 +614,7 @@ urlDecodeAsForm = fromForm <=< urlDecodeForm -- -- This is effectively @'urlEncodeForm' . 'toForm'@. -- --- _NOTE:_ this encoding is unstable and may change the order of keys +-- _NOTE:_ this encoding is unstable and may result in different key order -- (but not values). For a stable encoding see 'urlEncodeAsFormStable'. urlEncodeAsForm :: ToForm a => a -> BSL.ByteString urlEncodeAsForm = urlEncodeForm . toForm From a129fe875862ae6f7e16c01d1c7fe4bef1bc097e Mon Sep 17 00:00:00 2001 From: Nickolay Kudasov Date: Tue, 30 Jan 2018 16:03:00 +0300 Subject: [PATCH 6/6] Define custom sortOn to fix GHC 7.8 build --- src/Web/Internal/FormUrlEncoded.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Web/Internal/FormUrlEncoded.hs b/src/Web/Internal/FormUrlEncoded.hs index c105a9b..e2bc3a5 100644 --- a/src/Web/Internal/FormUrlEncoded.hs +++ b/src/Web/Internal/FormUrlEncoded.hs @@ -35,10 +35,11 @@ import qualified Data.HashMap.Strict as HashMap import Data.Int import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap -import Data.List (intersperse, sortOn) +import Data.List (intersperse, sortBy) import Data.Map (Map) import qualified Data.Map as Map import Data.Monoid +import Data.Ord (comparing) import Data.Text (Text) import qualified Data.Text as Text @@ -760,3 +761,6 @@ defaultFormOptions :: FormOptions defaultFormOptions = FormOptions { fieldLabelModifier = id } + +sortOn :: Ord b => (a -> b) -> [a] -> [a] +sortOn f = sortBy (comparing f)