Remove allow-newer for postgresql-simple

Upstream has released updated versions.

.github/workflows/master.yml

@@ -76,40 +76,40 @@ jobs:
         (cd servant-conduit && eval $DOCTEST)
         (cd servant-pipes && eval $DOCTEST)
 
-  # stack:
+  stack:
-  #   name: stack / ghc ${{ matrix.ghc }}
+    name: stack / ghc ${{ matrix.ghc }}
-  #   runs-on: ubuntu-latest
+    runs-on: ubuntu-latest
-  #   strategy:
+    strategy:
-  #     matrix:
+      matrix:
-  #       stack: ["2.7.5"]
+        stack: ["2.7.5"]
-  #       ghc: ["8.10.7"]
+        ghc: ["8.10.7"]
 
-  #   steps:
+    steps:
-  #   - uses: actions/checkout@v2
+    - uses: actions/checkout@v2
 
-  #   - uses: haskell/actions/setup@v1
+    - uses: haskell/actions/setup@v1
-  #     name: Setup Haskell Stack
+      name: Setup Haskell Stack
-  #     with:
+      with:
-  #       ghc-version: ${{ matrix.ghc }}
+        ghc-version: ${{ matrix.ghc }}
-  #       stack-version: ${{ matrix.stack }}
+        stack-version: ${{ matrix.stack }}
 
-  #   - uses: actions/cache@v2.1.3
+    - uses: actions/cache@v2.1.3
-  #     name: Cache ~/.stack
+      name: Cache ~/.stack
-  #     with:
+      with:
-  #       path: ~/.stack
+        path: ~/.stack
-  #       key: ${{ runner.os }}-${{ matrix.ghc }}-stack
+        key: ${{ runner.os }}-${{ matrix.ghc }}-stack
 
-  #   - name: Install dependencies
+    - name: Install dependencies
-  #     run: |
+      run: |
-  #       stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --only-dependencies
+        stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --only-dependencies
 
-  #   - name: Build
+    - name: Build
-  #     run: |
+      run: |
-  #       stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks
+        stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks
 
-  #   - name: Test
+    - name: Test
-  #     run: |
+      run: |
-  #       stack test --system-ghc
+        stack test --system-ghc
 
   ghcjs:
     name: ubuntu-latest / ghcjs 8.6

cabal.project

@@ -47,7 +47,6 @@ packages:
   doc/cookbook/using-custom-monad
   doc/cookbook/using-free-client
   -- doc/cookbook/open-id-connect
-  doc/cookbook/managed-resource
 
 tests: True
 optimization: False

changelog.d/1573

@@ -1,2 +0,0 @@
-synopsis: Add API docs for ServerT
-prs: #1573

changelog.d/1606

@@ -1,10 +0,0 @@
-synopsis: Handle Cookies correctly for RunStreamingClient
-prs: #1606
-issues: #1605
-
-description: {
-
-Makes performWithStreamingRequest take into consideration the
-CookieJar, which it previously didn't.
-
-}

changelog.d/1638

@@ -1,2 +0,0 @@
-synopsis: Add Functor instance to AuthHandler.
-prs: #1638

changelog.d/1649

@@ -1,8 +0,0 @@
-synopsis: Add HasStatus instance for Headers (that defers StatusOf to underlying value)
-prs: #1649
-
-description: {
-
-Adds a new HasStatus (Headers hs a) instance (StatusOf (Headers hs a) = StatusOf a)
-
-}

doc/cookbook/index.rst

@@ -37,4 +37,3 @@ you name it!
   sentry/Sentry.lhs
   testing/Testing.lhs
   open-id-connect/OpenIdConnect.lhs
-  managed-resource/ManagedResource.lhs

doc/cookbook/managed-resource/ManagedResource.lhs

