master..9d66e16 · typeable/servant

.github/workflows/master.yml+4−2

@@ -19,7 +19,6 @@ jobs:

1919 - "8.8.4"

2020 - "8.10.7"

2121 - "9.0.2"

22− - "9.2.2"

2322

2423 steps:

2524 - uses: actions/checkout@v2

@@ -59,6 +58,9 @@ jobs:

5958 cabal test all

6059

6160 - name: Run doctests

61+ # doctests are broken on GHC 9 due to compiler bug:

62+ # https://gitlab.haskell.org/ghc/ghc/-/issues/19460

63+ continue-on-error: ${{ matrix.ghc == '9.0.1' }}

6264 run: |

6365 # Necessary for doctest to be found in $PATH

6466 export PATH="$HOME/.cabal/bin:$PATH"

@@ -80,7 +82,7 @@ jobs:

8082 runs-on: ubuntu-latest

8183 strategy:

8284 matrix:

83− stack: ["2.7.5"]

85+ stack: ["2.7.3"]

8486 ghc: ["8.10.7"]

8587

8688 steps:

cabal.project+4

@@ -51,3 +51,7 @@ packages:

5151tests: True

5252optimization: False

5353-- reorder-goals: True

54+

55+-- https://github.com/chordify/haskell-servant-pagination/pull/12

56+allow-newer: servant-pagination-2.2.2:servant

57+allow-newer: servant-pagination-2.2.2:servant-server

changelog.d/1556deleted−81

@@ -1,81 +0,0 @@

1−synopsis: Display capture hints in router layout

2−prs: #1556

3−

4−description: {

5−

6−This PR enhances the `Servant.Server.layout` function, which produces a textual description of the routing layout of an API. More precisely, it changes `<capture>` blocks, so that they display the name and type of the variable being captured instead.

7−

8−Example:

9−

10−For the following API

11−```haskell

12−type API =

13− "a" :> "d" :> Get '[JSON] NoContent

14− :<|> "b" :> Capture "x" Int :> Get '[JSON] Bool

15− :<|> "a" :> "e" :> Get '[JSON] Int

16−```

17−

18−we previously got the following output:

19−

20−```

21−/

22−├─ a/

23−│ ├─ d/

24−│ │ └─•

25−│ └─ e/

26−│ └─•

27−└─ b/

28− └─ <capture>/

29− ├─•

30− ┆

31− └─•

32−```

33−

34−now we get:

35−

36−```

37−/

38−├─ a/

39−│ ├─ d/

40−│ │ └─•

41−│ └─ e/

42−│ └─•

43−└─ b/

44− └─ <x::Int>/

45− ├─•

46− ┆

47− └─•

48−```

49−

50−This change is achieved by the introduction of a CaptureHint type, which is passed as an extra argument to the CaptureRouter and CaptureAllRouter constructors for the Router' type.

51−CaptureHint values are then used in routerLayout, to display the name and type of captured values, instead of just `<capture>` previously.

52−

53−N.B.:

54−Because the choice smart constructor for routers can aggregate Capture combinators with different capture hints, the Capture*Router constructors actually take a list of CaptureHint, instead of a single one.

55−

56−This PR also introduces Spec tests for the routerLayout function.

57−

58−Warning:

59−This change is potentially breaking, because it adds the constraint `Typeable a` to all types that are to be captured. Because all types are typeable since GHC 7.10, this is not as bad as it sounds ; it only break expressions where `a` is quantified in an expression with `Capture a`.

60−In those cases, the fix is easy: it suffices to add `Typeable a` to the left-hand side of the quantification constraint.

61−

62−For instance, the following code will no longer compile:

63−```haskell

64−type MyAPI a = Capture "foo" a :> Get '[JSON] ()

65−

66−myServer :: forall a. Server (MyAPI a)

67−myServer = const $ return ()

68−

69−myApi :: forall a. Proxy (MyAPI a)

70−myApi = Proxy

71−

72−app :: forall a. (FromHttpApiData a) => Application

73−app = serve (myApi @a) (myServer @a)

74−```

75−

76−Indeed, `app` should be replaced with:

77−```haskell

78−app :: forall a. (FromHttpApiData a, Typeable a) => Application

79−app = serve (myApi @a) (myServer @a)

80−```

81−}

changelog.d/1569deleted−13

@@ -1,13 +0,0 @@

1−synopsis: Encode captures using toEncodedUrlPiece

2−prs: #1569

3−issues: #1511

4−

5−description: {

6−The `servant-client` library now makes direct use of `toEncodedUrlPiece` from `ToHttpApiData`

7−to encode captured values when building the request path. It gives user freedom to implement

8−URL-encoding however they need.

9−

10−Previous behavior was to use `toUrlPiece` and URL-encode its output using `toEncodedUrlPiece`

11−from the `Text` instance of `ToHttpApiData`. The issue with this approach is that

12−`ToHttpApiData Text` is overly zealous and also encodes characters, such as `*`, which are perfectly valid in a URL.

13−}

changelog.d/1580deleted−12

@@ -1,12 +0,0 @@

1−synopsis: Allow IO in validationKeys

2−prs: #1580

3−issues: #1579

4−

5−description: {

6−

7−Currently validationKeys are a fixed JWKSet. This does not work with OIDC

8−providers such as AWS Cognito or Okta, which regularly fetching jwks_uri to

9−discover new and expired keys.

10−

11−This change alters the type of validationKeys from JWKSet to IO JWKSet.

12−}

changelog.d/1589deleted−2

@@ -1,2 +0,0 @@

1−synopsis: Only include question mark for nonempty query strings

2−prs: 1589

changelog.d/1595deleted−2

@@ -1,2 +0,0 @@

1−synopsis: Run ClientEnv's makeClientRequest in IO.

2−prs: #1595

doc/cookbook/curl-mock/curl-mock.cabal−3

@@ -11,9 +11,6 @@ build-type: Simple

1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

1212

1313executable cookbock-curl-mock

14− if impl(ghc >= 9.2)

15− -- generic-arbitrary is incompatible

16− buildable: False

1714 main-is: CurlMock.lhs

1815 build-depends: base == 4.*

1916 , aeson

doc/cookbook/using-free-client/UsingFreeClient.lhs+1−1

@@ -119,7 +119,7 @@ Now we can use `servant-client`'s internals to convert servant's `Request`

119119to http-client's `Request`, and we can inspect it:

120120

121121```haskell

122− req' <- I.defaultMakeClientRequest burl req

122+ let req' = I.defaultMakeClientRequest burl req

123123 putStrLn $ "Making request: " ++ show req'

124124```

125125

doc/tutorial/tutorial.cabal+1−1

@@ -64,7 +64,7 @@ library

