48d8552 · typeable/http-api-data

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

on master help sign in

Try to fix SetCooke instances

48d8552Oleg Grenrus8 years ago

http-api-data.cabal+1

compare with master

unifiedsplit

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

99 , time

100 , bytestring

101 , uuid-types

102+ , cookie

102

103

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

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

104 , hspec >= 2.5.5 && <2.6

105 , hspec >= 2.5.5 && <2.6

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

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

25import Data.ByteString (ByteString)

26import qualified Data.ByteString as BS

27+import qualified Data.ByteString.Lazy as LBS

27import Data.Monoid

28import Data.Monoid

29import qualified Data.Fixed as F

30import qualified Data.Fixed as F

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

33import Data.Text (Text)

34import Data.Text (Text)

34import qualified Data.Text as T

35import 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)

36import qualified Data.Text.Lazy as L

38import qualified Data.Text.Lazy as L

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

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

38 signed)

40 signed)

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

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

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

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

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

541

543

542−-- |

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

545+--

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

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

544-- >>> toUrlPiece c

547-- >>> toUrlPiece c

548+-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"

549+--

550+-- >>> toHeader c

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

551+-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"

552+--

546instance ToHttpApiData SetCookie where

553instance ToHttpApiData SetCookie where

554+ toUrlPiece = decodeUtf8With lenientDecode . toHeader

547− toUrlPiece = showt . BS.toLazyByteString . renderSetCookie

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

548− toEncodedUrlPiece = renderSetCookie

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

549

557

550-- |

558-- |

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

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

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

681 parseHeader = Right . LenientData . parseHeader

689 parseHeader = Right . LenientData . parseHeader

682 parseQueryParam = Right . LenientData . parseQueryParam

690 parseQueryParam = Right . LenientData . parseQueryParam

683

691

684−-- |

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

693+--

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

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

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

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

687instance FromHttpApiData SetCookie where

696instance FromHttpApiData SetCookie where

688 parseUrlPiece = parseHeader . encodeUtf8

697 parseUrlPiece = parseHeader . encodeUtf8

689 parseHeader = Right . parseSetCookie

698 parseHeader = Right . parseSetCookie

699+

690-------------------------------------------------------------------------------

700-------------------------------------------------------------------------------

691-- Attoparsec helpers

701-- Attoparsec helpers

692-------------------------------------------------------------------------------

702-------------------------------------------------------------------------------

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

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

5import Control.Applicative

6import qualified Data.Fixed as F

7import Data.Int

8+import Data.Char

8import Data.Word

9import Data.Word

9import Data.Time

10import Data.Time

10import qualified Data.Text as T

11import qualified Data.Text as T

12+import qualified Data.Text.Encoding as TE

11import qualified Data.Text.Lazy as L

13import qualified Data.Text.Lazy as L

12import qualified Data.ByteString as BS

14import qualified Data.ByteString as BS

13import Data.ByteString.Builder (toLazyByteString)

15import Data.ByteString.Builder (toLazyByteString)

14import Data.Version

16import Data.Version

15import qualified Data.UUID.Types as UUID

17import qualified Data.UUID.Types as UUID

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

17import Data.Proxy

20import Data.Proxy

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

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

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

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

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

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

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

60-- Use a given generator.

63-- Use a given generator.

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

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

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

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

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

90 checkUrlPiece' nominalDiffTimeGen "NominalDiffTime"

93 checkUrlPiece' nominalDiffTimeGen "NominalDiffTime"

91 checkUrlPiece (Proxy :: Proxy Version) "Version"

94 checkUrlPiece (Proxy :: Proxy Version) "Version"

92 checkUrlPiece' uuidGen "UUID"

95 checkUrlPiece' uuidGen "UUID"

96+ checkUrlPiece' setCookieGen "Cookie"

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

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

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

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

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

127 checkEncodedUrlPiece' nominalDiffTimeGen "NominalDiffTime"

131 checkEncodedUrlPiece' nominalDiffTimeGen "NominalDiffTime"

128 checkEncodedUrlPiece (Proxy :: Proxy Version) "Version"

132 checkEncodedUrlPiece (Proxy :: Proxy Version) "Version"

129 checkEncodedUrlPiece' uuidGen "UUID"

133 checkEncodedUrlPiece' uuidGen "UUID"

134+ checkEncodedUrlPiece' setCookieGen "SetCookie"

130

135

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

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

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

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

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

179

184

180nominalDiffTimeGen :: Gen NominalDiffTime

185nominalDiffTimeGen :: Gen NominalDiffTime

181nominalDiffTimeGen = fromInteger <$> arbitrary

186nominalDiffTimeGen = 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 }