19f79be · typeable/http-api-data

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

on master help sign in

Merge pull request #50 from fizruk/toEncodedUrlPiece

19f79beNickolay Kudasov10 years ago

http-api-data.cabal+1

compare with master

unifiedsplit

@@ -41,6 +41,7 @@ library

41 , bytestring

42 , containers

43 , hashable

44+ , http-types

44 , text >= 0.5

45 , text >= 0.5

45 , time

46 , time

46 , time-locale-compat >=0.1.1.0 && <0.2

47 , time-locale-compat >=0.1.1.0 && <0.2

src/Web/Internal/HttpApiData.hs+74−30

@@ -55,6 +55,9 @@ import qualified Data.UUID.Types as UUID

56import Data.Typeable (Typeable)

57import Data.Data (Data)

58+import qualified Data.ByteString.Builder as BS

59+import qualified Network.HTTP.Types as H

60+

59-- $setup

62-- $setup

60-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)

63-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)

@@ -70,6 +73,12 @@ class ToHttpApiData a where

70 toUrlPiece :: a -> Text

73 toUrlPiece :: a -> Text

71 toUrlPiece = toQueryParam

74 toUrlPiece = toQueryParam

76+ -- | Convert to a URL path piece, making sure to encode any special chars.

77+ -- The default definition uses 'H.encodePathSegmentsRelative',

78+ -- but this may be overriden with a more efficient version.

79+ toEncodedUrlPiece :: a -> BS.Builder

80+ toEncodedUrlPiece = H.encodePathSegmentsRelative . (:[]) . toUrlPiece

81+

73 -- | Convert to HTTP header value.

82 -- | Convert to HTTP header value.

74 toHeader :: a -> ByteString

83 toHeader :: a -> ByteString

75 toHeader = encodeUtf8 . toUrlPiece

84 toHeader = encodeUtf8 . toUrlPiece

@@ -387,46 +396,58 @@ parseBounded reader input = do

387 l = toInteger (minBound :: a)

396 l = toInteger (minBound :: a)

388 h = toInteger (maxBound :: a)

397 h = toInteger (maxBound :: a)

389

398

399+-- | Convert to a URL-encoded path piece using 'toUrlPiece'.

400+-- /Note/: this function does not check if the result contains unescaped characters!

401+-- This function can be used to override 'toEncodedUrlPiece' as a more efficient implementation

402+-- when the resulting URL piece /never/ has to be escaped.

403+unsafeToEncodedUrlPiece :: ToHttpApiData a => a -> BS.Builder

404+unsafeToEncodedUrlPiece = BS.byteString . encodeUtf8 . toUrlPiece

405+

390-- |

406-- |

391-- >>> toUrlPiece ()

407-- >>> toUrlPiece ()

392-- "_"

408-- "_"

393instance ToHttpApiData () where

409instance ToHttpApiData () where

394 toUrlPiece () = "_"

410 toUrlPiece () = "_"

411+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

395

412

396−instance ToHttpApiData Char where toUrlPiece = T.singleton

413+instance ToHttpApiData Char where

414+ toUrlPiece = T.singleton

397

415

398-- |

416-- |

399-- >>> toUrlPiece (Version [1, 2, 3] [])

417-- >>> toUrlPiece (Version [1, 2, 3] [])

400-- "1.2.3"

418-- "1.2.3"

401instance ToHttpApiData Version where

419instance ToHttpApiData Version where

402 toUrlPiece = T.pack . showVersion

420 toUrlPiece = T.pack . showVersion

421+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

403

422

404#if MIN_VERSION_base(4,8,0)

423#if MIN_VERSION_base(4,8,0)

405instance ToHttpApiData Void where toUrlPiece = absurd

424instance ToHttpApiData Void where toUrlPiece = absurd

406−instance ToHttpApiData Natural where toUrlPiece = showt

425+instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

407#endif

426#endif

408

427

409−instance ToHttpApiData Bool where toUrlPiece = showTextData

