Update changelog

release 0.12: allow http-types-0.11

.travis.yml

@@ -10,6 +10,11 @@ sudo: false
 git:
   submodules: false  # whether to recursively clone submodules
 
+branches:
+  only:
+    - master
+    - release-0.12
+
 cache:
   directories:
     - $HOME/.cabal/packages

servant-client-core/servant-client-core.cabal

@@ -1,5 +1,6 @@
 name:                servant-client-core
 version:             0.12
+x-revision:          1
 synopsis:            Core functionality and class for client function generation for servant APIs
 description:
   This library provides backend-agnostic generation of client functions. For
@@ -49,7 +50,7 @@ library
     , generics-sop          >= 0.1.0.0  && < 0.4
     , http-api-data         >= 0.3.6    && < 0.4
     , http-media            >= 0.6.2    && < 0.8
-    , http-types            >= 0.8.6    && < 0.11
+    , http-types            >= 0.8.6    && < 0.12
     , mtl                   >= 2.1      && < 2.3
     , network-uri           >= 2.6      && < 2.7
     , safe                  >= 0.3.9    && < 0.4

servant-client/CHANGELOG.md

@@ -1,6 +1,12 @@
 [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md)
 [Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
 
+0.12.0.1
+--------
+
+- Send `Accept` header.
+  ([#858](https://github.com/haskell-servant/servant/issues/858))
+
 0.12
 ----
 

servant-client/servant-client.cabal

@@ -1,5 +1,6 @@
 name:                servant-client
-version:             0.12
+version:             0.12.0.1
+x-revision:          1
 synopsis: automatical derivation of querying functions for servant webservices
 description:
   This library lets you derive automatically Haskell functions that
@@ -45,7 +46,7 @@ library
     , http-client           >= 0.4.30   && < 0.6
     , http-client-tls       >= 0.2.2    && < 0.4
     , http-media            >= 0.6.2    && < 0.8
-    , http-types            >= 0.8.6    && < 0.11
+    , http-types            >= 0.8.6    && < 0.12
     , exceptions            >= 0.8      && < 0.9
     , monad-control         >= 1.0.0.4  && < 1.1
     , mtl                   >= 2.1      && < 2.3

servant-client/src/Servant/Client/Internal/HttpClient.hs

@@ -28,6 +28,7 @@ import           Data.ByteString.Builder     (toLazyByteString)
 import qualified Data.ByteString.Lazy        as BSL
 import           Data.Foldable               (toList)
 import           Data.Functor.Alt            (Alt (..))
+import           Data.Maybe                  (maybeToList)
 import           Data.Monoid                 ((<>))
 import           Data.Proxy                  (Proxy (..))
 import           Data.Sequence               (fromList)
@@ -133,16 +134,26 @@ requestToClientRequest burl r = Client.defaultRequest
                <> toLazyByteString (requestPath r)
   , Client.queryString = renderQuery True . toList $ requestQueryString r
   , Client.requestHeaders =
-      let orig = toList $ requestHeaders r
+    maybeToList acceptHdr ++ maybeToList contentTypeHdr ++ headers
-      in maybe orig (: orig) contentTypeHdr
   , Client.requestBody = body
   , Client.secure = isSecure
   }
   where
+    -- Content-Type and Accept are specified by requestBody and requestAccept
+    headers = filter (\(h, _) -> h /= "Accept" && h /= "Content-Type") $
+        toList $requestHeaders r
+
+    acceptHdr
+        | null hs   = Nothing
+        | otherwise = Just ("Accept", renderHeader hs)
+      where
+        hs = toList $ requestAccept r
+
     (body, contentTypeHdr) = case requestBody r of
       Nothing -> (Client.RequestBodyLBS "", Nothing)
       Just (RequestBodyLBS body', typ)
         -> (Client.RequestBodyLBS body', Just (hContentType, renderHeader typ))
+
     isSecure = case baseUrlScheme burl of
       Http -> False
       Https -> True

servant-server/servant-server.cabal

@@ -1,5 +1,6 @@
 name:                servant-server
 version:             0.12
+x-revision:          1
 synopsis:            A family of combinators for defining webservices APIs and serving them
 description:
   A family of combinators for defining webservices APIs and serving them
@@ -64,7 +65,7 @@ library
       , containers         >= 0.5  && < 0.6
       , exceptions         >= 0.8  && < 0.9
       , http-api-data      >= 0.3  && < 0.4
-      , http-types         >= 0.8  && < 0.11
+      , http-types         >= 0.8  && < 0.12
       , network-uri        >= 2.6  && < 2.7
       , monad-control      >= 1.0.0.4 && < 1.1
       , mtl                >= 2    && < 2.3
@@ -136,7 +137,7 @@ test-suite spec
     , directory
     , exceptions
     , hspec == 2.*
-    , hspec-wai >= 0.8 && <0.9
+    , hspec-wai >= 0.8 && <0.10
     , http-types
     , mtl
     , network >= 2.6

servant/CHANGELOG.md

@@ -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/servant.cabal

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

servant/src/Servant/Utils/Links.hs

@@ -126,12 +126,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
@@ -149,7 +161,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
@@ -170,6 +182,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
 
@@ -192,7 +212,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
@@ -257,7 +277,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)
 
@@ -307,14 +327,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