@@ -1,114 +0,0 @@
-# Request-lifetime Managed Resources
-
-Let's see how we can write a handle that uses a resource managed by Servant. The resource is created automatically by Servant when the server recieves a request, and the resource is automatically destroyed when the server is finished handling a request.
-
-As usual, we start with a little bit of throat clearing.
-
-
-``` haskell
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeOperators #-}
-import Control.Concurrent
-import Control.Exception (bracket, throwIO)
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Resource
-import Data.Acquire
-import Network.HTTP.Client (newManager, defaultManagerSettings)
-import Network.Wai.Handler.Warp
-import Servant
-import Servant.Client
-import System.IO
-```
-
-Here we define an API type that uses the `WithResource` combinator. The server handler for an endpoint with a `WithResource res` component will receive a value of that type as an argument.
-
-``` haskell
-type API = WithResource Handle :> ReqBody '[PlainText] String :> Post '[JSON] NoContent
-
-api :: Proxy API
-api = Proxy
-```
-
-But this resource value has to come from somewhere. Servant obtains the value using an Acquire provided in the context. The Acquire knows how to both create and destroy resources of a particular type.
-
-``` haskell
-appContext :: Context '[Acquire Handle]
-appContext = acquireHandle :. EmptyContext
-
-acquireHandle :: Acquire Handle
-acquireHandle = mkAcquire newHandle closeHandle
-
-newHandle :: IO Handle
-newHandle = do
-  putStrLn "opening file"
-  h <- openFile "test.txt" AppendMode
-  putStrLn "opened file"
-  return h
-
-closeHandle :: Handle -> IO ()
-closeHandle h = do
-  putStrLn "closing file"
-  hClose h
-  putStrLn "closed file"
-```
-
-Now we create the handler which will use this resource. This handler will write the request message to the System.IO.Handle which was provided to us. In some situations the handler will succeed, but in some in will fail. In either case, Servant will clean up the resource for us.
-
-``` haskell
-server :: Server API
-server = writeToFile
-
-  where writeToFile :: (ReleaseKey, Handle) -> String -> Handler NoContent
-        writeToFile (_, h) msg = case msg of
-          "illegal" -> error "wait, that's illegal!"
-          legalMsg -> liftIO $ do
-            putStrLn "writing file"
-            hPutStrLn h legalMsg
-            putStrLn "wrote file"
-            return NoContent
-```
-
-Finally we run the server in the background while we post messages to it.
-
-``` haskell
-runApp :: IO ()
-runApp = run 8080 (serveWithContext api appContext $ server)
-
-postMsg :: String -> ClientM NoContent
-postMsg = client api
-
-main :: IO ()
-main = do
-  mgr <- newManager defaultManagerSettings
-  bracket (forkIO $ runApp) killThread $ \_ -> do
-    ms <- flip runClientM (mkClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do
-      liftIO $ putStrLn "sending hello message"
-      _ <- postMsg "hello"
-      liftIO $ putStrLn "sending illegal message"
-      _ <- postMsg "illegal"
-      liftIO $ putStrLn "done"
-    print ms
-```
-
-This program prints
-
-```
-sending hello message
-opening file
-opened file
-writing file
-wrote file
-closing file
-closed file
-sending illegal message
-opening file
-opened file
-closing file
-closed file
-wait, that's illegal!
-CallStack (from HasCallStack):
-  error, called at ManagedResource.lhs:63:24 in main:Main
-Left (FailureResponse (Request {requestPath = (BaseUrl {baseUrlScheme = Http, baseUrlHost = "localhost", baseUrlPort = 8080, baseUrlPath = ""},""), requestQueryString = fromList [], requestBody = Just ((),text/plain;charset=utf-8), requestAccept = fromList [], requestHeaders = fromList [], requestHttpVersion = HTTP/1.1, requestMethod = "POST"}) (Response {responseStatusCode = Status {statusCode = 500, statusMessage = "Internal Server Error"}, responseHeaders = fromList [("Transfer-Encoding","chunked"),("Date","Thu, 24 Nov 2022 21:04:47 GMT"),("Server","Warp/3.3.23"),("Content-Type","text/plain; charset=utf-8")], responseHttpVersion = HTTP/1.1, responseBody = "Something went wrong"}))
-```
-
-and appends to a file called `test.txt`. We can see from the output that when a legal message is sent, the file is opened, written to, and closed. We can also see that when an illegal message is sent, the file is opened but not written to. Crucially, it is still closed even though the handler threw an exception.

doc/cookbook/managed-resource/managed-resource.cabal

@@ -1,30 +0,0 @@
-cabal-version:       2.2
-name:                cookbook-managed-resource
-version:             0.1
-synopsis:            Simple managed resource cookbook example
-homepage:            http://docs.servant.dev/
-license:             BSD-3-Clause
-license-file:        ../../../servant/LICENSE
-author:              Servant Contributors
-maintainer:          haskell-servant-maintainers@googlegroups.com
-build-type:          Simple
-tested-with:         GHC==9.4.2
-
-executable cookbook-managed-resource
-  main-is:             ManagedResource.lhs
-  build-depends:       base == 4.*
-                     , text >= 1.2
-                     , aeson >= 1.2
-                     , servant
-                     , servant-client
-                     , servant-server
-                     , warp >= 3.2
-                     , wai >= 3.2
-                     , http-types >= 0.12
-                     , markdown-unlit >= 0.4
-                     , http-client >= 0.5
-                     , transformers
-                     , resourcet
-  default-language:    Haskell2010
-  ghc-options:         -Wall -pgmL markdown-unlit
-  build-tool-depends: markdown-unlit:markdown-unlit

doc/cookbook/open-id-connect/OpenIdConnect.lhs

@@ -330,7 +330,7 @@ data Customer = Customer {
 ```
 
 Here is the code that displays the homepage.
-It should contain a link to the `/login` URL.
+It should contain a link to the the `/login` URL.
 When the user clicks on this link it will be redirected to Google login page
 with some generated information.
 

doc/cookbook/uverb/UVerb.lhs

@@ -199,7 +199,7 @@ parsers in the hope that the ones that should will always error out so
 you can try until the right one returns a value.)
 
 [servant-exceptions](https://github.com/ch1bo/servant-exceptions) is
-another shot at the problem.  It is inspired by
+another shot at at the problem.  It is inspired by
 servant-checked-exceptions, so it may be worth taking a closer look.
 The README claims that
 [cardano-sl](https://github.com/input-output-hk/cardano-sl) also has

doc/requirements.txt

@@ -1,4 +1,3 @@
 recommonmark==0.5.0
 Sphinx==1.8.4
 sphinx_rtd_theme>=0.4.2
-jinja2<3.1.0

servant-auth/servant-auth-client/servant-auth-client.cabal

@@ -74,7 +74,7 @@ test-suite spec
     , transformers         >= 0.4.2.0  && < 0.6
     , wai                  >= 3.2.1.2  && < 3.3
     , warp                 >= 3.2.25   && < 3.4
-    , jose                 >= 0.10     && < 0.11
+    , jose                 >= 0.7.0.0  && < 0.10
   other-modules:
       Servant.Auth.ClientSpec
   default-language: Haskell2010

servant-auth/servant-auth-server/servant-auth-server.cabal

@@ -41,11 +41,11 @@ library
     , data-default-class      >= 0.1.2.0  && < 0.2
     , entropy                 >= 0.4.1.3  && < 0.5
     , http-types              >= 0.12.2   && < 0.13
-    , jose                    >= 0.10     && < 0.11
+    , jose                    >= 0.7.0.0  && < 0.10
     , lens                    >= 4.16.1   && < 5.3
     , memory                  >= 0.14.16  && < 0.19
     , monad-time              >= 0.3.1.0  && < 0.4
-    , mtl                     ^>= 2.2.2   || ^>= 2.3.1
+    , mtl                     >= 2.2.2    && < 2.3
     , servant                 >= 0.13     && < 0.20
     , servant-auth            == 0.4.*
     , servant-server          >= 0.13     && < 0.20

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Cookie.hs

@@ -2,7 +2,6 @@
 module Servant.Auth.Server.Internal.Cookie where
 
 import           Blaze.ByteString.Builder (toByteString)
-import           Control.Monad (MonadPlus(..), guard)
 import           Control.Monad.Except
 import           Control.Monad.Reader
 import qualified Crypto.JOSE              as Jose

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs

@@ -1,14 +1,18 @@
 module Servant.Auth.Server.Internal.JWT where
 
 import           Control.Lens
-import           Control.Monad (MonadPlus(..), guard)
+import           Control.Monad.Except
 import           Control.Monad.Reader
 import qualified Crypto.JOSE          as Jose
 import qualified Crypto.JWT           as Jose
+import           Data.Aeson           (FromJSON, Result (..), ToJSON, fromJSON,
+                                       toJSON)
 import           Data.ByteArray       (constEq)
 import qualified Data.ByteString      as BS
 import qualified Data.ByteString.Lazy as BSL
+import qualified Data.HashMap.Strict  as HM
 import           Data.Maybe           (fromMaybe)
+import qualified Data.Text            as T
 import           Data.Time            (UTCTime)
 import           Network.Wai          (requestHeaders)
 
@@ -38,7 +42,7 @@ jwtAuthCheck jwtSettings = do
 -- token expires.
 makeJWT :: ToJWT a
   => a -> JWTSettings -> Maybe UTCTime -> IO (Either Jose.Error BSL.ByteString)
-makeJWT v cfg expiry = Jose.runJOSE $ do
+makeJWT v cfg expiry = runExceptT $ do
   bestAlg <- Jose.bestJWSAlg $ signingKey cfg
   let alg = fromMaybe bestAlg $ jwtAlg cfg
   ejwt <- Jose.signClaims (signingKey cfg)
@@ -55,7 +59,7 @@ makeJWT v cfg expiry = Jose.runJOSE $ do
 verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a)
 verifyJWT jwtCfg input = do
   keys <- validationKeys jwtCfg
-  verifiedJWT <- Jose.runJOSE $ do
+  verifiedJWT <- runExceptT $ do
     unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)
     Jose.verifyClaims
       (jwtSettingsToJwtValidationSettings jwtCfg)

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Types.hs

@@ -2,7 +2,6 @@
 module Servant.Auth.Server.Internal.Types where
 
 import Control.Applicative
-import Control.Monad        (MonadPlus(..), ap)
 import Control.Monad.Reader
 import Control.Monad.Time
 import Data.Monoid          (Monoid (..))

servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs

@@ -6,12 +6,13 @@ module Servant.Auth.ServerSpec (spec) where
 #endif
 
 import           Control.Lens
+import           Control.Monad.Except                (runExceptT)
 import           Control.Monad.IO.Class              (liftIO)
 import           Crypto.JOSE                         (Alg (HS256, None), Error,
                                                       JWK, JWSHeader,
                                                       KeyMaterialGenParam (OctGenParam),
                                                       ToCompact, encodeCompact,
-                                                      genJWK, newJWSHeader, runJOSE)
+                                                      genJWK, newJWSHeader)
 import           Crypto.JWT                          (Audience (..), ClaimsSet,
                                                       NumericDate (NumericDate),
                                                       SignedJWT,
@@ -539,7 +540,7 @@ addJwtToHeader jwt = case jwt of
     $ defaults & header "Authorization" .~ ["Bearer " <> BSL.toStrict v]
 
 createJWT :: JWK -> JWSHeader () -> ClaimsSet -> IO (Either Error Crypto.JWT.SignedJWT)
-createJWT k a b = runJOSE $ signClaims k a b
+createJWT k a b = runExceptT $ signClaims k a b
 
 addJwtToCookie :: ToCompact a => CookieSettings -> Either Error a -> IO Options
 addJwtToCookie ccfg jwt = case jwt >>= (return . encodeCompact) of

servant-auth/servant-auth/servant-auth.cabal

@@ -36,7 +36,7 @@ library
       base                    >= 4.10     && < 4.18
     , containers              >= 0.6      && < 0.7
     , aeson                   >= 1.3.1.1  && < 3
-    , jose                    >= 0.10     && < 0.11
+    , jose                    >= 0.7.0.0  && < 0.10
     , lens                    >= 4.16.1   && < 5.3
     , servant                 >= 0.15     && < 0.20
     , text                    >= 1.2.3.0  && < 2.1

servant-auth/servant-auth/src/Servant/Auth.hs

@@ -27,7 +27,7 @@ instance HasLink sub => HasLink (Auth (tag :: [*]) value :> sub) where
 
 -- ** Combinators
 
--- | A JSON Web Token (JWT) in the Authorization header:
+-- | A JSON Web Token (JWT) in the the Authorization header:
 --
 --    @Authorization: Bearer \<token\>@
 --

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

@@ -56,7 +56,7 @@ library
     , containers            >= 0.5.7.1  && < 0.7
     , deepseq               >= 1.4.2.0  && < 1.5
     , text                  >= 1.2.3.0  && < 2.1
-    , transformers          >= 0.5.2.0  && < 0.7
+    , transformers          >= 0.5.2.0  && < 0.6
     , template-haskell      >= 2.11.1.0 && < 2.20
 
   if !impl(ghc >= 8.2)

servant-client-core/src/Servant/Client/Core/HasClient.hs

@@ -77,7 +77,7 @@ import           Servant.API
                  NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw,
                  ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
                  StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,
-                 Verb, WithNamedContext, WithResource, WithStatus (..), contentType, getHeadersHList,
+                 Verb, WithNamedContext, WithStatus (..), contentType, getHeadersHList,
                  getResponse, toEncodedUrlPiece, toUrlPiece, NamedRoutes)
 import           Servant.API.Generic
                  (GenericMode(..), ToServant, ToServantApi
@@ -776,14 +776,6 @@ instance HasClient m subapi =>
 
   hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
 
-instance HasClient m subapi =>
-  HasClient m (WithResource res :> subapi) where
-
-  type Client m (WithResource res :> subapi) = Client m subapi
-  clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)
-
-  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
-
 instance ( HasClient m api
          ) => HasClient m (AuthProtect tag :> api) where
   type Client m (AuthProtect tag :> api)
@@ -902,7 +894,7 @@ infixl 2 /:
 -- rootClient = client api
 --
 -- endpointClient :: ClientM Person
--- endpointClient = client \/\/ subApi \/\/ endpoint
+-- endpointClient = client // subApi // endpoint
 -- @
 (//) :: a -> (a -> b) -> b
 x // f = f x
@@ -935,10 +927,10 @@ x // f = f x
 -- rootClient = client api
 --
 -- hello :: String -> ClientM String
--- hello name = rootClient \/\/ hello \/: name
+-- hello name = rootClient // hello /: name
 --
 -- endpointClient :: ClientM Person
--- endpointClient = client \/\/ subApi \/: "foobar123" \/\/ endpoint
+-- endpointClient = client // subApi /: "foobar123" // endpoint
 -- @
 (/:) :: (a -> b -> c) -> b -> a -> c
 (/:) = flip

servant-client-ghcjs/servant-client-ghcjs.cabal

@@ -48,7 +48,7 @@ library
     , http-media          >=0.6.2   && <0.9
     , http-types          >=0.12    && <0.13
     , monad-control       >=1.0.0.4 && <1.1
-    , mtl                 ^>=2.2.2  || ^>=2.3.1
+    , mtl                 >=2.2.2   && <2.3
     , semigroupoids       >=5.3     && <5.4
     , string-conversions  >=0.3     && <0.5
     , transformers        >=0.3     && <0.6

servant-client/servant-client.cabal

@@ -45,11 +45,11 @@ library
     , bytestring            >= 0.10.8.1 && < 0.12
     , containers            >= 0.5.7.1  && < 0.7
     , deepseq               >= 1.4.2.0  && < 1.5
-    , mtl                   ^>= 2.2.2   || ^>= 2.3.1
+    , mtl                   >= 2.2.2    && < 2.3
     , stm                   >= 2.4.5.1  && < 2.6
     , text                  >= 1.2.3.0  && < 2.1
     , time                  >= 1.6.0.1  && < 1.13
-    , transformers          >= 0.5.2.0  && < 0.7
+    , transformers          >= 0.5.2.0  && < 0.6
 
   if !impl(ghc >= 8.2)
     build-depends:

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

@@ -24,8 +24,7 @@ import           Control.DeepSeq
                  (NFData, force)
 import           Control.Exception
                  (evaluate, throwIO)
-import           Control.Monad
+import           Control.Monad ()
-                 (unless)
 import           Control.Monad.Base
                  (MonadBase (..))
 import           Control.Monad.Codensity
@@ -175,21 +174,10 @@ performRequest acceptStatus req = do
 -- | TODO: support UVerb ('acceptStatus' argument, like in 'performRequest' above).
 performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a
 performWithStreamingRequest req k = do
-  ClientEnv m burl cookieJar' createClientRequest <- ask
+  m <- asks manager
-  clientRequest <- liftIO $ createClientRequest burl req
+  burl <- asks baseUrl
-  request <- case cookieJar' of
+  createClientRequest <- asks makeClientRequest
-    Nothing -> pure clientRequest
+  request <- liftIO $ createClientRequest burl req
-    Just cj -> liftIO $ do
-      now <- getCurrentTime
-      atomically $ do
-        oldCookieJar <- readTVar cj
-        let (newRequest, newCookieJar) =
-              Client.insertCookiesIntoRequest
-                clientRequest
-                oldCookieJar
-                now
-        writeTVar cj newCookieJar
-        pure newRequest
   ClientM $ lift $ lift $ Codensity $ \k1 ->
       Client.withResponse request m $ \res -> do
           let status = Client.responseStatus res

servant-conduit/servant-conduit.cabal

@@ -31,8 +31,8 @@ library
       base          >=4.9      && <5
     , bytestring    >=0.10.8.1 && <0.12
     , conduit       >=1.3.1    && <1.4
-    , mtl           ^>=2.2.2   || ^>=2.3.1
+    , mtl           >=2.2.2    && <2.3
-    , resourcet     >=1.2.2    && <1.4
+    , resourcet     >=1.2.2    && <1.3
     , servant       >=0.15     && <0.20
     , unliftio-core >=0.1.2.0  && <0.3
   hs-source-dirs:      src

servant-docs/golden/comprehensive.md

@@ -530,24 +530,6 @@
 
 ```
 
-## GET /resource
-
-### Response:
-
-- Status code 200
-- Headers: []
-
-- Supported content types are:
-
-    - `application/json;charset=utf-8`
-    - `application/json`
-
-- Example (`application/json;charset=utf-8`, `application/json`):
-
-```javascript
-
-```
-
 ## GET /streaming
 
 ### Request:

servant-docs/src/Servant/Docs/Internal.hs

@@ -447,7 +447,7 @@ docsWith opts intros (ExtraInfo endpoints) p =
       & apiEndpoints %~ HM.unionWith (flip combineAction) endpoints
 
 
--- | Generate the docs for a given API that implements 'HasDocs' with any
+-- | Generate the docs for a given API that implements 'HasDocs' with with any
 -- number of introduction(s)
 docsWithIntros :: HasDocs api => [DocIntro] -> Proxy api -> API
 docsWithIntros intros = docsWith defaultDocOptions intros mempty
@@ -1144,9 +1144,6 @@ instance HasDocs api => HasDocs (Vault :> api) where
 instance HasDocs api => HasDocs (WithNamedContext name context api) where
   docsFor Proxy = docsFor (Proxy :: Proxy api)
 
-instance HasDocs api => HasDocs (WithResource res :> api) where
-  docsFor Proxy = docsFor (Proxy :: Proxy api)
-
 instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth realm usr :> api) where
   docsFor Proxy (endpoint, action) =
     docsFor (Proxy :: Proxy api) (endpoint, action')

servant-foreign/src/Servant/Foreign/Internal.hs

@@ -487,13 +487,6 @@ instance HasForeign lang ftype api =>
 
   foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy api)
 
-instance HasForeign lang ftype api =>
-  HasForeign lang ftype (WithResource res :> api) where
-
-  type Foreign ftype (WithResource res :> api) = Foreign ftype api
-
-  foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy api)
-
 instance HasForeign lang ftype api
   => HasForeign lang ftype (HttpVersion :> api) where
   type Foreign ftype (HttpVersion :> api) = Foreign ftype api

servant-http-streams/servant-http-streams.cabal

@@ -42,10 +42,10 @@ library
     , bytestring            >= 0.10.8.1 && < 0.12
     , containers            >= 0.5.7.1  && < 0.7
     , deepseq               >= 1.4.2.0  && < 1.5
-    , mtl                   ^>= 2.2.2   || ^>= 2.3.1
+    , mtl                   >= 2.2.2    && < 2.3
     , text                  >= 1.2.3.0  && < 2.1
     , time                  >= 1.6.0.1  && < 1.13
-    , transformers          >= 0.5.2.0  && < 0.7
+    , transformers          >= 0.5.2.0  && < 0.6
 
   if !impl(ghc >= 8.2)
     build-depends:

servant-machines/servant-machines.cabal

@@ -31,7 +31,7 @@ library
       base          >=4.9      && <5
     , bytestring    >=0.10.8.1 && <0.12
     , machines      >=0.6.4    && <0.8
