Merge pull request #696 from edsko/pr/escape-capture

Make sure path components get escaped
This commit is contained in:
Oleg Grenrus 2017-05-14 21:01:53 +03:00 committed by GitHub
commit 018a38cc93

View file

@ -27,6 +27,7 @@ import Control.Monad.Base (MonadBase (..))
import Control.Monad.IO.Class () import Control.Monad.IO.Class ()
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Control (MonadBaseControl (..)) 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.ByteString.Lazy hiding (pack, filter, map, null, elem, any)
import Data.String import Data.String
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
@ -86,7 +87,7 @@ instance Eq ServantError where
instance Exception ServantError instance Exception ServantError
data Req = Req data Req = Req
{ reqPath :: String { reqPath :: BS.Builder
, qs :: QueryText , qs :: QueryText
, reqBody :: Maybe (RequestBody, MediaType) , reqBody :: Maybe (RequestBody, MediaType)
, reqAccept :: [MediaType] , reqAccept :: [MediaType]
@ -98,7 +99,7 @@ defReq = Req "" [] Nothing [] []
appendToPath :: String -> Req -> Req appendToPath :: String -> Req -> Req
appendToPath p req = appendToPath p req =
req { reqPath = reqPath req ++ "/" ++ p } req { reqPath = reqPath req <> "/" <> toEncodedUrlPiece p }
appendToQueryString :: Text -- ^ param name appendToQueryString :: Text -- ^ param name
-> Maybe Text -- ^ param value -> Maybe Text -- ^ param value
@ -151,8 +152,9 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
, uriRegName = reqHost , uriRegName = reqHost
, uriPort = ":" ++ show reqPort , uriPort = ":" ++ show reqPort
} }
, uriPath = path ++ reqPath req , uriPath = fullPath
} }
fullPath = path ++ cs (BS.toLazyByteString (reqPath req))
setrqb r = case reqBody req of setrqb r = case reqBody req of
Nothing -> r Nothing -> r