diff --git a/servant-client/src/Servant/Common/Req.hs b/servant-client/src/Servant/Common/Req.hs index f3de9687..d4795eb5 100644 --- a/servant-client/src/Servant/Common/Req.hs +++ b/servant-client/src/Servant/Common/Req.hs @@ -27,6 +27,7 @@ import Control.Monad.Base (MonadBase (..)) import Control.Monad.IO.Class () import Control.Monad.Reader import Control.Monad.Trans.Control (MonadBaseControl (..)) +import qualified Data.ByteString.Builder as BS import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any) import Data.String import Data.String.Conversions (cs) @@ -86,7 +87,7 @@ instance Eq ServantError where instance Exception ServantError data Req = Req - { reqPath :: String + { reqPath :: BS.Builder , qs :: QueryText , reqBody :: Maybe (RequestBody, MediaType) , reqAccept :: [MediaType] @@ -98,7 +99,7 @@ defReq = Req "" [] Nothing [] [] appendToPath :: String -> Req -> Req appendToPath p req = - req { reqPath = reqPath req ++ "/" ++ p } + req { reqPath = reqPath req <> "/" <> toEncodedUrlPiece p } appendToQueryString :: Text -- ^ param name -> Maybe Text -- ^ param value @@ -151,8 +152,9 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) = , uriRegName = reqHost , uriPort = ":" ++ show reqPort } - , uriPath = path ++ reqPath req + , uriPath = fullPath } + fullPath = path ++ cs (BS.toLazyByteString (reqPath req)) setrqb r = case reqBody req of Nothing -> r @@ -224,7 +226,7 @@ runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a) runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm -performRequest :: Method -> Req +performRequest :: Method -> Req -> ClientM ( Int, ByteString, MediaType , [HTTP.Header], Response ByteString) performRequest reqMethod req = do @@ -253,7 +255,7 @@ performRequest reqMethod req = do throwError $ FailureResponse status ct body return (status_code, body, ct, hdrs, response) -performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req +performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req -> ClientM ([HTTP.Header], result) performRequestCT ct reqMethod req = do let acceptCTS = contentTypes ct