48d8552 · typeable/http-api-data

git.iko.soy/typeable/http-api-data

Try to fix SetCooke instances

commit48d85522b20172140e77acff42bdc3d4085dc381 authorOleg Grenrus <oleg.grenrus@iki.fi> dateTue 2 Oct 2018, 10:49 (8 years ago) parentaf01cff

3 files changed+29−7

compare with master

unifiedsplit

http-api-data.cabal+1 src/Web/Internal/HttpApiData.hs+16−6 test/Web/Internal/HttpApiDataSpec.hs+12−1

http-api-data.cabal+1

@@ -99,6 +99,7 @@ test-suite spec

9999 , time

100100 , bytestring

101101 , uuid-types

102+ , cookie

102103

103104 build-depends: HUnit >= 1.6.0.0 && <1.7

104105 , hspec >= 2.5.5 && <2.6

src/Web/Internal/HttpApiData.hs+16−6

@@ -24,6 +24,7 @@ import Control.Monad ((<=<))

2424

2525import Data.ByteString (ByteString)

2626import qualified Data.ByteString as BS

27+import qualified Data.ByteString.Lazy as LBS

2728import Data.Monoid

2829

2930import qualified Data.Fixed as F

@@ -32,7 +33,8 @@ import Data.Word

3233

3334import Data.Text (Text)

3435import qualified Data.Text as T

35−import Data.Text.Encoding (decodeUtf8', encodeUtf8)

36+import Data.Text.Encoding (decodeUtf8With, decodeUtf8', encodeUtf8)

37+import Data.Text.Encoding.Error (lenientDecode)

3638import qualified Data.Text.Lazy as L

3739import Data.Text.Read (Reader, decimal, rational,

3840 signed)

@@ -539,13 +541,19 @@ instance (ToHttpApiData a, ToHttpApiData b) => ToHttpApiData (Either a b) where

539541 toUrlPiece (Left x) = "left " <> toUrlPiece x

540542 toUrlPiece (Right x) = "right " <> toUrlPiece x

541543

542−-- |

544+-- | /Note:/ this instance works correctly for alphanumeric name and value

545+--

543546-- >>> let Right c = parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie

544547-- >>> toUrlPiece c

545−-- "\"SESSID=r2t5uvjq435r4q7ib3vtdjq120\""

548+-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"

549+--

550+-- >>> toHeader c

551+-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"

552+--

546553instance ToHttpApiData SetCookie where

547− toUrlPiece = showt . BS.toLazyByteString . renderSetCookie

548− toEncodedUrlPiece = renderSetCookie

554+ toUrlPiece = decodeUtf8With lenientDecode . toHeader

555+ toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie

556+ -- toEncodedUrlPiece = renderSetCookie -- doesn't do things.

549557

550558-- |

551559-- >>> parseUrlPiece "_" :: Either Text ()

@@ -681,12 +689,14 @@ instance FromHttpApiData a => FromHttpApiData (LenientData a) where

681689 parseHeader = Right . LenientData . parseHeader

682690 parseQueryParam = Right . LenientData . parseQueryParam

683691

684−-- |

692+-- | /Note:/ this instance works correctly for alphanumeric name and value

693+--

685694-- >>> parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie

686695-- Right (SetCookie {setCookieName = "SESSID", setCookieValue = "r2t5uvjq435r4q7ib3vtdjq120", setCookiePath = Nothing, setCookieExpires = Nothing, setCookieMaxAge = Nothing, setCookieDomain = Nothing, setCookieHttpOnly = False, setCookieSecure = False, setCookieSameSite = Nothing})

687696instance FromHttpApiData SetCookie where

688697 parseUrlPiece = parseHeader . encodeUtf8

689698 parseHeader = Right . parseSetCookie

699+

690700-------------------------------------------------------------------------------

691701-- Attoparsec helpers

692702-------------------------------------------------------------------------------

test/Web/Internal/HttpApiDataSpec.hs+12−1

@@ -5,14 +5,17 @@ module Web.Internal.HttpApiDataSpec (spec) where

55import Control.Applicative

66import qualified Data.Fixed as F

77import Data.Int

8+import Data.Char

89import Data.Word

910import Data.Time

1011import qualified Data.Text as T

12+import qualified Data.Text.Encoding as TE

1113import qualified Data.Text.Lazy as L

1214import qualified Data.ByteString as BS

1315import Data.ByteString.Builder (toLazyByteString)

1416import Data.Version

1517import qualified Data.UUID.Types as UUID

18+import Web.Cookie (SetCookie, defaultSetCookie, setCookieName, setCookieValue)

1619

1720import Data.Proxy

1821

@@ -56,7 +59,7 @@ checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a))

5659checkEncodedUrlPiece :: forall a. (Show a, ToHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec

5760checkEncodedUrlPiece _ = checkEncodedUrlPiece' (arbitrary :: Gen a)

5861

59−-- | Check that 'toEncodedUrlPiece' is equivallent to default implementation.

62+-- | Check that 'toEncodedUrlPiece' is equivalent to default implementation.

6063-- Use a given generator.

6164checkEncodedUrlPiece' :: forall a. (Show a, ToHttpApiData a) => Gen a -> String -> Spec

6265checkEncodedUrlPiece' gen name = prop name $ forAll gen encodedUrlPieceProp

@@ -90,6 +93,7 @@ spec = do

9093 checkUrlPiece' nominalDiffTimeGen "NominalDiffTime"

9194 checkUrlPiece (Proxy :: Proxy Version) "Version"

9295 checkUrlPiece' uuidGen "UUID"

96+ checkUrlPiece' setCookieGen "Cookie"

9397

9498 checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"

9599 checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"

@@ -127,6 +131,7 @@ spec = do

127131 checkEncodedUrlPiece' nominalDiffTimeGen "NominalDiffTime"

128132 checkEncodedUrlPiece (Proxy :: Proxy Version) "Version"

129133 checkEncodedUrlPiece' uuidGen "UUID"

134+ checkEncodedUrlPiece' setCookieGen "SetCookie"

130135

131136 checkEncodedUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"

132137 checkEncodedUrlPiece (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"

@@ -179,3 +184,9 @@ utcTimeGen = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))

179184

180185nominalDiffTimeGen :: Gen NominalDiffTime

181186nominalDiffTimeGen = fromInteger <$> arbitrary

187+

188+setCookieGen :: Gen SetCookie

189+setCookieGen = do

190+ n <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary

191+ v <- TE.encodeUtf8 . T.pack . filter isAlphaNum <$> arbitrary

192+ return $ defaultSetCookie { setCookieName = n, setCookieValue = v }