6464 , blaze-markup >= 0.8.0.0 && < 0.9

6565 , cookie >= 0.4.3 && < 0.5

6666 , js-jquery >= 3.3.1 && < 3.4

67− , lucid >= 2.9.11 && < 2.12

67+ , lucid >= 2.9.11 && < 2.10

6868 , random >= 1.1 && < 1.3

6969 , servant-js >= 0.9 && < 0.10

7070 , time >= 1.6.0.1 && < 1.13

servant-auth/servant-auth-client/servant-auth-client.cabal+5−5

@@ -31,8 +31,8 @@ library

3131 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

3232 ghc-options: -Wall

3333 build-depends:

34− base >= 4.10 && < 4.17

35− , bytestring >= 0.10.6.0 && < 0.12

34+ base >= 4.10 && < 4.16

35+ , bytestring >= 0.10.6.0 && < 0.11

3636 , containers >= 0.5.6.2 && < 0.7

3737 , servant-auth == 0.4.*

3838 , servant >= 0.13 && < 0.20

@@ -50,7 +50,7 @@ test-suite spec

5050 test

5151 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

5252 ghc-options: -Wall

53− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10

53+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.9

5454

5555 -- dependencies with bounds inherited from the library stanza

5656 build-depends:

@@ -62,10 +62,10 @@ test-suite spec

6262

6363 -- test dependencies

6464 build-depends:

65− hspec >= 2.5.5 && < 2.10

65+ hspec >= 2.5.5 && < 2.9

6666 , QuickCheck >= 2.11.3 && < 2.15

6767 , aeson >= 1.3.1.1 && < 3

68− , bytestring >= 0.10.6.0 && < 0.12

68+ , bytestring >= 0.10.6.0 && < 0.11

6969 , http-client >= 0.5.13.1 && < 0.8

7070 , http-types >= 0.12.2 && < 0.13

7171 , servant-auth-server >= 0.4.2.0 && < 0.5

servant-auth/servant-auth-docs/servant-auth-docs.cabal+3−3

@@ -35,7 +35,7 @@ library

3535 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

3636 ghc-options: -Wall

3737 build-depends:

38− base >= 4.10 && < 4.17

38+ base >= 4.10 && < 4.16

3939 , servant-docs >= 0.11.2 && < 0.13

4040 , servant >= 0.13 && < 0.20

4141 , servant-auth == 0.4.*

@@ -64,7 +64,7 @@ test-suite spec

6464 test

6565 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

6666 ghc-options: -Wall

67− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10

67+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.9

6868

6969 -- dependencies with bounds inherited from the library stanza

7070 build-depends:

@@ -78,7 +78,7 @@ test-suite spec

7878 -- test dependencies

7979 build-depends:

8080 servant-auth-docs

81− , hspec >= 2.5.5 && < 2.10

81+ , hspec >= 2.5.5 && < 2.9

8282 , QuickCheck >= 2.11.3 && < 2.15

8383

8484 default-language: Haskell2010

servant-auth/servant-auth-server/servant-auth-server.cabal+7−7

@@ -31,11 +31,11 @@ library

3131 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

3232 ghc-options: -Wall

3333 build-depends:

34− base >= 4.10 && < 4.17

34+ base >= 4.10 && < 4.16

3535 , aeson >= 1.0.0.1 && < 3

3636 , base64-bytestring >= 1.0.0.1 && < 2

3737 , blaze-builder >= 0.4.1.0 && < 0.5

38− , bytestring >= 0.10.6.0 && < 0.12

38+ , bytestring >= 0.10.6.0 && < 0.11

3939 , case-insensitive >= 1.2.0.11 && < 1.3

4040 , cookie >= 0.4.4 && < 0.5

4141 , data-default-class >= 0.1.2.0 && < 0.2

@@ -43,7 +43,7 @@ library

4343 , http-types >= 0.12.2 && < 0.13

4444 , jose >= 0.7.0.0 && < 0.10

4545 , lens >= 4.16.1 && < 5.2

46− , memory >= 0.14.16 && < 0.18

46+ , memory >= 0.14.16 && < 0.17

4747 , monad-time >= 0.3.1.0 && < 0.4

4848 , mtl >= 2.2.2 && < 2.3

4949 , servant >= 0.13 && < 0.20

@@ -51,7 +51,7 @@ library

5151 , servant-server >= 0.13 && < 0.20

5252 , tagged >= 0.8.4 && < 0.9

5353 , text >= 1.2.3.0 && < 2.1

54− , time >= 1.5.0.1 && < 1.12

54+ , time >= 1.5.0.1 && < 1.10

5555 , unordered-containers >= 0.2.9.0 && < 0.3

5656 , wai >= 3.2.1.2 && < 3.3

5757

@@ -102,7 +102,7 @@ test-suite spec

102102 test

103103 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

104104 ghc-options: -Wall

105− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10

105+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.8

106106

107107 -- dependencies with bounds inherited from the library stanza

108108 build-depends:

@@ -123,10 +123,10 @@ test-suite spec

123123 -- test dependencies

124124 build-depends:

125125 servant-auth-server

126− , hspec >= 2.5.5 && < 2.10

126+ , hspec >= 2.5.5 && < 2.8

127127 , QuickCheck >= 2.11.3 && < 2.15

128128 , http-client >= 0.5.13.1 && < 0.8

129− , lens-aeson >= 1.0.2 && < 1.3

129+ , lens-aeson >= 1.0.2 && < 1.2

130130 , warp >= 3.2.25 && < 3.4

131131 , wreq >= 0.5.2.1 && < 0.6

132132 other-modules:

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs+2−2

@@ -33,7 +33,7 @@ data JWTSettings = JWTSettings

3333 -- | Algorithm used to sign JWT.

3434 , jwtAlg :: Maybe Jose.Alg

3535 -- | Keys used to validate JWT.

36− , validationKeys :: IO Jose.JWKSet

36+ , validationKeys :: Jose.JWKSet

3737 -- | An @aud@ predicate. The @aud@ is a string or URI that identifies the

3838 -- intended recipient of the JWT.

3939 , audienceMatches :: Jose.StringOrURI -> IsMatch

@@ -44,7 +44,7 @@ defaultJWTSettings :: Jose.JWK -> JWTSettings

4444defaultJWTSettings k = JWTSettings

4545 { signingKey = k

4646 , jwtAlg = Nothing

47− , validationKeys = pure $ Jose.JWKSet [k]

47+ , validationKeys = Jose.JWKSet [k]

4848 , audienceMatches = const Matches }

4949

5050-- | The policies to use when generating cookies.

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs+3−4

@@ -58,15 +58,14 @@ makeJWT v cfg expiry = runExceptT $ do

5858

