276ca2e · typeable/servant

changelog.d/1569new file+13

compare with master

unifiedsplit

@@ -0,0 +1,13 @@

1+synopsis: Encode captures using toEncodedUrlPiece

2+prs: #1569

3+issues: #1511

4+

5+description: {

6+The `servant-client` library now makes direct use of `toEncodedUrlPiece` from `ToHttpApiData`

7+to encode captured values when building the request path. It gives user freedom to implement

8+URL-encoding however they need.

9+

10+Previous behavior was to use `toUrlPiece` and URL-encode its output using `toEncodedUrlPiece`

11+from the `Text` instance of `ToHttpApiData`. The issue with this approach is that

12+`ToHttpApiData Text` is overly zealous and also encodes characters, such as `*`, which are perfectly valid in a URL.

13+}

servant-client-core/src/Servant/Client/Core/HasClient.hs+3−3

@@ -208,7 +208,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)

208 clientWithRoute pm (Proxy :: Proxy api)

209 (appendToPath p req)

210

211− where p = (toUrlPiece val)

211+ where p = toEncodedUrlPiece val

212

213 hoistClientMonad pm _ f cl = \a ->

214 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)

@@ -243,7 +243,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)

243 clientWithRoute pm (Proxy :: Proxy sublayout)

244 (foldl' (flip appendToPath) req ps)

245

246− where ps = map (toUrlPiece) vals

246+ where ps = map toEncodedUrlPiece vals

247

248 hoistClientMonad pm _ f cl = \as ->

249 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)

@@ -740,7 +740,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where

740 clientWithRoute pm (Proxy :: Proxy api)

741 (appendToPath p req)

742

743− where p = pack $ symbolVal (Proxy :: Proxy path)

743+ where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)

744

745 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl

746

servant-client-core/src/Servant/Client/Core/Request.hs+6−3

@@ -34,6 +34,8 @@ import Data.Bifunctor

34import Data.Bitraversable

35 (Bitraversable (..), bifoldMapDefault, bimapDefault)

36import qualified Data.ByteString as BS

37+import Data.ByteString.Builder

38+ (Builder)

37import qualified Data.ByteString.Builder as Builder

39import qualified Data.ByteString.Builder as Builder

38import qualified Data.ByteString.Lazy as LBS

40import qualified Data.ByteString.Lazy as LBS

39import qualified Data.Sequence as Seq

41import qualified Data.Sequence as Seq

@@ -112,7 +114,7 @@ instance (NFData path, NFData body) => NFData (RequestF body path) where

112 rnfB Nothing = ()

114 rnfB Nothing = ()

113 rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt

115 rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt

114

116

115−type Request = RequestF RequestBody Builder.Builder

117+type Request = RequestF RequestBody Builder

116

118

117-- | The request body. R replica of the @http-client@ @RequestBody@.

119-- | The request body. R replica of the @http-client@ @RequestBody@.

118data RequestBody

120data RequestBody

@@ -145,9 +147,10 @@ defaultRequest = Request

145

147

146-- | Append extra path to the request being constructed.

148-- | Append extra path to the request being constructed.

147--

149--

150+-- Warning: This function assumes that the path fragment is already URL-encoded.

148−appendToPath :: Text -> Request -> Request

151+appendToPath :: Builder -> Request -> Request

149appendToPath p req

152appendToPath p req

150− = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }

153+ = req { requestPath = requestPath req <> "/" <> p }

151

154

152-- | Append a query parameter to the request being constructed.

155-- | Append a query parameter to the request being constructed.

153--

156--

servant-client/test/Servant/ClientTestUtils.hs+13−1

@@ -160,6 +160,7 @@ type Api =

160 WithStatus 301 Text]

161 :<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person]

162 :<|> NamedRoutes RecordRoutes

163+ :<|> "captureVerbatim" :> Capture "someString" Verbatim :> Get '[PlainText] Text

163

164

164api :: Proxy Api

165api :: Proxy Api

165api = Proxy

166api = Proxy

@@ -214,7 +215,8 @@ getRoot

214 :<|> EmptyClient

215 :<|> EmptyClient

215 :<|> uverbGetSuccessOrRedirect

216 :<|> uverbGetSuccessOrRedirect

216 :<|> uverbGetCreated

217 :<|> uverbGetCreated

217− :<|> recordRoutes = client api

218+ :<|> recordRoutes

219+ :<|> captureVerbatim = client api

218

220

219server :: Application

221server :: Application

220server = serve api (

222server = serve api (

@@ -259,6 +261,7 @@ server = serve api (

259 { something = pure ["foo", "bar", "pweet"]

261 { something = pure ["foo", "bar", "pweet"]

260 }

262 }

261 }

263 }

264+ :<|> pure . decodeUtf8 . unVerbatim

262 )

265 )

263

266

264-- * api for testing failures

267-- * api for testing failures

@@ -370,3 +373,12 @@ instance ToHttpApiData UrlEncodedByteString where

370

373

371instance FromHttpApiData UrlEncodedByteString where

374instance FromHttpApiData UrlEncodedByteString where

372 parseUrlPiece = pure . UrlEncodedByteString . HTTP.urlDecode True . encodeUtf8

375 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

36import Data.Monoid ()

37import Data.Text

38 (Text)

39+import Data.Text.Encoding

40+ (encodeUtf8)

39import qualified Network.HTTP.Client as C

41import qualified Network.HTTP.Client as C

40import qualified Network.HTTP.Types as HTTP

42import qualified Network.HTTP.Types as HTTP

41import Test.Hspec

43import Test.Hspec

@@ -196,3 +198,10 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

196 case eitherResponse of

198 case eitherResponse of

197 Left clientError -> fail $ show clientError

199 Left clientError -> fail $ show clientError

198 Right response -> matchUnion response `shouldBe` Just (WithStatus @201 carol)

200 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