507f021 · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Make sure path components get escaped

507f021Edsko de Vries10 years ago

servant-client/src/Servant/Common/Req.hs+7−5

compare with master

unifiedsplit

@@ -27,6 +27,7 @@ import Control.Monad.Base (MonadBase (..))

27import Control.Monad.IO.Class ()

28import Control.Monad.Reader

29import Control.Monad.Trans.Control (MonadBaseControl (..))

30+import qualified Data.ByteString.Builder as BS

30import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)

31import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)

31import Data.String

32import Data.String

32import Data.String.Conversions (cs)

33import Data.String.Conversions (cs)

@@ -86,7 +87,7 @@ instance Eq ServantError where

86instance Exception ServantError

87instance Exception ServantError

88data Req = Req

89data Req = Req

89− { reqPath :: String

90+ { reqPath :: BS.Builder

90 , qs :: QueryText

91 , qs :: QueryText

91 , reqBody :: Maybe (RequestBody, MediaType)

92 , reqBody :: Maybe (RequestBody, MediaType)

92 , reqAccept :: [MediaType]

93 , reqAccept :: [MediaType]

@@ -98,7 +99,7 @@ defReq = Req "" [] Nothing [] []

99appendToPath :: String -> Req -> Req

100appendToPath :: String -> Req -> Req

100appendToPath p req =

101appendToPath p req =

101− req { reqPath = reqPath req ++ "/" ++ p }

102+ req { reqPath = reqPath req <> "/" <> toEncodedUrlPiece p }

102

103

103appendToQueryString :: Text -- ^ param name

104appendToQueryString :: Text -- ^ param name

104 -> Maybe Text -- ^ param value

105 -> Maybe Text -- ^ param value

@@ -151,8 +152,9 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =

151 , uriRegName = reqHost

152 , uriRegName = reqHost

152 , uriPort = ":" ++ show reqPort

153 , uriPort = ":" ++ show reqPort

153 }

154 }

154− , uriPath = path ++ reqPath req

155+ , uriPath = fullPath

155 }

156 }

157+ fullPath = path ++ cs (BS.toLazyByteString (reqPath req))

156

158

157 setrqb r = case reqBody req of

159 setrqb r = case reqBody req of

158 Nothing -> r

160 Nothing -> r

@@ -224,7 +226,7 @@ runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)

224runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm

226runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm

225

227

226

228

227−performRequest :: Method -> Req

229+performRequest :: Method -> Req

228 -> ClientM ( Int, ByteString, MediaType

230 -> ClientM ( Int, ByteString, MediaType

229 , [HTTP.Header], Response ByteString)

231 , [HTTP.Header], Response ByteString)

230performRequest reqMethod req = do

232performRequest reqMethod req = do

@@ -253,7 +255,7 @@ performRequest reqMethod req = do

253 throwError $ FailureResponse status ct body

255 throwError $ FailureResponse status ct body

254 return (status_code, body, ct, hdrs, response)

256 return (status_code, body, ct, hdrs, response)

255

257

256−performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req

258+performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req

257 -> ClientM ([HTTP.Header], result)

259 -> ClientM ([HTTP.Header], result)

258performRequestCT ct reqMethod req = do

260performRequestCT ct reqMethod req = do

259 let acceptCTS = contentTypes ct

261 let acceptCTS = contentTypes ct