5959verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a)

6060verifyJWT jwtCfg input = do

61− keys <- validationKeys jwtCfg

62− verifiedJWT <- runExceptT $ do

61+ verifiedJWT <- liftIO $ runExceptT $ do

6362 unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)

6463 Jose.verifyClaims

6564 (jwtSettingsToJwtValidationSettings jwtCfg)

66− keys

65+ (validationKeys jwtCfg)

6766 unverifiedJWT

6867 return $ case verifiedJWT of

6968 Left (_ :: Jose.JWTError) -> Nothing

7069 Right v -> case decodeJWT v of

7170 Left _ -> Nothing

72− Right v' -> Just v'

71+ Right v' -> Just v'

servant-auth/servant-auth-swagger/servant-auth-swagger.cabal+7−3

@@ -31,13 +31,15 @@ library

3131 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

3232 ghc-options: -Wall

3333 build-depends:

34− base >= 4.10 && < 4.17

34+ base >= 4.10 && < 4.16

3535 , text >= 1.2.3.0 && < 2.1

3636 , servant-swagger >= 1.1.5 && < 2

3737 , swagger2 >= 2.2.2 && < 3

3838 , servant >= 0.13 && < 0.20

3939 , servant-auth == 0.4.*

4040 , lens >= 4.16.1 && < 5.2

41+ if impl(ghc >= 9)

42+ buildable: False

4143 exposed-modules:

4244 Servant.Auth.Swagger

4345 default-language: Haskell2010

@@ -49,7 +51,7 @@ test-suite spec

4951 test

5052 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

5153 ghc-options: -Wall

52− build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.10

54+ build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.9

5355 -- dependencies with bounds inherited from the library stanza

5456 build-depends:

5557 base

@@ -59,11 +61,13 @@ test-suite spec

5961 , servant

6062 , servant-auth

6163 , lens

64+ if impl(ghc >= 9)

65+ buildable: False

6266

6367 -- test dependencies

6468 build-depends:

6569 servant-auth-swagger

66− , hspec >= 2.5.5 && < 2.10

70+ , hspec >= 2.5.5 && < 2.9

6771 , QuickCheck >= 2.11.3 && < 2.15

6872 other-modules:

6973 Servant.Auth.SwaggerSpec

servant-auth/servant-auth/servant-auth.cabal+1−1

@@ -33,7 +33,7 @@ library

3333 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

3434 ghc-options: -Wall

3535 build-depends:

36− base >= 4.10 && < 4.17

36+ base >= 4.10 && < 4.16

3737 , containers >= 0.6 && < 0.7

3838 , aeson >= 1.3.1.1 && < 3

3939 , jose >= 0.7.0.0 && < 0.10

servant-client-core/servant-client-core.cabal+5−5

@@ -50,14 +50,14 @@ library

5050 --

5151 -- note: mtl lower bound is so low because of GHC-7.8

5252 build-depends:

53− base >= 4.9 && < 4.17

53+ base >= 4.9 && < 4.16

5454 , bytestring >= 0.10.8.1 && < 0.12

5555 , constraints >= 0.2 && < 0.14

5656 , containers >= 0.5.7.1 && < 0.7

5757 , deepseq >= 1.4.2.0 && < 1.5

5858 , text >= 1.2.3.0 && < 2.1

5959 , transformers >= 0.5.2.0 && < 0.6

60− , template-haskell >= 2.11.1.0 && < 2.19

60+ , template-haskell >= 2.11.1.0 && < 2.18

6161

6262 if !impl(ghc >= 8.2)

6363 build-depends:

@@ -71,7 +71,7 @@ library

7171 -- Here can be exceptions if we really need features from the newer versions.

7272 build-depends:

7373 aeson >= 1.4.1.0 && < 3

74− , base-compat >= 0.10.5 && < 0.13

74+ , base-compat >= 0.10.5 && < 0.12

7575 , base64-bytestring >= 1.0.0.1 && < 1.3

7676 , exceptions >= 0.10.0 && < 0.11

7777 , free >= 5.1 && < 5.2

@@ -104,8 +104,8 @@ test-suite spec

104104 -- Additional dependencies

105105 build-depends:

106106 deepseq >= 1.4.2.0 && < 1.5

107− , hspec >= 2.6.0 && < 2.10

107+ , hspec >= 2.6.0 && < 2.9

108108 , QuickCheck >= 2.12.6.1 && < 2.15

109109

110110 build-tool-depends:

111− hspec-discover:hspec-discover >= 2.6.0 && <2.10

111+ hspec-discover:hspec-discover >= 2.6.0 && <2.9

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

@@ -208,7 +208,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)

208208 clientWithRoute pm (Proxy :: Proxy api)

209209 (appendToPath p req)

210210

211− where p = toEncodedUrlPiece val

211+ where p = (toUrlPiece val)

212212

213213 hoistClientMonad pm _ f cl = \a ->

214214 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)

@@ -243,7 +243,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)

243243 clientWithRoute pm (Proxy :: Proxy sublayout)

244244 (foldl' (flip appendToPath) req ps)

245245

246− where ps = map toEncodedUrlPiece vals

246+ where ps = map (toUrlPiece) vals

247247

248248 hoistClientMonad pm _ f cl = \as ->

249249 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)

@@ -740,7 +740,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where

740740 clientWithRoute pm (Proxy :: Proxy api)

741741 (appendToPath p req)

742742

743− where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)

743+ where p = pack $ symbolVal (Proxy :: Proxy path)

744744

745745 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl

746746

@@ -874,7 +874,7 @@ infixl 2 /:

874874--

875875-- Example:

876876--

877−-- @

877+-- @@

878878-- type Api = NamedRoutes RootApi

879879--

880880-- data RootApi mode = RootApi

@@ -895,7 +895,7 @@ infixl 2 /:

895895--

896896-- endpointClient :: ClientM Person

897897-- endpointClient = client // subApi // endpoint

898−-- @

898+-- @@

899899(//) :: a -> (a -> b) -> b

900900x // f = f x

901901

@@ -906,7 +906,7 @@ x // f = f x

906906--

907907-- Example:

908908--

909−-- @

909+-- @@

910910-- type Api = NamedRoutes RootApi

911911--

912912-- data RootApi mode = RootApi

@@ -931,7 +931,7 @@ x // f = f x

931931--

932932-- endpointClient :: ClientM Person

933933-- endpointClient = client // subApi /: "foobar123" // endpoint

934−-- @

934+-- @@

935935(/:) :: (a -> b -> c) -> b -> a -> c

936936(/:) = flip

937937

servant-client-core/src/Servant/Client/Core/Request.hs+6−10

@@ -34,8 +34,6 @@ import Data.Bifunctor

3434import Data.Bitraversable

3535 (Bitraversable (..), bifoldMapDefault, bimapDefault)

3636import qualified Data.ByteString as BS

37−import Data.ByteString.Builder

38− (Builder)

3937import qualified Data.ByteString.Builder as Builder

4038import qualified Data.ByteString.Lazy as LBS

4139import qualified Data.Sequence as Seq

@@ -51,9 +49,9 @@ import Network.HTTP.Media

5149 (MediaType)

5250import Network.HTTP.Types

5351 (Header, HeaderName, HttpVersion (..), Method, QueryItem,

54− http11, methodGet, urlEncodeBuilder)

52+ http11, methodGet)

