master..bd9151b · typeable/servant

.github/workflows/master.yml+26−14

since splitsnapshots

unifiedsplit

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

19 - "8.8.4"

20 - "8.10.7"

21 - "9.0.2"

22− - "9.2.2"

23

22

24 steps:

23 steps:

25 - uses: actions/checkout@v2

24 - uses: actions/checkout@v2

@@ -48,7 +47,10 @@ jobs:

48

47

49 - name: Configure

48 - name: Configure

50 run: |

49 run: |

50+ # Using separate store-dir because default one already has 'ghc-paths' package installed

51+ # with hardcoded path to ghcup's GHC path (which it was built with). This leads to failure in

52+ # doctest, as it tries to invoke that GHC, and it doesn't exist here.

51− cabal install --ignore-project -j2 doctest --constraint='doctest ^>=0.20'

53+ cabal --store-dir /tmp/cabal-store install --ignore-project -j2 doctest --constraint='doctest ^>=0.18'

52

54

53 - name: Build

55 - name: Build

54 run: |

56 run: |

@@ -59,28 +61,38 @@ jobs:

59 cabal test all

61 cabal test all

60

62

61 - name: Run doctests

63 - name: Run doctests

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

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

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

62 run: |

67 run: |

63 # Necessary for doctest to be found in $PATH

68 # Necessary for doctest to be found in $PATH

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

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

65

70

66− DOCTEST="cabal repl --with-ghc=doctest --ghc-options=-w"

71+ # Filter out base-compat-batteries from .ghc.environment.*, as its modules

72+ # conflict with those of base-compat.

73+ #

74+ # FIXME: This is an ugly hack. Ultimately, we'll want to use cabal-doctest

75+ # (or cabal v2-doctest, if it ever lands) to provide a clean GHC environment.

76+ # This might allow running doctests in GHCJS build as well.

77+ perl -i -e 'while (<ARGV>) { print unless /package-id\s+(base-compat-batteries)-\d+(\.\d+)*/; }' .ghc.environment.*

78+

67− (cd servant && eval $DOCTEST)

79+ (cd servant && doctest src)

68− (cd servant-client && eval $DOCTEST)

80+ (cd servant-client && doctest src)

69− (cd servant-client-core && eval $DOCTEST)

81+ (cd servant-client-core && doctest src)

70− (cd servant-http-streams && eval $DOCTEST)

82+ (cd servant-http-streams && doctest src)

71− (cd servant-docs && eval $DOCTEST)

83+ (cd servant-docs && doctest src)

72− (cd servant-foreign && eval $DOCTEST)

84+ (cd servant-foreign && doctest src)

73− (cd servant-server && eval $DOCTEST)

85+ (cd servant-server && doctest src)

74− (cd servant-machines && eval $DOCTEST)

86+ (cd servant-machines && doctest src)

75− (cd servant-conduit && eval $DOCTEST)

87+ (cd servant-conduit && doctest src)

76− (cd servant-pipes && eval $DOCTEST)

88+ (cd servant-pipes && doctest src)

77

89

78 stack:

90 stack:

79 name: stack / ghc ${{ matrix.ghc }}

91 name: stack / ghc ${{ matrix.ghc }}

80 runs-on: ubuntu-latest

92 runs-on: ubuntu-latest

81 strategy:

93 strategy:

82 matrix:

94 matrix:

83− stack: ["2.7.5"]

95+ stack: ["2.7.3"]

84 ghc: ["8.10.7"]

96 ghc: ["8.10.7"]

85

97

86 steps:

98 steps:

cabal.project+26

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

51tests: True

52optimization: False

53-- reorder-goals: True

54+

55+constraints:

56+ -- see https://github.com/haskell-infra/hackage-trustees/issues/119

57+ foundation >=0.0.14,

58+ memory <0.14.12 || >0.14.12

59+

60+constraints: base-compat ^>=0.11

61+constraints: semigroups ^>=0.19

62+

63+-- allow-newer: sqlite-simple-0.4.16.0:semigroups

64+-- allow-newer: direct-sqlite-2.3.24:semigroups

65+

66+-- needed for doctests

67+write-ghc-environment-files: always

68+

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

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

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

72+

73+allow-newer: servant-js:servant

74+allow-newer: servant-multipart:servant

75+allow-newer: servant-multipart:servant-server

76+allow-newer: servant-multipart-api:servant

77+

78+-- ghc 9

79+allow-newer: tdigest:base

changelog.d/1529deleted−10

@@ -1,10 +0,0 @@

1−synopsis: Fix performRequest in servant-client-ghcjs

2−prs: #1529

3−

4−description: {

5−

6−performRequest function in servant-client-ghcjs was not compatible with the

7−latest RunClient typeclass. Added the acceptStatus parameter and fixed the

8−functionality to match what servant-client provides.

9−

10−}

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/Makefile+1−1

@@ -10,7 +10,7 @@ BUILDDIR = _build

10

11# Put it first so that "make" without argument is like "make help".

12help:

13− @if [ ! -d venv ]; then echo "WARNING: There is no venv directory, did you forget to 'virtualenv venv'. Check README.md."; fi

13+ @if [ ! -d venv ]; then echo "WARNING: There is no venv directory, did you forget to 'virtualenv venv'. Check building-the-docs file."; fi

14 @if [ ! "z$$(which $(SPHINXBUILD))" = "z$$(pwd)/venv/bin/sphinx-build" ]; then echo "WARNING: Did you forgot to 'source venv/bin/activate'"; fi

15 @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)

16

doc/conf.py+2−1

@@ -46,7 +46,7 @@ master_doc = 'index'

46

47# General information about the project.

48project = u'Servant'

49−copyright = u'2022, Servant Contributors'

49+copyright = u'2018, Servant Contributors'

50author = u'Servant Contributors'

51

52# The version info for the project you're documenting, acts as replacement for

@@ -169,3 +169,4 @@ texinfo_documents = [

169source_parsers = {

170 '.lhs': CommonMarkParser,

171}

172+

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

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

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

12

13executable cookbock-curl-mock

14− if impl(ghc >= 9.2)

15− -- generic-arbitrary is incompatible

16− buildable: False

17 main-is: CurlMock.lhs

14 main-is: CurlMock.lhs

18 build-depends: base == 4.*

15 build-depends: base == 4.*

19 , aeson

16 , 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`

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

120

121```haskell

122− req' <- I.defaultMakeClientRequest burl req

122+ let req' = I.defaultMakeClientRequest burl req

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

124```

125

doc/tutorial/install.rst−26

@@ -40,29 +40,3 @@ nix

40`Nix <https://nixos.org/nix/>`_ users should feel free to take a look at

41the `nix/shell.nix` file in the repository and use it to provision a suitable

42environment to build and run the examples.

43−

44−Note for Ubuntu users

45−--------

46−

47−Ubuntu's packages for `ghc`, `cabal`, and `stack` are years out of date.

48−If the instructions above fail for you,

49−try replacing the Ubuntu packages with up-to-date versions.

50−First remove the installed versions:

51−

52−.. code-block:: bash

53−

54− # remove the obsolete versions

55− $ sudo apt remove ghc haskell-stack cabal-install

56−

57−Then install fresh versions of the Haskell toolchain

58−using the `ghcup <https://www.haskell.org/ghcup/install/>`_ installer.

59−

60−As of February 2022, one easy way to do this is by running a bootstrap script:

61−

62−.. code-block:: bash

63−

64− $ curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh

65−

66−The script is interactive and will prompt you for details about what

67−you want installed and where. To install manually,

68−see `the detailed instructions <https://www.haskell.org/ghcup/install/#manual-install>`_.

doc/tutorial/tutorial.cabal+1−1

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

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

65 , cookie >= 0.4.3 && < 0.5

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

67− , lucid >= 2.9.11 && < 2.12

67+ , lucid >= 2.9.11 && < 2.10

68 , random >= 1.1 && < 1.3

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

70 , time >= 1.6.0.1 && < 1.13

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

@@ -7,9 +7,9 @@ description: This package provides instances that allow generating clients fr

7 APIs that use

8 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.

9 .

10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.

10+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.

11category: Web, Servant, Authentication

12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme

12+homepage: http://github.com/haskell-servant/servant/servant-auth#readme

13bug-reports: https://github.com/haskell-servant/servant/issues

14author: Julian K. Arni

15maintainer: jkarni@gmail.com

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

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

32 ghc-options: -Wall

33 build-depends:

34− base >= 4.10 && < 4.17

34+ base >= 4.10 && < 4.16

35− , bytestring >= 0.10.6.0 && < 0.12

35+ , bytestring >= 0.10.6.0 && < 0.11

36 , containers >= 0.5.6.2 && < 0.7

37 , servant-auth == 0.4.*

38 , servant >= 0.13 && < 0.20

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

50 test

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

52 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

54

55 -- dependencies with bounds inherited from the library stanza

56 build-depends:

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

62

63 -- test dependencies

64 build-depends:

65− hspec >= 2.5.5 && < 2.10

65+ hspec >= 2.5.5 && < 2.9

66 , QuickCheck >= 2.11.3 && < 2.15

67 , aeson >= 1.3.1.1 && < 3

68− , bytestring >= 0.10.6.0 && < 0.12

68+ , bytestring >= 0.10.6.0 && < 0.11

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

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

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

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

@@ -7,9 +7,9 @@ description: This package provides instances that allow generating docs from

7 APIs that use

8 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.

9 .

10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.

10+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.

11category: Web, Servant, Authentication

12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme

12+homepage: http://github.com/haskell-servant/servant/servant-auth#readme

13bug-reports: https://github.com/haskell-servant/servant/issues

14author: Julian K. Arni

15maintainer: jkarni@gmail.com

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

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

36 ghc-options: -Wall

37 build-depends:

38− base >= 4.10 && < 4.17

38+ base >= 4.10 && < 4.16

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

40 , servant >= 0.13 && < 0.20

41 , servant-auth == 0.4.*

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

64 test

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

66 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

68

69 -- dependencies with bounds inherited from the library stanza

70 build-depends:

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

78 -- test dependencies

79 build-depends:

80 servant-auth-docs

81− , hspec >= 2.5.5 && < 2.10

81+ , hspec >= 2.5.5 && < 2.9

82 , QuickCheck >= 2.11.3 && < 2.15

83

84 default-language: Haskell2010

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

@@ -7,9 +7,9 @@ description: This package provides the required instances for using the @Auth

7 .

8 Both cookie- and token- (REST API) based authentication is provided.

9 .

10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.

10+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.

11category: Web, Servant, Authentication

12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme

12+homepage: http://github.com/haskell-servant/servant/servant-auth#readme

13bug-reports: https://github.com/haskell-servant/servant/issues

14author: Julian K. Arni

15maintainer: jkarni@gmail.com

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

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

32 ghc-options: -Wall

33 build-depends:

34− base >= 4.10 && < 4.17

34+ base >= 4.10 && < 4.16

35 , aeson >= 1.0.0.1 && < 3

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

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

38− , bytestring >= 0.10.6.0 && < 0.12

38+ , bytestring >= 0.10.6.0 && < 0.11

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

40 , cookie >= 0.4.4 && < 0.5

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

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

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

44 , jose >= 0.7.0.0 && < 0.10

45 , lens >= 4.16.1 && < 5.2

46− , memory >= 0.14.16 && < 0.18

46+ , memory >= 0.14.16 && < 0.17

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

48 , mtl >= 2.2.2 && < 2.3

49 , servant >= 0.13 && < 0.20

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

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

52 , tagged >= 0.8.4 && < 0.9

53 , text >= 1.2.3.0 && < 2.1

54− , time >= 1.5.0.1 && < 1.12

54+ , time >= 1.5.0.1 && < 1.10

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

56 , wai >= 3.2.1.2 && < 3.3

57

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

102 test

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

104 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

106

107 -- dependencies with bounds inherited from the library stanza

108 build-depends:

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

123 -- test dependencies

124 build-depends:

125 servant-auth-server

126− , hspec >= 2.5.5 && < 2.10

126+ , hspec >= 2.5.5 && < 2.8

127 , QuickCheck >= 2.11.3 && < 2.15

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

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

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

130 , warp >= 3.2.25 && < 3.4

131 , wreq >= 0.5.2.1 && < 0.6

132 other-modules:

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

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

33 -- | Algorithm used to sign JWT.

34 , jwtAlg :: Maybe Jose.Alg

35 -- | Keys used to validate JWT.

36− , validationKeys :: IO Jose.JWKSet

36+ , validationKeys :: Jose.JWKSet

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

38 -- intended recipient of the JWT.

39 , audienceMatches :: Jose.StringOrURI -> IsMatch

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

44defaultJWTSettings k = JWTSettings

45 { signingKey = k

46 , jwtAlg = Nothing

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

47+ , validationKeys = Jose.JWKSet [k]

48 , audienceMatches = const Matches }

49

50-- | 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

58

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

60verifyJWT jwtCfg input = do

61− keys <- validationKeys jwtCfg

62− verifiedJWT <- runExceptT $ do

61+ verifiedJWT <- liftIO $ runExceptT $ do

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

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

64 Jose.verifyClaims

63 Jose.verifyClaims

65 (jwtSettingsToJwtValidationSettings jwtCfg)

64 (jwtSettingsToJwtValidationSettings jwtCfg)

66− keys

65+ (validationKeys jwtCfg)

67 unverifiedJWT

66 unverifiedJWT

68 return $ case verifiedJWT of

67 return $ case verifiedJWT of

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

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

70 Right v -> case decodeJWT v of

69 Right v -> case decodeJWT v of

71 Left _ -> Nothing

70 Left _ -> Nothing

72− Right v' -> Just v'

71+ Right v' -> Just v'

servant-auth/servant-auth-swagger/servant-auth-swagger.cabal+10−6

@@ -7,9 +7,9 @@ description: This package provides instances that allow generating swagger2 s

7 APIs that use

8 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.

9 .

10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.

10+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.

11category: Web, Servant, Authentication

12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme

12+homepage: http://github.com/haskell-servant/servant/servant-auth#readme

13bug-reports: https://github.com/haskell-servant/servant/issues

14author: Julian K. Arni

15maintainer: jkarni@gmail.com

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

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

32 ghc-options: -Wall

33 build-depends:

34− base >= 4.10 && < 4.17

34+ base >= 4.10 && < 4.16

35 , text >= 1.2.3.0 && < 2.1

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

37 , swagger2 >= 2.2.2 && < 3

38 , servant >= 0.13 && < 0.20

39 , servant-auth == 0.4.*

40 , lens >= 4.16.1 && < 5.2

41+ if impl(ghc >= 9)

42+ buildable: False

41 exposed-modules:

43 exposed-modules:

42 Servant.Auth.Swagger

44 Servant.Auth.Swagger

43 default-language: Haskell2010

45 default-language: Haskell2010

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

49 test

51 test

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

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

51 ghc-options: -Wall

53 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

53 -- dependencies with bounds inherited from the library stanza

55 -- dependencies with bounds inherited from the library stanza

54 build-depends:

56 build-depends:

55 base

57 base

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

59 , servant

61 , servant

60 , servant-auth

62 , servant-auth

61 , lens

63 , lens

62−

64+ if impl(ghc >= 9)

65+ buildable: False

66+

63 -- test dependencies

67 -- test dependencies

64 build-depends:

68 build-depends:

65 servant-auth-swagger

69 servant-auth-swagger

66− , hspec >= 2.5.5 && < 2.10

70+ , hspec >= 2.5.5 && < 2.9

67 , QuickCheck >= 2.11.3 && < 2.15

71 , QuickCheck >= 2.11.3 && < 2.15

68 other-modules:

72 other-modules:

69 Servant.Auth.SwaggerSpec

73 Servant.Auth.SwaggerSpec

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

@@ -9,9 +9,9 @@ description: This package provides an @Auth@ combinator for 'servant'. This c

9 'servant-auth' additionally provides concrete authentication schemes, such

10 as Basic Access Authentication, JSON Web Tokens, and Cookies.

11 .

12− For more details on how to use this, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.

12+ For more details on how to use this, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.

13category: Web, Servant, Authentication

14−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme

14+homepage: http://github.com/haskell-servant/servant/servant-auth#readme

15bug-reports: https://github.com/haskell-servant/servant/issues

16author: Julian K. Arni

17maintainer: jkarni@gmail.com

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

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

34 ghc-options: -Wall

35 build-depends:

36− base >= 4.10 && < 4.17

36+ base >= 4.10 && < 4.16

37 , containers >= 0.6 && < 0.7

38 , aeson >= 1.3.1.1 && < 3

39 , jose >= 0.7.0.0 && < 0.10

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

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

50 --

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

52 build-depends:

53− base >= 4.9 && < 4.17

53+ base >= 4.9 && < 4.16

54 , bytestring >= 0.10.8.1 && < 0.12

55 , constraints >= 0.2 && < 0.14

56 , containers >= 0.5.7.1 && < 0.7

57 , deepseq >= 1.4.2.0 && < 1.5

58 , text >= 1.2.3.0 && < 2.1

59 , 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

61

62 if !impl(ghc >= 8.2)

63 build-depends:

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

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

72 build-depends:

73 aeson >= 1.4.1.0 && < 3

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

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

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

76 , exceptions >= 0.10.0 && < 0.11

77 , free >= 5.1 && < 5.2

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

104 -- Additional dependencies

105 build-depends:

106 deepseq >= 1.4.2.0 && < 1.5

107− , hspec >= 2.6.0 && < 2.10

107+ , hspec >= 2.6.0 && < 2.9

108 , QuickCheck >= 2.12.6.1 && < 2.15

109

110 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.hs−1

@@ -59,7 +59,6 @@ module Servant.Client.Core

59 , appendToPath

60 , setRequestBodyLBS

61 , setRequestBody

62− , encodeQueryParamValue

63 ) where

62 ) where

64import Servant.Client.Core.Auth

63import Servant.Client.Core.Auth

65import Servant.Client.Core.BaseUrl

64import Servant.Client.Core.BaseUrl

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

@@ -33,7 +33,9 @@ import Control.Arrow

33import Control.Monad

34 (unless)

35import qualified Data.ByteString as BS

36+import Data.ByteString.Builder

37+ (toLazyByteString)

36−import qualified Data.ByteString.Lazy as BL

38+import qualified Data.ByteString.Lazy as BL

37import Data.Either

39import Data.Either

38 (partitionEithers)

40 (partitionEithers)

39import Data.Constraint (Dict(..))

41import Data.Constraint (Dict(..))

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

208 clientWithRoute pm (Proxy :: Proxy api)

210 clientWithRoute pm (Proxy :: Proxy api)

209 (appendToPath p req)

211 (appendToPath p req)

210

212

211− where p = toEncodedUrlPiece val

213+ where p = (toUrlPiece val)

212

214

213 hoistClientMonad pm _ f cl = \a ->

215 hoistClientMonad pm _ f cl = \a ->

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

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

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

243 clientWithRoute pm (Proxy :: Proxy sublayout)

245 clientWithRoute pm (Proxy :: Proxy sublayout)

244 (foldl' (flip appendToPath) req ps)

246 (foldl' (flip appendToPath) req ps)

245

247

246− where ps = map toEncodedUrlPiece vals

248+ where ps = map (toUrlPiece) vals

247

249

248 hoistClientMonad pm _ f cl = \as ->

250 hoistClientMonad pm _ f cl = \as ->

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

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

@@ -569,7 +571,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire

569 (Proxy :: Proxy mods) add (maybe req add) mparam

571 (Proxy :: Proxy mods) add (maybe req add) mparam

570 where

572 where

571 add :: a -> Request

573 add :: a -> Request

572− add param = appendToQueryString pname (Just $ encodeQueryParamValue param) req

574+ add param = appendToQueryString pname (Just $ encodeQueryParam param) req

573

575

574 pname :: Text

576 pname :: Text

575 pname = pack $ symbolVal (Proxy :: Proxy sym)

577 pname = pack $ symbolVal (Proxy :: Proxy sym)

@@ -577,6 +579,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire

577 hoistClientMonad pm _ f cl = \arg ->

579 hoistClientMonad pm _ f cl = \arg ->

578 hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)

580 hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)

579

581

582+encodeQueryParam :: ToHttpApiData a => a -> BS.ByteString

583+encodeQueryParam = BL.toStrict . toLazyByteString . toEncodedUrlPiece

584+

580-- | If you use a 'QueryParams' in one of your endpoints in your API,

585-- | If you use a 'QueryParams' in one of your endpoints in your API,

581-- the corresponding querying function will automatically take

586-- the corresponding querying function will automatically take

582-- an additional argument, a list of values of the type specified

587-- an additional argument, a list of values of the type specified

@@ -618,7 +623,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)

618 )

623 )

619

624

620 where pname = pack $ symbolVal (Proxy :: Proxy sym)

625 where pname = pack $ symbolVal (Proxy :: Proxy sym)

621− paramlist' = map (Just . encodeQueryParamValue) paramlist

626+ paramlist' = map (Just . encodeQueryParam) paramlist

622

627

623 hoistClientMonad pm _ f cl = \as ->

628 hoistClientMonad pm _ f cl = \as ->

624 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)

629 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)

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

740 clientWithRoute pm (Proxy :: Proxy api)

745 clientWithRoute pm (Proxy :: Proxy api)

741 (appendToPath p req)

746 (appendToPath p req)

742

747

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

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

744

749

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

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

746

751

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

874--

879--

875-- Example:

880-- Example:

876--

881--

877−-- @

882+-- @@

878-- type Api = NamedRoutes RootApi

883-- type Api = NamedRoutes RootApi

879--

884--

880-- data RootApi mode = RootApi

885-- data RootApi mode = RootApi

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

895--

900--

896-- endpointClient :: ClientM Person

901-- endpointClient :: ClientM Person

897-- endpointClient = client // subApi // endpoint

902-- endpointClient = client // subApi // endpoint

898−-- @

903+-- @@

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

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

900x // f = f x

905x // f = f x

901

906

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

906--

911--

907-- Example:

912-- Example:

908--

913--

909−-- @

914+-- @@

910-- type Api = NamedRoutes RootApi

915-- type Api = NamedRoutes RootApi

911--

916--

912-- data RootApi mode = RootApi

917-- data RootApi mode = RootApi

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

931--

936--

932-- endpointClient :: ClientM Person

937-- endpointClient :: ClientM Person

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

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

934−-- @

939+-- @@

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

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

936(/:) = flip

941(/:) = flip

937

942

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

@@ -17,7 +17,6 @@ module Servant.Client.Core.Request (

17 addHeader,

18 appendToPath,

19 appendToQueryString,

20− encodeQueryParamValue,

21 setRequestBody,

20 setRequestBody,

22 setRequestBodyLBS,

21 setRequestBodyLBS,

23 ) where

22 ) where

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

34import Data.Bitraversable

33import Data.Bitraversable

35 (Bitraversable (..), bifoldMapDefault, bimapDefault)

34 (Bitraversable (..), bifoldMapDefault, bimapDefault)

36import qualified Data.ByteString as BS

35import qualified Data.ByteString as BS

37−import Data.ByteString.Builder

38− (Builder)

39import qualified Data.ByteString.Builder as Builder

36import qualified Data.ByteString.Builder as Builder

40import qualified Data.ByteString.Lazy as LBS

37import qualified Data.ByteString.Lazy as LBS

41import qualified Data.Sequence as Seq

38import qualified Data.Sequence as Seq

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

51 (MediaType)

48 (MediaType)

52import Network.HTTP.Types

49import Network.HTTP.Types

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

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

54− http11, methodGet, urlEncodeBuilder)

51+ http11, methodGet)

55import Servant.API

52import Servant.API

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

53+ (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)

57

54

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

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

59

56

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

114 rnfB Nothing = ()

111 rnfB Nothing = ()

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

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

116

113

117−type Request = RequestF RequestBody Builder

114+type Request = RequestF RequestBody Builder.Builder

118

115

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

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

120data RequestBody

117data RequestBody

@@ -145,31 +142,18 @@ defaultRequest = Request

145 , requestMethod = methodGet

142 , requestMethod = methodGet

146 }

143 }

147

144

148−-- | Append extra path to the request being constructed.

149−--

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

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

145+appendToPath :: Text -> Request -> Request

152appendToPath p req

146appendToPath p req

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

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

154

148

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

156−--

157−appendToQueryString :: Text -- ^ query param name

149+appendToQueryString :: Text -- ^ param name

158− -> Maybe BS.ByteString -- ^ query param value

150+ -> Maybe BS.ByteString -- ^ param value

159 -> Request

151 -> Request

160 -> Request

152 -> Request

161appendToQueryString pname pvalue req

153appendToQueryString pname pvalue req

162 = req { requestQueryString = requestQueryString req

154 = req { requestQueryString = requestQueryString req

163 Seq.|> (encodeUtf8 pname, pvalue)}

155 Seq.|> (encodeUtf8 pname, pvalue)}

164

156

165−-- | Encode a query parameter value.

166−--

167−encodeQueryParamValue :: ToHttpApiData a => a -> BS.ByteString

168−encodeQueryParamValue = LBS.toStrict . Builder.toLazyByteString

169− . urlEncodeBuilder True . encodeUtf8 . toQueryParam

170−

171−-- | Add header to the request being constructed.

172−--

173addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request

157addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request

174addHeader name val req

158addHeader name val req

175 = req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}

159 = req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}

servant-client-ghcjs/servant-client-ghcjs.cabal+1−1

@@ -38,7 +38,7 @@ library

38 Servant.Client.Internal.XhrClient

39

40 build-depends:

41− base >=4.11 && <5

41+ base >=4.11 && <4.12

42 , bytestring >=0.10 && <0.12

43 , case-insensitive >=1.2.0.0 && <1.3.0.0

44 , containers >=0.5 && <0.7

servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs+5−8

@@ -120,7 +120,7 @@ instance Exception StreamingNotSupportedException where

120 displayException _ = "streamingRequest: streaming is not supported!"

121

122instance RunClient ClientM where

123− runRequestAcceptStatus = performRequest

123+ runRequest = performRequest

124 throwClientError = throwError

125

126runClientMOrigin :: ClientM a -> ClientEnv -> IO (Either ClientError a)

@@ -152,18 +152,15 @@ runClientM m = do

152

153 runClientMOrigin m (ClientEnv (BaseUrl protocol hostname port ""))

154

155−performRequest :: Maybe [Status] -> Request -> ClientM Response

155+performRequest :: Request -> ClientM Response

156−performRequest acceptStatus req = do

156+performRequest req = do

157 xhr <- liftIO initXhr

158 burl <- asks baseUrl

159 liftIO $ performXhr xhr burl req

160 resp <- toResponse xhr

161

162− let status = responseStatusCode resp

162+ let status = statusCode (responseStatusCode resp)

163− goodStatus = case acceptStatus of

163+ unless (status >= 200 && status < 300) $ do

164− Nothing -> statusIsSuccessful status

165− Just good -> status `elem` good

166− unless goodStatus $ do

167 let f b = (burl, BL.toStrict $ toLazyByteString b)

164 let f b = (burl, BL.toStrict $ toLazyByteString b)

168 throwError $ FailureResponse (bimap (const ()) f req) resp

165 throwError $ FailureResponse (bimap (const ()) f req) resp

169

166

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

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

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

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

43 build-depends:

44− base >= 4.9 && < 4.17

44+ base >= 4.9 && < 4.16

45 , bytestring >= 0.10.8.1 && < 0.12

46 , containers >= 0.5.7.1 && < 0.7

47 , deepseq >= 1.4.2.0 && < 1.5

48 , mtl >= 2.2.2 && < 2.3

49 , stm >= 2.4.5.1 && < 2.6

50 , text >= 1.2.3.0 && < 2.1

51− , time >= 1.6.0.1 && < 1.12

51+ , time >= 1.6.0.1 && < 1.10

52 , transformers >= 0.5.2.0 && < 0.6

53

54 if !impl(ghc >= 8.2)

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

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

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

66 build-depends:

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

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

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

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

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

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

124 -- Additional dependencies

125 build-depends:

126 entropy >= 0.4.1.3 && < 0.5

127− , hspec >= 2.6.0 && < 2.10

127+ , hspec >= 2.6.0 && < 2.9

128 , HUnit >= 1.6.0.0 && < 1.7

129 , network >= 2.8.0.0 && < 3.2

130 , QuickCheck >= 2.12.6.1 && < 2.15

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

133 , tdigest >= 0.2 && < 0.3

134

135 build-tool-depends:

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

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

137

138test-suite readme

139 type: exitcode-stdio-1.0

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

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

24import Control.Monad.Base

25 (MonadBase (..))

26import Control.Monad.Catch

27− (MonadCatch, MonadThrow, MonadMask)

27+ (MonadCatch, MonadThrow)

28import Control.Monad.Error.Class

29 (MonadError (..))

30import Control.Monad.IO.Class

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

80 { manager :: Client.Manager

81 , baseUrl :: BaseUrl

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

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

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

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

85 -- Note that:

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

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

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

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

138 , MonadReader ClientEnv, MonadError ClientError, MonadThrow

139− , MonadCatch, MonadMask)

139+ , MonadCatch)

140

141instance MonadBase IO ClientM where

142 liftBase = ClientM . liftBase

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

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

163performRequest acceptStatus req = do

164 ClientEnv m burl cookieJar' createClientRequest <- ask

165− clientRequest <- liftIO $ createClientRequest burl req

165+ let clientRequest = createClientRequest burl req

166 request <- case cookieJar' of

167 Nothing -> pure clientRequest

168 Just cj -> liftIO $ do

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

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

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

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

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

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

233−defaultMakeClientRequest burl r = return Client.defaultRequest

233+defaultMakeClientRequest burl r = Client.defaultRequest

234 { Client.method = requestMethod r

235 , Client.host = fromString $ baseUrlHost burl

236 , Client.port = baseUrlPort burl

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

246 where

247 -- Content-Type and Accept are specified by requestBody and requestAccept

248 headers = filter (\(h, _) -> h /= "Accept" && h /= "Content-Type") $

249− toList $ requestHeaders r

249+ toList $requestHeaders r

250

251 acceptHdr

252 | null hs = Nothing

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

289 Https -> True

290

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

292− buildQueryString [] = mempty

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

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

294

293

295 addQueryParam qs (k, v) =

294 addQueryParam qs (k, v) =

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

295 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

140performRequest acceptStatus req = do

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

142 ClientEnv m burl cookieJar' createClientRequest <- ask

143− clientRequest <- liftIO $ createClientRequest burl req

143+ let clientRequest = createClientRequest burl req

144 request <- case cookieJar' of

145 Nothing -> pure clientRequest

146 Just cj -> liftIO $ do

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

177 m <- asks manager

178 burl <- asks baseUrl

179 createClientRequest <- asks makeClientRequest

180− request <- liftIO $ createClientRequest burl req

180+ let request = createClientRequest burl req

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

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

183 let status = Client.responseStatus res

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

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

160 WithStatus 301 Text]

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

162 :<|> NamedRoutes RecordRoutes

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

164

163

165api :: Proxy Api

164api :: Proxy Api

166api = Proxy

165api = Proxy

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

215 :<|> EmptyClient

214 :<|> EmptyClient

216 :<|> uverbGetSuccessOrRedirect

215 :<|> uverbGetSuccessOrRedirect

217 :<|> uverbGetCreated

216 :<|> uverbGetCreated

218− :<|> recordRoutes

217+ :<|> recordRoutes = client api

219− :<|> captureVerbatim = client api

220

218

221server :: Application

219server :: Application

222server = serve api (

220server = serve api (

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

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

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

262 }

260 }

263 }

261 }

264− :<|> pure . decodeUtf8 . unVerbatim

265 )

262 )

266

263

267-- * api for testing failures

264-- * api for testing failures

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

373

370

374instance FromHttpApiData UrlEncodedByteString where

371instance FromHttpApiData UrlEncodedByteString where

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

372 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

36import Data.Monoid ()

37import Data.Text

38 (Text)

39−import Data.Text.Encoding

40− (encodeUtf8)

41import qualified Network.HTTP.Client as C

39import qualified Network.HTTP.Client as C

42import qualified Network.HTTP.Types as HTTP

40import qualified Network.HTTP.Types as HTTP

43import Test.Hspec

41import Test.Hspec

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

162 mgr <- C.newManager C.defaultManagerSettings

160 mgr <- C.newManager C.defaultManagerSettings

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

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

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

162 -- 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")] })

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

166− (defaultMakeClientRequest url r)

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

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

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

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

169 case res of

166 case res of

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

199 case eitherResponse of

196 case eitherResponse of

200 Left clientError -> fail $ show clientError

197 Left clientError -> fail $ show clientError

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

198 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-conduit/servant-conduit.cabal+1−1

@@ -23,7 +23,7 @@ extra-source-files:

23

24source-repository head

25 type: git

26− location: http://github.com/haskell-servant/servant.git

26+ location: http://github.com/haskell-servant/servant-conduit.git

27

28library

29 exposed-modules: Servant.Conduit

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

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

41 --

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

43 build-depends:

44− base >= 4.9 && < 4.17

44+ base >= 4.9 && < 4.16

45 , bytestring >= 0.10.8.1 && < 0.12

46 , text >= 1.2.3.0 && < 2.1

47

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

54 build-depends:

55 aeson >= 1.4.1.0 && < 3

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

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

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

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

59 , hashable >= 1.2.7.0 && < 1.5

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

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

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

62import Servant.API

63import Servant.API.ContentTypes

64import Servant.API.TypeLevel

65−import Servant.API.Generic

66

65

67import qualified Data.Universe.Helpers as U

66import qualified Data.Universe.Helpers as U

68

67

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

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

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

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

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

1153

1152

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

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

1156−

1157-- ToSample instances for simple types

1153-- ToSample instances for simple types

1158instance ToSample NoContent

1154instance ToSample NoContent

1159instance ToSample Bool

1155instance ToSample Bool

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

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

41 --

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

43 build-depends:

44− base >= 4.9 && < 4.17

44+ base >= 4.9 && < 4.16

45 , text >= 1.2.3.0 && < 2.1

46

47 -- Servant dependencies

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

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

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

53 build-depends:

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

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

55 , lens >= 4.17 && < 5.2

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

57

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

74

75 -- Additional dependencies

76 build-depends:

77− hspec >= 2.6.0 && <2.10

77+ hspec >= 2.6.0 && <2.9

78 build-tool-depends:

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

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

80 default-language: Haskell2010

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

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

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

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

40 build-depends:

41− base >= 4.9 && < 4.17

41+ base >= 4.9 && < 4.16

42 , bytestring >= 0.10.8.1 && < 0.12

43 , containers >= 0.5.7.1 && < 0.7

44 , deepseq >= 1.4.2.0 && < 1.5

45 , mtl >= 2.2.2 && < 2.3

46 , text >= 1.2.3.0 && < 2.1

47− , time >= 1.6.0.1 && < 1.12

47+ , time >= 1.6.0.1 && < 1.10

48 , transformers >= 0.5.2.0 && < 0.6

49

50 if !impl(ghc >= 8.2)

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

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

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

62 build-depends:

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

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

64 , case-insensitive

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

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

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

68 , 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

70 , exceptions >= 0.10.0 && < 0.11

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

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

73 , semigroupoids >= 5.3.1 && < 5.4

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

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

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

76

77 hs-source-dirs: src

78 default-language: Haskell2010

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

112 -- Additional dependencies

113 build-depends:

114 entropy >= 0.4.1.3 && < 0.5

115− , hspec >= 2.6.0 && < 2.10

115+ , hspec >= 2.6.0 && < 2.9

116 , HUnit >= 1.6.0.0 && < 1.7

117 , network >= 2.8.0.0 && < 3.2

118 , QuickCheck >= 2.12.6.1 && < 2.15

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

121 , tdigest >= 0.2 && < 0.3

122

123 build-tool-depends:

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

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

125

126test-suite readme

127 type: exitcode-stdio-1.0

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

@@ -23,7 +23,7 @@ extra-source-files:

23

24source-repository head

25 type: git

26− location: http://github.com/haskell-servant/servant.git

26+ location: http://github.com/haskell-servant/servant-machines.git

27

28library

29 exposed-modules: Servant.Machines

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

@@ -23,7 +23,7 @@ extra-source-files:

23

24source-repository head

25 type: git

26− location: http://github.com/haskell-servant/servant.git

26+ location: http://github.com/haskell-servant/servant-pipes.git

27

28library

29 exposed-modules: Servant.Pipes

servant-server/CHANGELOG.md−6

@@ -3,12 +3,6 @@

3

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

5

6−0.19.1

7−------

8−

9−- 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)

11−

120.19

60.19

13----

7----

14

8

servant-server/example/greet.hs+1

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

18

19import Servant

20import Servant.Server.Generic ()

21+import Servant.API.Generic

21

22

22-- * Example

23-- * Example

23

24

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

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

1cabal-version: 2.2

2name: servant-server

3−version: 0.19.1

3+version: 0.19

4

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

6category: Servant, Web

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

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

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

62 build-depends:

63− base >= 4.9 && < 4.17

63+ base >= 4.9 && < 4.16

64 , bytestring >= 0.10.8.1 && < 0.12

65 , constraints >= 0.2 && < 0.14

66 , containers >= 0.5.7.1 && < 0.7

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

72 -- Servant dependencies

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

74 build-depends:

75− servant >= 0.19 && < 0.20

75+ servant >= 0.19

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

77

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

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

80 build-depends:

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

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

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

83 , exceptions >= 0.10.0 && < 0.11

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

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

159 build-depends:

160 aeson >= 1.4.1.0 && < 3

161 , directory >= 1.3.0.0 && < 1.4

162− , hspec >= 2.6.0 && < 2.10

162+ , hspec >= 2.6.0 && < 2.9

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

164 , QuickCheck >= 2.12.6.1 && < 2.15

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

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

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

168

169 build-tool-depends:

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

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

servant-server/src/Servant/Server.hs+2−3

@@ -235,7 +235,7 @@ hoistServer p = hoistServerWithContext p (Proxy :: Proxy '[])

235-- > │ └─ e/

236-- > │ └─•

237-- > ├─ b/

238−-- > │ └─ <x::Int>/

238+-- > │ └─ <capture>/

239-- > │ ├─•

240-- > │ ┆

241-- > │ └─•

@@ -252,8 +252,7 @@ hoistServer p = hoistServerWithContext p (Proxy :: Proxy '[])

252--

253-- [@─•@] Leaves reflect endpoints.

254--

255−-- [@\<x::Int\>/@] This is a delayed capture of a single

255+-- [@\<capture\>/@] This is a delayed capture of a path component.

256−-- path component named @x@, of expected type @Int@.

257--

256--

258-- [@\<raw\>@] This is a part of the API we do not know anything about.

257-- [@\<raw\>@] This is a part of the API we do not know anything about.

259--

258--

servant-server/src/Servant/Server/Internal.hs+4−6

@@ -173,7 +173,7 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont

173-- > server = getBook

174-- > where getBook :: Text -> Handler Book

175-- > getBook isbn = ...

176−instance (KnownSymbol capture, FromHttpApiData a, Typeable a

176+instance (KnownSymbol capture, FromHttpApiData a

177 , HasServer api context, SBoolI (FoldLenient mods)

178 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters

179 )

@@ -185,7 +185,7 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a

185 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

186

187 route Proxy context d =

188− CaptureRouter [hint] $

188+ CaptureRouter $

189 route (Proxy :: Proxy api)

190 context

191 (addCapture d $ \ txt -> withRequest $ \ request ->

@@ -197,7 +197,6 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a

197 where

198 rep = typeRep (Proxy :: Proxy Capture')

199 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)

200− hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy a))

201

200

202-- | If you use 'CaptureAll' in one of the endpoints for your API,

201-- | If you use 'CaptureAll' in one of the endpoints for your API,

203-- this automatically requires your server-side handler to be a

202-- this automatically requires your server-side handler to be a

@@ -216,7 +215,7 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a

216-- > server = getSourceFile

215-- > server = getSourceFile

217-- > where getSourceFile :: [Text] -> Handler Book

216-- > where getSourceFile :: [Text] -> Handler Book

218-- > getSourceFile pathSegments = ...

217-- > getSourceFile pathSegments = ...

219−instance (KnownSymbol capture, FromHttpApiData a, Typeable a

218+instance (KnownSymbol capture, FromHttpApiData a

220 , HasServer api context

219 , HasServer api context

221 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters

220 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters

222 )

221 )

@@ -228,7 +227,7 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a

228 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

227 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

229

228

230 route Proxy context d =

229 route Proxy context d =

231− CaptureAllRouter [hint] $

230+ CaptureAllRouter $

232 route (Proxy :: Proxy api)

231 route (Proxy :: Proxy api)

233 context

232 context

234 (addCapture d $ \ txts -> withRequest $ \ request ->

233 (addCapture d $ \ txts -> withRequest $ \ request ->

@@ -239,7 +238,6 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a

239 where

238 where

240 rep = typeRep (Proxy :: Proxy CaptureAll)

239 rep = typeRep (Proxy :: Proxy CaptureAll)

241 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)

240 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)

242− hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy [a]))

243

241

244allowedMethodHead :: Method -> Request -> Bool

242allowedMethodHead :: Method -> Request -> Bool

245allowedMethodHead method request = method == methodGet && requestMethod request == methodHead

243allowedMethodHead method request = method == methodGet && requestMethod request == methodHead

servant-server/src/Servant/Server/Internal/Handler.hs+2−7

@@ -13,19 +13,17 @@ import Control.Monad.Base

13import Control.Monad.Catch

14 (MonadCatch, MonadMask, MonadThrow)

15import Control.Monad.Error.Class

16− (MonadError, throwError)

16+ (MonadError)

17import Control.Monad.IO.Class

18 (MonadIO)

19import Control.Monad.Trans.Control

20 (MonadBaseControl (..))

21import Control.Monad.Trans.Except

22 (ExceptT, runExceptT)

23−import Data.String

24− (fromString)

25import GHC.Generics

23import GHC.Generics

26 (Generic)

24 (Generic)

27import Servant.Server.Internal.ServerError

25import Servant.Server.Internal.ServerError

28− (ServerError, errBody, err500)

26+ (ServerError)

29

27

30newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }

28newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }

31 deriving

29 deriving

@@ -34,9 +32,6 @@ newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }

34 , MonadThrow, MonadCatch, MonadMask

32 , MonadThrow, MonadCatch, MonadMask

35 )

33 )

36

34

37−instance MonadFail Handler where

38− fail str = throwError err500 { errBody = fromString str }

39−

40instance MonadBase IO Handler where

35instance MonadBase IO Handler where

41 liftBase = Handler . liftBase

36 liftBase = Handler . liftBase

42

37

servant-server/src/Servant/Server/Internal/Router.hs+14−31

@@ -9,16 +9,12 @@ import Prelude.Compat

9

10import Data.Function

11 (on)

12−import Data.List

13− (nub)

14import Data.Map

12import Data.Map

15 (Map)

13 (Map)

16import qualified Data.Map as M

14import qualified Data.Map as M

17import Data.Text

15import Data.Text

18 (Text)

16 (Text)

19import qualified Data.Text as T

17import qualified Data.Text as T

20−import Data.Typeable

21− (TypeRep)

22import Network.Wai

18import Network.Wai

23 (Response, pathInfo)

19 (Response, pathInfo)

24import Servant.Server.Internal.ErrorFormatter

20import Servant.Server.Internal.ErrorFormatter

@@ -28,18 +24,6 @@ import Servant.Server.Internal.ServerError

28

24

29type Router env = Router' env RoutingApplication

25type Router env = Router' env RoutingApplication

