@@ -127,12 +127,24 @@ import Servant.API.Experimental.Auth ( AuthProtect )
127127-- The only way of constructing a 'Link' is using 'safeLink', which means any
128128-- 'Link' is guaranteed to be part of the mentioned API.
129129data Link = Link
130− { _segments :: [String] -- ^ Segments of "foo/bar" would be ["foo", "bar"]
130+ { _segments :: [Escaped]
131131 , _queryParams :: [Param]
132132 } deriving Show
133133
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+
134146linkSegments :: Link -> [String]
135−linkSegments = _segments
147+linkSegments = map getEscaped . _segments
136148
137149linkQueryParams :: Link -> [Param]
138150linkQueryParams = _queryParams
@@ -150,7 +162,7 @@ data Param
150162 | FlagParam String
151163 deriving Show
152164
153−addSegment :: String -> Link -> Link
165+addSegment :: Escaped -> Link -> Link
154166addSegment seg l = l { _segments = _segments l <> [seg] }
155167
156168addQueryParam :: Param -> Link -> Link
@@ -171,6 +183,14 @@ addQueryParam qp l =
171183-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
172184-- foo%2Fbar
173185--
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+--
174194linkURI :: Link -> URI
175195linkURI = linkURI' LinkArrayElementBracket
176196
@@ -193,7 +213,7 @@ linkURI' :: LinkArrayElementStyle -> Link -> URI
193213linkURI' addBrackets (Link segments q_params) =
194214 URI mempty -- No scheme (relative)
195215 Nothing -- Or authority (relative)
196− (intercalate "/" $ map escape segments)
216+ (intercalate "/" $ map getEscaped segments)
197217 (makeQueries q_params) mempty
198218 where
199219 makeQueries :: [Param] -> String
@@ -258,7 +278,7 @@ class HasLink endpoint where
258278instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
259279 type MkLink (sym :> sub) = MkLink sub
260280 toLink _ =
261− toLink (Proxy :: Proxy sub) . addSegment seg
281+ toLink (Proxy :: Proxy sub) . addSegment (escaped seg)
262282 where
263283 seg = symbolVal (Proxy :: Proxy sym)
264284
@@ -308,14 +328,14 @@ instance (ToHttpApiData v, HasLink sub)
308328 type MkLink (Capture sym v :> sub) = v -> MkLink sub
309329 toLink _ l v =
310330 toLink (Proxy :: Proxy sub) $
311− addSegment (escape . Text.unpack $ toUrlPiece v) l
331+ addSegment (escaped . Text.unpack $ toUrlPiece v) l
312332
313333instance (ToHttpApiData v, HasLink sub)
314334 => HasLink (CaptureAll sym v :> sub) where
315335 type MkLink (CaptureAll sym v :> sub) = [v] -> MkLink sub
316336 toLink _ l vs =
317337 toLink (Proxy :: Proxy sub) $
318− foldl' (flip $ addSegment . escape . Text.unpack . toUrlPiece) l vs
338+ foldl' (flip $ addSegment . escaped . Text.unpack . toUrlPiece) l vs
319339
320340instance HasLink sub => HasLink (Header sym a :> sub) where
321341 type MkLink (Header sym a :> sub) = MkLink sub