5553import Servant.API

56− (ToHttpApiData, toEncodedUrlPiece, toQueryParam, toHeader, SourceIO)

54+ (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)

5755

5856import Servant.Client.Core.Internal (mediaTypeRnf)

5957

@@ -114,7 +112,7 @@ instance (NFData path, NFData body) => NFData (RequestF body path) where

114112 rnfB Nothing = ()

115113 rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt

116114

117−type Request = RequestF RequestBody Builder

115+type Request = RequestF RequestBody Builder.Builder

118116

119117-- | The request body. R replica of the @http-client@ @RequestBody@.

120118data RequestBody

@@ -147,10 +145,9 @@ defaultRequest = Request

147145

148146-- | Append extra path to the request being constructed.

149147--

150−-- Warning: This function assumes that the path fragment is already URL-encoded.

151−appendToPath :: Builder -> Request -> Request

148+appendToPath :: Text -> Request -> Request

152149appendToPath p req

153− = req { requestPath = requestPath req <> "/" <> p }

150+ = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }

154151

155152-- | Append a query parameter to the request being constructed.

156153--

@@ -165,8 +162,7 @@ appendToQueryString pname pvalue req

165162-- | Encode a query parameter value.

166163--

167164encodeQueryParamValue :: ToHttpApiData a => a -> BS.ByteString

168−encodeQueryParamValue = LBS.toStrict . Builder.toLazyByteString

169− . urlEncodeBuilder True . encodeUtf8 . toQueryParam

165+encodeQueryParamValue = LBS.toStrict . Builder.toLazyByteString . toEncodedUrlPiece

170166

171167-- | Add header to the request being constructed.

172168--

servant-client/servant-client.cabal+5−5

@@ -41,14 +41,14 @@ library

4141 -- Bundled with GHC: Lower bound to not force re-installs

4242 -- text and mtl are bundled starting with GHC-8.4

4343 build-depends:

44− base >= 4.9 && < 4.17

44+ base >= 4.9 && < 4.16

4545 , bytestring >= 0.10.8.1 && < 0.12

4646 , containers >= 0.5.7.1 && < 0.7

4747 , deepseq >= 1.4.2.0 && < 1.5

4848 , mtl >= 2.2.2 && < 2.3

4949 , stm >= 2.4.5.1 && < 2.6

5050 , text >= 1.2.3.0 && < 2.1

51− , time >= 1.6.0.1 && < 1.12

51+ , time >= 1.6.0.1 && < 1.10

5252 , transformers >= 0.5.2.0 && < 0.6

5353

5454 if !impl(ghc >= 8.2)

@@ -64,7 +64,7 @@ library

6464 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.

6565 -- Here can be exceptions if we really need features from the newer versions.

6666 build-depends:

67− base-compat >= 0.10.5 && < 0.13

67+ base-compat >= 0.10.5 && < 0.12

6868 , http-client >= 0.5.13.1 && < 0.8

6969 , http-media >= 0.7.1.3 && < 0.9

7070 , http-types >= 0.12.2 && < 0.13

@@ -124,7 +124,7 @@ test-suite spec

124124 -- Additional dependencies

125125 build-depends:

126126 entropy >= 0.4.1.3 && < 0.5

127− , hspec >= 2.6.0 && < 2.10

127+ , hspec >= 2.6.0 && < 2.9

128128 , HUnit >= 1.6.0.0 && < 1.7

129129 , network >= 2.8.0.0 && < 3.2

130130 , QuickCheck >= 2.12.6.1 && < 2.15

@@ -133,7 +133,7 @@ test-suite spec

133133 , tdigest >= 0.2 && < 0.3

134134

135135 build-tool-depends:

136− hspec-discover:hspec-discover >= 2.6.0 && < 2.10

136+ hspec-discover:hspec-discover >= 2.6.0 && < 2.9

137137

138138test-suite readme

139139 type: exitcode-stdio-1.0

servant-client/src/Servant/Client/Internal/HttpClient.hs+7−8

@@ -24,7 +24,7 @@ import Control.Monad

2424import Control.Monad.Base

2525 (MonadBase (..))

2626import Control.Monad.Catch

27− (MonadCatch, MonadThrow, MonadMask)

27+ (MonadCatch, MonadThrow)

2828import Control.Monad.Error.Class

2929 (MonadError (..))

3030import Control.Monad.IO.Class

@@ -80,7 +80,7 @@ data ClientEnv

8080 { manager :: Client.Manager

8181 , baseUrl :: BaseUrl

8282 , cookieJar :: Maybe (TVar Client.CookieJar)

83− , makeClientRequest :: BaseUrl -> Request -> IO Client.Request

83+ , makeClientRequest :: BaseUrl -> Request -> Client.Request

8484 -- ^ this function can be used to customize the creation of @http-client@ requests from @servant@ requests. Default value: 'defaultMakeClientRequest'

8585 -- Note that:

8686 -- 1. 'makeClientRequest' exists to allow overriding operational semantics e.g. 'responseTimeout' per request,

@@ -136,7 +136,7 @@ newtype ClientM a = ClientM

136136 { unClientM :: ReaderT ClientEnv (ExceptT ClientError IO) a }

137137 deriving ( Functor, Applicative, Monad, MonadIO, Generic

138138 , MonadReader ClientEnv, MonadError ClientError, MonadThrow

139− , MonadCatch, MonadMask)

139+ , MonadCatch)

140140

141141instance MonadBase IO ClientM where

142142 liftBase = ClientM . liftBase

@@ -162,7 +162,7 @@ runClientM cm env = runExceptT $ flip runReaderT env $ unClientM cm

162162performRequest :: Maybe [Status] -> Request -> ClientM Response

163163performRequest acceptStatus req = do

164164 ClientEnv m burl cookieJar' createClientRequest <- ask

165− clientRequest <- liftIO $ createClientRequest burl req

165+ let clientRequest = createClientRequest burl req

166166 request <- case cookieJar' of

167167 Nothing -> pure clientRequest

168168 Just cj -> liftIO $ do

@@ -229,8 +229,8 @@ clientResponseToResponse f r = Response

229229-- | Create a @http-client@ 'Client.Request' from a @servant@ 'Request'

230230-- The 'Client.host', 'Client.path' and 'Client.port' fields are extracted from the 'BaseUrl'

231231-- otherwise the body, headers and query string are derived from the @servant@ 'Request'

232−defaultMakeClientRequest :: BaseUrl -> Request -> IO Client.Request

233−defaultMakeClientRequest burl r = return Client.defaultRequest

232+defaultMakeClientRequest :: BaseUrl -> Request -> Client.Request

233+defaultMakeClientRequest burl r = Client.defaultRequest

234234 { Client.method = requestMethod r

235235 , Client.host = fromString $ baseUrlHost burl

236236 , Client.port = baseUrlPort burl

@@ -289,8 +289,7 @@ defaultMakeClientRequest burl r = return Client.defaultRequest

289289 Https -> True

290290

291291 -- Query string builder which does not do any encoding

292− buildQueryString [] = mempty

293− buildQueryString qps = "?" <> foldl' addQueryParam mempty qps

292+ buildQueryString = ("?" <>) . foldl' addQueryParam mempty

294293

295294 addQueryParam qs (k, v) =

296295 qs <> (if BS.null qs then mempty else "&") <> urlEncode True k <> foldMap ("=" <>) v

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

@@ -140,7 +140,7 @@ performRequest :: Maybe [Status] -> Request -> ClientM Response

140140performRequest acceptStatus req = do

141141 -- TODO: should use Client.withResponse here too

142142 ClientEnv m burl cookieJar' createClientRequest <- ask

143− clientRequest <- liftIO $ createClientRequest burl req

143+ let clientRequest = createClientRequest burl req

144144 request <- case cookieJar' of

145145 Nothing -> pure clientRequest

146146 Just cj -> liftIO $ do

@@ -177,7 +177,7 @@ performWithStreamingRequest req k = do

177177 m <- asks manager

178178 burl <- asks baseUrl

179179 createClientRequest <- asks makeClientRequest

180− request <- liftIO $ createClientRequest burl req

180+ let request = createClientRequest burl req

181181 ClientM $ lift $ lift $ Codensity $ \k1 ->

182182 Client.withResponse request m $ \res -> do

183183 let status = Client.responseStatus res

servant-client/test/Servant/ClientTestUtils.hs+1−13

@@ -160,7 +160,6 @@ type Api =

160160 WithStatus 301 Text]

161161 :<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person]

162162 :<|> NamedRoutes RecordRoutes

163− :<|> "captureVerbatim" :> Capture "someString" Verbatim :> Get '[PlainText] Text

164163

165164api :: Proxy Api

166165api = Proxy

@@ -215,8 +214,7 @@ getRoot

215214 :<|> EmptyClient

216215 :<|> uverbGetSuccessOrRedirect

217216 :<|> uverbGetCreated

218− :<|> recordRoutes

219− :<|> captureVerbatim = client api

217+ :<|> recordRoutes = client api

220218

221219server :: Application

222220server = serve api (

@@ -261,7 +259,6 @@ server = serve api (

261259 { something = pure ["foo", "bar", "pweet"]

262260 }

263261 }

264− :<|> pure . decodeUtf8 . unVerbatim

265262 )

266263

267264-- * api for testing failures

@@ -373,12 +370,3 @@ instance ToHttpApiData UrlEncodedByteString where

373370

374371instance FromHttpApiData UrlEncodedByteString where

375372 parseUrlPiece = pure . UrlEncodedByteString . HTTP.urlDecode True . encodeUtf8

376−

377−newtype Verbatim = Verbatim { unVerbatim :: ByteString }

378−

379−instance ToHttpApiData Verbatim where

380− toEncodedUrlPiece = byteString . unVerbatim

381− toUrlPiece = decodeUtf8 . unVerbatim

382−

383−instance FromHttpApiData Verbatim where

384− parseUrlPiece = pure . Verbatim . encodeUtf8

servant-client/test/Servant/SuccessSpec.hs+1−11

@@ -36,8 +36,6 @@ import Data.Maybe

3636import Data.Monoid ()

3737import Data.Text

3838 (Text)

39−import Data.Text.Encoding

40− (encodeUtf8)

4139import qualified Network.HTTP.Client as C

4240import qualified Network.HTTP.Types as HTTP

4341import Test.Hspec

@@ -162,8 +160,7 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

162160 mgr <- C.newManager C.defaultManagerSettings

163161 -- In proper situation, extra headers should probably be visible in API type.

164162 -- However, testing for response timeout is difficult, so we test with something which is easy to observe

165− let createClientRequest url r = fmap (\req -> req { C.requestHeaders = [("X-Added-Header", "XXX")] })

166− (defaultMakeClientRequest url r)

163+ let createClientRequest url r = (defaultMakeClientRequest url r) { C.requestHeaders = [("X-Added-Header", "XXX")] }

167164 clientEnv = (mkClientEnv mgr baseUrl) { makeClientRequest = createClientRequest }

168165 res <- runClientM (getRawSuccessPassHeaders HTTP.methodGet) clientEnv

169166 case res of

@@ -199,10 +196,3 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

199196 case eitherResponse of

200197 Left clientError -> fail $ show clientError

201198 Right response -> matchUnion response `shouldBe` Just (WithStatus @201 carol)

202−

203− it "encodes URL pieces following ToHttpApiData instance" $ \(_, baseUrl) -> do

204− let textOrig = "*"

205− eitherResponse <- runClient (captureVerbatim $ Verbatim $ encodeUtf8 textOrig) baseUrl

206− case eitherResponse of

207− Left clientError -> fail $ show clientError

208− Right textBack -> textBack `shouldBe` textOrig

servant-docs/servant-docs.cabal+2−2

@@ -41,7 +41,7 @@ library

4141 --

4242 -- note: mtl lower bound is so low because of GHC-7.8

4343 build-depends:

44− base >= 4.9 && < 4.17

44+ base >= 4.9 && < 4.16

4545 , bytestring >= 0.10.8.1 && < 0.12

4646 , text >= 1.2.3.0 && < 2.1

4747

@@ -54,7 +54,7 @@ library

5454 build-depends:

5555 aeson >= 1.4.1.0 && < 3

5656 , aeson-pretty >= 0.8.5 && < 0.9

57− , base-compat >= 0.10.5 && < 0.13

57+ , base-compat >= 0.10.5 && < 0.12

5858 , case-insensitive >= 1.2.0.11 && < 1.3

5959 , hashable >= 1.2.7.0 && < 1.5

6060 , http-media >= 0.7.1.3 && < 0.9

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

@@ -62,7 +62,6 @@ import GHC.TypeLits

6262import Servant.API

6363import Servant.API.ContentTypes

6464import Servant.API.TypeLevel

65−import Servant.API.Generic

6665

6766import qualified Data.Universe.Helpers as U

6867

@@ -1151,9 +1150,6 @@ instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth r

11511150 authProxy = Proxy :: Proxy (BasicAuth realm usr)

11521151 action' = over authInfo (|> toAuthInfo authProxy) action

11531152

1154−instance HasDocs (ToServantApi api) => HasDocs (NamedRoutes api) where

1155− docsFor Proxy = docsFor (Proxy :: Proxy (ToServantApi api))

1156−

11571153-- ToSample instances for simple types

11581154instance ToSample NoContent

11591155instance ToSample Bool

servant-foreign/servant-foreign.cabal+4−4

@@ -41,7 +41,7 @@ library

4141 --

4242 -- note: mtl lower bound is so low because of GHC-7.8

4343 build-depends:

44− base >= 4.9 && < 4.17

44+ base >= 4.9 && < 4.16

4545 , text >= 1.2.3.0 && < 2.1

4646

4747 -- Servant dependencies

@@ -51,7 +51,7 @@ library

5151 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.

5252 -- Here can be exceptions if we really need features from the newer versions.

5353 build-depends:

54− base-compat >= 0.10.5 && < 0.13

54+ base-compat >= 0.10.5 && < 0.12

5555 , lens >= 4.17 && < 5.2

5656 , http-types >= 0.12.2 && < 0.13

5757

@@ -74,7 +74,7 @@ test-suite spec

7474

7575 -- Additional dependencies

7676 build-depends:

77− hspec >= 2.6.0 && <2.10

77+ hspec >= 2.6.0 && <2.9

7878 build-tool-depends:

79− hspec-discover:hspec-discover >=2.6.0 && <2.10

79+ hspec-discover:hspec-discover >=2.6.0 && <2.9

8080 default-language: Haskell2010

servant-http-streams/servant-http-streams.cabal+7−7

@@ -38,13 +38,13 @@ library

3838 -- Bundled with GHC: Lower bound to not force re-installs

3939 -- text and mtl are bundled starting with GHC-8.4

4040 build-depends:

41− base >= 4.9 && < 4.17

41+ base >= 4.9 && < 4.16

4242 , bytestring >= 0.10.8.1 && < 0.12

4343 , containers >= 0.5.7.1 && < 0.7

4444 , deepseq >= 1.4.2.0 && < 1.5

4545 , mtl >= 2.2.2 && < 2.3

4646 , text >= 1.2.3.0 && < 2.1

47− , time >= 1.6.0.1 && < 1.12

47+ , time >= 1.6.0.1 && < 1.10

4848 , transformers >= 0.5.2.0 && < 0.6

4949

5050 if !impl(ghc >= 8.2)

@@ -60,19 +60,19 @@ library

6060 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.

6161 -- Here can be exceptions if we really need features from the newer versions.

6262 build-depends:

63− base-compat >= 0.10.5 && < 0.13

63+ base-compat >= 0.10.5 && < 0.12

6464 , case-insensitive

6565 , http-streams >= 0.8.6.1 && < 0.9

6666 , http-media >= 0.7.1.3 && < 0.9

6767 , io-streams >= 1.5.0.1 && < 1.6

6868 , http-types >= 0.12.2 && < 0.13

69− , http-common >= 0.8.2.0 && < 0.9

69+ , http-common >= 0.8.2.0 && < 0.8.3

7070 , exceptions >= 0.10.0 && < 0.11

7171 , kan-extensions >= 5.2 && < 5.3

7272 , monad-control >= 1.0.2.3 && < 1.1

7373 , semigroupoids >= 5.3.1 && < 5.4

7474 , transformers-base >= 0.4.5.2 && < 0.5

75− , transformers-compat >= 0.6.2 && < 0.8

75+ , transformers-compat >= 0.6.2 && < 0.7

7676

7777 hs-source-dirs: src

7878 default-language: Haskell2010

@@ -112,7 +112,7 @@ test-suite spec

112112 -- Additional dependencies

113113 build-depends:

114114 entropy >= 0.4.1.3 && < 0.5

115− , hspec >= 2.6.0 && < 2.10

115+ , hspec >= 2.6.0 && < 2.9

116116 , HUnit >= 1.6.0.0 && < 1.7

117117 , network >= 2.8.0.0 && < 3.2

118118 , QuickCheck >= 2.12.6.1 && < 2.15

@@ -121,7 +121,7 @@ test-suite spec

121121 , tdigest >= 0.2 && < 0.3

122122

123123 build-tool-depends:

124− hspec-discover:hspec-discover >= 2.6.0 && < 2.10

124+ hspec-discover:hspec-discover >= 2.6.0 && < 2.9

125125

126126test-suite readme

127127 type: exitcode-stdio-1.0

servant-server/CHANGELOG.md+2−3

@@ -3,11 +3,10 @@

33

44Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions.

55

6−0.19.1

7−------

6+Unreleased

7+----------

88

