cb294aa..master · servant

.github/workflows/master.yml+51−62

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

1313 strategy:

1414 matrix:

1515 os: [ubuntu-latest]

16− cabal: ["3.4"]

16+ cabal: ["3.6"]

1717 ghc:

1818 - "8.6.5"

1919 - "8.8.4"

2020 - "8.10.7"

21− - "9.0.1"

21+ - "9.0.2"

22+ - "9.2.2"

23+ - "9.4.2"

2224

2325 steps:

2426 - uses: actions/checkout@v2

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

4749

4850 - name: Configure

4951 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'

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

5453

5554 - name: Build

5655 run: |

@@ -61,66 +60,56 @@ jobs:

6160 cabal test all

6261

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

6763 run: |

6864 # Necessary for doctest to be found in $PATH

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

7066

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−

79− (cd servant && doctest src)

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

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

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

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

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

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

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

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

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

89−

90− stack:

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

92− runs-on: ubuntu-latest

93− strategy:

94− matrix:

95− stack: ["2.7.3"]

96− ghc: ["8.10.4"]

97−

98− steps:

99− - uses: actions/checkout@v2

100−

101− - uses: haskell/actions/setup@v1

102− name: Setup Haskell Stack

103− with:

104− ghc-version: ${{ matrix.ghc }}

105− stack-version: ${{ matrix.stack }}

106−

107− - uses: actions/cache@v2.1.3

108− name: Cache ~/.stack

109− with:

110− path: ~/.stack

111− key: ${{ runner.os }}-${{ matrix.ghc }}-stack

112−

113− - name: Install dependencies

114− run: |

115− stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --only-dependencies

116−

117− - name: Build

118− run: |

119− stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks

120−

121− - name: Test

122− run: |

123− stack test --system-ghc

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

68+ (cd servant && eval $DOCTEST)

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

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

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

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

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

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

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

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

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

78+

79+ # stack:

80+ # name: stack / ghc ${{ matrix.ghc }}

81+ # runs-on: ubuntu-latest

82+ # strategy:

83+ # matrix:

84+ # stack: ["2.7.5"]

85+ # ghc: ["8.10.7"]

86+

87+ # steps:

88+ # - uses: actions/checkout@v2

89+

90+ # - uses: haskell/actions/setup@v1

91+ # name: Setup Haskell Stack

92+ # with:

93+ # ghc-version: ${{ matrix.ghc }}

94+ # stack-version: ${{ matrix.stack }}

95+

96+ # - uses: actions/cache@v2.1.3

97+ # name: Cache ~/.stack

98+ # with:

99+ # path: ~/.stack

100+ # key: ${{ runner.os }}-${{ matrix.ghc }}-stack

101+

102+ # - name: Install dependencies

103+ # run: |

104+ # stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --only-dependencies

105+

106+ # - name: Build

107+ # run: |

108+ # stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks

109+

110+ # - name: Test

111+ # run: |

112+ # stack test --system-ghc

124113

125114 ghcjs:

126115 name: ubuntu-latest / ghcjs 8.6

CONTRIBUTING.md+4−2

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

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

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

8181getting 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

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

82+know about it! Either hop on

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

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

85+read it).

8486

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

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

cabal.project+1−23

@@ -47,30 +47,8 @@ packages:

4747 doc/cookbook/using-custom-monad

4848 doc/cookbook/using-free-client

4949 -- doc/cookbook/open-id-connect

50+ doc/cookbook/managed-resource

5051

5152tests: True

5253optimization: False

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

75−-- ghc 9

76−allow-newer: tdigest:base

changelog.d/1469new file+11

@@ -0,0 +1,11 @@

1+synopsis: Derive HasClient good response status from Verb status

2+prs: #1469

3+description: {

4+`HasClient` instances for the `Verb` datatype use `runRequest` in

5+`clientWithRoute` definitions.

6+This means that a request performed with `runClientM` will be successful if and

7+only if the endpoint specify a response status code >=200 and <300.

8+This change replaces `runRequest` with `runRequestAcceptStatus` in `Verb`

9+instances for the `HasClient` class, deriving the good response status from

10+the `Verb` status.

11+}

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/1571new file+10

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

1+synopsis: Support UVerb in servant-auth-server

2+prs: #1571

3+issues: #1570

4+description: {

5+UVerb endpoints are now supported by servant-auth-server and can be used under the

6+Auth combinator when writing servers. It is still unsupported by

7+servant-auth-client.

8+

9+This PR also brings Headers support in UVerb responses

10+}

changelog.d/1573new file+2

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

1+synopsis: Add API docs for ServerT

2+prs: #1573

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

changelog.d/1606new file+10

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

1+synopsis: Handle Cookies correctly for RunStreamingClient

2+prs: #1606

3+issues: #1605

4+

5+description: {

6+

7+Makes performWithStreamingRequest take into consideration the

8+CookieJar, which it previously didn't.

9+

10+}

changelog.d/1638new file+2

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

1+synopsis: Add Functor instance to AuthHandler.

2+prs: #1638

changelog.d/1649new file+8

@@ -0,0 +1,8 @@

1+synopsis: Add HasStatus instance for Headers (that defers StatusOf to underlying value)

2+prs: #1649

3+

4+description: {

5+

6+Adds a new HasStatus (Headers hs a) instance (StatusOf (Headers hs a) = StatusOf a)

7+

8+}

doc/Makefile+1−1

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

1010

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

1212help:

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

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

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

1616

doc/conf.py+1−2

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

4646

4747# General information about the project.

4848project = u'Servant'

49−copyright = u'2018, Servant Contributors'

49+copyright = u'2022, Servant Contributors'

5050author = u'Servant Contributors'

5151

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

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

169169source_parsers = {

170170 '.lhs': CommonMarkParser,

171171}

172−

doc/cookbook/basic-auth/basic-auth.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-basic-auth

23version: 0.1

34synopsis: Basic Authentication cookbook example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

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

1212

1313executable cookbook-basic-auth

doc/cookbook/basic-streaming/basic-streaming.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-basic-streaming

23version: 2.1

34synopsis: Streaming in servant without streaming libs

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

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

1212

1313executable cookbook-basic-streaming

doc/cookbook/curl-mock/curl-mock.cabal+4−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-curl-mock

23version: 0.1

34synopsis: Generate curl mock requests cookbook example

@@ -7,10 +8,12 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

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

1212

1313executable cookbock-curl-mock

14+ if impl(ghc >= 9.2)

15+ -- generic-arbitrary is incompatible

16+ buildable: False

1417 main-is: CurlMock.lhs

1518 build-depends: base == 4.*

1619 , aeson

doc/cookbook/custom-errors/custom-errors.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-custom-errors

23version: 0.1

34synopsis: Return custom error messages from combinators

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

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

1212

1313executable cookbook-custom-errors

doc/cookbook/db-mysql-basics/mysql-basics.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: mysql-basics

23version: 0.1.0.0

34synopsis: Simple MySQL API cookbook example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

1111

1212executable run

1313 hs-source-dirs: .

doc/cookbook/db-postgres-pool/db-postgres-pool.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-db-postgres-pool

23version: 0.1

34synopsis: Simple PostgreSQL connection pool cookbook example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

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

1212

1313executable cookbook-db-postgres-pool

doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-db-sqlite-simple

23version: 0.1

34synopsis: Simple SQLite DB cookbook example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

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

1212

1313executable cookbook-db-sqlite-simple

doc/cookbook/file-upload/file-upload.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-file-upload

23version: 0.1

34synopsis: File upload cookbook example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

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

1212

1313executable cookbook-file-upload

doc/cookbook/generic/generic.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-generic

23version: 0.1

34synopsis: Using custom monad to pass a state between handlers

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

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

1212

1313executable cookbook-using-custom-monad

doc/cookbook/hoist-server-with-context/hoist-server-with-context.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-hoist-server-with-context

23version: 0.0.1

34synopsis: JWT and basic access authentication with a Custom Monad cookbook example

@@ -10,7 +11,6 @@ author: Servant Contributors

1011maintainer: haskell-servant-maintainers@googlegroups.com

1112category: Servant

1213build-type: Simple

13−cabal-version: >=1.10

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

1515

1616executable cookbook-hoist-server-with-context

doc/cookbook/https/https.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-https

23version: 0.1

34synopsis: HTTPS cookbook example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

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

1212

1313executable cookbook-https

doc/cookbook/index.rst+3−2

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

66interested in contributing examples of your own, feel free

77to open an issue or a pull request on

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

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

10−on freenode or on

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

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

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

1212

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

@@ -37,3 +37,4 @@ you name it!

3737 sentry/Sentry.lhs

3838 testing/Testing.lhs

3939 open-id-connect/OpenIdConnect.lhs

40+ managed-resource/ManagedResource.lhs

doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-jwt-and-basic-auth

23version: 0.0.1

34synopsis: JWT and basic access authentication cookbook example

@@ -10,7 +11,6 @@ author: Servant Contributors

1011maintainer: haskell-servant-maintainers@googlegroups.com

1112category: Servant

1213build-type: Simple

13−cabal-version: >=1.10

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

1515

1616executable cookbook-jwt-and-basic-auth

doc/cookbook/managed-resource/ManagedResource.lhsnew file+114

@@ -0,0 +1,114 @@

1+# Request-lifetime Managed Resources

2+

3+Let's see how we can write a handle that uses a resource managed by Servant. The resource is created automatically by Servant when the server recieves a request, and the resource is automatically destroyed when the server is finished handling a request.

4+

5+As usual, we start with a little bit of throat clearing.

6+

7+

8+``` haskell

9+{-# LANGUAGE DataKinds #-}

10+{-# LANGUAGE TypeOperators #-}

11+import Control.Concurrent

12+import Control.Exception (bracket, throwIO)

13+import Control.Monad.IO.Class

14+import Control.Monad.Trans.Resource

15+import Data.Acquire

16+import Network.HTTP.Client (newManager, defaultManagerSettings)

17+import Network.Wai.Handler.Warp

18+import Servant

19+import Servant.Client

20+import System.IO

21+```

22+

23+Here we define an API type that uses the `WithResource` combinator. The server handler for an endpoint with a `WithResource res` component will receive a value of that type as an argument.

24+

25+``` haskell

26+type API = WithResource Handle :> ReqBody '[PlainText] String :> Post '[JSON] NoContent

27+

28+api :: Proxy API

29+api = Proxy

30+```

31+

32+But this resource value has to come from somewhere. Servant obtains the value using an Acquire provided in the context. The Acquire knows how to both create and destroy resources of a particular type.

33+

34+``` haskell

35+appContext :: Context '[Acquire Handle]

36+appContext = acquireHandle :. EmptyContext

37+

38+acquireHandle :: Acquire Handle

39+acquireHandle = mkAcquire newHandle closeHandle

40+

41+newHandle :: IO Handle

42+newHandle = do

43+ putStrLn "opening file"

44+ h <- openFile "test.txt" AppendMode

45+ putStrLn "opened file"

46+ return h

47+

48+closeHandle :: Handle -> IO ()

49+closeHandle h = do

50+ putStrLn "closing file"

51+ hClose h

52+ putStrLn "closed file"

53+```

54+

55+Now we create the handler which will use this resource. This handler will write the request message to the System.IO.Handle which was provided to us. In some situations the handler will succeed, but in some in will fail. In either case, Servant will clean up the resource for us.

56+

57+``` haskell

58+server :: Server API

59+server = writeToFile

60+

61+ where writeToFile :: (ReleaseKey, Handle) -> String -> Handler NoContent

62+ writeToFile (_, h) msg = case msg of

63+ "illegal" -> error "wait, that's illegal!"

64+ legalMsg -> liftIO $ do

65+ putStrLn "writing file"

66+ hPutStrLn h legalMsg

67+ putStrLn "wrote file"

68+ return NoContent

69+```

70+

71+Finally we run the server in the background while we post messages to it.

72+

73+``` haskell

74+runApp :: IO ()

75+runApp = run 8080 (serveWithContext api appContext $ server)

76+

77+postMsg :: String -> ClientM NoContent

78+postMsg = client api

79+

80+main :: IO ()

81+main = do

82+ mgr <- newManager defaultManagerSettings

83+ bracket (forkIO $ runApp) killThread $ \_ -> do

84+ ms <- flip runClientM (mkClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do

85+ liftIO $ putStrLn "sending hello message"

86+ _ <- postMsg "hello"

87+ liftIO $ putStrLn "sending illegal message"

88+ _ <- postMsg "illegal"

89+ liftIO $ putStrLn "done"

90+ print ms

91+```

92+

93+This program prints

94+

95+```

96+sending hello message

97+opening file

98+opened file

99+writing file

100+wrote file

101+closing file

102+closed file

103+sending illegal message

104+opening file

105+opened file

106+closing file

107+closed file

108+wait, that's illegal!

109+CallStack (from HasCallStack):

110+ error, called at ManagedResource.lhs:63:24 in main:Main

111+Left (FailureResponse (Request {requestPath = (BaseUrl {baseUrlScheme = Http, baseUrlHost = "localhost", baseUrlPort = 8080, baseUrlPath = ""},""), requestQueryString = fromList [], requestBody = Just ((),text/plain;charset=utf-8), requestAccept = fromList [], requestHeaders = fromList [], requestHttpVersion = HTTP/1.1, requestMethod = "POST"}) (Response {responseStatusCode = Status {statusCode = 500, statusMessage = "Internal Server Error"}, responseHeaders = fromList [("Transfer-Encoding","chunked"),("Date","Thu, 24 Nov 2022 21:04:47 GMT"),("Server","Warp/3.3.23"),("Content-Type","text/plain; charset=utf-8")], responseHttpVersion = HTTP/1.1, responseBody = "Something went wrong"}))

112+```

113+

114+and appends to a file called `test.txt`. We can see from the output that when a legal message is sent, the file is opened, written to, and closed. We can also see that when an illegal message is sent, the file is opened but not written to. Crucially, it is still closed even though the handler threw an exception.

doc/cookbook/managed-resource/managed-resource.cabalnew file+30

@@ -0,0 +1,30 @@

1+cabal-version: 2.2

2+name: cookbook-managed-resource

3+version: 0.1

4+synopsis: Simple managed resource cookbook example

5+homepage: http://docs.servant.dev/

6+license: BSD-3-Clause

7+license-file: ../../../servant/LICENSE

8+author: Servant Contributors

9+maintainer: haskell-servant-maintainers@googlegroups.com

10+build-type: Simple

11+tested-with: GHC==9.4.2

12+

13+executable cookbook-managed-resource

14+ main-is: ManagedResource.lhs

15+ build-depends: base == 4.*

16+ , text >= 1.2

17+ , aeson >= 1.2

18+ , servant

19+ , servant-client

20+ , servant-server

21+ , warp >= 3.2

22+ , wai >= 3.2

23+ , http-types >= 0.12

24+ , markdown-unlit >= 0.4

25+ , http-client >= 0.5

26+ , transformers

27+ , resourcet

28+ default-language: Haskell2010

29+ ghc-options: -Wall -pgmL markdown-unlit

30+ build-tool-depends: markdown-unlit:markdown-unlit

doc/cookbook/open-id-connect/OpenIdConnect.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: open-id-connect

23version: 0.1

34synopsis: OpenId Connect with Servant example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >= 1.10

1111tested-with: GHC==8.6.5

1212

1313executable cookbook-openidconnect

doc/cookbook/open-id-connect/OpenIdConnect.lhs+1−1

@@ -330,7 +330,7 @@ data Customer = Customer {

330330```

331331

332332Here is the code that displays the homepage.

333−It should contain a link to the the `/login` URL.

333+It should contain a link to the `/login` URL.

334334When the user clicks on this link it will be redirected to Google login page

335335with some generated information.

336336

doc/cookbook/pagination/pagination.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-pagination

23version: 2.1

34synopsis: Pagination with Servant example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

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

1212

1313executable cookbook-pagination

doc/cookbook/sentry/sentry.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-sentry

23version: 0.1

34synopsis: Collecting runtime exceptions using Sentry

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

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

1212

1313executable cookbook-sentry

doc/cookbook/structuring-apis/structuring-apis.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-structuring-apis

23version: 0.1

34synopsis: Example that shows how APIs can be structured

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

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

1212

1313executable cookbook-structuring-apis

doc/cookbook/testing/testing.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-testing

23version: 0.0.1

34synopsis: Common testing patterns in Servant apps

@@ -9,7 +10,6 @@ author: Servant Contributors

910maintainer: haskell-servant-maintainers@googlegroups.com

1011category: Servant

1112build-type: Simple

12−cabal-version: >=1.10

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

1414

1515executable cookbook-testing

doc/cookbook/using-custom-monad/using-custom-monad.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-using-custom-monad

23version: 0.1

34synopsis: Using custom monad to pass a state between handlers

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

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

1212

1313executable cookbook-using-custom-monad

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

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

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

120120

121121```haskell

122− let req' = I.defaultMakeClientRequest burl req

122+ req' <- I.defaultMakeClientRequest burl req

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

124124```

125125

doc/cookbook/using-free-client/using-free-client.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-using-free-client

23version: 0.1

34synopsis: Using Free client

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

78author: Servant Contributors

89maintainer: haskell-servant-maintainers@googlegroups.com

910build-type: Simple

10−cabal-version: >=1.10

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

1212

1313executable cookbook-using-free-client

doc/cookbook/uverb/UVerb.lhs+1−1

@@ -199,7 +199,7 @@ parsers in the hope that the ones that should will always error out so

199199you can try until the right one returns a value.)

200200

201201[servant-exceptions](https://github.com/ch1bo/servant-exceptions) is

202−another shot at at the problem. It is inspired by

202+another shot at the problem. It is inspired by

203203servant-checked-exceptions, so it may be worth taking a closer look.

204204The README claims that

205205[cardano-sl](https://github.com/input-output-hk/cardano-sl) also has

doc/cookbook/uverb/uverb.cabal+1−1

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: cookbook-uverb

23version: 0.0.1

34synopsis: How to use the 'UVerb' type.

@@ -9,7 +10,6 @@ author: Servant Contributors

910maintainer: haskell-servant-maintainers@googlegroups.com

1011category: Servant

1112build-type: Simple

12−cabal-version: >=1.10

1313tested-with: GHC==8.6.5, GHC==8.8.4, GHC==8.10.7

1414

1515executable cookbook-uverb

doc/links.rst+1−1

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

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

1313

1414- the irc channel:

15− ``#servant`` on freenode

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

1616

1717- the mailing list:

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

doc/requirements.txt+1

@@ -1,3 +1,4 @@

11recommonmark==0.5.0

22Sphinx==1.8.4

33sphinx_rtd_theme>=0.4.2

4+jinja2<3.1.0

doc/tutorial/install.rst+26

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

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

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

4242environment 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+2−2

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: tutorial

23version: 0.10

34synopsis: The servant tutorial

@@ -11,7 +12,6 @@ license-file: LICENSE

1112author: Servant Contributors

1213maintainer: haskell-servant-maintainers@googlegroups.com

1314build-type: Simple

14−cabal-version: >=1.10

1515tested-with:

1616 GHC==8.6.5

1717 GHC==8.8.3, GHC ==8.10.7

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

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

6565 , cookie >= 0.4.3 && < 0.5

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

67− , lucid >= 2.9.11 && < 2.10

67+ , lucid >= 2.9.11 && < 2.12

6868 , random >= 1.1 && < 1.3

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

7070 , time >= 1.6.0.1 && < 1.13

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

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: servant-auth-client

23version: 0.4.1.0

34synopsis: servant-client/servant-auth compatibility

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

67 APIs that use

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

89 .

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

1011category: Web, Servant, Authentication

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

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

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

1314author: Julian K. Arni

1415maintainer: jkarni@gmail.com

@@ -17,7 +18,6 @@ license: BSD-3-Clause

1718license-file: LICENSE

1819tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1

1920build-type: Simple

20−cabal-version: >= 1.10

2121extra-source-files:

2222 CHANGELOG.md

2323

@@ -31,12 +31,12 @@ library

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

3232 ghc-options: -Wall

3333 build-depends:

34− base >= 4.10 && < 4.16

35− , bytestring >= 0.10.6.0 && < 0.11

34+ base >= 4.10 && < 4.18

35+ , bytestring >= 0.10.6.0 && < 0.12

3636 , containers >= 0.5.6.2 && < 0.7

3737 , servant-auth == 0.4.*

38− , servant >= 0.13 && < 0.19

39− , servant-client-core >= 0.13 && < 0.19

38+ , servant >= 0.13 && < 0.20

39+ , servant-client-core >= 0.13 && < 0.20

4040

4141 exposed-modules:

4242 Servant.Auth.Client

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

5050 test

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

5252 ghc-options: -Wall

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

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

5454

5555 -- dependencies with bounds inherited from the library stanza

5656 build-depends:

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

6262

6363 -- test dependencies

6464 build-depends:

65− hspec >= 2.5.5 && < 2.9

65+ hspec >= 2.5.5 && < 2.10

6666 , QuickCheck >= 2.11.3 && < 2.15

6767 , aeson >= 1.3.1.1 && < 3

68− , bytestring >= 0.10.6.0 && < 0.11

68+ , bytestring >= 0.10.6.0 && < 0.12

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

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

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

72− , servant-server >= 0.13 && < 0.19

72+ , servant-server >= 0.13 && < 0.20

7373 , time >= 1.5.0.1 && < 1.13

7474 , transformers >= 0.4.2.0 && < 0.6

7575 , wai >= 3.2.1.2 && < 3.3

7676 , warp >= 3.2.25 && < 3.4

77− , jose >= 0.7.0.0 && < 0.10

77+ , jose >= 0.10 && < 0.11

7878 other-modules:

7979 Servant.Auth.ClientSpec

8080 default-language: Haskell2010

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

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: servant-auth-docs

23version: 0.2.10.0

34synopsis: servant-docs/servant-auth compatibility

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

67 APIs that use

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

89 .

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

1011category: Web, Servant, Authentication

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

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

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

1314author: Julian K. Arni

1415maintainer: jkarni@gmail.com

@@ -17,7 +18,6 @@ license: BSD-3-Clause

1718license-file: LICENSE

1819tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1

1920build-type: Custom

20−cabal-version: >= 1.10

2121extra-source-files:

2222 CHANGELOG.md

2323

@@ -35,11 +35,11 @@ library

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

3636 ghc-options: -Wall

3737 build-depends:

38− base >= 4.10 && < 4.16

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

40− , servant >= 0.13 && < 0.19

38+ base >= 4.10 && < 4.18

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

40+ , servant >= 0.13 && < 0.20

4141 , servant-auth == 0.4.*

42− , lens >= 4.16.1 && <5.1

42+ , lens >= 4.16.1 && <5.3

4343 exposed-modules:

4444 Servant.Auth.Docs

4545 default-language: Haskell2010

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

5050 build-depends:

5151 base,

5252 servant-auth-docs,

53− doctest >= 0.16 && < 0.19,

53+ doctest >= 0.16 && < 0.21,

5454 QuickCheck >= 2.11.3 && < 2.15,

5555 template-haskell

5656 ghc-options: -Wall -threaded

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

6464 test

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

6666 ghc-options: -Wall

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

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

6868

6969 -- dependencies with bounds inherited from the library stanza

7070 build-depends:

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

7878 -- test dependencies

7979 build-depends:

8080 servant-auth-docs

81− , hspec >= 2.5.5 && < 2.9

81+ , hspec >= 2.5.5 && < 2.10

8282 , QuickCheck >= 2.11.3 && < 2.15

8383

8484 default-language: Haskell2010

servant-auth/servant-auth-server/servant-auth-server.cabal+18−17

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

1+cabal-version: 2.2

12name: servant-auth-server

2−version: 0.4.6.0

3+version: 0.4.7.0

34synopsis: servant-server/servant-auth compatibility

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

56 in your 'servant' server.

67 .

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

89 .

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

1011category: Web, Servant, Authentication

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

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

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

1314author: Julian K. Arni

1415maintainer: jkarni@gmail.com

@@ -17,7 +18,6 @@ license: BSD-3-Clause

1718license-file: LICENSE

1819tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1

1920build-type: Simple

20−cabal-version: >= 1.10

2121extra-source-files:

2222 CHANGELOG.md

2323

@@ -31,27 +31,27 @@ library

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

3232 ghc-options: -Wall

3333 build-depends:

34− base >= 4.10 && < 4.16

34+ base >= 4.10 && < 4.18

3535 , aeson >= 1.0.0.1 && < 3

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

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

38− , bytestring >= 0.10.6.0 && < 0.11

38+ , bytestring >= 0.10.6.0 && < 0.12

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

4040 , cookie >= 0.4.4 && < 0.5

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

4242 , entropy >= 0.4.1.3 && < 0.5

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

44− , jose >= 0.7.0.0 && < 0.10

45− , lens >= 4.16.1 && < 5.1

46− , memory >= 0.14.16 && < 0.17

44+ , jose >= 0.10 && < 0.11

45+ , lens >= 4.16.1 && < 5.3

46+ , memory >= 0.14.16 && < 0.19

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

48− , mtl >= 2.2.2 && < 2.3

49− , servant >= 0.13 && < 0.19

48+ , mtl ^>= 2.2.2 || ^>= 2.3.1

49+ , servant >= 0.13 && < 0.20

5050 , servant-auth == 0.4.*

51− , servant-server >= 0.13 && < 0.19

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

5252 , tagged >= 0.8.4 && < 0.9

53− , text >= 1.2.3.0 && < 1.3

54− , time >= 1.5.0.1 && < 1.10

53+ , text >= 1.2.3.0 && < 2.1

54+ , time >= 1.5.0.1 && < 1.13

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

5656 , wai >= 3.2.1.2 && < 3.3

5757

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

102102 test

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

104104 ghc-options: -Wall

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

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

106106

107107 -- dependencies with bounds inherited from the library stanza

108108 build-depends:

@@ -123,12 +123,13 @@ test-suite spec

123123 -- test dependencies

124124 build-depends:

125125 servant-auth-server

126− , hspec >= 2.5.5 && < 2.8

126+ , hspec >= 2.5.5 && < 2.10

127127 , QuickCheck >= 2.11.3 && < 2.15

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

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

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

130130 , warp >= 3.2.25 && < 3.4

131131 , wreq >= 0.5.2.1 && < 0.6

132+ , text >= 1.2.3.0 && < 2.1

132133 other-modules:

133134 Servant.Auth.ServerSpec

134135 default-language: Haskell2010

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal.hs+6−9

@@ -54,15 +54,12 @@ instance ( n ~ 'S ('S 'Z)

5454

5555 makeCookies :: AuthResult v -> IO (SetCookieList ('S ('S 'Z)))

5656 makeCookies authResult = do

57− xsrf <- makeXsrfCookie cookieSettings

58− fmap (Just xsrf `SetCookieCons`) $

59− case authResult of

60− (Authenticated v) -> do

61− ejwt <- makeSessionCookie cookieSettings jwtSettings v

62− case ejwt of

63− Nothing -> return $ Nothing `SetCookieCons` SetCookieNil

64− Just jwt -> return $ Just jwt `SetCookieCons` SetCookieNil

65− _ -> return $ Nothing `SetCookieCons` SetCookieNil

57+ case authResult of

58+ (Authenticated v) -> do

59+ ejwt <- makeSessionCookie cookieSettings jwtSettings v

60+ xsrf <- makeXsrfCookie cookieSettings

61+ return $ Just xsrf `SetCookieCons` (ejwt `SetCookieCons` SetCookieNil)

62+ _ -> return $ Nothing `SetCookieCons` (Nothing `SetCookieCons` SetCookieNil)

6663

6764 go :: (AuthResult v -> ServerT api Handler)

6865 -> (AuthResult v, SetCookieList n)

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/AddSetCookie.hs+26−1

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

1111import qualified Network.HTTP.Types as HTTP

1212import Network.Wai (mapResponseHeaders)

1313import Servant

14+import Servant.API.UVerb.Union

15+import Servant.API.Generic

16+import Servant.Server.Generic

1417import Web.Cookie

1518

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

@@ -31,11 +34,24 @@ type family AddSetCookieApiVerb a where

3134 AddSetCookieApiVerb (Headers ls a) = Headers (Header "Set-Cookie" SetCookie ': ls) a

3235 AddSetCookieApiVerb a = Headers '[Header "Set-Cookie" SetCookie] a

3336

37+#if MIN_VERSION_servant_server(0,18,1)

38+type family MapAddSetCookieApiVerb (as :: [*]) where

39+ MapAddSetCookieApiVerb '[] = '[]

40+ MapAddSetCookieApiVerb (a ': as) = (AddSetCookieApiVerb a ': MapAddSetCookieApiVerb as)

41+#endif

42+

3443type family AddSetCookieApi a :: *

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

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

46+#if MIN_VERSION_servant_server(0,19,0)

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

48+#endif

3749type instance AddSetCookieApi (Verb method stat ctyps a)

3850 = Verb method stat ctyps (AddSetCookieApiVerb a)

51+#if MIN_VERSION_servant_server(0,18,1)

52+type instance AddSetCookieApi (UVerb method ctyps as)

53+ = UVerb method ctyps (MapAddSetCookieApiVerb as)

54+#endif

3955type instance AddSetCookieApi Raw = Raw

4056#if MIN_VERSION_servant_server(0,15,0)

4157type instance AddSetCookieApi (Stream method stat framing ctyps a)

@@ -54,7 +70,7 @@ instance {-# OVERLAPS #-} AddSetCookies ('S n) oldb newb

5470 => AddSetCookies ('S n) (a -> oldb) (a -> newb) where

5571 addSetCookies cookies oldfn = addSetCookies cookies . oldfn

5672

57−instance AddSetCookies 'Z orig orig where

73+instance (orig1 ~ orig2) => AddSetCookies 'Z orig1 orig2 where

5874 addSetCookies _ = id

5975

6076instance {-# OVERLAPPABLE #-}

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

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

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

7490

91+instance {-# OVERLAPS #-}

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

93+ , Generic (api (AsServerT m))

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

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

96+ )

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

98+ addSetCookies cookies = addSetCookies cookies . toServant

99+

75100-- | for @servant <0.11@

76101instance

77102 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

3333 -- | Algorithm used to sign JWT.

3434 , jwtAlg :: Maybe Jose.Alg

3535 -- | Keys used to validate JWT.

36− , validationKeys :: Jose.JWKSet

36+ , validationKeys :: IO Jose.JWKSet

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

3838 -- intended recipient of the JWT.

3939 , audienceMatches :: Jose.StringOrURI -> IsMatch

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

4444defaultJWTSettings k = JWTSettings

4545 { signingKey = k

4646 , jwtAlg = Nothing

47− , validationKeys = Jose.JWKSet [k]

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

4848 , audienceMatches = const Matches }

4949

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

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

@@ -2,6 +2,7 @@

22module Servant.Auth.Server.Internal.Cookie where

33

44import Blaze.ByteString.Builder (toByteString)

5+import Control.Monad (MonadPlus(..), guard)

56import Control.Monad.Except

67import Control.Monad.Reader

78import qualified Crypto.JOSE as Jose

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs+6−9

@@ -1,18 +1,14 @@

11module Servant.Auth.Server.Internal.JWT where

22

33import Control.Lens

4−import Control.Monad.Except

4+import Control.Monad (MonadPlus(..), guard)

55import Control.Monad.Reader

66import qualified Crypto.JOSE as Jose

77import qualified Crypto.JWT as Jose

8−import Data.Aeson (FromJSON, Result (..), ToJSON, fromJSON,

9− toJSON)

108import Data.ByteArray (constEq)

119import qualified Data.ByteString as BS

1210import qualified Data.ByteString.Lazy as BSL

13−import qualified Data.HashMap.Strict as HM

1411import Data.Maybe (fromMaybe)

15−import qualified Data.Text as T

1612import Data.Time (UTCTime)

1713import Network.Wai (requestHeaders)

1814

@@ -42,7 +38,7 @@ jwtAuthCheck jwtSettings = do

4238-- token expires.

4339makeJWT :: ToJWT a

4440 => a -> JWTSettings -> Maybe UTCTime -> IO (Either Jose.Error BSL.ByteString)

45−makeJWT v cfg expiry = runExceptT $ do

41+makeJWT v cfg expiry = Jose.runJOSE $ do

4642 bestAlg <- Jose.bestJWSAlg $ signingKey cfg

4743 let alg = fromMaybe bestAlg $ jwtAlg cfg

4844 ejwt <- Jose.signClaims (signingKey cfg)

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

5854

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

6056verifyJWT jwtCfg input = do

61− verifiedJWT <- liftIO $ runExceptT $ do

57+ keys <- validationKeys jwtCfg

58+ verifiedJWT <- Jose.runJOSE $ do

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

6360 Jose.verifyClaims

6461 (jwtSettingsToJwtValidationSettings jwtCfg)

65− (validationKeys jwtCfg)

62+ keys

6663 unverifiedJWT

6764 return $ case verifiedJWT of

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

6966 Right v -> case decodeJWT v of

7067 Left _ -> Nothing

71− Right v' -> Just v'

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

88

99import Control.Monad.Error.Class

1010import 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

1215import Network.HTTP.Types

1316import Network.Wai

1417

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

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

2730 throwAll e = throwAll e :<|> throwAll e

2831

32+instance

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

34+ ThrowAll (api (AsServerT m)) where

35+

36+ throwAll = fromServant . throwAll

37+

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

3039-- MonadError, no?

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

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

@@ -2,6 +2,7 @@

22module Servant.Auth.Server.Internal.Types where

33

44import Control.Applicative

5+import Control.Monad (MonadPlus(..), ap)

56import Control.Monad.Reader

67import Control.Monad.Time

78import Data.Monoid (Monoid (..))

servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs+39−5

@@ -1,4 +1,5 @@

11{-# LANGUAGE CPP #-}

2+{-# LANGUAGE TypeApplications #-}

23module Servant.Auth.ServerSpec (spec) where

34

45#if !MIN_VERSION_servant_server(0,16,0)

@@ -6,13 +7,12 @@ module Servant.Auth.ServerSpec (spec) where

67#endif

78

89import Control.Lens

9−import Control.Monad.Except (runExceptT)

1010import Control.Monad.IO.Class (liftIO)

1111import Crypto.JOSE (Alg (HS256, None), Error,

1212 JWK, JWSHeader,

1313 KeyMaterialGenParam (OctGenParam),

1414 ToCompact, encodeCompact,

15− genJWK, newJWSHeader)

15+ genJWK, newJWSHeader, runJOSE)

1616import Crypto.JWT (Audience (..), ClaimsSet,

1717 NumericDate (NumericDate),

1818 SignedJWT,

@@ -25,6 +25,7 @@ import Data.Aeson (FromJSON, ToJSON, Value,

2525import Data.Aeson.Lens (_JSON)

2626import qualified Data.ByteString as BS

2727import qualified Data.ByteString.Lazy as BSL

28+import Data.Text (Text, pack)

2829import Data.CaseInsensitive (mk)

2930import Data.Foldable (find)

3031import Data.Monoid

@@ -40,6 +41,7 @@ import Network.HTTP.Types (Status, status200,

4041import Network.Wai (responseLBS)

4142import Network.Wai.Handler.Warp (testWithApplication)

4243import Network.Wreq (Options, auth, basicAuth,

44+ checkResponse,

4345 cookieExpiryTime, cookies,

4446 defaults, get, getWith, postWith,

4547 header, oauth2Bearer,

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

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

5153import Servant hiding (BasicAuth,

5254 IsSecure (..), header)

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

5356import Servant.Auth.Server

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

5558import Servant.Auth.Server.SetCookieOrphan ()

@@ -182,8 +185,21 @@ cookieAuthSpec

182185 it "fails with no XSRF header or cookie" $ \port -> property

183186 $ \(user :: User) -> do

184187 jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)

185− opts <- addJwtToCookie cookieCfg jwt

186− getWith opts (url port) `shouldHTTPErrorWith` status401

188+ opts' <- addJwtToCookie cookieCfg jwt

189+ let opts = opts' & checkResponse .~ Just mempty

190+ resp <- getWith opts (url port)

191+ resp ^. responseStatus `shouldBe` status401

192+ (resp ^. responseCookieJar) `shouldNotHaveCookies` ["XSRF-TOKEN"]

193+

194+ -- Validating that the XSRF cookie isn't added for UVerb routes either.

195+ -- These routes can return a 401 response directly without using throwError / throwAll,

196+ -- which revealed a bug:

197+ --

198+ -- https://github.com/haskell-servant/servant/issues/1570#issuecomment-1076374449

199+ resp <- getWith opts (url port ++ "/uverb")

200+ resp ^. responseStatus `shouldBe` status401

201+ (resp ^. responseCookieJar) `shouldNotHaveCookies` ["XSRF-TOKEN"]

202+

187203

188204 it "succeeds if XSRF header and cookie match, and JWT is valid" $ \port -> property

189205 $ \(user :: User) -> do

@@ -405,17 +421,23 @@ type API auths

405421 = Auth auths User :>

406422 ( Get '[JSON] Int

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

424+ :<|> "named" :> NamedRoutes DummyRoutes

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

409426#if MIN_VERSION_servant_server(0,15,0)

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

411428#endif

412429 :<|> "raw" :> Raw

413430 )

431+ :<|> "uverb" :> Auth auths User :> UVerb 'GET '[JSON] '[WithStatus 200 Int, WithStatus 401 Text, WithStatus 403 Text]

414432 :<|> "login" :> ReqBody '[JSON] User :> Post '[JSON] (Headers '[ Header "Set-Cookie" SetCookie

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

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

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

418436

437+data DummyRoutes mode = DummyRoutes

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

439+ } deriving Generic

440+

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

420442jwtOnlyApi = Proxy

421443

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

476498 (\authResult -> case authResult of

477499 Authenticated usr -> getInt usr

478500 :<|> postInt usr

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

479502 :<|> getHeaderInt

480503#if MIN_VERSION_servant_server(0,15,0)

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

@@ -483,6 +506,11 @@ server ccfg =

483506 :<|> raw

484507 Indefinite -> throwAll err401

485508 _ -> throwAll err403

509+ ) :<|>

510+ (\authResult -> case authResult of

511+ Authenticated usr -> respond (WithStatus @200 (42 :: Int))

512+ Indefinite -> respond (WithStatus @401 $ pack "Authentication required")

513+ _ -> respond (WithStatus @403 $ pack "Forbidden")

486514 )

487515 :<|> getLogin

488516 :<|> getLogout

@@ -533,7 +561,7 @@ addJwtToHeader jwt = case jwt of

533561 $ defaults & header "Authorization" .~ ["Bearer " <> BSL.toStrict v]

534562

535563createJWT :: JWK -> JWSHeader () -> ClaimsSet -> IO (Either Error Crypto.JWT.SignedJWT)

536−createJWT k a b = runExceptT $ signClaims k a b

564+createJWT k a b = runJOSE $ signClaims k a b

537565

538566addJwtToCookie :: ToCompact a => CookieSettings -> Either Error a -> IO Options

539567addJwtToCookie ccfg jwt = case jwt >>= (return . encodeCompact) of

@@ -563,6 +591,12 @@ shouldMatchCookieNames cj patterns

563591 = fmap cookie_name (destroyCookieJar cj)

564592 `shouldMatchList` patterns

565593

594+shouldNotHaveCookies :: HCli.CookieJar -> [BS.ByteString] -> Expectation

595+shouldNotHaveCookies cj patterns =

596+ sequence_ $ (\cookieName -> cookieNames `shouldNotContain` [cookieName]) <$> patterns

597+ where cookieNames :: [BS.ByteString]

598+ cookieNames = cookie_name <$> destroyCookieJar cj

599+

566600shouldMatchCookieNameValues :: HCli.CookieJar -> [(BS.ByteString, BS.ByteString)] -> Expectation

567601shouldMatchCookieNameValues cj patterns

568602 = fmap ((,) <$> cookie_name <*> cookie_value) (destroyCookieJar cj)

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

@@ -1,3 +1,4 @@

1+cabal-version: 2.2

12name: servant-auth-swagger

23version: 0.2.10.1

34synopsis: servant-swagger/servant-auth compatibility

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

67 APIs that use

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

89 .

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

1011category: Web, Servant, Authentication

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

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

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

1314author: Julian K. Arni

1415maintainer: jkarni@gmail.com

@@ -17,7 +18,6 @@ license: BSD-3-Clause

1718license-file: LICENSE

1819tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4

1920build-type: Simple

20−cabal-version: >= 1.10

2121extra-source-files:

2222 CHANGELOG.md

2323

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

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

3232 ghc-options: -Wall

3333 build-depends:

34− base >= 4.10 && < 4.16

35− , text >= 1.2.3.0 && < 1.3

34+ base >= 4.10 && < 4.18

35+ , text >= 1.2.3.0 && < 2.1

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

3737 , swagger2 >= 2.2.2 && < 3

38− , servant >= 0.13 && < 0.19

38+ , servant >= 0.13 && < 0.20

3939 , servant-auth == 0.4.*

40− , lens >= 4.16.1 && < 5.1

41− if impl(ghc >= 9)

42− buildable: False

40+ , lens >= 4.16.1 && < 5.3

4341 exposed-modules:

4442 Servant.Auth.Swagger

4543 default-language: Haskell2010

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

5149 test

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

5351 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

5553 -- dependencies with bounds inherited from the library stanza

5654 build-depends:

5755 base

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

6159 , servant

6260 , servant-auth

6361 , lens

64− if impl(ghc >= 9)

65− buildable: False

66−

62+

6763 -- test dependencies

6864 build-depends:

6965 servant-auth-swagger

70− , hspec >= 2.5.5 && < 2.9

66+ , hspec >= 2.5.5 && < 2.10

7167 , QuickCheck >= 2.11.3 && < 2.15

7268 other-modules:

7369 Servant.Auth.SwaggerSpec

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

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

1+cabal-version: 2.2

12name: servant-auth

2−version: 0.4.0.0

3+version: 0.4.1.0

34synopsis: Authentication combinators for servant

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

56 allows using different authentication schemes in a straightforward way,

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

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

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

1011 .

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

1213category: Web, Servant, Authentication

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

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

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

1516author: Julian K. Arni

1617maintainer: jkarni@gmail.com

@@ -19,7 +20,6 @@ license: BSD-3-Clause

1920license-file: LICENSE

2021tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1

2122build-type: Simple

22−cabal-version: >= 1.10

2323extra-source-files:

2424 CHANGELOG.md

2525

@@ -33,13 +33,13 @@ library

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

3434 ghc-options: -Wall

3535 build-depends:

36− base >= 4.10 && < 4.16

36+ base >= 4.10 && < 4.18

3737 , containers >= 0.6 && < 0.7

3838 , aeson >= 1.3.1.1 && < 3

39− , jose >= 0.7.0.0 && < 0.10

40− , lens >= 4.16.1 && < 5.1

41− , servant >= 0.15 && < 0.19

42− , text >= 1.2.3.0 && < 1.3

39+ , jose >= 0.10 && < 0.11

40+ , lens >= 4.16.1 && < 5.3

41+ , servant >= 0.15 && < 0.20

42+ , text >= 1.2.3.0 && < 2.1

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

4444 exposed-modules:

4545 Servant.Auth

servant-auth/servant-auth/src/Servant/Auth.hs+1−1

@@ -27,7 +27,7 @@ instance HasLink sub => HasLink (Auth (tag :: [*]) value :> sub) where

2727

2828-- ** Combinators

2929

30−-- | A JSON Web Token (JWT) in the the Authorization header:

30+-- | A JSON Web Token (JWT) in the Authorization header:

3131--

3232-- @Authorization: Bearer \<token\>@

3333--

servant-client-core/CHANGELOG.md+31

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

11[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client-core/CHANGELOG.md)

22[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)

33

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

7+----

8+

9+### Significant changes

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

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

15+ related to hash collisions.

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

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

18+- Add custom type errors for partially applied combinators

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

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

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

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

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

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

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

26+ `Servant.Client.Core.Request`.

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

28+ in Query parameters.

29+ ([#1432](https://github.com/haskell-servant/servant/pull/1432)).

30+

31+### Other changes

32+

33+- Various version bumps.

34+

4350.18.3

536------

637

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

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

1−cabal-version: >=1.10

1+cabal-version: 2.2

22name: servant-client-core

3−version: 0.18.3

3+version: 0.19

44

55synopsis: Core functionality and class for client function generation for servant APIs

66category: Servant, Web

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

5050 --

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

5252 build-depends:

53− base >= 4.9 && < 4.16

53+ base >= 4.9 && < 4.18

5454 , bytestring >= 0.10.8.1 && < 0.12

5555 , constraints >= 0.2 && < 0.14

5656 , containers >= 0.5.7.1 && < 0.7

5757 , deepseq >= 1.4.2.0 && < 1.5

58− , text >= 1.2.3.0 && < 1.3

59− , transformers >= 0.5.2.0 && < 0.6

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

58+ , text >= 1.2.3.0 && < 2.1

59+ , transformers >= 0.5.2.0 && < 0.7

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

6161

6262 if !impl(ghc >= 8.2)

6363 build-depends:

@@ -65,13 +65,13 @@ library

6565

6666 -- Servant dependencies

6767 build-depends:

68− servant >= 0.18.3 && <0.19

68+ servant >= 0.19

6969

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

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

7272 build-depends:

7373 aeson >= 1.4.1.0 && < 3

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

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

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

7676 , exceptions >= 0.10.0 && < 0.11

7777 , free >= 5.1 && < 5.2

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

104104 -- Additional dependencies

105105 build-depends:

106106 deepseq >= 1.4.2.0 && < 1.5

107− , hspec >= 2.6.0 && < 2.9

107+ , hspec >= 2.6.0 && < 2.10

108108 , QuickCheck >= 2.12.6.1 && < 2.15

109109

110110 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

5959 , appendToPath

6060 , setRequestBodyLBS

6161 , setRequestBody

62+ , encodeQueryParamValue

6263 ) where

6364import Servant.Client.Core.Auth

6465import Servant.Client.Core.BaseUrl

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

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

3333import Control.Monad

3434 (unless)

3535import 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

3937import Data.Either

4038 (partitionEithers)

4139import Data.Constraint (Dict(..))

@@ -65,7 +63,7 @@ import Data.Text

6563import Data.Proxy

6664 (Proxy (Proxy))

6765import GHC.TypeLits

68− (KnownSymbol, symbolVal)

66+ (KnownNat, KnownSymbol, TypeError, symbolVal)

6967import Network.HTTP.Types

7068 (Status)

7169import qualified Network.HTTP.Types as H

@@ -76,19 +74,22 @@ import Servant.API

7674 FromSourceIO (..), Header', Headers (..), HttpVersion,

7775 IsSecure, MimeRender (mimeRender),

7876 MimeUnrender (mimeUnrender), NoContent (NoContent),

79− NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw,

77+ NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw, RawM,

8078 ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,

8179 StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,

82− Verb, WithNamedContext, WithStatus (..), contentType, getHeadersHList,

80+ Verb, WithNamedContext, WithResource, WithStatus (..), contentType, getHeadersHList,

8381 getResponse, toEncodedUrlPiece, toUrlPiece, NamedRoutes)

8482import Servant.API.Generic

8583 (GenericMode(..), ToServant, ToServantApi

8684 , GenericServant, toServant, fromServant)

8785import Servant.API.ContentTypes

8886 (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))

87+import Servant.API.Status

88+ (statusFromNat)

8989import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)

9090import Servant.API.Modifiers

9191 (FoldRequired, RequiredArgument, foldRequiredArgument)

92+import Servant.API.TypeErrors

9293import Servant.API.UVerb

9394 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)

9495

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

207208 clientWithRoute pm (Proxy :: Proxy api)

208209 (appendToPath p req)

209210

210− where p = (toUrlPiece val)

211+ where p = toEncodedUrlPiece val

211212

212213 hoistClientMonad pm _ f cl = \a ->

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

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

242243 clientWithRoute pm (Proxy :: Proxy sublayout)

243244 (foldl' (flip appendToPath) req ps)

244245

245− where ps = map (toUrlPiece) vals

246+ where ps = map toEncodedUrlPiece vals

246247

247248 hoistClientMonad pm _ f cl = \as ->

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

@@ -250,10 +251,11 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)

250251instance {-# OVERLAPPABLE #-}

251252 -- Note [Non-Empty Content Types]

252253 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)

254+ , KnownNat status

253255 ) => HasClient m (Verb method status cts' a) where

254256 type Client m (Verb method status cts' a) = m a

255257 clientWithRoute _pm Proxy req = do

256− response <- runRequest req

258+ response <- runRequestAcceptStatus (Just [status]) req

257259 { requestAccept = fromList $ toList accept

258260 , requestMethod = method

259261 }

@@ -261,18 +263,20 @@ instance {-# OVERLAPPABLE #-}

261263 where

262264 accept = contentTypes (Proxy :: Proxy ct)

263265 method = reflectMethod (Proxy :: Proxy method)

266+ status = statusFromNat (Proxy :: Proxy status)

264267

265268 hoistClientMonad _ _ f ma = f ma

266269

267270instance {-# OVERLAPPING #-}

268− ( RunClient m, ReflectMethod method

271+ ( RunClient m, ReflectMethod method, KnownNat status

269272 ) => HasClient m (Verb method status cts NoContent) where

270273 type Client m (Verb method status cts NoContent)

271274 = m NoContent

272275 clientWithRoute _pm Proxy req = do

273− _response <- runRequest req { requestMethod = method }

276+ _response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }

274277 return NoContent

275278 where method = reflectMethod (Proxy :: Proxy method)

279+ status = statusFromNat (Proxy :: Proxy status)

276280

277281 hoistClientMonad _ _ f ma = f ma

278282

@@ -289,13 +293,13 @@ instance (RunClient m, ReflectMethod method) =>

289293

290294instance {-# OVERLAPPING #-}

291295 -- Note [Non-Empty Content Types]

292− ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls

296+ ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls, KnownNat status

293297 , ReflectMethod method, cts' ~ (ct ': cts)

294298 ) => HasClient m (Verb method status cts' (Headers ls a)) where

295299 type Client m (Verb method status cts' (Headers ls a))

296300 = m (Headers ls a)

297301 clientWithRoute _pm Proxy req = do

298− response <- runRequest req

302+ response <- runRequestAcceptStatus (Just [status]) req

299303 { requestMethod = method

300304 , requestAccept = fromList $ toList accept

301305 }

@@ -303,22 +307,26 @@ instance {-# OVERLAPPING #-}

303307 return $ Headers { getResponse = val

304308 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

305309 }

306− where method = reflectMethod (Proxy :: Proxy method)

307− accept = contentTypes (Proxy :: Proxy ct)

310+ where

311+ method = reflectMethod (Proxy :: Proxy method)

312+ accept = contentTypes (Proxy :: Proxy ct)

313+ status = statusFromNat (Proxy :: Proxy status)

308314

309315 hoistClientMonad _ _ f ma = f ma

310316

311317instance {-# OVERLAPPING #-}

312− ( RunClient m, BuildHeadersTo ls, ReflectMethod method

318+ ( RunClient m, BuildHeadersTo ls, ReflectMethod method, KnownNat status

313319 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where

314320 type Client m (Verb method status cts (Headers ls NoContent))

315321 = m (Headers ls NoContent)

316322 clientWithRoute _pm Proxy req = do

317− let method = reflectMethod (Proxy :: Proxy method)

318− response <- runRequest req { requestMethod = method }

323+ response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }

319324 return $ Headers { getResponse = NoContent

320325 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

321326 }

327+ where

328+ method = reflectMethod (Proxy :: Proxy method)

329+ status = statusFromNat (Proxy :: Proxy status)

322330

323331 hoistClientMonad _ _ f ma = f ma

324332

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

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

562570 where

563571 add :: a -> Request

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

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

565573

566574 pname :: Text

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

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

569577 hoistClientMonad pm _ f cl = \arg ->

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

571579

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

573−encodeQueryParam = BL.toStrict . toLazyByteString . toEncodedUrlPiece

574−

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

576581-- the corresponding querying function will automatically take

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

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

613618 )

614619

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

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

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

617622

618623 hoistClientMonad pm _ f cl = \as ->

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

@@ -669,6 +674,16 @@ instance RunClient m => HasClient m Raw where

669674

670675 hoistClientMonad _ _ f cl = \meth -> f (cl meth)

671676

677+instance RunClient m => HasClient m RawM where

678+ type Client m RawM

679+ = H.Method -> m Response

680+

681+ clientWithRoute :: Proxy m -> Proxy RawM -> Request -> Client m RawM

682+ clientWithRoute _pm Proxy req httpMethod = do

683+ runRequest req { requestMethod = httpMethod }

684+

685+ hoistClientMonad _ _ f cl = \meth -> f (cl meth)

686+

672687-- | If you use a 'ReqBody' in one of your endpoints in your API,

673688-- the corresponding querying function will automatically take

674689-- an additional argument of the type specified by your 'ReqBody'.

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

735750 clientWithRoute pm (Proxy :: Proxy api)

736751 (appendToPath p req)

737752

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

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

739754

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

741756

@@ -771,6 +786,14 @@ instance HasClient m subapi =>

771786

772787 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl

773788

789+instance HasClient m subapi =>

790+ HasClient m (WithResource res :> subapi) where

791+

792+ type Client m (WithResource res :> subapi) = Client m subapi

793+ clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)

794+

795+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl

796+

774797instance ( HasClient m api

775798 ) => HasClient m (AuthProtect tag :> api) where

776799 type Client m (AuthProtect tag :> api)

@@ -784,7 +807,7 @@ instance ( HasClient m api

784807

785808-- | Ignore @'Fragment'@ in client functions.

786809-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.

787−--

810+--

788811-- Example:

789812--

790813-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]

@@ -801,7 +824,7 @@ instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient

801824

802825 type Client m (Fragment a :> api) = Client m api

803826

804− clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)

827+ clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)

805828

806829 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)

807830

@@ -869,7 +892,7 @@ infixl 2 /:

869892--

870893-- Example:

871894--

872−-- @@

895+-- @

873896-- type Api = NamedRoutes RootApi

874897--

875898-- data RootApi mode = RootApi

@@ -889,8 +912,8 @@ infixl 2 /:

889912-- rootClient = client api

890913--

891914-- endpointClient :: ClientM Person

892−-- endpointClient = client // subApi // endpoint

893−-- @@

915+-- endpointClient = client \/\/ subApi \/\/ endpoint

916+-- @

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

895918x // f = f x

896919

@@ -901,7 +924,7 @@ x // f = f x

901924--

902925-- Example:

903926--

904−-- @@

927+-- @

905928-- type Api = NamedRoutes RootApi

906929--

907930-- data RootApi mode = RootApi

@@ -922,11 +945,11 @@ x // f = f x

922945-- rootClient = client api

923946--

924947-- hello :: String -> ClientM String

925−-- hello name = rootClient // hello /: name

948+-- hello name = rootClient \/\/ hello \/: name

926949--

927950-- endpointClient :: ClientM Person

928−-- endpointClient = client // subApi /: "foobar123" // endpoint

929−-- @@

951+-- endpointClient = client \/\/ subApi \/: "foobar123" \/\/ endpoint

952+-- @

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

931954(/:) = flip

932955

@@ -970,3 +993,19 @@ decodedAs response ct = do

970993 Right val -> return val

971994 where

972995 accept = toList $ contentTypes ct

996+

997+-------------------------------------------------------------------------------

998+-- Custom type errors

999+-------------------------------------------------------------------------------

1000+

1001+-- Erroring instance for HasClient' when a combinator is not fully applied

1002+instance (RunClient m, TypeError (PartialApplication HasClient arr)) => HasClient m ((arr :: a -> b) :> sub)

1003+ where

1004+ type Client m (arr :> sub) = TypeError (PartialApplication HasClient arr)

1005+ clientWithRoute _ _ _ = error "unreachable"

1006+ hoistClientMonad _ _ _ _ = error "unreachable"

1007+

1008+-- Erroring instances for 'HasClient' for unknown API combinators

1009+instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceForSub (HasClient m) ty)) => HasClient m (ty :> sub)

1010+

1011+instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceFor (HasClient m api))) => HasClient m api

servant-client-core/src/Servant/Client/Core/Request.hs+20−5

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

1717 addHeader,

1818 appendToPath,

1919 appendToQueryString,

20+ encodeQueryParamValue,

2021 setRequestBody,

2122 setRequestBodyLBS,

2223 ) where

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

3334import Data.Bitraversable

3435 (Bitraversable (..), bifoldMapDefault, bimapDefault)

3536import qualified Data.ByteString as BS

37+import Data.ByteString.Builder

38+ (Builder)

3639import qualified Data.ByteString.Builder as Builder

3740import qualified Data.ByteString.Lazy as LBS

3841import qualified Data.Sequence as Seq

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

111114 rnfB Nothing = ()

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

113116

114−type Request = RequestF RequestBody Builder.Builder

117+type Request = RequestF RequestBody Builder

115118

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

117120data RequestBody

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

142145 , requestMethod = methodGet

143146 }

144147

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

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

146152appendToPath p req

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

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

148154

149−appendToQueryString :: Text -- ^ param name

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

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

156+--

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

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

151159 -> Request

152160 -> Request

153161appendToQueryString pname pvalue req

154162 = req { requestQueryString = requestQueryString req

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

156164

165+-- | Encode a query parameter value.

166+--

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

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

169+

170+-- | Add header to the request being constructed.

171+--

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

158173addHeader name val req

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

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

@@ -1,4 +1,4 @@

1−cabal-version: >=1.10

1+cabal-version: 2.2

22name: servant-client-ghcjs

33version: 0.16

44synopsis:

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

3838 Servant.Client.Internal.XhrClient

3939

4040 build-depends:

41− base >=4.11 && <4.12

41+ base >=4.11 && <5

4242 , bytestring >=0.10 && <0.12

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

4444 , containers >=0.5 && <0.7

@@ -48,7 +48,7 @@ library

4848 , http-media >=0.6.2 && <0.9

4949 , http-types >=0.12 && <0.13

5050 , monad-control >=1.0.0.4 && <1.1

51− , mtl >=2.2.2 && <2.3

51+ , mtl ^>=2.2.2 || ^>=2.3.1

5252 , semigroupoids >=5.3 && <5.4

5353 , string-conversions >=0.3 && <0.5

5454 , transformers >=0.3 && <0.6

@@ -56,8 +56,8 @@ library

5656

5757 -- strict, as we re-export stuff

5858 build-depends:

59− servant >=0.16 && <0.17

60− , servant-client-core >=0.16 && <0.16.1

59+ servant >=0.16 && <0.20

60+ , servant-client-core >=0.16 && <0.20

6161

6262 hs-source-dirs: src

6363 default-language: Haskell2010

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

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

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

121121

122122instance RunClient ClientM where

123− runRequest = performRequest

123+ runRequestAcceptStatus = performRequest

124124 throwClientError = throwError

125125

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

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

152152

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

154154

155−performRequest :: Request -> ClientM Response

156−performRequest req = do

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

156+performRequest acceptStatus req = do

157157 xhr <- liftIO initXhr

158158 burl <- asks baseUrl

159159 liftIO $ performXhr xhr burl req

160160 resp <- toResponse xhr

161161

162− let status = statusCode (responseStatusCode resp)

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

162+ let status = responseStatusCode resp

163+ goodStatus = case acceptStatus of

164+ Nothing -> statusIsSuccessful status

165+ Just good -> status `elem` good

166+ unless goodStatus $ do

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

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

166169

servant-client/CHANGELOG.md+31

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

11[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md)