e494574...master · typeable/servant

.github/workflows/master.yml+17−29

since splitsnapshots

unifiedsplit

@@ -13,12 +13,13 @@ jobs:

13 strategy:

14 matrix:

15 os: [ubuntu-latest]

16− cabal: ["3.4"]

16+ cabal: ["3.6"]

17 ghc:

18 - "8.6.5"

19 - "8.8.4"

20 - "8.10.7"

21− - "9.0.1"

21+ - "9.0.2"

22+ - "9.2.2"

22

23

23 steps:

24 steps:

24 - uses: actions/checkout@v2

25 - uses: actions/checkout@v2

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

47

48

48 - name: Configure

49 - name: Configure

49 run: |

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

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

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

54

52

55 - name: Build

53 - name: Build

56 run: |

54 run: |

@@ -61,39 +59,29 @@ jobs:

61 cabal test all

59 cabal test all

62

60

63 - name: Run doctests

61 - 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' }}

67 run: |

62 run: |

68 # Necessary for doctest to be found in $PATH

63 # Necessary for doctest to be found in $PATH

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

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

70

65

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

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

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−

79− (cd servant && doctest src)

67+ (cd servant && eval $DOCTEST)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

89

77

90 stack:

78 stack:

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

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

92 runs-on: ubuntu-latest

80 runs-on: ubuntu-latest

93 strategy:

81 strategy:

94 matrix:

82 matrix:

95− stack: ["2.7.3"]

83+ stack: ["2.7.5"]

96− ghc: ["8.10.4"]

84+ ghc: ["8.10.7"]

97

85

98 steps:

86 steps:

99 - uses: actions/checkout@v2

87 - uses: actions/checkout@v2

CONTRIBUTING.md+4−2