-    , mtl           ^>=2.2.2   || ^>=2.3.1
+    , mtl           >=2.2.2    && <2.3
     , servant       >=0.15     && <0.20
   hs-source-dirs:      src
   default-language:    Haskell2010

servant-pipes/servant-pipes.cabal

@@ -32,7 +32,7 @@ library
     , bytestring    >=0.10.8.1 && <0.12
     , pipes         >=4.3.9    && <4.4
     , pipes-safe    >=2.3.1    && <2.4
-    , mtl           ^>=2.2.2   || ^>=2.3.1
+    , mtl           >=2.2.2    && <2.3
     , monad-control >=1.0.2.3  && <1.1
     , servant       >=0.15     && <0.20
   hs-source-dirs:      src

servant-server/CHANGELOG.md

@@ -13,7 +13,6 @@ Compatibility with GHC 9.4, see [PR #1592](https://github.com/haskell-servant/se
 
 - Add `MonadFail` instance for `Handler` wrt [#1545](https://github.com/haskell-servant/servant/issues/1545)
 - Support GHC 9.2 [#1525](https://github.com/haskell-servant/servant/issues/1525)
-- Add capture hints in `Router` type for debug and display purposes [PR #1556] (https://github.com/haskell-servant/servant/pull/1556)
 
 0.19
 ----

servant-server/servant-server.cabal

@@ -23,7 +23,7 @@ author:              Servant Contributors
 maintainer:          haskell-servant-maintainers@googlegroups.com
 copyright:           2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors
 build-type:          Simple
-tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.3
+tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.2 || ==9.0.1
 
 extra-source-files:
   CHANGELOG.md
@@ -64,9 +64,9 @@ library
     , bytestring          >= 0.10.8.1 && < 0.12
     , constraints         >= 0.2      && < 0.14
     , containers          >= 0.5.7.1  && < 0.7
-    , mtl                 ^>= 2.2.2   || ^>= 2.3.1
+    , mtl                 >= 2.2.2    && < 2.3
     , text                >= 1.2.3.0  && < 2.1
-    , transformers        >= 0.5.2.0  && < 0.7
+    , transformers        >= 0.5.2.0  && < 0.6
     , filepath            >= 1.4.1.1  && < 1.5
 
   -- Servant dependencies
@@ -88,10 +88,10 @@ library
     , network             >= 2.8      && < 3.2
     , sop-core            >= 0.4.0.0  && < 0.6
     , string-conversions  >= 0.4.0.1  && < 0.5
-    , resourcet           >= 1.2.2    && < 1.4
+    , resourcet           >= 1.2.2    && < 1.3
     , tagged              >= 0.8.6    && < 0.9
     , transformers-base   >= 0.4.5.2  && < 0.5
-    , wai                 >= 3.2.2.1  && < 3.3
+    , wai                 >= 3.2.1.2  && < 3.3
     , wai-app-static      >= 3.1.6.2  && < 3.2
     , word8               >= 0.1.3    && < 0.2
 

servant-server/src/Servant/Server/Experimental/Auth.hs

@@ -1,6 +1,5 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE DeriveDataTypeable    #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
@@ -45,7 +44,7 @@ type family AuthServerData a :: *
 -- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
 newtype AuthHandler r usr = AuthHandler
   { unAuthHandler :: r -> Handler usr }
-  deriving (Functor, Generic, Typeable)
+  deriving (Generic, Typeable)
 
 -- | NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
 mkAuthHandler :: (r -> Handler usr) -> AuthHandler r usr

servant-server/src/Servant/Server/Internal.hs

@@ -35,10 +35,9 @@ module Servant.Server.Internal
 import           Control.Monad
                  (join, when)
 import           Control.Monad.Trans
-                 (liftIO, lift)
+                 (liftIO)
 import           Control.Monad.Trans.Resource
-                 (runResourceT, ReleaseKey)
+                 (runResourceT)
-import           Data.Acquire
 import qualified Data.ByteString                            as B
 import qualified Data.ByteString.Builder                    as BB
 import qualified Data.ByteString.Char8                      as BC8
@@ -78,7 +77,7 @@ import           Servant.API
                  QueryParam', QueryParams, Raw, ReflectMethod (reflectMethod),
                  RemoteHost, ReqBody', SBool (..), SBoolI (..), SourceIO,
                  Stream, StreamBody', Summary, ToSourceIO (..), Vault, Verb,
-                 WithNamedContext, WithResource, NamedRoutes)
+                 WithNamedContext, NamedRoutes)
 import           Servant.API.Generic (GenericMode(..), ToServant, ToServantApi, GServantProduct, toServant, fromServant)
 import           Servant.API.ContentTypes
                  (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),
@@ -116,10 +115,6 @@ import           Servant.API.TypeLevel
                  (AtLeastOneFragment, FragmentUnique)
 
 class HasServer api context where
-  -- | The type of a server for this API, given a monad to run effects in.
-  --
-  -- Note that the result kind is @*@, so it is /not/ a monad transformer, unlike
-  -- what the @T@ in the name might suggest.
   type ServerT api (m :: * -> *) :: *
 
   route ::
@@ -249,42 +244,6 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
       formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
       hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy [a]))
 
--- | If you use 'WithResource' in one of the endpoints for your API Servant
--- will provide the handler for this endpoint an argument of the specified type.
--- The lifespan of this resource will be automatically managed by Servant. This
--- resource will be created before the handler starts and it will be destoyed
--- after it ends. A new resource is created for each request to the endpoint.
-
--- The creation and destruction are done using a 'Data.Acquire.Acquire'
--- provided via server 'Context'.
---
--- Example
---
--- > type MyApi = WithResource Handle :> "writeToFile" :> Post '[JSON] NoContent
--- >
--- > server :: Server MyApi
--- > server = writeToFile
--- >   where writeToFile :: (ReleaseKey, Handle) -> Handler NoContent
--- >         writeToFile (_, h) = hPutStrLn h "message"
---
--- In addition to the resource, the handler will also receive a 'ReleaseKey'
--- which can be used to deallocate the resource before the end of the request
--- if desired.
-
-instance (HasServer api ctx, HasContextEntry ctx (Acquire a))
-      => HasServer (WithResource a :> api) ctx where
-
-  type ServerT (WithResource a :> api) m = (ReleaseKey, a) -> ServerT api m
-
-  hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy @api) pc nt . s
-
-  route Proxy context d = route (Proxy @api) context (d `addParameterCheck` allocateResource)
-    where
-      allocateResource :: DelayedIO (ReleaseKey, a)
-      allocateResource = DelayedIO $ lift $ allocateAcquire (getContextEntry context)
-
-
-
 allowedMethodHead :: Method -> Request -> Bool
 allowedMethodHead method request = method == methodGet && requestMethod request == methodHead
 

servant-server/src/Servant/Server/Internal/Router.hs

@@ -28,12 +28,9 @@ import           Servant.Server.Internal.ServerError
 
 type Router env = Router' env RoutingApplication
 
--- | Holds information about pieces of url that are captured as variables.
 data CaptureHint = CaptureHint
   { captureName :: Text
-  -- ^ Holds the name of the captured variable
   , captureType :: TypeRep
-  -- ^ Holds the type of the captured variable
   }
   deriving (Show, Eq)
 
