http-api-data 0.3.5 → 0.3.6
raw patch · 4 files changed
+133/−31 lines, 4 filesdep +http-typesdep ~bytestringdep ~containersdep ~hashable
Dependencies added: http-types
Dependency ranges changed: bytestring, containers, hashable, time, unordered-containers, uri-bytestring
Files
- CHANGELOG.md +6/−0
- http-api-data.cabal +2/−1
- src/Web/Internal/HttpApiData.hs +74/−30
- test/Web/Internal/HttpApiDataSpec.hs +51/−0
CHANGELOG.md view
@@ -1,3 +1,9 @@+0.3.6+---++* Minor change:+ * Add `toEncodedUrlPiece` class method for URL-encoded path segments (see [#50](https://github.com/fizruk/http-api-data/pull/50)); use efficient encoding for types whose values don't need URL-encoding.+ 0.3.5 ---
http-api-data.cabal view
@@ -1,5 +1,5 @@ name: http-api-data-version: 0.3.5+version: 0.3.6 license: BSD3 license-file: LICENSE author: Nickolay Kudasov <nickolay.kudasov@gmail.com>@@ -41,6 +41,7 @@ , bytestring , containers , hashable+ , http-types , text >= 0.5 , time , time-locale-compat >=0.1.1.0 && <0.2
src/Web/Internal/HttpApiData.hs view
@@ -55,7 +55,10 @@ import Data.Typeable (Typeable) import Data.Data (Data)+import qualified Data.ByteString.Builder as BS+import qualified Network.HTTP.Types as H + -- $setup -- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show) -- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p@@ -70,6 +73,12 @@ toUrlPiece :: a -> Text toUrlPiece = toQueryParam + -- | Convert to a URL path piece, making sure to encode any special chars.+ -- The default definition uses 'H.encodePathSegmentsRelative',+ -- but this may be overriden with a more efficient version.+ toEncodedUrlPiece :: a -> BS.Builder+ toEncodedUrlPiece = H.encodePathSegmentsRelative . (:[]) . toUrlPiece+ -- | Convert to HTTP header value. toHeader :: a -> ByteString toHeader = encodeUtf8 . toUrlPiece@@ -387,46 +396,58 @@ l = toInteger (minBound :: a) h = toInteger (maxBound :: a) +-- | Convert to a URL-encoded path piece using 'toUrlPiece'.+-- /Note/: this function does not check if the result contains unescaped characters!+-- This function can be used to override 'toEncodedUrlPiece' as a more efficient implementation+-- when the resulting URL piece /never/ has to be escaped.+unsafeToEncodedUrlPiece :: ToHttpApiData a => a -> BS.Builder+unsafeToEncodedUrlPiece = BS.byteString . encodeUtf8 . toUrlPiece+ -- | -- >>> toUrlPiece () -- "_" instance ToHttpApiData () where toUrlPiece () = "_"+ toEncodedUrlPiece = unsafeToEncodedUrlPiece -instance ToHttpApiData Char where toUrlPiece = T.singleton+instance ToHttpApiData Char where+ toUrlPiece = T.singleton -- | -- >>> toUrlPiece (Version [1, 2, 3] []) -- "1.2.3" instance ToHttpApiData Version where toUrlPiece = T.pack . showVersion+ toEncodedUrlPiece = unsafeToEncodedUrlPiece #if MIN_VERSION_base(4,8,0) instance ToHttpApiData Void where toUrlPiece = absurd-instance ToHttpApiData Natural where toUrlPiece = showt+instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece #endif -instance ToHttpApiData Bool where toUrlPiece = showTextData-instance ToHttpApiData Ordering where toUrlPiece = showTextData+instance ToHttpApiData Bool where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece -instance ToHttpApiData Double where toUrlPiece = showt-instance ToHttpApiData Float where toUrlPiece = showt-instance ToHttpApiData Int where toUrlPiece = showt-instance ToHttpApiData Int8 where toUrlPiece = showt-instance ToHttpApiData Int16 where toUrlPiece = showt-instance ToHttpApiData Int32 where toUrlPiece = showt-instance ToHttpApiData Int64 where toUrlPiece = showt-instance ToHttpApiData Integer where toUrlPiece = showt-instance ToHttpApiData Word where toUrlPiece = showt-instance ToHttpApiData Word8 where toUrlPiece = showt-instance ToHttpApiData Word16 where toUrlPiece = showt-instance ToHttpApiData Word32 where toUrlPiece = showt-instance ToHttpApiData Word64 where toUrlPiece = showt+instance ToHttpApiData Double where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Float where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Int where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Int8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Int16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Int32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Int64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Integer where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Word where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Word8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Word16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece+instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece -- | -- >>> toUrlPiece (fromGregorian 2015 10 03) -- "2015-10-03"-instance ToHttpApiData Day where toUrlPiece = T.pack . show+instance ToHttpApiData Day where+ toUrlPiece = T.pack . show+ toEncodedUrlPiece = unsafeToEncodedUrlPiece timeToUrlPiece :: FormatTime t => String -> t -> Text timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))@@ -434,33 +455,55 @@ -- | -- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01) -- "2015-10-03T14:55:01"-instance ToHttpApiData LocalTime where toUrlPiece = timeToUrlPiece "%H:%M:%S"+instance ToHttpApiData LocalTime where+ toUrlPiece = timeToUrlPiece "%H:%M:%S"+ toEncodedUrlPiece = unsafeToEncodedUrlPiece -- | -- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)) utc -- "2015-10-03T14:55:01+0000"-instance ToHttpApiData ZonedTime where toUrlPiece = timeToUrlPiece "%H:%M:%S%z"+instance ToHttpApiData ZonedTime where+ toUrlPiece = timeToUrlPiece "%H:%M:%S%z"+ toEncodedUrlPiece = unsafeToEncodedUrlPiece -- | -- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864 -- "2015-10-03T00:14:24Z"-instance ToHttpApiData UTCTime where toUrlPiece = timeToUrlPiece "%H:%M:%SZ"+instance ToHttpApiData UTCTime where+ toUrlPiece = timeToUrlPiece "%H:%M:%SZ"+ toEncodedUrlPiece = unsafeToEncodedUrlPiece -instance ToHttpApiData NominalDiffTime where toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)+instance ToHttpApiData NominalDiffTime where+ toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)+ toEncodedUrlPiece = unsafeToEncodedUrlPiece instance ToHttpApiData String where toUrlPiece = T.pack instance ToHttpApiData Text where toUrlPiece = id instance ToHttpApiData L.Text where toUrlPiece = L.toStrict -instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll-instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny+instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll; toEncodedUrlPiece = toEncodedUrlPiece . getAll+instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny; toEncodedUrlPiece = toEncodedUrlPiece . getAny -instance ToHttpApiData a => ToHttpApiData (Dual a) where toUrlPiece = toUrlPiece . getDual-instance ToHttpApiData a => ToHttpApiData (Sum a) where toUrlPiece = toUrlPiece . getSum-instance ToHttpApiData a => ToHttpApiData (Product a) where toUrlPiece = toUrlPiece . getProduct-instance ToHttpApiData a => ToHttpApiData (First a) where toUrlPiece = toUrlPiece . getFirst-instance ToHttpApiData a => ToHttpApiData (Last a) where toUrlPiece = toUrlPiece . getLast+instance ToHttpApiData a => ToHttpApiData (Dual a) where+ toUrlPiece = toUrlPiece . getDual+ toEncodedUrlPiece = toEncodedUrlPiece . getDual +instance ToHttpApiData a => ToHttpApiData (Sum a) where+ toUrlPiece = toUrlPiece . getSum+ toEncodedUrlPiece = toEncodedUrlPiece . getSum++instance ToHttpApiData a => ToHttpApiData (Product a) where+ toUrlPiece = toUrlPiece . getProduct+ toEncodedUrlPiece = toEncodedUrlPiece . getProduct++instance ToHttpApiData a => ToHttpApiData (First a) where+ toUrlPiece = toUrlPiece . getFirst+ toEncodedUrlPiece = toEncodedUrlPiece . getFirst++instance ToHttpApiData a => ToHttpApiData (Last a) where+ toUrlPiece = toUrlPiece . getLast+ toEncodedUrlPiece = toEncodedUrlPiece . getLast+ -- | -- >>> toUrlPiece (Just "Hello") -- "just Hello"@@ -508,7 +551,7 @@ parseUrlPiece s = do n <- runReader (signed decimal) s if n < 0- then Left ("undeflow: " <> s <> " (should be a non-negative integer)")+ then Left ("underflow: " <> s <> " (should be a non-negative integer)") else Right (fromInteger n) #endif @@ -590,6 +633,7 @@ instance ToHttpApiData UUID.UUID where toUrlPiece = UUID.toText toHeader = UUID.toASCIIBytes+ toEncodedUrlPiece = unsafeToEncodedUrlPiece instance FromHttpApiData UUID.UUID where parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText
test/Web/Internal/HttpApiDataSpec.hs view
@@ -9,6 +9,7 @@ import qualified Data.Text as T 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 as UUID @@ -29,6 +30,10 @@ (<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool (f <=> g) x = g (f x) == Right x +encodedUrlPieceProp :: ToHttpApiData a => a -> Bool+encodedUrlPieceProp x = toLazyByteString (toEncodedUrlPiece (toUrlPiece x)) == toLazyByteString (toEncodedUrlPiece x)++ checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool) @@ -40,6 +45,15 @@ 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@@ -78,6 +92,42 @@ 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' 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+ it "bad integers are rejected" $ do parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int) @@ -87,6 +137,7 @@ it "invalid utf8 is handled" $ do parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)+ uuidGen :: Gen UUID.UUID uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary