diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,10 +1,18 @@ +0.3.10 +--- + +* Fix 'SetCookie' instances + (see [#86](https://github.com/fizruk/http-api-data/pull/86)) +* Add support for `Fixed` + (see [#78](https://github.com/fizruk/http-api-data/pull/87)) + 0.3.9 --- * GHC-8.6 support * Remove dependency on `uri-bytestring` and use functions from `http-types` instead (see [#75](https://github.com/fizruk/http-api-data/pull/78)) -* Add support for `Cookie` +* Add support for `SetCookie` (see [#74](https://github.com/fizruk/http-api-data/pull/74)) 0.3.8.1 diff --git a/http-api-data.cabal b/http-api-data.cabal --- a/http-api-data.cabal +++ b/http-api-data.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: http-api-data -version: 0.3.9 +version: 0.3.10 synopsis: Converting to/from HTTP API data like URL pieces, headers and query parameters. category: Web @@ -99,6 +99,7 @@ , time , bytestring , uuid-types + , cookie build-depends: HUnit >= 1.6.0.0 && <1.7 , hspec >= 2.5.5 && <2.6 diff --git a/src/Web/Internal/HttpApiData.hs b/src/Web/Internal/HttpApiData.hs --- a/src/Web/Internal/HttpApiData.hs +++ b/src/Web/Internal/HttpApiData.hs @@ -24,20 +24,25 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS import Data.Monoid +import qualified Data.Fixed as F import Data.Int import Data.Word import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8', encodeUtf8) +import Data.Text.Encoding (decodeUtf8With, decodeUtf8', encodeUtf8) +import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.Lazy as L import Data.Text.Read (Reader, decimal, rational, signed) import Data.Time +#if __GLASGOW_HASKELL__ < 710 import Data.Time.Locale.Compat +#endif import Data.Version #if MIN_VERSION_base(4,8,0) @@ -449,6 +454,8 @@ instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece +instance F.HasResolution a => ToHttpApiData (F.Fixed a) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece + -- | -- >>> toUrlPiece (fromGregorian 2015 10 03) -- "2015-10-03" @@ -534,13 +541,19 @@ toUrlPiece (Left x) = "left " <> toUrlPiece x toUrlPiece (Right x) = "right " <> toUrlPiece x --- | +-- | /Note:/ this instance works correctly for alphanumeric name and value +-- -- >>> let Right c = parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie -- >>> toUrlPiece c --- "\"SESSID=r2t5uvjq435r4q7ib3vtdjq120\"" +-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120" +-- +-- >>> toHeader c +-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120" +-- instance ToHttpApiData SetCookie where - toUrlPiece = showt . BS.toLazyByteString . renderSetCookie - toEncodedUrlPiece = renderSetCookie + toUrlPiece = decodeUtf8With lenientDecode . toHeader + toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie + -- toEncodedUrlPiece = renderSetCookie -- doesn't do things. -- | -- >>> parseUrlPiece "_" :: Either Text () @@ -596,6 +609,9 @@ instance FromHttpApiData Text where parseUrlPiece = Right instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict +instance F.HasResolution a => FromHttpApiData (F.Fixed a) where + parseUrlPiece = runReader rational + -- | -- >>> toGregorian <$> parseUrlPiece "2016-12-01" -- Right (2016,12,1) @@ -676,12 +692,14 @@ parseHeader = Right . LenientData . parseHeader parseQueryParam = Right . LenientData . parseQueryParam --- | +-- | /Note:/ this instance works correctly for alphanumeric name and value +-- -- >>> parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie -- Right (SetCookie {setCookieName = "SESSID", setCookieValue = "r2t5uvjq435r4q7ib3vtdjq120", setCookiePath = Nothing, setCookieExpires = Nothing, setCookieMaxAge = Nothing, setCookieDomain = Nothing, setCookieHttpOnly = False, setCookieSecure = False, setCookieSameSite = Nothing}) instance FromHttpApiData SetCookie where parseUrlPiece = parseHeader . encodeUtf8 parseHeader = Right . parseSetCookie + ------------------------------------------------------------------------------- -- Attoparsec helpers ------------------------------------------------------------------------------- diff --git a/test/Web/Internal/HttpApiDataSpec.hs b/test/Web/Internal/HttpApiDataSpec.hs --- a/test/Web/Internal/HttpApiDataSpec.hs +++ b/test/Web/Internal/HttpApiDataSpec.hs @@ -3,15 +3,19 @@ module Web.Internal.HttpApiDataSpec (spec) where import Control.Applicative +import qualified Data.Fixed as F import Data.Int +import Data.Char import Data.Word import Data.Time import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as L import qualified Data.ByteString as BS import Data.ByteString.Builder (toLazyByteString) import Data.Version import qualified Data.UUID.Types as UUID +import Web.Cookie (SetCookie, defaultSetCookie, setCookieName, setCookieValue) import Data.Proxy @@ -39,30 +43,24 @@ encodedUrlPieceProp :: ToHttpApiData a => a -> Property encodedUrlPieceProp x = toLazyByteString (toEncodedUrlPiece (toUrlPiece x)) === toLazyByteString (toEncodedUrlPiece x) - +-- | Check 'ToHttpApiData' and 'FromHttpApiData' compatibility checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec -checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Property) +checkUrlPiece _ = checkUrlPiece' (arbitrary :: Gen a) --- | Check with given generator checkUrlPiece' :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a) => Gen a -> String -> Spec -checkUrlPiece' gen name = prop name $ forAll gen (toUrlPiece <=> parseUrlPiece) +checkUrlPiece' gen name = describe name $ do + prop "toUrlPiece <=> parseUrlPiece" $ forAll gen (toUrlPiece <=> parseUrlPiece :: a -> Property) + prop "toQueryParam <=> parseQueryParam" $ forAll gen (toQueryParam <=> parseQueryParam :: a -> Property) + prop "toHeader <=> parseHeader" $ forAll gen (toHeader <=> parseHeader :: a -> Property) + prop "toEncodedUrlPiece encodes correctly" $ forAll gen encodedUrlPieceProp -- | Check case insensitivity for @parseUrlPiece@. checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a)) --- | Check that 'toEncodedUrlPiece' is equivallent to default implementation. -checkEncodedUrlPiece :: forall a. (Show a, ToHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec -checkEncodedUrlPiece _ = checkEncodedUrlPiece' (arbitrary :: Gen a) - --- | Check that 'toEncodedUrlPiece' is equivallent to default implementation. --- Use a given generator. -checkEncodedUrlPiece' :: forall a. (Show a, ToHttpApiData a) => Gen a -> String -> Spec -checkEncodedUrlPiece' gen name = prop name $ forAll gen encodedUrlPieceProp - spec :: Spec spec = do - describe "toUrlPiece <=> parseUrlPiece" $ do + describe "Instances" $ do checkUrlPiece (Proxy :: Proxy ()) "()" checkUrlPiece (Proxy :: Proxy Char) "Char" checkUrlPieceI (Proxy :: Proxy Bool) "Bool" @@ -89,7 +87,16 @@ checkUrlPiece' nominalDiffTimeGen "NominalDiffTime" checkUrlPiece (Proxy :: Proxy Version) "Version" checkUrlPiece' uuidGen "UUID" + checkUrlPiece' setCookieGen "Cookie" + checkUrlPiece (Proxy :: Proxy F.Uni) "Uni" + checkUrlPiece (Proxy :: Proxy F.Deci) "Deci" + checkUrlPiece (Proxy :: Proxy F.Centi) "Centi" + checkUrlPiece (Proxy :: Proxy F.Milli) "Milli" + checkUrlPiece (Proxy :: Proxy F.Micro) "Micro" + checkUrlPiece (Proxy :: Proxy F.Nano) "Nano" + checkUrlPiece (Proxy :: Proxy F.Pico) "Pico" + checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String" checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer" checkUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text" @@ -99,43 +106,6 @@ checkUrlPiece (Proxy :: Proxy Natural) "Natural" #endif - describe "toEncodedUrlPiece encodes correctly" $ do - checkEncodedUrlPiece (Proxy :: Proxy ()) "()" - checkEncodedUrlPiece (Proxy :: Proxy Char) "Char" - checkEncodedUrlPiece (Proxy :: Proxy Bool) "Bool" - checkEncodedUrlPiece (Proxy :: Proxy Ordering) "Ordering" - checkEncodedUrlPiece (Proxy :: Proxy Int) "Int" - checkEncodedUrlPiece (Proxy :: Proxy Int8) "Int8" - checkEncodedUrlPiece (Proxy :: Proxy Int16) "Int16" - checkEncodedUrlPiece (Proxy :: Proxy Int32) "Int32" - checkEncodedUrlPiece (Proxy :: Proxy Int64) "Int64" - checkEncodedUrlPiece (Proxy :: Proxy Integer) "Integer" - checkEncodedUrlPiece (Proxy :: Proxy Word) "Word" - checkEncodedUrlPiece (Proxy :: Proxy Word8) "Word8" - checkEncodedUrlPiece (Proxy :: Proxy Word16) "Word16" - checkEncodedUrlPiece (Proxy :: Proxy Word32) "Word32" - checkEncodedUrlPiece (Proxy :: Proxy Word64) "Word64" - checkEncodedUrlPiece (Proxy :: Proxy String) "String" - checkEncodedUrlPiece (Proxy :: Proxy T.Text) "Text.Strict" - checkEncodedUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy" - checkEncodedUrlPiece (Proxy :: Proxy Day) "Day" - checkEncodedUrlPiece' timeOfDayGen "TimeOfDay" - checkEncodedUrlPiece' localTimeGen "LocalTime" - checkEncodedUrlPiece' zonedTimeGen "ZonedTime" - checkEncodedUrlPiece' utcTimeGen "UTCTime" - checkEncodedUrlPiece' nominalDiffTimeGen "NominalDiffTime" - checkEncodedUrlPiece (Proxy :: Proxy Version) "Version" - checkEncodedUrlPiece' uuidGen "UUID" - - checkEncodedUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String" - checkEncodedUrlPiece (Proxy :: Proxy (Maybe Integer)) "Maybe Integer" - checkEncodedUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text" - checkEncodedUrlPiece (Proxy :: Proxy (Either Version Day)) "Either Version Day" - -#if MIN_VERSION_base(4,8,0) - checkEncodedUrlPiece (Proxy :: Proxy Natural) "Natural" -#endif - it "bad integers are rejected" $ do parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int) @@ -170,3 +140,9 @@ nominalDiffTimeGen :: Gen NominalDiffTime nominalDiffTimeGen = fromInteger <$> arbitrary + +setCookieGen :: Gen SetCookie +setCookieGen = do + n <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary + v <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary + return $ defaultSetCookie { setCookieName = n, setCookieValue = v }