@@ -57,21 +54,10 @@ data Router' env a =
       --   for the empty path, to be tried in order
   | CaptureRouter [CaptureHint] (Router' (Text, env) a)
       -- ^ first path component is passed to the child router in its
-      --   environment and removed afterwards.
+      --   environment and removed afterwards
-      --   The first argument is a list of hints for all variables that can be
-      --   captured by the router. The fact that it is a list is counter-intuitive,
-      --   because the 'Capture' combinator only allows to capture a single varible,
-      --   with a single name and a single type. However, the 'choice' smart
-      --   constructor may merge two 'Capture' combinators with different hints, thus
-      --   forcing the type to be '[CaptureHint]'.
-      --   Because 'CaptureRouter' is built from a 'Capture' combinator, the list of
-      --   hints should always be non-empty.
   | CaptureAllRouter [CaptureHint] (Router' ([Text], env) a)
       -- ^ all path components are passed to the child router in its
       --   environment and are removed afterwards
-      --   The first argument is a hint for the list of variables that can be
-      --   captured by the router. Note that the 'captureType' field of the hint
-      --   should always be '[a]' for some 'a'.
   | RawRouter     (env -> a)
       -- ^ to be used for routes we do not know anything about
   | Choice        (Router' env a) (Router' env a)
@@ -115,10 +101,6 @@ choice router1 router2 = Choice router1 router2
 data RouterStructure =
     StaticRouterStructure  (Map Text RouterStructure) Int
   | CaptureRouterStructure [CaptureHint] RouterStructure
-  -- ^ The first argument holds information about variables
-  -- that are captured by the router. There may be several hints
-  -- if several routers have been aggregated by the 'choice'
-  -- smart constructor.
   | RawRouterStructure
   | ChoiceStructure        RouterStructure RouterStructure
   deriving (Eq, Show)

servant-server/test/Servant/ServerSpec.hs

@@ -21,8 +21,6 @@ import           Control.Monad.Error.Class
                  (MonadError (..))
 import           Data.Aeson
                  (FromJSON, ToJSON, decode', encode)
-import           Data.Acquire
-                 (Acquire, mkAcquire)
 import qualified Data.ByteString                   as BS
 import qualified Data.ByteString.Base64            as Base64
 import           Data.Char
@@ -83,11 +81,8 @@ import           Servant.Server.Internal.Context
 -- This declaration simply checks that all instances are in place.
 _ = serveWithContext comprehensiveAPI comprehensiveApiContext
 
-comprehensiveApiContext :: Context '[NamedContext "foo" '[], Acquire Int]
+comprehensiveApiContext :: Context '[NamedContext "foo" '[]]
-comprehensiveApiContext =
+comprehensiveApiContext = NamedContext EmptyContext :. EmptyContext
-  NamedContext EmptyContext :.
-  mkAcquire (pure 10) (\_ -> pure ()) :.
-  EmptyContext
 
 -- * Specs
 

servant-swagger/src/Servant/Swagger/Internal.hs

@@ -304,10 +304,6 @@ instance (HasSwagger sub) => HasSwagger (HttpVersion :> sub) where
 instance (HasSwagger sub) => HasSwagger (WithNamedContext x c sub) where
   toSwagger _ = toSwagger (Proxy :: Proxy sub)
 
--- | @'WithResource'@ combinator does not change our specification at all.
-instance (HasSwagger sub) => HasSwagger (WithResource res :> sub) where
-  toSwagger _ = toSwagger (Proxy :: Proxy sub)
-
 instance (KnownSymbol sym, HasSwagger sub) => HasSwagger (sym :> sub) where
   toSwagger _ = prependPath piece (toSwagger (Proxy :: Proxy sub))
     where

servant/servant.cabal

@@ -62,7 +62,6 @@ library
     Servant.API.Vault
     Servant.API.Verbs
     Servant.API.WithNamedContext
-    Servant.API.WithResource
 
   -- Types
   exposed-modules:
@@ -84,9 +83,9 @@ library
       base                   >= 4.9      && < 4.18
     , bytestring             >= 0.10.8.1 && < 0.12
     , constraints            >= 0.2
-    , mtl                    ^>= 2.2.2   || ^>= 2.3.1
+    , mtl                    >= 2.2.2    && < 2.3
     , sop-core               >= 0.4.0.0  && < 0.6
-    , transformers           >= 0.5.2.0  && < 0.7
+    , transformers           >= 0.5.2.0  && < 0.6
     , text                   >= 1.2.3.0  && < 2.1
 
 

servant/src/Servant/API.hs

@@ -31,8 +31,6 @@ module Servant.API (
   -- | Access the location for arbitrary data to be shared by applications and middleware
   module Servant.API.WithNamedContext,
   -- | Access context entries in combinators in servant-server
-  module Servant.API.WithResource,
-  -- | Access a managed resource scoped to a single request
 
   -- * Actual endpoints, distinguished by HTTP method
   module Servant.API.Verbs,
@@ -103,19 +101,17 @@ import           Servant.API.Experimental.Auth
                  (AuthProtect)
 import           Servant.API.Fragment
                  (Fragment)
-import           Servant.API.Generic
-                 (AsApi, GServantProduct, GenericMode ((:-)), GenericServant,
-                 ToServant, ToServantApi, fromServant, genericApi, toServant)
 import           Servant.API.Header
                  (Header, Header')
+import           Servant.API.Generic
+                 (GenericMode ((:-)), AsApi, ToServant, ToServantApi, GServantProduct,
+                 GenericServant, fromServant, toServant, genericApi)
 import           Servant.API.HttpVersion
                  (HttpVersion (..))
 import           Servant.API.IsSecure
                  (IsSecure (..))
 import           Servant.API.Modifiers
                  (Lenient, Optional, Required, Strict)
-import           Servant.API.NamedRoutes
-                 (NamedRoutes)
 import           Servant.API.QueryParam
                  (QueryFlag, QueryParam, QueryParam', QueryParams)
 import           Servant.API.Raw
@@ -141,6 +137,8 @@ import           Servant.API.UVerb
                  Unique, WithStatus (..), inject, statusOf)
 import           Servant.API.Vault
                  (Vault)
+import           Servant.API.NamedRoutes
+                 (NamedRoutes)
 import           Servant.API.Verbs
                  (Delete, DeleteAccepted, DeleteNoContent,
                  DeleteNonAuthoritative, Get, GetAccepted, GetNoContent,
@@ -152,8 +150,6 @@ import           Servant.API.Verbs
                  ReflectMethod (reflectMethod), StdMethod (..), Verb)
 import           Servant.API.WithNamedContext
                  (WithNamedContext)
-import           Servant.API.WithResource
-                 (WithResource)
 import           Servant.Links
                  (HasLink (..), IsElem, IsElem', Link, URI (..), safeLink)
 import           Web.HttpApiData

servant/src/Servant/API/UVerb.hs

@@ -38,7 +38,6 @@ import GHC.TypeLits (Nat)
 import Network.HTTP.Types (Status, StdMethod)
 import Servant.API.ContentTypes (JSON, PlainText, FormUrlEncoded, OctetStream, NoContent, MimeRender(mimeRender), MimeUnrender(mimeUnrender))
 import Servant.API.Status (KnownStatus, statusVal)
-import Servant.API.ResponseHeaders (Headers)
 import Servant.API.UVerb.Union
 
 class KnownStatus (StatusOf a) => HasStatus (a :: *) where
@@ -53,9 +52,6 @@ statusOf = const (statusVal (Proxy :: Proxy (StatusOf a)))
 instance HasStatus NoContent where
   type StatusOf NoContent = 204
 
-instance HasStatus a => HasStatus (Headers hs a) where
-  type StatusOf (Headers hs a) = StatusOf a
-
 class HasStatuses (as :: [*]) where
   type Statuses (as :: [*]) :: [Nat]
   statuses :: Proxy as -> [Status]

servant/src/Servant/API/UVerb/Union.hs

@@ -128,9 +128,9 @@ type DuplicateElementError (rs :: [k]) =
     ':$$: 'Text "    " ':<>: 'ShowType rs
 
 type family Elem (x :: k) (xs :: [k]) :: Bool where
-  Elem x (x ': _) = 'True
-  Elem x (_ ': xs) = Elem x xs
   Elem _ '[] = 'False
+  Elem x (x' ': xs) =
+    If (x == x') 'True (Elem x xs)
 
 type family Unique xs :: Constraint where
   Unique xs = If (Nubbed xs == 'True) (() :: Constraint) (TypeError (DuplicateElementError xs))

servant/src/Servant/API/WithResource.hs

@@ -1,3 +0,0 @@
-module Servant.API.WithResource (WithResource) where
-
-data WithResource res

servant/src/Servant/Links.hs

@@ -193,8 +193,6 @@ import           Servant.API.Verbs
                  (Verb, NoContentVerb)
 import           Servant.API.WithNamedContext
                  (WithNamedContext)
-import           Servant.API.WithResource
-                 (WithResource)
 import           Web.HttpApiData
 import           Data.Kind
                  (Type)
@@ -560,10 +558,6 @@ instance HasLink sub => HasLink (WithNamedContext name context sub) where
     type MkLink (WithNamedContext name context sub) a = MkLink sub a
     toLink toA _ = toLink toA (Proxy :: Proxy sub)
 
-instance HasLink sub => HasLink (WithResource res :> sub) where
-    type MkLink (WithResource res :> sub) a = MkLink sub a
-    toLink toA _ = toLink toA (Proxy :: Proxy sub)
-
 instance HasLink sub => HasLink (RemoteHost :> sub) where
     type MkLink (RemoteHost :> sub) a = MkLink sub a
     toLink = simpleToLink (Proxy :: Proxy sub)

servant/src/Servant/Test/ComprehensiveAPI.hs

@@ -72,7 +72,6 @@ type ComprehensiveAPIWithoutStreamingOrRaw' endpoint =
     :<|> "description"      :> Description "foo" :> GET
     :<|> "alternative"      :> ("left" :> GET :<|> "right" :> GET)
     :<|> "fragment"         :> Fragment Int :> GET
-    :<|> "resource"         :> WithResource Int :> GET
     :<|> endpoint
 
 type ComprehensiveAPIWithoutStreamingOrRaw = ComprehensiveAPIWithoutStreamingOrRaw' EmptyEndpoint

servant/src/Servant/Types/SourceT.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE DeriveFunctor       #-}
 {-# LANGUAGE GADTs               #-}
 {-# LANGUAGE RankNTypes          #-}
@@ -155,10 +154,8 @@ instance (Applicative m, Show1 m, Show a) => Show (StepT m a) where
 -- | >>> lift [1,2,3] :: StepT [] Int
 -- Effect [Yield 1 Stop,Yield 2 Stop,Yield 3 Stop]
 --
-#if !MIN_VERSION_transformers(0,6,0)
 instance MonadTrans StepT where
     lift = Effect . fmap (`Yield` Stop)
-#endif
 
 instance MFunctor StepT where
     hoist f = go where

servant/test/Servant/API/ResponseHeadersSpec.hs

@@ -2,14 +2,10 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Servant.API.ResponseHeadersSpec where
 
-import           Data.Proxy
-import           GHC.TypeLits
 import           Test.Hspec
 
-import           Servant.API.ContentTypes
 import           Servant.API.Header
 import           Servant.API.ResponseHeaders
-import           Servant.API.UVerb
 
 spec :: Spec
 spec = describe "Servant.API.ResponseHeaders" $ do
@@ -32,10 +28,3 @@ spec = describe "Servant.API.ResponseHeaders" $ do
     it "does not add a header" $ do
       let val = noHeader 5 :: Headers '[Header "test" Int] Int
       getHeaders val `shouldBe` []
-
-  describe "HasStatus Headers" $ do
-
-    it "gets the status from the underlying value" $ do
-      natVal (Proxy :: Proxy (StatusOf (Headers '[Header "first" Int] NoContent))) `shouldBe` 204
-      natVal (Proxy :: Proxy (StatusOf (Headers '[Header "first" Int] (WithStatus 503 ())))) `shouldBe` 503
-