git.iko.soy/servant
on master help sign in
Use toEncodedUrlPiece directly when encoding captures

Current implementation of captures uses the `toUrlPiece` method from the `ToHttpApiData` typeclass, and encodes the resulting `Text` using `toEncodedUrlPiece` when appending to the request path. The problem with this approach is that the instance for `Text` percent-encodes characters that are perfectly valid in URLs, such as `*`. This patch makes direct use of `toEncodedUrlPiece`, which lets users implement encoding according to their needs. Closes #1511

commit658217b021f9dc3315f18fde9f629b2cb0e7fa1f authorGaël Deest <gael.deest@tweag.io> dateMon 21 Mar 2022, 17:29 (5 years ago) parentaf3dde1
4 files changed+31−7
compare with master
unifiedsplit
servant-client-core/src/Servant/Client/Core/HasClient.hs+3−3 servant-client-core/src/Servant/Client/Core/Request.hs+6−3 servant-client/test/Servant/ClientTestUtils.hs+13−1 servant-client/test/Servant/SuccessSpec.hs+9
servant-client-core/src/Servant/Client/Core/HasClient.hs+3−3
@@ -208,7 +208,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
208208 clientWithRoute pm (Proxy :: Proxy api)
209209 (appendToPath p req)
210210
211− where p = (toUrlPiece val)
211+ where p = toEncodedUrlPiece val
212212
213213 hoistClientMonad pm _ f cl = \a ->
214214 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
@@ -243,7 +243,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
243243 clientWithRoute pm (Proxy :: Proxy sublayout)
244244 (foldl' (flip appendToPath) req ps)
245245
246− where ps = map (toUrlPiece) vals
246+ where ps = map toEncodedUrlPiece vals
247247
248248 hoistClientMonad pm _ f cl = \as ->
249249 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
@@ -740,7 +740,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
740740 clientWithRoute pm (Proxy :: Proxy api)
741741 (appendToPath p req)
742742
743− where p = pack $ symbolVal (Proxy :: Proxy path)
743+ where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)
744744
745745 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
746746
servant-client-core/src/Servant/Client/Core/Request.hs+6−3
@@ -34,6 +34,8 @@ import Data.Bifunctor
3434import Data.Bitraversable
3535 (Bitraversable (..), bifoldMapDefault, bimapDefault)
3636import qualified Data.ByteString as BS
37+import Data.ByteString.Builder
38+ (Builder)
3739import qualified Data.ByteString.Builder as Builder
3840import qualified Data.ByteString.Lazy as LBS
3941import qualified Data.Sequence as Seq
@@ -112,7 +114,7 @@ instance (NFData path, NFData body) => NFData (RequestF body path) where
112114 rnfB Nothing = ()
113115 rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt
114116
115−type Request = RequestF RequestBody Builder.Builder
117+type Request = RequestF RequestBody Builder
116118
117119-- | The request body. R replica of the @http-client@ @RequestBody@.
118120data RequestBody
@@ -145,9 +147,10 @@ defaultRequest = Request
145147
146148-- | Append extra path to the request being constructed.
147149--
148−appendToPath :: Text -> Request -> Request
150+-- Warning: This function assumes that the path fragment is already URL-encoded.
151+appendToPath :: Builder -> Request -> Request
149152appendToPath p req
150− = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }
153+ = req { requestPath = requestPath req <> "/" <> p }
151154
152155-- | Append a query parameter to the request being constructed.
153156--
servant-client/test/Servant/ClientTestUtils.hs+13−1
@@ -160,6 +160,7 @@ type Api =
160160 WithStatus 301 Text]
161161 :<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person]
162162 :<|> NamedRoutes RecordRoutes
163+ :<|> "captureVerbatim" :> Capture "someString" Verbatim :> Get '[PlainText] Text
163164
164165api :: Proxy Api
165166api = Proxy
@@ -214,7 +215,8 @@ getRoot
214215 :<|> EmptyClient
215216 :<|> uverbGetSuccessOrRedirect
216217 :<|> uverbGetCreated
217− :<|> recordRoutes = client api
218+ :<|> recordRoutes
219+ :<|> captureVerbatim = client api
218220
219221server :: Application
220222server = serve api (
@@ -259,6 +261,7 @@ server = serve api (
259261 { something = pure ["foo", "bar", "pweet"]
260262 }
261263 }
264+ :<|> pure . decodeUtf8 . unVerbatim
262265 )
263266
264267-- * api for testing failures
@@ -370,3 +373,12 @@ instance ToHttpApiData UrlEncodedByteString where
370373
371374instance FromHttpApiData UrlEncodedByteString where
372375 parseUrlPiece = pure . UrlEncodedByteString . HTTP.urlDecode True . encodeUtf8
376+
377+newtype Verbatim = Verbatim { unVerbatim :: ByteString }
378+
379+instance ToHttpApiData Verbatim where
380+ toEncodedUrlPiece = byteString . unVerbatim
381+ toUrlPiece = decodeUtf8 . unVerbatim
382+
383+instance FromHttpApiData Verbatim where
384+ parseUrlPiece = pure . Verbatim . encodeUtf8
servant-client/test/Servant/SuccessSpec.hs+9
@@ -36,6 +36,8 @@ import Data.Maybe
3636import Data.Monoid ()
3737import Data.Text
3838 (Text)
39+import Data.Text.Encoding
40+ (encodeUtf8)
3941import qualified Network.HTTP.Client as C
4042import qualified Network.HTTP.Types as HTTP
4143import Test.Hspec
@@ -196,3 +198,10 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
196198 case eitherResponse of
197199 Left clientError -> fail $ show clientError
198200 Right response -> matchUnion response `shouldBe` Just (WithStatus @201 carol)
201+
202+ it "encodes URL pieces following ToHttpApiData instance" $ \(_, baseUrl) -> do
203+ let textOrig = "*"
204+ eitherResponse <- runClient (captureVerbatim $ Verbatim $ encodeUtf8 textOrig) baseUrl
205+ case eitherResponse of
206+ Left clientError -> fail $ show clientError
207+ Right textBack -> textBack `shouldBe` textOrig