30

26

31−data CaptureHint = CaptureHint

32− { captureName :: Text

33− , captureType :: TypeRep

34− }

35− deriving (Show, Eq)

36−

37−toCaptureTag :: CaptureHint -> Text

38−toCaptureTag hint = captureName hint <> "::" <> (T.pack . show) (captureType hint)

39−

40−toCaptureTags :: [CaptureHint] -> Text

41−toCaptureTags hints = "<" <> T.intercalate "|" (map toCaptureTag hints) <> ">"

42−

43-- | Internal representation of a router.

27-- | Internal representation of a router.

44--

28--

45-- The first argument describes an environment type that is

29-- The first argument describes an environment type that is

@@ -52,10 +36,10 @@ data Router' env a =

52 -- ^ the map contains routers for subpaths (first path component used

36 -- ^ the map contains routers for subpaths (first path component used

53 -- for lookup and removed afterwards), the list contains handlers

37 -- for lookup and removed afterwards), the list contains handlers

54 -- for the empty path, to be tried in order

38 -- for the empty path, to be tried in order

55− | CaptureRouter [CaptureHint] (Router' (Text, env) a)

39+ | CaptureRouter (Router' (Text, env) a)

56 -- ^ first path component is passed to the child router in its

40 -- ^ first path component is passed to the child router in its

57 -- environment and removed afterwards

41 -- environment and removed afterwards

58− | CaptureAllRouter [CaptureHint] (Router' ([Text], env) a)

42+ | CaptureAllRouter (Router' ([Text], env) a)

59 -- ^ all path components are passed to the child router in its

43 -- ^ all path components are passed to the child router in its

60 -- environment and are removed afterwards

44 -- environment and are removed afterwards

61 | RawRouter (env -> a)

45 | RawRouter (env -> a)

@@ -85,8 +69,8 @@ leafRouter l = StaticRouter M.empty [l]

85choice :: Router' env a -> Router' env a -> Router' env a

69choice :: Router' env a -> Router' env a -> Router' env a

86choice (StaticRouter table1 ls1) (StaticRouter table2 ls2) =

70choice (StaticRouter table1 ls1) (StaticRouter table2 ls2) =

87 StaticRouter (M.unionWith choice table1 table2) (ls1 ++ ls2)

71 StaticRouter (M.unionWith choice table1 table2) (ls1 ++ ls2)

88−choice (CaptureRouter hints1 router1) (CaptureRouter hints2 router2) =

72+choice (CaptureRouter router1) (CaptureRouter router2) =

89− CaptureRouter (nub $ hints1 ++ hints2) (choice router1 router2)

73+ CaptureRouter (choice router1 router2)

90choice router1 (Choice router2 router3) = Choice (choice router1 router2) router3

74choice router1 (Choice router2 router3) = Choice (choice router1 router2) router3

91choice router1 router2 = Choice router1 router2

75choice router1 router2 = Choice router1 router2

92

76

@@ -100,7 +84,7 @@ choice router1 router2 = Choice router1 router2

100--

84--

101data RouterStructure =

85data RouterStructure =

102 StaticRouterStructure (Map Text RouterStructure) Int

86 StaticRouterStructure (Map Text RouterStructure) Int

103− | CaptureRouterStructure [CaptureHint] RouterStructure

87+ | CaptureRouterStructure RouterStructure

104 | RawRouterStructure

88 | RawRouterStructure

105 | ChoiceStructure RouterStructure RouterStructure

89 | ChoiceStructure RouterStructure RouterStructure

106 deriving (Eq, Show)

90 deriving (Eq, Show)

@@ -114,11 +98,11 @@ data RouterStructure =

114routerStructure :: Router' env a -> RouterStructure

98routerStructure :: Router' env a -> RouterStructure

115routerStructure (StaticRouter m ls) =

99routerStructure (StaticRouter m ls) =

116 StaticRouterStructure (fmap routerStructure m) (length ls)

100 StaticRouterStructure (fmap routerStructure m) (length ls)

117−routerStructure (CaptureRouter hints router) =

101+routerStructure (CaptureRouter router) =

118− CaptureRouterStructure hints $

102+ CaptureRouterStructure $

119 routerStructure router

103 routerStructure router

120−routerStructure (CaptureAllRouter hints router) =

104+routerStructure (CaptureAllRouter router) =

121− CaptureRouterStructure hints $

105+ CaptureRouterStructure $

122 routerStructure router

106 routerStructure router

123routerStructure (RawRouter _) =

107routerStructure (RawRouter _) =

124 RawRouterStructure

108 RawRouterStructure

@@ -130,8 +114,8 @@ routerStructure (Choice r1 r2) =

130-- | Compare the structure of two routers.

114-- | Compare the structure of two routers.

131--

115--

132sameStructure :: Router' env a -> Router' env b -> Bool

116sameStructure :: Router' env a -> Router' env b -> Bool

133−sameStructure router1 router2 =

117+sameStructure r1 r2 =

134− routerStructure router1 == routerStructure router2

118+ routerStructure r1 == routerStructure r2

135

119

136-- | Provide a textual representation of the

120-- | Provide a textual representation of the

137-- structure of a router.

121-- structure of a router.

@@ -142,8 +126,7 @@ routerLayout router =

142 where

126 where

143 mkRouterLayout :: Bool -> RouterStructure -> [Text]

127 mkRouterLayout :: Bool -> RouterStructure -> [Text]

144 mkRouterLayout c (StaticRouterStructure m n) = mkSubTrees c (M.toList m) n

128 mkRouterLayout c (StaticRouterStructure m n) = mkSubTrees c (M.toList m) n

145− mkRouterLayout c (CaptureRouterStructure hints r) =

129+ mkRouterLayout c (CaptureRouterStructure r) = mkSubTree c "<capture>" (mkRouterLayout False r)

146− mkSubTree c (toCaptureTags hints) (mkRouterLayout False r)

147 mkRouterLayout c RawRouterStructure =

130 mkRouterLayout c RawRouterStructure =

148 if c then ["├─ <raw>"] else ["└─ <raw>"]

131 if c then ["├─ <raw>"] else ["└─ <raw>"]

149 mkRouterLayout c (ChoiceStructure r1 r2) =

132 mkRouterLayout c (ChoiceStructure r1 r2) =

@@ -186,7 +169,7 @@ runRouterEnv fmt router env request respond =

186 -> let request' = request { pathInfo = rest }

169 -> let request' = request { pathInfo = rest }

187 in runRouterEnv fmt router' env request' respond

170 in runRouterEnv fmt router' env request' respond

188 _ -> respond $ Fail $ fmt request

171 _ -> respond $ Fail $ fmt request

189− CaptureRouter _ router' ->

172+ CaptureRouter router' ->

190 case pathInfo request of

173 case pathInfo request of

191 [] -> respond $ Fail $ fmt request

174 [] -> respond $ Fail $ fmt request

192 -- This case is to handle trailing slashes.

175 -- This case is to handle trailing slashes.

@@ -194,7 +177,7 @@ runRouterEnv fmt router env request respond =

194 first : rest

177 first : rest

195 -> let request' = request { pathInfo = rest }

178 -> let request' = request { pathInfo = rest }

196 in runRouterEnv fmt router' (first, env) request' respond

179 in runRouterEnv fmt router' (first, env) request' respond

197− CaptureAllRouter _ router' ->

180+ CaptureAllRouter router' ->

198 let segments = pathInfo request

181 let segments = pathInfo request

199 request' = request { pathInfo = [] }

182 request' = request { pathInfo = [] }

200 in runRouterEnv fmt router' (segments, env) request' respond

183 in runRouterEnv fmt router' (segments, env) request' respond

servant-server/test/Servant/Server/RouterSpec.hs+6−127

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

9import Data.Proxy

10 (Proxy (..))

11import Data.Text

12− (Text, unpack)

12+ (unpack)

13−import Data.Typeable

14− (typeRep)

15import Network.HTTP.Types

13import Network.HTTP.Types

16 (Status (..))

14 (Status (..))

17import Network.Wai

15import Network.Wai

@@ -29,7 +27,6 @@ spec :: Spec

29spec = describe "Servant.Server.Internal.Router" $ do

27spec = describe "Servant.Server.Internal.Router" $ do

30 routerSpec

28 routerSpec

31 distributivitySpec

29 distributivitySpec

32− serverLayoutSpec

33

30

34routerSpec :: Spec

31routerSpec :: Spec

35routerSpec = do

32routerSpec = do

@@ -54,7 +51,7 @@ routerSpec = do

54 toApp = toApplication . runRouter (const err404)

51 toApp = toApplication . runRouter (const err404)

55

52

56 cap :: Router ()

53 cap :: Router ()

57− cap = CaptureRouter [hint] $

54+ cap = CaptureRouter $

58 let delayed = addCapture (emptyDelayed $ Route pure) (const $ delayedFail err400)

55 let delayed = addCapture (emptyDelayed $ Route pure) (const $ delayedFail err400)

59 in leafRouter

56 in leafRouter

60 $ \env req res ->

57 $ \env req res ->

@@ -62,9 +59,6 @@ routerSpec = do

62 . const

59 . const

63 $ Route success

60 $ Route success

64

61

65− hint :: CaptureHint

66− hint = CaptureHint "anything" $ typeRep (Proxy :: Proxy ())

67−

68 router :: Router ()

62 router :: Router ()

69 router = leafRouter (\_ _ res -> res $ Route success)

63 router = leafRouter (\_ _ res -> res $ Route success)

70 `Choice` cap

64 `Choice` cap

@@ -104,30 +98,12 @@ distributivitySpec =

104 it "properly handles mixing static paths at different levels" $ do

98 it "properly handles mixing static paths at different levels" $ do

105 level `shouldHaveSameStructureAs` levelRef

99 level `shouldHaveSameStructureAs` levelRef

106

100

107−serverLayoutSpec :: Spec

108−serverLayoutSpec =

109− describe "serverLayout" $ do

110− it "correctly represents the example API" $ do

111− exampleLayout `shouldHaveLayout` expectedExampleLayout

112− it "aggregates capture hints when different" $ do

113− captureDifferentTypes `shouldHaveLayout` expectedCaptureDifferentTypes

114− it "nubs capture hints when equal" $ do

115− captureSameType `shouldHaveLayout` expectedCaptureSameType

116− it "properly displays CaptureAll hints" $ do

117− captureAllLayout `shouldHaveLayout` expectedCaptureAllLayout

118−

119shouldHaveSameStructureAs ::

101shouldHaveSameStructureAs ::

120 (HasServer api1 '[], HasServer api2 '[]) => Proxy api1 -> Proxy api2 -> Expectation

102 (HasServer api1 '[], HasServer api2 '[]) => Proxy api1 -> Proxy api2 -> Expectation

121shouldHaveSameStructureAs p1 p2 =

103shouldHaveSameStructureAs p1 p2 =

122 unless (sameStructure (makeTrivialRouter p1) (makeTrivialRouter p2)) $

104 unless (sameStructure (makeTrivialRouter p1) (makeTrivialRouter p2)) $

123 expectationFailure ("expected:\n" ++ unpack (layout p2) ++ "\nbut got:\n" ++ unpack (layout p1))

105 expectationFailure ("expected:\n" ++ unpack (layout p2) ++ "\nbut got:\n" ++ unpack (layout p1))

124

106

125−shouldHaveLayout ::

126− (HasServer api '[]) => Proxy api -> Text -> Expectation

127−shouldHaveLayout p l =

128− unless (routerLayout (makeTrivialRouter p) == l) $

129− expectationFailure ("expected:\n" ++ unpack l ++ "\nbut got:\n" ++ unpack (layout p))

130−

131makeTrivialRouter :: (HasServer layout '[]) => Proxy layout -> Router ()

107makeTrivialRouter :: (HasServer layout '[]) => Proxy layout -> Router ()

132makeTrivialRouter p =

108makeTrivialRouter p =

133 route p EmptyContext (emptyDelayed (FailFatal err501))

109 route p EmptyContext (emptyDelayed (FailFatal err501))

@@ -168,12 +144,12 @@ staticRef = Proxy

168-- structure:

144-- structure:

169

145

170type Dynamic =

146type Dynamic =

171− "a" :> Capture "foo" Int :> "b" :> End

147+ "a" :> Capture "foo" Int :> "b" :> End

172− :<|> "a" :> Capture "foo" Int :> "c" :> End

148+ :<|> "a" :> Capture "bar" Bool :> "c" :> End

173− :<|> "a" :> Capture "foo" Int :> "d" :> End

149+ :<|> "a" :> Capture "baz" Char :> "d" :> End

174

150

175type DynamicRef =

151type DynamicRef =

176− "a" :> Capture "foo" Int :>

152+ "a" :> Capture "anything" () :>

177 ("b" :> End :<|> "c" :> End :<|> "d" :> End)

153 ("b" :> End :<|> "c" :> End :<|> "d" :> End)

178

154

179dynamic :: Proxy Dynamic

155dynamic :: Proxy Dynamic

@@ -363,100 +339,3 @@ level = Proxy

363

339

364levelRef :: Proxy LevelRef

340levelRef :: Proxy LevelRef

365levelRef = Proxy

341levelRef = Proxy

366−

367−-- The example API for the 'layout' function.

368−-- Should get factorized by the 'choice' smart constructor.

369−type ExampleLayout =

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

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

372− :<|> "c" :> Put '[JSON] Bool

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

374− :<|> "b" :> Capture "x" Int :> Put '[JSON] Bool

375− :<|> Raw

376−

377−exampleLayout :: Proxy ExampleLayout

378−exampleLayout = Proxy

379−

380−-- The expected representation of the example API layout

381−--

382−expectedExampleLayout :: Text

383−expectedExampleLayout =

384− "/\n\

385− \├─ a/\n\

386− \│ ├─ d/\n\

387− \│ │ └─•\n\

388− \│ └─ e/\n\

389− \│ └─•\n\

390− \├─ b/\n\

391− \│ └─ <x::Int>/\n\

392− \│ ├─•\n\

393− \│ ┆\n\

394− \│ └─•\n\

395− \├─ c/\n\

396− \│ └─•\n\

397− \┆\n\

398− \└─ <raw>\n"

399−

400−-- A capture API with all capture types being the same

401−--

402−type CaptureSameType =

403− "a" :> Capture "foo" Int :> "b" :> End

404− :<|> "a" :> Capture "foo" Int :> "c" :> End

405− :<|> "a" :> Capture "foo" Int :> "d" :> End

406−

407−captureSameType :: Proxy CaptureSameType

408−captureSameType = Proxy

409−

410−-- The expected representation of the CaptureSameType API layout.

411−--

412−expectedCaptureSameType :: Text

413−expectedCaptureSameType =

414− "/\n\

415− \└─ a/\n\

416− \ └─ <foo::Int>/\n\

417− \ ├─ b/\n\

418− \ │ └─•\n\

419− \ ├─ c/\n\

420− \ │ └─•\n\

421− \ └─ d/\n\

422− \ └─•\n"

423−

424−-- A capture API capturing different types

425−--

426−type CaptureDifferentTypes =

427− "a" :> Capture "foo" Int :> "b" :> End

428− :<|> "a" :> Capture "bar" Bool :> "c" :> End

429− :<|> "a" :> Capture "baz" Char :> "d" :> End

430−

431−captureDifferentTypes :: Proxy CaptureDifferentTypes

432−captureDifferentTypes = Proxy

433−

434−-- The expected representation of the CaptureDifferentTypes API layout.

435−--

436−expectedCaptureDifferentTypes :: Text

437−expectedCaptureDifferentTypes =

438− "/\n\

439− \└─ a/\n\

440− \ └─ <foo::Int|bar::Bool|baz::Char>/\n\

441− \ ├─ b/\n\

442− \ │ └─•\n\

443− \ ├─ c/\n\

444− \ │ └─•\n\

445− \ └─ d/\n\

446− \ └─•\n"

447−

448−-- An API with a CaptureAll part

449−

450−type CaptureAllLayout = "a" :> CaptureAll "foos" Int :> End

451−

452−captureAllLayout :: Proxy CaptureAllLayout

453−captureAllLayout = Proxy

454−

455−-- The expected representation of the CaptureAllLayout API.

456−--

457−expectedCaptureAllLayout :: Text

458−expectedCaptureAllLayout =

459− "/\n\

460− \└─ a/\n\

461− \ └─ <foos::[Int]>/\n\

462− \ └─•\n"

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

@@ -3,10 +3,10 @@ name: servant-swagger

3version: 1.1.11

4synopsis: Generate a Swagger/OpenAPI/OAS 2.0 specification for your servant API.

5description:

6− Swagger is a project used to describe and document RESTful APIs. The core of the

6+ Swagger is a project used to describe and document RESTful APIs. The core of the

7− project is the [OpenAPI Specification (OAS)](https://swagger.io/docs/specification/about/).

7+ project is the [OpenAPI Specification (OAS)](https://swagger.io/docs/specification/about/).

8− This library implements v2.0 of the spec. Unlike Servant it is language-agnostic and thus is

8+ This library implements v2.0 of the spec. Unlike Servant it is language-agnostic and thus is

9− quite popular among developers in different languages. It has also existed for a longer time

9+ quite popular among developers in different languages. It has also existed for a longer time

10 and has more helpful tooling.

11 .

12 This package provides means to generate a Swagger/OAS specification for a Servant API

@@ -19,7 +19,7 @@ description:

19 * generating clients and servers in many languages using [Swagger Codegen](http://swagger.io/swagger-codegen/);

20 .

21 * and [many others](http://swagger.io/open-source-integrations/).

22−homepage: https://github.com/haskell-servant/servant/tree/master/servant-swagger#readme

22+homepage: https://github.com/haskell-servant/servant/servant-swagger

23bug-reports: https://github.com/haskell-servant/servant/issues

24license: BSD-3-Clause

25license-file: LICENSE

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

50custom-setup

51 setup-depends:

52 base >=4.9 && <5,

53− Cabal >= 1.24,

53+ Cabal >= 1.24 && < 3.5,

54 cabal-doctest >=1.0.6 && <1.1

55

56library

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

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

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

74 , base >=4.9.1.0 && <5

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

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

76− , bytestring >=0.10.8.1 && <0.12

76+ , bytestring >=0.10.8.1 && <0.11

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

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

79 , lens >=4.17 && <6

80− , servant >=0.18.2 && <0.20

80+ , servant >=0.18.1 && <0.20

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

82 , swagger2 >=2.3.0.1 && <3

83 , text >=1.2.3.0 && <2.1

@@ -92,7 +92,7 @@ test-suite doctests

92 build-depends:

93 base,

94 directory >= 1.0,

95− doctest >= 0.17 && <0.21,

95+ doctest >= 0.17 && <0.19,

96 servant,

97 QuickCheck,

98 filepath

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

106 type: exitcode-stdio-1.0

107 hs-source-dirs: test

108 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

110 build-depends: base

111 , base-compat

112 , aeson >=1.4.2.0 && <3

113− , hspec >=2.6.0 && <2.10

113+ , hspec >=2.6.0 && <2.8

114 , QuickCheck

115 , lens

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

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

117 , servant

118 , servant-swagger

119 , swagger2

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

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

55-- >>> import Data.Typeable

56-- >>> import GHC.Generics

57-- >>> import Servant.API

58−-- >>> import System.Environment

59-- >>> import Test.Hspec

58-- >>> import Test.Hspec

60-- >>> import Test.QuickCheck

59-- >>> import Test.QuickCheck

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

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

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

65-- >>> :set -XGeneralizedNewtypeDeriving

64-- >>> :set -XGeneralizedNewtypeDeriving

66-- >>> :set -XOverloadedStrings

65-- >>> :set -XOverloadedStrings

67-- >>> :set -XTypeOperators

66-- >>> :set -XTypeOperators

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

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

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

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

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

71-- >>> instance ToJSON User

69-- >>> instance ToJSON User

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

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

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

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

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

164-- <BLANKLINE>

162-- <BLANKLINE>

165−-- [User]...

163+-- [User]

166-- ...

164-- ...

167−-- User...

165+-- User

168-- ...

166-- ...

169−-- UserId...

167+-- UserId

170-- ...

168-- ...

171-- Finished in ... seconds

169-- Finished in ... seconds

172-- 3 examples, 0 failures

170-- 3 examples, 0 failures

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

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

3{-# LANGUAGE DataKinds #-}

4{-# LANGUAGE FlexibleContexts #-}

5{-# LANGUAGE FlexibleInstances #-}

6−{-# LANGUAGE OverloadedLists #-}

7{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE OverloadedStrings #-}

8{-# LANGUAGE PolyKinds #-}

7{-# LANGUAGE PolyKinds #-}

9{-# LANGUAGE RankNTypes #-}

8{-# LANGUAGE RankNTypes #-}

10{-# LANGUAGE ScopedTypeVariables #-}

9{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE TypeOperators #-}

10{-# LANGUAGE TypeOperators #-}

12−{-# LANGUAGE TypeFamilies #-}

13#if __GLASGOW_HASKELL__ >= 806

11#if __GLASGOW_HASKELL__ >= 806

14{-# LANGUAGE UndecidableInstances #-}

12{-# LANGUAGE UndecidableInstances #-}

15#endif

13#endif

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

32import Data.Swagger.Declare

30import Data.Swagger.Declare

33import Data.Text (Text)

31import Data.Text (Text)

34import qualified Data.Text as Text

32import qualified Data.Text as Text

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

36import GHC.TypeLits

33import GHC.TypeLits

37import Network.HTTP.Media (MediaType)

34import Network.HTTP.Media (MediaType)

38import Servant.API

35import Servant.API

39import Servant.API.Description (FoldDescription,

36import Servant.API.Description (FoldDescription,

40 reflectDescription)

37 reflectDescription)

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

42import Servant.API.Modifiers (FoldRequired)

38import Servant.API.Modifiers (FoldRequired)

43

39

44import Servant.Swagger.Internal.TypeLevel.API

40import Servant.Swagger.Internal.TypeLevel.API

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

153addParam :: Param -> Swagger -> Swagger

149addParam :: Param -> Swagger -> Swagger

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

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

155

151

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

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

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

159−

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

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

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

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

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

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

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

447 & required ?~ True

439 & required ?~ True

448 & schema .~ ParamBody ref

440 & schema .~ ParamBody ref

449

441

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−

453-- =======================================================================

442-- =======================================================================

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

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

455-- =======================================================================

444-- =======================================================================

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

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

29-- >>> import Control.Applicative

30-- >>> import GHC.Generics

31-- >>> import Test.QuickCheck

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

33-- >>> :set -XDeriveGeneric

32-- >>> :set -XDeriveGeneric

34-- >>> :set -XGeneralizedNewtypeDeriving

33-- >>> :set -XGeneralizedNewtypeDeriving

35-- >>> :set -XDataKinds

34-- >>> :set -XDataKinds

36-- >>> :set -XTypeOperators

35-- >>> :set -XTypeOperators

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

38

36

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

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

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

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

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

55--

53--

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

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

57-- <BLANKLINE>

55-- <BLANKLINE>

58−-- ToJSON matches ToSchema...

56+-- ToJSON matches ToSchema

59−-- User...

57+-- User

60-- ...

58-- ...

61−-- UserId...

59+-- UserId

62-- ...

60-- ...

63-- Finished in ... seconds

61-- Finished in ... seconds

64-- 2 examples, 0 failures

62-- 2 examples, 0 failures

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

120-- :}

118-- :}

121-- <BLANKLINE>

119-- <BLANKLINE>

122-- read . show == id

120-- read . show == id

123−-- Bool...

121+-- Bool

124-- ...

122-- ...

125−-- Int...

123+-- Int

126-- ...

124-- ...

127−-- [Char]...

125+-- [Char]

128-- ...

126-- ...

129-- Finished in ... seconds

127-- Finished in ... seconds

130-- 3 examples, 0 failures

128-- 3 examples, 0 failures

servant/servant.cabal+5−5

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

80 --

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

82 build-depends:

83− base >= 4.9 && < 4.17

83+ base >= 4.9 && < 4.16

84 , bytestring >= 0.10.8.1 && < 0.12

85 , constraints >= 0.2

86 , mtl >= 2.2.2 && < 2.3

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

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

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

100 build-depends:

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

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

102 , aeson >= 1.4.1.0 && < 3

103 , attoparsec >= 0.13.2.2 && < 0.15

104 , bifunctors >= 5.5.3 && < 5.6

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

106 , deepseq >= 1.4.2.0 && < 1.5

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

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

109− , mmorph >= 1.1.2 && < 1.3

109+ , mmorph >= 1.1.2 && < 1.2

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

111 , QuickCheck >= 2.12.6.1 && < 2.15

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

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

166

167 -- Additional dependencies

168 build-depends:

169− hspec >= 2.6.0 && < 2.10

169+ hspec >= 2.6.0 && < 2.9

170 , QuickCheck >= 2.12.6.1 && < 2.15

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

172

173 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 (

38

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

40 module Servant.API.NamedRoutes,

41− module Servant.API.Generic,

42

41

43 -- * Streaming endpoints, distinguished by HTTP method

42 -- * Streaming endpoints, distinguished by HTTP method

44 module Servant.API.Stream,

43 module Servant.API.Stream,

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

103 (Fragment)

102 (Fragment)

104import Servant.API.Header

103import Servant.API.Header

105 (Header, Header')

104 (Header, Header')

106−import Servant.API.Generic

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

108− GenericServant, fromServant, toServant, genericApi)

109import Servant.API.HttpVersion

105import Servant.API.HttpVersion

110 (HttpVersion (..))

106 (HttpVersion (..))

111import Servant.API.IsSecure

107import Servant.API.IsSecure

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

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

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

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

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

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

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

299 where

300 pctyp = Proxy :: Proxy ctyp

301

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

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

33import qualified Data.Text as TextS

34import qualified Data.Text.Encoding as TextSE

35import qualified Data.Text.Lazy as TextL

36−import Control.Exception

37− (evaluate)

38import GHC.Generics

36import GHC.Generics

39import Test.Hspec

37import Test.Hspec

40import Test.QuickCheck

38import Test.QuickCheck

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

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

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

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

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

82

80

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−

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

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

93 let p = Proxy :: Proxy PlainText

82 let p = Proxy :: Proxy PlainText

94

83