428+instance ToHttpApiData Bool where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece

410−instance ToHttpApiData Ordering where toUrlPiece = showTextData

429+instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece

411−

430+

412−instance ToHttpApiData Double where toUrlPiece = showt

431+instance ToHttpApiData Double where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

413−instance ToHttpApiData Float where toUrlPiece = showt

432+instance ToHttpApiData Float where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

414−instance ToHttpApiData Int where toUrlPiece = showt

433+instance ToHttpApiData Int where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

415−instance ToHttpApiData Int8 where toUrlPiece = showt

434+instance ToHttpApiData Int8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

416−instance ToHttpApiData Int16 where toUrlPiece = showt

435+instance ToHttpApiData Int16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

417−instance ToHttpApiData Int32 where toUrlPiece = showt

436+instance ToHttpApiData Int32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

418−instance ToHttpApiData Int64 where toUrlPiece = showt

437+instance ToHttpApiData Int64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

419−instance ToHttpApiData Integer where toUrlPiece = showt

438+instance ToHttpApiData Integer where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

420−instance ToHttpApiData Word where toUrlPiece = showt

439+instance ToHttpApiData Word where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

421−instance ToHttpApiData Word8 where toUrlPiece = showt

440+instance ToHttpApiData Word8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

422−instance ToHttpApiData Word16 where toUrlPiece = showt

441+instance ToHttpApiData Word16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

423−instance ToHttpApiData Word32 where toUrlPiece = showt

442+instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

424−instance ToHttpApiData Word64 where toUrlPiece = showt

443+instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

425

444

426-- |

445-- |

427-- >>> toUrlPiece (fromGregorian 2015 10 03)

446-- >>> toUrlPiece (fromGregorian 2015 10 03)

428-- "2015-10-03"

447-- "2015-10-03"

429−instance ToHttpApiData Day where toUrlPiece = T.pack . show

448+instance ToHttpApiData Day where

449+ toUrlPiece = T.pack . show

450+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

430

451

431timeToUrlPiece :: FormatTime t => String -> t -> Text

452timeToUrlPiece :: FormatTime t => String -> t -> Text

432timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))

453timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))

@@ -434,32 +455,54 @@ timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (J

434-- |

455-- |

435-- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)

456-- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)

436-- "2015-10-03T14:55:01"

457-- "2015-10-03T14:55:01"

437−instance ToHttpApiData LocalTime where toUrlPiece = timeToUrlPiece "%H:%M:%S"

458+instance ToHttpApiData LocalTime where

459+ toUrlPiece = timeToUrlPiece "%H:%M:%S"

460+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

438

461

439-- |

462-- |

440-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)) utc

463-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)) utc

441-- "2015-10-03T14:55:01+0000"

464-- "2015-10-03T14:55:01+0000"

442−instance ToHttpApiData ZonedTime where toUrlPiece = timeToUrlPiece "%H:%M:%S%z"

465+instance ToHttpApiData ZonedTime where

466+ toUrlPiece = timeToUrlPiece "%H:%M:%S%z"

467+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

443

468

444-- |

469-- |

445-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864

470-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864

446-- "2015-10-03T00:14:24Z"

471-- "2015-10-03T00:14:24Z"

447−instance ToHttpApiData UTCTime where toUrlPiece = timeToUrlPiece "%H:%M:%SZ"

472+instance ToHttpApiData UTCTime where

473+ toUrlPiece = timeToUrlPiece "%H:%M:%SZ"

474+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

448

475

476+instance ToHttpApiData NominalDiffTime where

449−instance ToHttpApiData NominalDiffTime where toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)

477+ toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)

478+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

450

479

451instance ToHttpApiData String where toUrlPiece = T.pack

480instance ToHttpApiData String where toUrlPiece = T.pack

452instance ToHttpApiData Text where toUrlPiece = id

481instance ToHttpApiData Text where toUrlPiece = id

