eeva/servant
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Merge pull request #878 from phadej/issue-835-link-double-escape

Browse Source 
Fix #835. Use Escaped to prevent double-escaping
This commit is contained in:
Oleg Grenrus 2017-12-18 19:51:55 +02:00 committed by GitHub
commit ddbf169909
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 27 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
servant/src/Servant/Utils/Links.hs
View File

@ -127,12 +127,24 @@ import Servant.API.Experimental.Auth ( AuthProtect )
-- The only way of constructing a 'Link' is using 'safeLink', which means any
-- 'Link' is guaranteed to be part of the mentioned API.
data Link = Link
{ _segments :: [String] -- ^ Segments of "foo/bar" would be ["foo", "bar"]
{ _segments :: [Escaped]
, _queryParams :: [Param]
} deriving Show
newtype Escaped = Escaped String
escaped :: String -> Escaped
escaped = Escaped . escapeURIString isUnreserved
getEscaped :: Escaped -> String
getEscaped (Escaped s) = s
instance Show Escaped where
showsPrec d (Escaped s) = showsPrec d s
show (Escaped s) = show s
linkSegments :: Link -> [String]
linkSegments = _segments
linkSegments = map getEscaped . _segments
linkQueryParams :: Link -> [Param]
linkQueryParams = _queryParams
@ -150,7 +162,7 @@ data Param
| FlagParam String
deriving Show
addSegment :: String -> Link -> Link
addSegment :: Escaped -> Link -> Link
addSegment seg l = l { _segments = _segments l <> [seg] }
addQueryParam :: Param -> Link -> Link
@ -171,6 +183,14 @@ addQueryParam qp l =
-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
-- foo%2Fbar
--
-- >>> type SomeRoute = "abc" :> Capture "email" String :> Put '[JSON] ()
-- >>> let someRoute = Proxy :: Proxy SomeRoute
-- >>> safeLink someRoute someRoute "test@example.com"
-- Link {_segments = ["abc","test%40example.com"], _queryParams = []}
--
-- >>> linkURI $ safeLink someRoute someRoute "test@example.com"
-- abc/test%40example.com
--
linkURI :: Link -> URI
linkURI = linkURI' LinkArrayElementBracket
@ -193,7 +213,7 @@ linkURI' :: LinkArrayElementStyle -> Link -> URI
linkURI' addBrackets (Link segments q_params) =
URI mempty -- No scheme (relative)
Nothing -- Or authority (relative)
(intercalate "/" $ map escape segments)
(intercalate "/" $ map getEscaped segments)
(makeQueries q_params) mempty
where
makeQueries :: [Param] -> String
@ -258,7 +278,7 @@ class HasLink endpoint where
instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
type MkLink (sym :> sub) = MkLink sub
toLink _ =
toLink (Proxy :: Proxy sub) . addSegment seg
toLink (Proxy :: Proxy sub) . addSegment (escaped seg)
where
seg = symbolVal (Proxy :: Proxy sym)
@ -308,14 +328,14 @@ instance (ToHttpApiData v, HasLink sub)
type MkLink (Capture sym v :> sub) = v -> MkLink sub
toLink _ l v =
toLink (Proxy :: Proxy sub) $
addSegment (escape . Text.unpack $ toUrlPiece v) l
addSegment (escaped . Text.unpack $ toUrlPiece v) l
instance (ToHttpApiData v, HasLink sub)
=> HasLink (CaptureAll sym v :> sub) where
type MkLink (CaptureAll sym v :> sub) = [v] -> MkLink sub
toLink _ l vs =
toLink (Proxy :: Proxy sub) $
foldl' (flip $ addSegment . escape . Text.unpack . toUrlPiece) l vs
foldl' (flip $ addSegment . escaped . Text.unpack . toUrlPiece) l vs
instance HasLink sub => HasLink (Header sym a :> sub) where
type MkLink (Header sym a :> sub) = MkLink sub