@@ -79,8 +79,10 @@ not been a timely response to a PR, you can ping the Maintainers group (with

79We encourage people to experiment with new combinators and instances - it is

80one of the most powerful ways of using `servant`, and a wonderful way of

81getting to know it better. If you do write a new combinator, we would love to

82−know about it! Either hop on #servant on freenode and let us know, or open an

82+know about it! Either hop on

83+[#haskell-servant on libera.chat](https://web.libera.chat/#haskell-servant) and

83−issue with the `news` tag (which we will close when we read it).

84+let us know, or open an issue with the `news` tag (which we will close when we

85+read it).

84

86

85As for adding them to the main repo: maintaining combinators can be expensive,

87As for adding them to the main repo: maintaining combinators can be expensive,

86since official combinators must have instances for all classes (and new classes

88since official combinators must have instances for all classes (and new classes

cabal.project−26

@@ -51,29 +51,3 @@ 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/1529new file+10

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

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/1556new file+81

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

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/1569new file+13

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

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/1580new file+12

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

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/1589new file+2

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

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

2+prs: 1589

changelog.d/1595new file+2

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

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 building-the-docs file."; fi

13+ @if [ ! -d venv ]; then echo "WARNING: There is no venv directory, did you forget to 'virtualenv venv'. Check README.md."; 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+1−2

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

46

47# General information about the project.

48project = u'Servant'

49−copyright = u'2018, Servant Contributors'

49+copyright = u'2022, Servant Contributors'

50author = u'Servant Contributors'

51

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

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

169source_parsers = {

170 '.lhs': CommonMarkParser,

171}

172−

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

@@ -11,6 +11,9 @@ 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

14 main-is: CurlMock.lhs

17 main-is: CurlMock.lhs

15 build-depends: base == 4.*

18 build-depends: base == 4.*

16 , aeson

19 , aeson

doc/cookbook/index.rst+2−2

@@ -6,8 +6,8 @@ how to solve many common problems with servant. If you're

6interested in contributing examples of your own, feel free

7to open an issue or a pull request on

8`our github repository <https://github.com/haskell-servant/servant>`_

9−or even to just get in touch with us on the **#servant** IRC channel

9+or even to just get in touch with us on the `**#haskell-servant** IRC channel

10−on freenode or on

10+on libera.chat <https://web.libera.chat/#haskell-servant>_ or on

11`the mailing list <https://groups.google.com/forum/#!forum/haskell-servant>`_.

12

13The scope is very wide. Simple and fancy authentication schemes,

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− let req' = I.defaultMakeClientRequest burl req

122+ req' <- I.defaultMakeClientRequest burl req

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

124```

125

doc/links.rst+1−1

@@ -12,7 +12,7 @@ Helpful Links

12 `https://github.com/haskell-servant/servant/issues <https://github.com/haskell-servant/servant/issues>`_

13

14- the irc channel:

15− ``#servant`` on freenode

15+ `#haskell-servant on libera.chat <https://web.libera.chat/#haskell-servant>`_

16

17- the mailing list:

18 `groups.google.com/forum/#!forum/haskell-servant <https://groups.google.com/forum/#!forum/haskell-servant>`_

doc/tutorial/install.rst+26

@@ -40,3 +40,29 @@ 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.10

67+ , lucid >= 2.9.11 && < 2.12

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 <http://github.com/haskell-servant/servant/servant-auth#readme README>.

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

11category: Web, Servant, Authentication

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

12+homepage: https://github.com/haskell-servant/servant/tree/master/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.16

34+ base >= 4.10 && < 4.17

35− , bytestring >= 0.10.6.0 && < 0.11

35+ , bytestring >= 0.10.6.0 && < 0.12

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.9

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

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.9

65+ hspec >= 2.5.5 && < 2.10

66 , QuickCheck >= 2.11.3 && < 2.15

67 , aeson >= 1.3.1.1 && < 3

68− , bytestring >= 0.10.6.0 && < 0.11

68+ , bytestring >= 0.10.6.0 && < 0.12

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+7−7

@@ -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 <http://github.com/haskell-servant/servant/servant-auth#readme README>.

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

11category: Web, Servant, Authentication

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

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

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

14author: Julian K. Arni

15maintainer: jkarni@gmail.com

@@ -35,11 +35,11 @@ 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.16

38+ base >= 4.10 && < 4.17

39− , servant-docs >= 0.11.2 && < 0.12

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

40 , servant >= 0.13 && < 0.20

41 , servant-auth == 0.4.*

42− , lens >= 4.16.1 && <5.1

42+ , lens >= 4.16.1 && <5.2

43 exposed-modules:

44 Servant.Auth.Docs

45 default-language: Haskell2010

@@ -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.9

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

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.9

81+ , hspec >= 2.5.5 && < 2.10

82 , QuickCheck >= 2.11.3 && < 2.15

83

84 default-language: Haskell2010

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

@@ -1,15 +1,15 @@

1cabal-version: 2.2

2name: servant-auth-server

3−version: 0.4.6.0

3+version: 0.4.7.0

4synopsis: servant-server/servant-auth compatibility

5description: This package provides the required instances for using the @Auth@ combinator

6 in your 'servant' server.

7 .

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

9 .

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

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

11category: Web, Servant, Authentication

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

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

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

14author: Julian K. Arni

15maintainer: jkarni@gmail.com

@@ -31,27 +31,27 @@ 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.16

34+ base >= 4.10 && < 4.17

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.11

38+ , bytestring >= 0.10.6.0 && < 0.12

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

42 , entropy >= 0.4.1.3 && < 0.5

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

44 , jose >= 0.7.0.0 && < 0.10

45− , lens >= 4.16.1 && < 5.1

45+ , lens >= 4.16.1 && < 5.2

46− , memory >= 0.14.16 && < 0.17

46+ , memory >= 0.14.16 && < 0.18

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

48 , mtl >= 2.2.2 && < 2.3

49 , servant >= 0.13 && < 0.20

50 , servant-auth == 0.4.*

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

52 , tagged >= 0.8.4 && < 0.9

53− , text >= 1.2.3.0 && < 1.3

53+ , text >= 1.2.3.0 && < 2.1

54− , time >= 1.5.0.1 && < 1.10

54+ , time >= 1.5.0.1 && < 1.12

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.8

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

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.8

126+ , hspec >= 2.5.5 && < 2.10

127 , QuickCheck >= 2.11.3 && < 2.15

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

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

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

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/AddSetCookie.hs+12

@@ -11,6 +11,8 @@ import Data.Tagged (Tagged (..))

11import qualified Network.HTTP.Types as HTTP

12import Network.Wai (mapResponseHeaders)

13import Servant

14+import Servant.API.Generic

15+import Servant.Server.Generic

14import Web.Cookie

16import Web.Cookie

15

17

16-- What are we doing here? Well, the idea is to add headers to the response,

18-- What are we doing here? Well, the idea is to add headers to the response,

@@ -34,6 +36,7 @@ type family AddSetCookieApiVerb a where

34type family AddSetCookieApi a :: *

36type family AddSetCookieApi a :: *

35type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b

37type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b

36type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b

38type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b

39+type instance AddSetCookieApi (NamedRoutes api) = AddSetCookieApi (ToServantApi api)

37type instance AddSetCookieApi (Verb method stat ctyps a)

40type instance AddSetCookieApi (Verb method stat ctyps a)

38 = Verb method stat ctyps (AddSetCookieApiVerb a)

41 = Verb method stat ctyps (AddSetCookieApiVerb a)

39type instance AddSetCookieApi Raw = Raw

42type instance AddSetCookieApi Raw = Raw

@@ -72,6 +75,15 @@ instance {-# OVERLAPS #-}

72 => AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where

75 => AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where

73 addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b

76 addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b

74

77

78+instance {-# OVERLAPS #-}

79+ ( AddSetCookies ('S n) (ServerT (ToServantApi api) m) cookiedApi

80+ , Generic (api (AsServerT m))

81+ , GServantProduct (Rep (api (AsServerT m)))

82+ , ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m

83+ )

84+ => AddSetCookies ('S n) (api (AsServerT m)) cookiedApi where

85+ addSetCookies cookies = addSetCookies cookies . toServant

86+

75-- | for @servant <0.11@

87-- | for @servant <0.11@

76instance

88instance

77 AddSetCookies ('S n) Application Application where

89 AddSetCookies ('S n) Application Application where

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 :: Jose.JWKSet

36+ , validationKeys :: IO 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 = Jose.JWKSet [k]

47+ , validationKeys = pure $ 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+4−3

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

58

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

60verifyJWT jwtCfg input = do

61+ keys <- validationKeys jwtCfg

61− verifiedJWT <- liftIO $ runExceptT $ do

62+ verifiedJWT <- runExceptT $ do

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

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

63 Jose.verifyClaims

64 Jose.verifyClaims

64 (jwtSettingsToJwtValidationSettings jwtCfg)

65 (jwtSettingsToJwtValidationSettings jwtCfg)

65− (validationKeys jwtCfg)

66+ keys

66 unverifiedJWT

67 unverifiedJWT

67 return $ case verifiedJWT of

68 return $ case verifiedJWT of

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

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

69 Right v -> case decodeJWT v of

70 Right v -> case decodeJWT v of

70 Left _ -> Nothing

71 Left _ -> Nothing

71− Right v' -> Just v'

72+ Right v' -> Just v'

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs+10−1

@@ -8,7 +8,10 @@ module Servant.Auth.Server.Internal.ThrowAll where

8

9import Control.Monad.Error.Class

10import Data.Tagged (Tagged (..))

11−import Servant ((:<|>) (..), ServerError(..))

11+import Servant ((:<|>) (..), ServerError(..), NamedRoutes(..))

12+import Servant.API.Generic

13+import Servant.Server.Generic

14+import Servant.Server

12import Network.HTTP.Types

15import Network.HTTP.Types

13import Network.Wai

16import Network.Wai

14

17

@@ -26,6 +29,12 @@ class ThrowAll a where

26instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where

29instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where

27 throwAll e = throwAll e :<|> throwAll e

30 throwAll e = throwAll e :<|> throwAll e

28

31

32+instance

33+ ( ThrowAll (ToServant api (AsServerT m)) , GenericServant api (AsServerT m)) =>

34+ ThrowAll (api (AsServerT m)) where

35+

36+ throwAll = fromServant . throwAll

37+

29-- Really this shouldn't be necessary - ((->) a) should be an instance of

38-- Really this shouldn't be necessary - ((->) a) should be an instance of

30-- MonadError, no?

39-- MonadError, no?

31instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where

40instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where

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

@@ -50,6 +50,7 @@ import Network.Wreq (Options, auth, basicAuth,

50import Network.Wreq.Types (Postable(..))

51import Servant hiding (BasicAuth,

52 IsSecure (..), header)

53+import Servant.API.Generic ((:-))

53import Servant.Auth.Server

54import Servant.Auth.Server

54import Servant.Auth.Server.Internal.Cookie (expireTime)

55import Servant.Auth.Server.Internal.Cookie (expireTime)

55import Servant.Auth.Server.SetCookieOrphan ()

56import Servant.Auth.Server.SetCookieOrphan ()

@@ -405,6 +406,7 @@ type API auths

405 = Auth auths User :>

406 = Auth auths User :>

406 ( Get '[JSON] Int

407 ( Get '[JSON] Int

407 :<|> ReqBody '[JSON] Int :> Post '[JSON] Int

408 :<|> ReqBody '[JSON] Int :> Post '[JSON] Int

409+ :<|> NamedRoutes DummyRoutes

408 :<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int)

410 :<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int)

409#if MIN_VERSION_servant_server(0,15,0)

411#if MIN_VERSION_servant_server(0,15,0)

410 :<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)

412 :<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)

@@ -416,6 +418,10 @@ type API auths

416 :<|> "logout" :> Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie

418 :<|> "logout" :> Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie

417 , Header "Set-Cookie" SetCookie ] NoContent)

419 , Header "Set-Cookie" SetCookie ] NoContent)

418

420

421+data DummyRoutes mode = DummyRoutes

422+ { dummyInt :: mode :- "dummy" :> Get '[JSON] Int

423+ } deriving Generic

424+

419jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT])

425jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT])

420jwtOnlyApi = Proxy

426jwtOnlyApi = Proxy

421

427

@@ -476,6 +482,7 @@ server ccfg =

476 (\authResult -> case authResult of

482 (\authResult -> case authResult of

477 Authenticated usr -> getInt usr

483 Authenticated usr -> getInt usr

478 :<|> postInt usr

484 :<|> postInt usr

485+ :<|> DummyRoutes { dummyInt = getInt usr }

479 :<|> getHeaderInt

486 :<|> getHeaderInt

480#if MIN_VERSION_servant_server(0,15,0)

487#if MIN_VERSION_servant_server(0,15,0)

481 :<|> return (S.source ["bytestring"])

488 :<|> return (S.source ["bytestring"])

servant-auth/servant-auth-swagger/servant-auth-swagger.cabal+8−12

@@ -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 <http://github.com/haskell-servant/servant/servant-auth#readme README>.

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

11category: Web, Servant, Authentication

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

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

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

14author: Julian K. Arni

15maintainer: jkarni@gmail.com

@@ -31,15 +31,13 @@ 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.16

34+ base >= 4.10 && < 4.17

35− , text >= 1.2.3.0 && < 1.3

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.1

40+ , lens >= 4.16.1 && < 5.2

41− if impl(ghc >= 9)

42− buildable: False

43 exposed-modules:

41 exposed-modules:

44 Servant.Auth.Swagger

42 Servant.Auth.Swagger

45 default-language: Haskell2010

43 default-language: Haskell2010

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

51 test

49 test

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

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

53 ghc-options: -Wall

51 ghc-options: -Wall

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

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

55 -- dependencies with bounds inherited from the library stanza

53 -- dependencies with bounds inherited from the library stanza

56 build-depends:

54 build-depends:

57 base

55 base

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

61 , servant

59 , servant

62 , servant-auth

60 , servant-auth

63 , lens

61 , lens

64− if impl(ghc >= 9)

62+

65− buildable: False

66−

67 -- test dependencies

63 -- test dependencies

68 build-depends:

64 build-depends:

69 servant-auth-swagger

65 servant-auth-swagger

70− , hspec >= 2.5.5 && < 2.9

66+ , hspec >= 2.5.5 && < 2.10

71 , QuickCheck >= 2.11.3 && < 2.15

67 , QuickCheck >= 2.11.3 && < 2.15

72 other-modules:

68 other-modules:

73 Servant.Auth.SwaggerSpec

69 Servant.Auth.SwaggerSpec

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

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

1cabal-version: 2.2

2name: servant-auth

3−version: 0.4.0.0

3+version: 0.4.1.0

4synopsis: Authentication combinators for servant

5description: This package provides an @Auth@ combinator for 'servant'. This combinator

6 allows using different authentication schemes in a straightforward way,

@@ -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 <http://github.com/haskell-servant/servant/servant-auth#readme README>.

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

13category: Web, Servant, Authentication

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

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

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

16author: Julian K. Arni

17maintainer: jkarni@gmail.com

@@ -33,13 +33,13 @@ 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.16

36+ base >= 4.10 && < 4.17

37 , containers >= 0.6 && < 0.7

38 , aeson >= 1.3.1.1 && < 3

39 , jose >= 0.7.0.0 && < 0.10

40− , lens >= 4.16.1 && < 5.1

40+ , lens >= 4.16.1 && < 5.2

41 , servant >= 0.15 && < 0.20

42− , text >= 1.2.3.0 && < 1.3

42+ , text >= 1.2.3.0 && < 2.1

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

44 exposed-modules:

45 Servant.Auth

servant-client-core/CHANGELOG.md+7−5

@@ -10,16 +10,18 @@ Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/

10

11- Drop support for GHC < 8.6.

12- Support GHC 9.0 (GHC 9.2 should work as well, but isn't fully tested yet).

13−- Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)).

13+- Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)),