453instance ToHttpApiData L.Text where toUrlPiece = L.toStrict

482instance ToHttpApiData L.Text where toUrlPiece = L.toStrict

454

483

455−instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll

484+instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll; toEncodedUrlPiece = toEncodedUrlPiece . getAll

456−instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny

485+instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny; toEncodedUrlPiece = toEncodedUrlPiece . getAny

486+

487+instance ToHttpApiData a => ToHttpApiData (Dual a) where

488+ toUrlPiece = toUrlPiece . getDual

489+ toEncodedUrlPiece = toEncodedUrlPiece . getDual

490+

491+instance ToHttpApiData a => ToHttpApiData (Sum a) where

492+ toUrlPiece = toUrlPiece . getSum

493+ toEncodedUrlPiece = toEncodedUrlPiece . getSum

494+

495+instance ToHttpApiData a => ToHttpApiData (Product a) where

496+ toUrlPiece = toUrlPiece . getProduct

497+ toEncodedUrlPiece = toEncodedUrlPiece . getProduct

498+

499+instance ToHttpApiData a => ToHttpApiData (First a) where

500+ toUrlPiece = toUrlPiece . getFirst

501+ toEncodedUrlPiece = toEncodedUrlPiece . getFirst

457

502

458−instance ToHttpApiData a => ToHttpApiData (Dual a) where toUrlPiece = toUrlPiece . getDual

503+instance ToHttpApiData a => ToHttpApiData (Last a) where

459−instance ToHttpApiData a => ToHttpApiData (Sum a) where toUrlPiece = toUrlPiece . getSum

504+ toUrlPiece = toUrlPiece . getLast

460−instance ToHttpApiData a => ToHttpApiData (Product a) where toUrlPiece = toUrlPiece . getProduct

505+ toEncodedUrlPiece = toEncodedUrlPiece . getLast

461−instance ToHttpApiData a => ToHttpApiData (First a) where toUrlPiece = toUrlPiece . getFirst

462−instance ToHttpApiData a => ToHttpApiData (Last a) where toUrlPiece = toUrlPiece . getLast

463

506

464-- |

507-- |

465-- >>> toUrlPiece (Just "Hello")

508-- >>> toUrlPiece (Just "Hello")

@@ -590,6 +633,7 @@ instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b)

590instance ToHttpApiData UUID.UUID where

633instance ToHttpApiData UUID.UUID where

591 toUrlPiece = UUID.toText

634 toUrlPiece = UUID.toText

592 toHeader = UUID.toASCIIBytes

635 toHeader = UUID.toASCIIBytes

636+ toEncodedUrlPiece = unsafeToEncodedUrlPiece

593

637

594instance FromHttpApiData UUID.UUID where

638instance FromHttpApiData UUID.UUID where

595 parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText

639 parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText

test/Web/Internal/HttpApiDataSpec.hs+51

@@ -9,6 +9,7 @@ import Data.Time

9import qualified Data.Text as T

10import qualified Data.Text.Lazy as L

11import qualified Data.ByteString as BS

12+import Data.ByteString.Builder (toLazyByteString)

12import Data.Version

13import Data.Version

13import qualified Data.UUID as UUID

14import qualified Data.UUID as UUID

@@ -29,6 +30,10 @@ import Web.Internal.TestInstances

29(<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool

30(<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool

30(f <=> g) x = g (f x) == Right x

31(f <=> g) x = g (f x) == Right x

33+encodedUrlPieceProp :: ToHttpApiData a => a -> Bool

34+encodedUrlPieceProp x = toLazyByteString (toEncodedUrlPiece (toUrlPiece x)) == toLazyByteString (toEncodedUrlPiece x)

35+

36+

32checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec

37checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec

33checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool)

38checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool)

@@ -40,6 +45,15 @@ checkUrlPiece' gen name = prop name $ forAll gen (toUrlPiece <=> parseUrlPiece)

40checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec

45checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec

41checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a))

46checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a))

48+-- | Check that 'toEncodedUrlPiece' is equivallent to default implementation.

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

50+checkEncodedUrlPiece _ = checkEncodedUrlPiece' (arbitrary :: Gen a)

51+

52+-- | Check that 'toEncodedUrlPiece' is equivallent to default implementation.

53+-- Use a given generator.

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

55+checkEncodedUrlPiece' gen name = prop name $ forAll gen encodedUrlPieceProp

56+

43spec :: Spec

57spec :: Spec

44spec = do

58spec = do

45 describe "toUrlPiece <=> parseUrlPiece" $ do

59 describe "toUrlPiece <=> parseUrlPiece" $ do

@@ -78,6 +92,42 @@ spec = do

78 checkUrlPiece (Proxy :: Proxy Natural) "Natural"

92 checkUrlPiece (Proxy :: Proxy Natural) "Natural"

79#endif

93#endif

95+ describe "toEncodedUrlPiece encodes correctly" $ do

96+ checkEncodedUrlPiece (Proxy :: Proxy ()) "()"

97+ checkEncodedUrlPiece (Proxy :: Proxy Char) "Char"

98+ checkEncodedUrlPiece (Proxy :: Proxy Bool) "Bool"

99+ checkEncodedUrlPiece (Proxy :: Proxy Ordering) "Ordering"

100+ checkEncodedUrlPiece (Proxy :: Proxy Int) "Int"

101+ checkEncodedUrlPiece (Proxy :: Proxy Int8) "Int8"

102+ checkEncodedUrlPiece (Proxy :: Proxy Int16) "Int16"

103+ checkEncodedUrlPiece (Proxy :: Proxy Int32) "Int32"

104+ checkEncodedUrlPiece (Proxy :: Proxy Int64) "Int64"

105+ checkEncodedUrlPiece (Proxy :: Proxy Integer) "Integer"

106+ checkEncodedUrlPiece (Proxy :: Proxy Word) "Word"

107+ checkEncodedUrlPiece (Proxy :: Proxy Word8) "Word8"

108+ checkEncodedUrlPiece (Proxy :: Proxy Word16) "Word16"

109+ checkEncodedUrlPiece (Proxy :: Proxy Word32) "Word32"

110+ checkEncodedUrlPiece (Proxy :: Proxy Word64) "Word64"

111+ checkEncodedUrlPiece (Proxy :: Proxy String) "String"

112+ checkEncodedUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"

113+ checkEncodedUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"

114+ checkEncodedUrlPiece (Proxy :: Proxy Day) "Day"

115+ checkEncodedUrlPiece' localTimeGen "LocalTime"

116+ checkEncodedUrlPiece' zonedTimeGen "ZonedTime"

117+ checkEncodedUrlPiece' utcTimeGen "UTCTime"

118+ checkEncodedUrlPiece' nominalDiffTimeGen "NominalDiffTime"

119+ checkEncodedUrlPiece (Proxy :: Proxy Version) "Version"

120+ checkEncodedUrlPiece' uuidGen "UUID"

121+

122+ checkEncodedUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"

123+ checkEncodedUrlPiece (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"

124+ checkEncodedUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text"

125+ checkEncodedUrlPiece (Proxy :: Proxy (Either Version Day)) "Either Version Day"

126+

127+#if MIN_VERSION_base(4,8,0)

128+ checkEncodedUrlPiece (Proxy :: Proxy Natural) "Natural"

129+#endif

130+

81 it "bad integers are rejected" $ do

131 it "bad integers are rejected" $ do

82 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)

132 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)

133

@@ -88,6 +138,7 @@ spec = do

88 it "invalid utf8 is handled" $ do

138 it "invalid utf8 is handled" $ do

89 parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)

139 parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)

140

141+

91uuidGen :: Gen UUID.UUID

142uuidGen :: Gen UUID.UUID

92uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

143uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

144