git.iko.soy/typeable/http-api-data
on master help sign in
Merge pull request #50 from fizruk/toEncodedUrlPiece

ToEncodedUrlPiece

commit19f79bea9e74b228cce87490a996b56d0b08eddb authorNickolay Kudasov <fizruk@users.noreply.github.com> dateMon 10 Apr 2017, 17:38 (10 years ago) parentf55c9dbd91475d
3 files changed+126−30
compare with master
unifiedsplit
http-api-data.cabal+1 src/Web/Internal/HttpApiData.hs+74−30 test/Web/Internal/HttpApiDataSpec.hs+51
http-api-data.cabal+1
@@ -41,6 +41,7 @@ library
4141 , bytestring
4242 , containers
4343 , hashable
44+ , http-types
4445 , text >= 0.5
4546 , time
4647 , 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
5555
5656import Data.Typeable (Typeable)
5757import Data.Data (Data)
58+import qualified Data.ByteString.Builder as BS
59+import qualified Network.HTTP.Types as H
60+
5861
5962-- $setup
6063-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
@@ -70,6 +73,12 @@ class ToHttpApiData a where
7073 toUrlPiece :: a -> Text
7174 toUrlPiece = toQueryParam
7275
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+
7382 -- | Convert to HTTP header value.
7483 toHeader :: a -> ByteString
7584 toHeader = encodeUtf8 . toUrlPiece
@@ -387,46 +396,58 @@ parseBounded reader input = do
387396 l = toInteger (minBound :: a)
388397 h = toInteger (maxBound :: a)
389398
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+
390406-- |
391407-- >>> toUrlPiece ()
392408-- "_"
393409instance ToHttpApiData () where
394410 toUrlPiece () = "_"
411+ toEncodedUrlPiece = unsafeToEncodedUrlPiece
395412
396−instance ToHttpApiData Char where toUrlPiece = T.singleton
413+instance ToHttpApiData Char where
414+ toUrlPiece = T.singleton
397415
398416-- |
399417-- >>> toUrlPiece (Version [1, 2, 3] [])
400418-- "1.2.3"
401419instance ToHttpApiData Version where
402420 toUrlPiece = T.pack . showVersion
421+ toEncodedUrlPiece = unsafeToEncodedUrlPiece
403422
404423#if MIN_VERSION_base(4,8,0)
405424instance ToHttpApiData Void where toUrlPiece = absurd
406−instance ToHttpApiData Natural where toUrlPiece = showt
425+instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
407426#endif
408427
409−instance ToHttpApiData Bool where toUrlPiece = showTextData
410−instance ToHttpApiData Ordering where toUrlPiece = showTextData
411−
412−instance ToHttpApiData Double where toUrlPiece = showt
413−instance ToHttpApiData Float where toUrlPiece = showt
414−instance ToHttpApiData Int where toUrlPiece = showt
415−instance ToHttpApiData Int8 where toUrlPiece = showt
416−instance ToHttpApiData Int16 where toUrlPiece = showt
417−instance ToHttpApiData Int32 where toUrlPiece = showt
418−instance ToHttpApiData Int64 where toUrlPiece = showt
419−instance ToHttpApiData Integer where toUrlPiece = showt
420−instance ToHttpApiData Word where toUrlPiece = showt
421−instance ToHttpApiData Word8 where toUrlPiece = showt
422−instance ToHttpApiData Word16 where toUrlPiece = showt
423−instance ToHttpApiData Word32 where toUrlPiece = showt
424−instance ToHttpApiData Word64 where toUrlPiece = showt
428+instance ToHttpApiData Bool where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece
429+instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece
430+
431+instance ToHttpApiData Double where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
432+instance ToHttpApiData Float where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
433+instance ToHttpApiData Int where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
434+instance ToHttpApiData Int8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
435+instance ToHttpApiData Int16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
436+instance ToHttpApiData Int32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
437+instance ToHttpApiData Int64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
438+instance ToHttpApiData Integer where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
439+instance ToHttpApiData Word where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
440+instance ToHttpApiData Word8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
441+instance ToHttpApiData Word16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
442+instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
443+instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
425444
426445-- |
427446-- >>> toUrlPiece (fromGregorian 2015 10 03)
428447-- "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
430451
431452timeToUrlPiece :: FormatTime t => String -> t -> Text
432453timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))
@@ -434,32 +455,54 @@ timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (J
434455-- |
435456-- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)
436457-- "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
438461
439462-- |
440463-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)) utc
441464-- "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
443468
444469-- |
445470-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864
446471-- "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
448475
449−instance ToHttpApiData NominalDiffTime where toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)
476+instance ToHttpApiData NominalDiffTime where
477+ toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)
478+ toEncodedUrlPiece = unsafeToEncodedUrlPiece
450479
451480instance ToHttpApiData String where toUrlPiece = T.pack
452481instance ToHttpApiData Text where toUrlPiece = id
453482instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
454483
455−instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll
456−instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny
484+instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll; toEncodedUrlPiece = toEncodedUrlPiece . getAll
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
457502
458−instance ToHttpApiData a => ToHttpApiData (Dual a) where toUrlPiece = toUrlPiece . getDual
459−instance ToHttpApiData a => ToHttpApiData (Sum a) where toUrlPiece = toUrlPiece . getSum
460−instance ToHttpApiData a => ToHttpApiData (Product a) where toUrlPiece = toUrlPiece . getProduct
461−instance ToHttpApiData a => ToHttpApiData (First a) where toUrlPiece = toUrlPiece . getFirst
462−instance ToHttpApiData a => ToHttpApiData (Last a) where toUrlPiece = toUrlPiece . getLast
503+instance ToHttpApiData a => ToHttpApiData (Last a) where
504+ toUrlPiece = toUrlPiece . getLast
505+ toEncodedUrlPiece = toEncodedUrlPiece . getLast
463506
464507-- |
465508-- >>> toUrlPiece (Just "Hello")
@@ -590,6 +633,7 @@ instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b)
590633instance ToHttpApiData UUID.UUID where
591634 toUrlPiece = UUID.toText
592635 toHeader = UUID.toASCIIBytes
636+ toEncodedUrlPiece = unsafeToEncodedUrlPiece
593637
594638instance FromHttpApiData UUID.UUID where
595639 parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText
test/Web/Internal/HttpApiDataSpec.hs+51
@@ -9,6 +9,7 @@ import Data.Time
99import qualified Data.Text as T
1010import qualified Data.Text.Lazy as L
1111import qualified Data.ByteString as BS
12+import Data.ByteString.Builder (toLazyByteString)
1213import Data.Version
1314import qualified Data.UUID as UUID
1415
@@ -29,6 +30,10 @@ import Web.Internal.TestInstances
2930(<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool
3031(f <=> g) x = g (f x) == Right x
3132
33+encodedUrlPieceProp :: ToHttpApiData a => a -> Bool
34+encodedUrlPieceProp x = toLazyByteString (toEncodedUrlPiece (toUrlPiece x)) == toLazyByteString (toEncodedUrlPiece x)
35+
36+
3237checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec
3338checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool)
3439
@@ -40,6 +45,15 @@ checkUrlPiece' gen name = prop name $ forAll gen (toUrlPiece <=> parseUrlPiece)
4045checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec
4146checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a))
4247
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+
4357spec :: Spec
4458spec = do
4559 describe "toUrlPiece <=> parseUrlPiece" $ do
@@ -78,6 +92,42 @@ spec = do
7892 checkUrlPiece (Proxy :: Proxy Natural) "Natural"
7993#endif
8094
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+
81131 it "bad integers are rejected" $ do
82132 parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int)
83133
@@ -88,6 +138,7 @@ spec = do
88138 it "invalid utf8 is handled" $ do
89139 parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)
90140
141+
91142uuidGen :: Gen UUID.UUID
92143uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
93144