diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,14 @@ +0.3.8 +--- + +* Minor changes: + * Stable URL-encoding for `Form`s (see [#67](https://github.com/fizruk/http-api-data/pull/67)): + * Introduce `urlEncodeParams` and `urlDecodeParams`; + * Introduce `urlEncodeAsFormStable` and use stable encoding for doctests; + * Add `toEntriesByKeyStable` and `toListStable`; + * Add `Semigroup` instance for `Form` (see [#69](https://github.com/fizruk/http-api-data/pull/69)); + * Relax upper bound on Cabal (see [#73](https://github.com/fizruk/http-api-data/pull/73)). + 0.3.7.2 --- diff --git a/http-api-data.cabal b/http-api-data.cabal --- a/http-api-data.cabal +++ b/http-api-data.cabal @@ -1,5 +1,5 @@ name: http-api-data -version: 0.3.7.2 +version: 0.3.8 license: BSD3 license-file: LICENSE author: Nickolay Kudasov @@ -23,12 +23,13 @@ GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, - GHC==8.2.2 + GHC==8.2.2, + GHC==8.4.1 custom-setup setup-depends: base >= 4.7 && <4.11, - Cabal >= 1.18 && <2.1, + Cabal >= 1.18 && <2.3, cabal-doctest >=1.0.6 && <1.1 flag use-text-show @@ -49,9 +50,11 @@ , text >= 1.1.1.3 && < 1.3 , time >= 1.4.2 && < 1.9 , time-locale-compat >= 0.1.1.0 && < 0.2 - , unordered-containers >= 0.2.5.0 && < 0.3 + , unordered-containers >= 0.2.6.0 && < 0.3 , uri-bytestring >= 0.1.7 && < 0.4 , uuid-types >= 1.0.2 && <1.1 + if !impl(ghc >= 8.0) + build-depends: semigroups >= 0.16 && < 0.19 if flag(use-text-show) cpp-options: -DUSE_TEXT_SHOW build-depends: text-show >= 2 diff --git a/src/Web/FormUrlEncoded.hs b/src/Web/FormUrlEncoded.hs --- a/src/Web/FormUrlEncoded.hs +++ b/src/Web/FormUrlEncoded.hs @@ -14,9 +14,11 @@ -- * Encoding and decoding @'Form'@s urlEncodeAsForm, + urlEncodeAsFormStable, urlDecodeAsForm, urlEncodeForm, + urlEncodeFormStable, urlDecodeForm, -- * 'Generic's @@ -28,7 +30,9 @@ defaultFormOptions, -- * Helpers + toListStable, toEntriesByKey, + toEntriesByKeyStable, fromEntriesByKey, lookupAll, @@ -38,6 +42,9 @@ parseAll, parseMaybe, parseUnique, + + urlEncodeParams, + urlDecodeParams, ) where import Web.Internal.FormUrlEncoded diff --git a/src/Web/Internal/FormUrlEncoded.hs b/src/Web/Internal/FormUrlEncoded.hs --- a/src/Web/Internal/FormUrlEncoded.hs +++ b/src/Web/Internal/FormUrlEncoded.hs @@ -35,10 +35,12 @@ import Data.Int import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap -import Data.List (intersperse) +import Data.List (intersperse, sortBy) import Data.Map (Map) import qualified Data.Map as Map import Data.Monoid +import qualified Data.Semigroup as Semi +import Data.Ord (comparing) import Data.Text (Text) import qualified Data.Text as Text @@ -182,17 +184,23 @@ -- -- 'Form' can be URL-encoded with 'urlEncodeForm' and URL-decoded with 'urlDecodeForm'. newtype Form = Form { unForm :: HashMap Text [Text] } - deriving (Eq, Read, Generic, Monoid) + deriving (Eq, Read, Generic, Semi.Semigroup, Monoid) 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: @@ -303,7 +311,7 @@ -- 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 @@ -388,6 +396,7 @@ 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 +411,22 @@ -- | 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,40 +500,54 @@ -- | Encode a 'Form' to an @application/x-www-form-urlencoded@ 'BSL.ByteString'. -- +-- _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 + +-- | 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 = toLazyByteString . mconcat . intersperse (shortByteString "&") . map encodePair . 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 'urlEncodeFormStable'. +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 +580,13 @@ -- >>> 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 +598,7 @@ [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'. @@ -577,11 +616,22 @@ -- -- This is effectively @'urlEncodeForm' . 'toForm'@. -- --- >>> urlEncodeAsForm Person {name = "Dennis", age = 22} --- "age=22&name=Dennis" +-- _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 +-- | 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" [] @@ -692,8 +742,8 @@ -- 'fromForm' = 'genericFromForm' myOptions -- @ -- --- >>> urlEncodeAsForm Project { projectName = "http-api-data", projectSize = 172 } --- "size=172&name=http-api-data" +-- >>> urlEncodeAsFormStable Project { projectName = "http-api-data", projectSize = 172 } +-- "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 @@ -712,3 +762,6 @@ defaultFormOptions = FormOptions { fieldLabelModifier = id } + +sortOn :: Ord b => (a -> b) -> [a] -> [a] +sortOn f = sortBy (comparing f)