99- Add `MonadFail` instance for `Handler` wrt [#1545](https://github.com/haskell-servant/servant/issues/1545)

10−- Support GHC 9.2 [#1525](https://github.com/haskell-servant/servant/issues/1525)

1110

12110.19

1312----

servant-server/example/greet.hs+1

@@ -18,6 +18,7 @@ import Network.Wai.Handler.Warp

1818

1919import Servant

2020import Servant.Server.Generic ()

21+import Servant.API.Generic

2122

2223-- * Example

2324

servant-server/servant-server.cabal+6−6

@@ -1,6 +1,6 @@

11cabal-version: 2.2

22name: servant-server

3−version: 0.19.1

3+version: 0.19

44

55synopsis: A family of combinators for defining webservices APIs and serving them

66category: Servant, Web

@@ -60,7 +60,7 @@ library

6060 -- Bundled with GHC: Lower bound to not force re-installs

6161 -- text and mtl are bundled starting with GHC-8.4

6262 build-depends:

63− base >= 4.9 && < 4.17

63+ base >= 4.9 && < 4.16

6464 , bytestring >= 0.10.8.1 && < 0.12

6565 , constraints >= 0.2 && < 0.14

6666 , containers >= 0.5.7.1 && < 0.7

@@ -72,13 +72,13 @@ library

7272 -- Servant dependencies

7373 -- strict dependency as we re-export 'servant' things.

7474 build-depends:

75− servant >= 0.19 && < 0.20

75+ servant >= 0.19

7676 , http-api-data >= 0.4.1 && < 0.4.4

7777

7878 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.

7979 -- Here can be exceptions if we really need features from the newer versions.

8080 build-depends:

81− base-compat >= 0.10.5 && < 0.13

81+ base-compat >= 0.10.5 && < 0.12

8282 , base64-bytestring >= 1.0.0.1 && < 1.3

8383 , exceptions >= 0.10.0 && < 0.11

8484 , http-media >= 0.7.1.3 && < 0.9

@@ -159,7 +159,7 @@ test-suite spec

159159 build-depends:

160160 aeson >= 1.4.1.0 && < 3

161161 , directory >= 1.3.0.0 && < 1.4

162− , hspec >= 2.6.0 && < 2.10

162+ , hspec >= 2.6.0 && < 2.9

163163 , hspec-wai >= 0.10.1 && < 0.12

164164 , QuickCheck >= 2.12.6.1 && < 2.15

165165 , should-not-typecheck >= 2.1.0 && < 2.2

@@ -167,4 +167,4 @@ test-suite spec

167167 , wai-extra >= 3.0.24.3 && < 3.2

168168

169169 build-tool-depends:

170− hspec-discover:hspec-discover >= 2.6.0 && <2.10

170+ hspec-discover:hspec-discover >= 2.6.0 && <2.9

servant-swagger/servant-swagger.cabal+7−7

@@ -50,7 +50,7 @@ source-repository head

5050custom-setup

5151 setup-depends:

5252 base >=4.9 && <5,

53− Cabal >= 1.24,

53+ Cabal >= 1.24 && < 3.5,

5454 cabal-doctest >=1.0.6 && <1.1

5555

5656library

@@ -72,12 +72,12 @@ library

7272 build-depends: aeson >=1.4.2.0 && <3

7373 , aeson-pretty >=0.8.7 && <0.9

7474 , base >=4.9.1.0 && <5

75− , base-compat >=0.10.5 && <0.13

76− , bytestring >=0.10.8.1 && <0.12

75+ , base-compat >=0.10.5 && <0.12

76+ , bytestring >=0.10.8.1 && <0.11

7777 , http-media >=0.7.1.3 && <0.9

7878 , insert-ordered-containers >=0.2.1.0 && <0.3

7979 , lens >=4.17 && <6

80− , servant >=0.18.2 && <0.20

80+ , servant >=0.18.1 && <0.20

8181 , singleton-bool >=0.1.4 && <0.2

8282 , swagger2 >=2.3.0.1 && <3

8383 , text >=1.2.3.0 && <2.1

@@ -106,14 +106,14 @@ test-suite spec

106106 type: exitcode-stdio-1.0

107107 hs-source-dirs: test

108108 main-is: Spec.hs

109− build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.10

109+ build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.8

110110 build-depends: base

111111 , base-compat

112112 , aeson >=1.4.2.0 && <3

113− , hspec >=2.6.0 && <2.10

113+ , hspec >=2.6.0 && <2.8

114114 , QuickCheck

115115 , lens

116− , lens-aeson >=1.0.2 && <1.3

116+ , lens-aeson >=1.0.2 && <1.2

117117 , servant

118118 , servant-swagger

119119 , swagger2

servant-swagger/src/Servant/Swagger.hs+3−5

@@ -55,7 +55,6 @@ import Servant.Swagger.Internal.Orphans ()

5555-- >>> import Data.Typeable

5656-- >>> import GHC.Generics

5757-- >>> import Servant.API

58−-- >>> import System.Environment

5958-- >>> import Test.Hspec

6059-- >>> import Test.QuickCheck

6160-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL8

@@ -65,7 +64,6 @@ import Servant.Swagger.Internal.Orphans ()

6564-- >>> :set -XGeneralizedNewtypeDeriving

6665-- >>> :set -XOverloadedStrings

6766-- >>> :set -XTypeOperators

68−-- >>> setEnv "HSPEC_COLOR" "no"

6967-- >>> data User = User { name :: String, age :: Int } deriving (Show, Generic, Typeable)

7068-- >>> newtype UserId = UserId Integer deriving (Show, Generic, Typeable, ToJSON)

7169-- >>> instance ToJSON User

@@ -162,11 +160,11 @@ import Servant.Swagger.Internal.Orphans ()

162160-- >>> instance Arbitrary UserId where arbitrary = UserId <$> arbitrary

163161-- >>> hspec $ validateEveryToJSON (Proxy :: Proxy UserAPI)

164162-- <BLANKLINE>

165−-- [User]...

163+-- [User]

166164-- ...

167−-- User...

165+-- User

168166-- ...

169−-- UserId...

167+-- UserId

170168-- ...

171169-- Finished in ... seconds

172170-- 3 examples, 0 failures

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

@@ -3,13 +3,11 @@

33{-# LANGUAGE DataKinds #-}

44{-# LANGUAGE FlexibleContexts #-}

55{-# LANGUAGE FlexibleInstances #-}

6−{-# LANGUAGE OverloadedLists #-}

76{-# LANGUAGE OverloadedStrings #-}

87{-# LANGUAGE PolyKinds #-}

98{-# LANGUAGE RankNTypes #-}

109{-# LANGUAGE ScopedTypeVariables #-}

1110{-# LANGUAGE TypeOperators #-}

12−{-# LANGUAGE TypeFamilies #-}

1311#if __GLASGOW_HASKELL__ >= 806

1412{-# LANGUAGE UndecidableInstances #-}

1513#endif

@@ -32,13 +30,11 @@ import qualified Data.Swagger as Swagger

3230import Data.Swagger.Declare

3331import Data.Text (Text)

3432import qualified Data.Text as Text

35−import GHC.Generics (D1, Meta(..), Rep)

3633import GHC.TypeLits

3734import Network.HTTP.Media (MediaType)

3835import Servant.API

3936import Servant.API.Description (FoldDescription,

4037 reflectDescription)

41−import Servant.API.Generic (ToServantApi, AsApi)

4238import Servant.API.Modifiers (FoldRequired)

4339

4440import Servant.Swagger.Internal.TypeLevel.API

@@ -153,10 +149,6 @@ mkEndpointNoContentVerb path _ = mempty

153149addParam :: Param -> Swagger -> Swagger

154150addParam param = allOperations.parameters %~ (Inline param :)

155151

156−-- | Add a tag to every operation in the spec.

157−addTag :: Text -> Swagger -> Swagger

158−addTag tag = allOperations.tags %~ ([tag] <>)

159−

160152-- | Add accepted content types to every operation in the spec.

161153addConsumes :: [MediaType] -> Swagger -> Swagger

162154addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs))

@@ -447,9 +439,6 @@ instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mo

447439 & required ?~ True

448440 & schema .~ ParamBody ref

449441

450−instance (HasSwagger (ToServantApi routes), KnownSymbol datatypeName, Rep (routes AsApi) ~ D1 ('MetaData datatypeName moduleName packageName isNewtype) f) => HasSwagger (NamedRoutes routes) where

451− toSwagger _ = addTag (Text.pack $ symbolVal (Proxy :: Proxy datatypeName)) (toSwagger (Proxy :: Proxy (ToServantApi routes)))

452−

453442-- =======================================================================

454443-- Below are the definitions that should be in Servant.API.ContentTypes

455444-- =======================================================================

servant-swagger/src/Servant/Swagger/Internal/Test.hs+6−8

@@ -29,12 +29,10 @@ import Servant.Swagger.Internal.TypeLevel

2929-- >>> import Control.Applicative

3030-- >>> import GHC.Generics

3131-- >>> import Test.QuickCheck

32−-- >>> import System.Environment (setEnv)

3332-- >>> :set -XDeriveGeneric

3433-- >>> :set -XGeneralizedNewtypeDeriving

3534-- >>> :set -XDataKinds

3635-- >>> :set -XTypeOperators

37−-- >>> setEnv "HSPEC_COLOR" "no"

3836

3937-- | Verify that every type used with @'JSON'@ content type in a servant API

4038-- has compatible @'ToJSON'@ and @'ToSchema'@ instances using @'validateToJSON'@.

@@ -55,10 +53,10 @@ import Servant.Swagger.Internal.TypeLevel

5553--

5654-- >>> hspec $ context "ToJSON matches ToSchema" $ validateEveryToJSON (Proxy :: Proxy UserAPI)

5755-- <BLANKLINE>

58−-- ToJSON matches ToSchema...

59−-- User...

56+-- ToJSON matches ToSchema

57+-- User

6058-- ...

61−-- UserId...

59+-- UserId

6260-- ...

6361-- Finished in ... seconds

6462-- 2 examples, 0 failures

@@ -120,11 +118,11 @@ validateEveryToJSONWithPatternChecker checker _ = props

120118-- :}

121119-- <BLANKLINE>

122120-- read . show == id

123−-- Bool...

121+-- Bool

124122-- ...

125−-- Int...

123+-- Int

126124-- ...

127−-- [Char]...

125+-- [Char]

128126-- ...

129127-- Finished in ... seconds

130128-- 3 examples, 0 failures

servant/servant.cabal+5−5

@@ -80,7 +80,7 @@ library

8080 --

8181 -- note: mtl lower bound is so low because of GHC-7.8

8282 build-depends:

83− base >= 4.9 && < 4.17

83+ base >= 4.9 && < 4.16

8484 , bytestring >= 0.10.8.1 && < 0.12

8585 , constraints >= 0.2

8686 , mtl >= 2.2.2 && < 2.3

@@ -98,7 +98,7 @@ library

9898 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.

9999 -- Here can be exceptions if we really need features from the newer versions.

100100 build-depends:

101− base-compat >= 0.10.5 && < 0.13

101+ base-compat >= 0.10.5 && < 0.12

102102 , aeson >= 1.4.1.0 && < 3

103103 , attoparsec >= 0.13.2.2 && < 0.15

104104 , bifunctors >= 5.5.3 && < 5.6

@@ -106,7 +106,7 @@ library

106106 , deepseq >= 1.4.2.0 && < 1.5

107107 , http-media >= 0.7.1.3 && < 0.9

108108 , http-types >= 0.12.2 && < 0.13

109− , mmorph >= 1.1.2 && < 1.3

109+ , mmorph >= 1.1.2 && < 1.2

110110 , network-uri >= 2.6.1.0 && < 2.7

111111 , QuickCheck >= 2.12.6.1 && < 2.15

112112 , string-conversions >= 0.4.0.1 && < 0.5

@@ -166,9 +166,9 @@ test-suite spec

166166

167167 -- Additional dependencies

168168 build-depends:

169− hspec >= 2.6.0 && < 2.10

169+ hspec >= 2.6.0 && < 2.9

170170 , QuickCheck >= 2.12.6.1 && < 2.15

171171 , quickcheck-instances >= 0.3.19 && < 0.4

172172

173173 build-tool-depends:

174− hspec-discover:hspec-discover >= 2.6.0 && < 2.10

174+ hspec-discover:hspec-discover >= 2.6.0 && < 2.9

servant/src/Servant/API.hs−4

@@ -38,7 +38,6 @@ module Servant.API (

3838

3939 -- * Sub-APIs defined as records of routes

4040 module Servant.API.NamedRoutes,

41− module Servant.API.Generic,

4241

4342 -- * Streaming endpoints, distinguished by HTTP method

4443 module Servant.API.Stream,

@@ -103,9 +102,6 @@ import Servant.API.Fragment

103102 (Fragment)

104103import Servant.API.Header

105104 (Header, Header')

106−import Servant.API.Generic

107− (GenericMode ((:-)), AsApi, ToServant, ToServantApi, GServantProduct,

108− GenericServant, fromServant, toServant, genericApi)

109105import Servant.API.HttpVersion

110106 (HttpVersion (..))

111107import Servant.API.IsSecure

servant/src/Servant/API/ContentTypes.hs+1−1

@@ -295,7 +295,7 @@ instance {-# OVERLAPPABLE #-}

295295-- then this would be taken care of. However there is no more specific instance

296296-- between that and 'MimeRender JSON a', so we do this instead

297297instance {-# OVERLAPPING #-} ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where

298− allMimeRender _ NoContent = map (, "") $ NE.toList $ contentTypes pctyp

298+ allMimeRender _ _ = map (, "") $ NE.toList $ contentTypes pctyp

299299 where

300300 pctyp = Proxy :: Proxy ctyp

301301

servant/test/Servant/API/ContentTypesSpec.hs−11

@@ -33,8 +33,6 @@ import Data.String.Conversions

3333import qualified Data.Text as TextS

3434import qualified Data.Text.Encoding as TextSE

3535import qualified Data.Text.Lazy as TextL

36−import Control.Exception

37− (evaluate)

3836import GHC.Generics

3937import Test.Hspec

4038import Test.QuickCheck

@@ -80,15 +78,6 @@ spec = describe "Servant.API.ContentTypes" $ do

8078 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do

8179 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)

8280

83− describe "The NoContent Content-Type type" $ do

84− let p = Proxy :: Proxy '[JSON]

85−

86− it "does not render any content" $

87− allMimeRender p NoContent `shouldSatisfy` (all (BSL8.null . snd))

88−

89− it "evaluates the NoContent value" $

90− evaluate (allMimeRender p (undefined :: NoContent)) `shouldThrow` anyErrorCall

91−

9281 describe "The PlainText Content-Type type" $ do

9382 let p = Proxy :: Proxy PlainText

9483