on master help sign in
Make sure path components get escaped

The derived client for an API containing `Capture` has a bug: it does not escape characters, so that if the string is "a/b", the URL becomes `".../a/b/..."` instead of `".../a%2Fb/..."`, causing the corresponding servant server to return a 404. This relies on https://github.com/fizruk/http-api-data/pull/47

commit507f0219191ba220bb8c1f5256f2322502f6a12d authorEdsko de Vries <edsko@well-typed.com> dateTue 7 Feb 2017, 16:51 (10 years ago) parent8a3ecb2
1 file changed+7−5
servant-client/src/Servant/Common/Req.hs+7−5
servant-client/src/Servant/Common/Req.hs+7−5
@@ -27,6 +27,7 @@ import Control.Monad.Base (MonadBase (..))
2727import Control.Monad.IO.Class ()
2828import Control.Monad.Reader
2929import Control.Monad.Trans.Control (MonadBaseControl (..))
30+import qualified Data.ByteString.Builder as BS
3031import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)
3132import Data.String
3233import Data.String.Conversions (cs)
@@ -86,7 +87,7 @@ instance Eq ServantError where
8687instance Exception ServantError
8788
8889data Req = Req
89− { reqPath :: String
90+ { reqPath :: BS.Builder
9091 , qs :: QueryText
9192 , reqBody :: Maybe (RequestBody, MediaType)
9293 , reqAccept :: [MediaType]
@@ -98,7 +99,7 @@ defReq = Req "" [] Nothing [] []
9899
99100appendToPath :: String -> Req -> Req
100101appendToPath p req =
101− req { reqPath = reqPath req ++ "/" ++ p }
102+ req { reqPath = reqPath req <> "/" <> toEncodedUrlPiece p }
102103
103104appendToQueryString :: Text -- ^ param name
104105 -> Maybe Text -- ^ param value
@@ -151,8 +152,9 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
151152 , uriRegName = reqHost
152153 , uriPort = ":" ++ show reqPort
153154 }
154− , uriPath = path ++ reqPath req
155+ , uriPath = fullPath
155156 }
157+ fullPath = path ++ cs (BS.toLazyByteString (reqPath req))
156158
157159 setrqb r = case reqBody req of
158160 Nothing -> r
@@ -224,7 +226,7 @@ runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
224226runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
225227
226228
227−performRequest :: Method -> Req
229+performRequest :: Method -> Req
228230 -> ClientM ( Int, ByteString, MediaType
229231 , [HTTP.Header], Response ByteString)
230232performRequest reqMethod req = do
@@ -253,7 +255,7 @@ performRequest reqMethod req = do
253255 throwError $ FailureResponse status ct body
254256 return (status_code, body, ct, hdrs, response)
255257
256−performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req
258+performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req
257259 -> ClientM ([HTTP.Header], result)
258260performRequestCT ct reqMethod req = do
259261 let acceptCTS = contentTypes ct