Skip to content

Commit

Permalink
Merge pull request #86 from fizruk/fix-set-cookie
Browse files Browse the repository at this point in the history 
Try to fix SetCooke instances
  • Loading branch information
@phadej
phadej authored Oct 5, 2018
2 parents af01cff + 34ab187 commit 283c747
Show file tree
Hide file tree
Showing 4 changed files with 56 additions and 67 deletions.
10 changes: 9 additions & 1 deletion CHANGELOG.md
View file
Original file line number Diff line number Diff line change
@@ -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
Expand Down
3 changes: 2 additions & 1 deletion http-api-data.cabal
View file
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -99,6 +99,7 @@ test-suite spec
, time
, bytestring
, uuid-types
, cookie

build-depends: HUnit >= 1.6.0.0 && <1.7
, hspec >= 2.5.5 && <2.6
Expand Down
25 changes: 19 additions & 6 deletions src/Web/Internal/HttpApiData.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,7 @@ import Control.Monad ((<=<))

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
Expand All @@ -32,7 +33,8 @@ 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)
Expand Down Expand Up @@ -539,13 +541,19 @@ instance (ToHttpApiData a, ToHttpApiData b) => ToHttpApiData (Either a b) where
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 ()
Expand Down Expand Up @@ -601,6 +609,9 @@ instance FromHttpApiData String where parseUrlPiece = Right . T.unpack
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)
Expand Down Expand Up @@ -681,12 +692,14 @@ instance FromHttpApiData a => FromHttpApiData (LenientData a) where
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
-------------------------------------------------------------------------------
Expand Down
85 changes: 26 additions & 59 deletions test/Web/Internal/HttpApiDataSpec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,14 +5,17 @@ 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

Expand Down Expand Up @@ -40,30 +43,24 @@ import Web.Internal.TestInstances
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"
Expand All @@ -90,6 +87,15 @@ spec = do
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"
Expand All @@ -100,51 +106,6 @@ spec = do
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

checkEncodedUrlPiece (Proxy :: Proxy F.Uni) "Uni"
checkEncodedUrlPiece (Proxy :: Proxy F.Deci) "Deci"
checkEncodedUrlPiece (Proxy :: Proxy F.Centi) "Centi"
checkEncodedUrlPiece (Proxy :: Proxy F.Milli) "Milli"
checkEncodedUrlPiece (Proxy :: Proxy F.Micro) "Micro"
checkEncodedUrlPiece (Proxy :: Proxy F.Nano) "Nano"
checkEncodedUrlPiece (Proxy :: Proxy F.Pico) "Pico"

it "bad integers are rejected" $ do
parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)

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

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 }

0 comments on commit 283c747

Please sign in to comment.