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
This commit is contained in:
Edsko de Vries 2017-02-07 16:51:56 +01:00
parent 8a3ecb2ebc
commit 507f021919

View file

@ -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