servant 0.12 → 0.12.1
raw patch · 3 files changed
+39/−10 lines, 3 files
Files
- CHANGELOG.md +10/−1
- servant.cabal +2/−2
- src/Servant/Utils/Links.hs +27/−7
CHANGELOG.md view
@@ -1,5 +1,14 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +0.12.1+------++### Bug fixes++- Prevent double-escaping in link segments+ ([#835](https://github.com/haskell-servant/servant/issues/835)+ [#878](https://github.com/haskell-servant/servant/pull/878))+ 0.12 --- @@ -59,7 +68,7 @@ - Lower `:>` and `:<|>` infix precedence to 4 and 3 respectively ([#761](https://github.com/haskell-servant/servant/issues/761)) - This should affect you, except if you define your own infix operators+ This shouldn't affect you, except if you define your own infix operators for Servant type-level DSL. ### Other changes
servant.cabal view
@@ -1,5 +1,5 @@ name: servant-version: 0.12+version: 0.12.1 synopsis: A family of combinators for defining webservices APIs description: A family of combinators for defining webservices APIs and serving them@@ -70,7 +70,7 @@ , case-insensitive >= 1.2 && < 1.3 , http-api-data >= 0.3 && < 0.4 , http-media >= 0.4 && < 0.8- , http-types >= 0.8 && < 0.11+ , http-types >= 0.8 && < 0.12 , natural-transformation >= 0.4 && < 0.5 , mtl >= 2.0 && < 2.3 , mmorph >= 1 && < 1.2
src/Servant/Utils/Links.hs view
@@ -126,12 +126,24 @@ -- 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@@ -149,7 +161,7 @@ | FlagParam String deriving Show -addSegment :: String -> Link -> Link+addSegment :: Escaped -> Link -> Link addSegment seg l = l { _segments = _segments l <> [seg] } addQueryParam :: Param -> Link -> Link@@ -170,6 +182,14 @@ -- >>> 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 @@ -192,7 +212,7 @@ 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@@ -257,7 +277,7 @@ 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) @@ -307,14 +327,14 @@ 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