14+ which fixes a [DOS vulnerability](https://github.com/haskell/aeson/issues/864)

15+ related to hash collisions.

14- Add `NamedRoutes` combinator, making support for records first-class in Servant

16- Add `NamedRoutes` combinator, making support for records first-class in Servant

15 ([#1388](https://github.com/haskell-servant/servant/pull/1388)).

17 ([#1388](https://github.com/haskell-servant/servant/pull/1388)).

16- Add custom type errors for partially applied combinators

18- Add custom type errors for partially applied combinators

17 ([#1289](https://github.com/haskell-servant/servant/pull/1289),

19 ([#1289](https://github.com/haskell-servant/servant/pull/1289),

18 [#1486](https://github.com/haskell-servant/servant/pull/1486)).

20 [#1486](https://github.com/haskell-servant/servant/pull/1486)).

19−- *servant-client* / *servant-client*: Fix erroneous behavior, where only 2XX

21+- *servant-client* / *servant-client-core* / *servant-http-streams*: Fix

20− status codes would be considered successful, irrelevant of the status

22+ erroneous behavior, where only 2XX status codes would be considered

21− parameter specified by the verb combinator.

23+ successful, irrelevant of the status parameter specified by the verb

22− ([#1469](https://github.com/haskell-servant/servant/pull/1469))

24+ combinator. ([#1469](https://github.com/haskell-servant/servant/pull/1469))

23- *servant-client* / *servant-client-core*: Fix `Show` instance for

25- *servant-client* / *servant-client-core*: Fix `Show` instance for

24 `Servant.Client.Core.Request`.

26 `Servant.Client.Core.Request`.

25- *servant-client* / *servant-client-core*: Allow passing arbitrary binary data

27- *servant-client* / *servant-client-core*: Allow passing arbitrary binary data

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

@@ -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.16

53+ base >= 4.9 && < 4.17

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 && < 1.3

58+ , text >= 1.2.3.0 && < 2.1

59 , transformers >= 0.5.2.0 && < 0.6

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

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

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.12

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

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.9

107+ , hspec >= 2.6.0 && < 2.10

108 , QuickCheck >= 2.12.6.1 && < 2.15

109

110 build-tool-depends:

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

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

servant-client-core/src/Servant/Client/Core.hs+1

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

59 , appendToPath

60 , setRequestBodyLBS

61 , setRequestBody

62+ , encodeQueryParamValue

62 ) where

63 ) where

63import Servant.Client.Core.Auth

64import Servant.Client.Core.Auth

64import Servant.Client.Core.BaseUrl

65import Servant.Client.Core.BaseUrl

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

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

33import Control.Monad

34 (unless)

35import qualified Data.ByteString as BS

36−import Data.ByteString.Builder

37− (toLazyByteString)

38−import qualified Data.ByteString.Lazy as BL

36+import qualified Data.ByteString.Lazy as BL

39import Data.Either

37import Data.Either

40 (partitionEithers)

38 (partitionEithers)

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

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

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

210 clientWithRoute pm (Proxy :: Proxy api)

208 clientWithRoute pm (Proxy :: Proxy api)

211 (appendToPath p req)

209 (appendToPath p req)

212

210

213− where p = (toUrlPiece val)

211+ where p = toEncodedUrlPiece val

214

212

215 hoistClientMonad pm _ f cl = \a ->

213 hoistClientMonad pm _ f cl = \a ->

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

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

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

245 clientWithRoute pm (Proxy :: Proxy sublayout)

243 clientWithRoute pm (Proxy :: Proxy sublayout)

246 (foldl' (flip appendToPath) req ps)

244 (foldl' (flip appendToPath) req ps)

247

245

248− where ps = map (toUrlPiece) vals

246+ where ps = map toEncodedUrlPiece vals

249

247

250 hoistClientMonad pm _ f cl = \as ->

248 hoistClientMonad pm _ f cl = \as ->

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

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

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

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

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

572 where

570 where

573 add :: a -> Request

571 add :: a -> Request

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

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

575

573

576 pname :: Text

574 pname :: Text

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

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

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

579 hoistClientMonad pm _ f cl = \arg ->

577 hoistClientMonad pm _ f cl = \arg ->

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

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

581

579

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

583−encodeQueryParam = BL.toStrict . toLazyByteString . toEncodedUrlPiece

584−

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

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

586-- the corresponding querying function will automatically take

581-- the corresponding querying function will automatically take

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

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

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

623 )

618 )

624

619

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

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

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

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

627

622

628 hoistClientMonad pm _ f cl = \as ->

623 hoistClientMonad pm _ f cl = \as ->

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

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

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

745 clientWithRoute pm (Proxy :: Proxy api)

740 clientWithRoute pm (Proxy :: Proxy api)

746 (appendToPath p req)

741 (appendToPath p req)

747

742

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

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

749

744

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

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

751

746

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

879--

874--

880-- Example:

875-- Example:

881--

876--

882−-- @@

877+-- @

883-- type Api = NamedRoutes RootApi

878-- type Api = NamedRoutes RootApi

884--

879--

885-- data RootApi mode = RootApi

880-- data RootApi mode = RootApi

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

900--

895--

901-- endpointClient :: ClientM Person

896-- endpointClient :: ClientM Person

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

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

903−-- @@

898+-- @

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

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

905x // f = f x

900x // f = f x

906

901

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

911--

906--

912-- Example:

907-- Example:

913--

908--

914−-- @@

909+-- @

915-- type Api = NamedRoutes RootApi

910-- type Api = NamedRoutes RootApi

916--

911--

917-- data RootApi mode = RootApi

912-- data RootApi mode = RootApi

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

936--

931--

937-- endpointClient :: ClientM Person

932-- endpointClient :: ClientM Person

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

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

939−-- @@

934+-- @

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

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

941(/:) = flip

936(/:) = flip

942

937

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

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

17 addHeader,

18 appendToPath,

19 appendToQueryString,

20+ encodeQueryParamValue,

20 setRequestBody,

21 setRequestBody,

21 setRequestBodyLBS,

22 setRequestBodyLBS,

22 ) where

23 ) where

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

33import Data.Bitraversable

34import Data.Bitraversable

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

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

35import qualified Data.ByteString as BS

36import qualified Data.ByteString as BS

37+import Data.ByteString.Builder

38+ (Builder)

36import qualified Data.ByteString.Builder as Builder

39import qualified Data.ByteString.Builder as Builder

37import qualified Data.ByteString.Lazy as LBS

40import qualified Data.ByteString.Lazy as LBS

38import qualified Data.Sequence as Seq

41import qualified Data.Sequence as Seq

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

48 (MediaType)

51 (MediaType)

49import Network.HTTP.Types

52import Network.HTTP.Types

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

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

51− http11, methodGet)

54+ http11, methodGet, urlEncodeBuilder)

52import Servant.API

55import Servant.API

53− (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)

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

54

57

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

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

56

59

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

111 rnfB Nothing = ()

114 rnfB Nothing = ()

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

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

113

116

114−type Request = RequestF RequestBody Builder.Builder

117+type Request = RequestF RequestBody Builder

115

118

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

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

117data RequestBody

120data RequestBody

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

142 , requestMethod = methodGet

145 , requestMethod = methodGet

143 }

146 }

144

147

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

149+--

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

145−appendToPath :: Text -> Request -> Request

151+appendToPath :: Builder -> Request -> Request

146appendToPath p req

152appendToPath p req

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

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

148

154

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

156+--

149−appendToQueryString :: Text -- ^ param name

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

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

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

151 -> Request

159 -> Request

152 -> Request

160 -> Request

153appendToQueryString pname pvalue req

161appendToQueryString pname pvalue req

154 = req { requestQueryString = requestQueryString req

162 = req { requestQueryString = requestQueryString req

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

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

156

164

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

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

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

158addHeader name val req

174addHeader name val req

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

175 = 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 && <4.12

41+ base >=4.11 && <5

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+8−5

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

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

121

122instance RunClient ClientM where

123− runRequest = performRequest

123+ runRequestAcceptStatus = performRequest

124 throwClientError = throwError

125

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

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

152

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

154

155−performRequest :: Request -> ClientM Response

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

156−performRequest req = do

156+performRequest acceptStatus req = do

157 xhr <- liftIO initXhr

158 burl <- asks baseUrl

159 liftIO $ performXhr xhr burl req

160 resp <- toResponse xhr

161

162− let status = statusCode (responseStatusCode resp)

162+ let status = responseStatusCode resp

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

163+ goodStatus = case acceptStatus of

164+ Nothing -> statusIsSuccessful status

165+ Just good -> status `elem` good

166+ unless goodStatus $ do

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

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

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

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

166

169

servant-client/CHANGELOG.md+7−5