git.iko.soy/typeable/servant
on master help sign in
Merge pull request #878 from phadej/issue-835-link-double-escape
ddbf169Oleg Grenrus
servant/src/Servant/Utils/Links.hs+27−7
compare with master
unifiedsplit
@@ -127,12 +127,24 @@ import Servant.API.Experimental.Auth ( AuthProtect )
127-- The only way of constructing a 'Link' is using 'safeLink', which means any
127-- The only way of constructing a 'Link' is using 'safeLink', which means any
128-- 'Link' is guaranteed to be part of the mentioned API.
128-- 'Link' is guaranteed to be part of the mentioned API.
129data Link = Link
129data Link = Link
130− { _segments :: [String] -- ^ Segments of "foo/bar" would be ["foo", "bar"]
130+ { _segments :: [Escaped]
131 , _queryParams :: [Param]
131 , _queryParams :: [Param]
132 } deriving Show
132 } deriving Show
133
133
134+newtype Escaped = Escaped String
135+
136+escaped :: String -> Escaped
137+escaped = Escaped . escapeURIString isUnreserved
138+
139+getEscaped :: Escaped -> String
140+getEscaped (Escaped s) = s
141+
142+instance Show Escaped where
143+ showsPrec d (Escaped s) = showsPrec d s
144+ show (Escaped s) = show s
145+
134linkSegments :: Link -> [String]
146linkSegments :: Link -> [String]
135−linkSegments = _segments
147+linkSegments = map getEscaped . _segments
136
148
137linkQueryParams :: Link -> [Param]
149linkQueryParams :: Link -> [Param]
138linkQueryParams = _queryParams
150linkQueryParams = _queryParams
@@ -150,7 +162,7 @@ data Param
150 | FlagParam String
162 | FlagParam String
151 deriving Show
163 deriving Show
152
164
153−addSegment :: String -> Link -> Link
165+addSegment :: Escaped -> Link -> Link
154addSegment seg l = l { _segments = _segments l <> [seg] }
166addSegment seg l = l { _segments = _segments l <> [seg] }
155
167
156addQueryParam :: Param -> Link -> Link
168addQueryParam :: Param -> Link -> Link
@@ -171,6 +183,14 @@ addQueryParam qp l =
171-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
183-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
172-- foo%2Fbar
184-- foo%2Fbar
173--
185--
186+-- >>> type SomeRoute = "abc" :> Capture "email" String :> Put '[JSON] ()
187+-- >>> let someRoute = Proxy :: Proxy SomeRoute
188+-- >>> safeLink someRoute someRoute "test@example.com"
189+-- Link {_segments = ["abc","test%40example.com"], _queryParams = []}
190+--
191+-- >>> linkURI $ safeLink someRoute someRoute "test@example.com"
192+-- abc/test%40example.com
193+--
174linkURI :: Link -> URI
194linkURI :: Link -> URI
175linkURI = linkURI' LinkArrayElementBracket
195linkURI = linkURI' LinkArrayElementBracket
176
196
@@ -193,7 +213,7 @@ linkURI' :: LinkArrayElementStyle -> Link -> URI
193linkURI' addBrackets (Link segments q_params) =
213linkURI' addBrackets (Link segments q_params) =
194 URI mempty -- No scheme (relative)
214 URI mempty -- No scheme (relative)
195 Nothing -- Or authority (relative)
215 Nothing -- Or authority (relative)
196− (intercalate "/" $ map escape segments)
216+ (intercalate "/" $ map getEscaped segments)
197 (makeQueries q_params) mempty
217 (makeQueries q_params) mempty
198 where
218 where
199 makeQueries :: [Param] -> String
219 makeQueries :: [Param] -> String
@@ -258,7 +278,7 @@ class HasLink endpoint where
258instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
278instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
259 type MkLink (sym :> sub) = MkLink sub
279 type MkLink (sym :> sub) = MkLink sub
260 toLink _ =
280 toLink _ =
261− toLink (Proxy :: Proxy sub) . addSegment seg
281+ toLink (Proxy :: Proxy sub) . addSegment (escaped seg)
262 where
282 where
263 seg = symbolVal (Proxy :: Proxy sym)
283 seg = symbolVal (Proxy :: Proxy sym)
264
284
@@ -308,14 +328,14 @@ instance (ToHttpApiData v, HasLink sub)
308 type MkLink (Capture sym v :> sub) = v -> MkLink sub
328 type MkLink (Capture sym v :> sub) = v -> MkLink sub
309 toLink _ l v =
329 toLink _ l v =
310 toLink (Proxy :: Proxy sub) $
330 toLink (Proxy :: Proxy sub) $
311− addSegment (escape . Text.unpack $ toUrlPiece v) l
331+ addSegment (escaped . Text.unpack $ toUrlPiece v) l
312
332
313instance (ToHttpApiData v, HasLink sub)
333instance (ToHttpApiData v, HasLink sub)
314 => HasLink (CaptureAll sym v :> sub) where
334 => HasLink (CaptureAll sym v :> sub) where
315 type MkLink (CaptureAll sym v :> sub) = [v] -> MkLink sub
335 type MkLink (CaptureAll sym v :> sub) = [v] -> MkLink sub
316 toLink _ l vs =
336 toLink _ l vs =
317 toLink (Proxy :: Proxy sub) $
337 toLink (Proxy :: Proxy sub) $
318− foldl' (flip $ addSegment . escape . Text.unpack . toUrlPiece) l vs
338+ foldl' (flip $ addSegment . escaped . Text.unpack . toUrlPiece) l vs
319
339
320instance HasLink sub => HasLink (Header sym a :> sub) where
340instance HasLink sub => HasLink (Header sym a :> sub) where
321 type MkLink (Header sym a :> sub) = MkLink sub
341 type MkLink (Header sym a :> sub) = MkLink sub