Compare commits

...

242 commits

Author SHA1 Message Date
Intolerable
a2e003367d
Add HasStatus instance for Headers (that defers StatusOf to underlying value) (#1649)
* Add HasStatus instance for Headers (that defers StatusOf to underlying value)

* changelog.d/1649
2023-02-14 23:28:57 +01:00
ˌbodʲɪˈɡrʲim
b3214eac38
Require wai >= 3.2.2.1 (#1644) 2023-01-28 13:02:36 +01:00
Jan Hrcek
f71953e63d
Fix haddock code examples in HasClient (#1640) 2023-01-28 13:02:11 +01:00
Théophile Choutri
c382a1f34e
Allow resourcet-1.3 in servant-server and servant-conduit (#1632) 2023-01-18 09:44:11 +01:00
Daan Rijks
2daae80ea8
Add (basic) API docs for ServerT (#1573) 2023-01-09 17:05:08 +01:00
Torgeir Strand Henriksen
a22600979a
Add Functor instance to AuthHandler. (#1638) 2022-12-30 12:56:52 +01:00
Théophile Choutri
b8675c0924
Provisionally disable the Stack CI, it's too flaky. (#1639) 2022-12-29 19:25:58 +01:00
andremarianiello
751350ba9e
WithResource combinator for Servant-managed resources (#1630) 2022-12-29 19:00:47 +01:00
Guillaume Bouchard
a4194dc490
feat: Polymorphic Elem for Union (#1637)
Close https://github.com/haskell-servant/servant/issues/1590
2022-12-23 09:42:52 +01:00
nbacquey
6392dce4bf
Document CaptureHint in Capture[All]Router (#1634)
Co-authored-by: Nicolas BACQUEY <nicolas.bacquey@tweag.io>
2022-12-08 09:20:53 +01:00
Janus Troelsen
8f081bd9ad
Allow mtl-2.3, require jose-0.10 (#1627) 2022-11-17 16:58:52 +01:00
romes
ad25e98e19
Handle Cookies correctly for RunStreamingClient (#1606) 2022-11-03 09:46:49 +01:00
Maxim Koltsov
0fc6e395cb
Remove allow-newer for postgresql-simple (#1625)
Upstream has released updated versions.
2022-10-31 23:59:35 +03:00
Maxim Koltsov
58aa0d1c0c
Merge pull request #1621 from haskell-servant/maksbotan/version-up
Version up for servant, servant-server
2022-10-28 01:26:00 +03:00
Maxim Koltsov
18bc2cf314
Version up for servant, servant-server 2022-10-27 21:26:36 +02:00
Maxim Koltsov
d5b9cbf634
Merge pull request #1592 from TeofilC/ghc-9.4
Support GHC-9.4
2022-10-27 22:14:26 +03:00
Teo Camarasu
ff135e868b Add flags to cabal.project to allow building with GHC-9.4 2022-10-27 13:05:51 +01:00
Teo Camarasu
86c61c6dbd Update doctest to be compatible with newer GHC 2022-10-27 13:05:51 +01:00
Teo Camarasu
3f6886ad2d Bump depedency bounds 2022-10-27 13:05:38 +01:00
Teo Camarasu
53c132173c Bump http-api-data bounds 2022-10-27 13:05:05 +01:00
Teo Camarasu
a445fbafd6 Use CPP to avoid errors with old GHC from TypeApplications in class instance 2022-10-27 13:05:05 +01:00
Teo Camarasu
52f76ea722 Add GHC-9.4 to workflow 2022-10-27 13:05:05 +01:00
Teo Camarasu
4627683a64 Fix TypeError for GHC-9.4
In GHC-9.4 the typechecker changed requiring more annotations in positions like this. See https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.4#ambiguous-types-containing-a-typeerror and https://gitlab.haskell.org/ghc/ghc/-/issues/21149
2022-10-18 10:45:21 +01:00
l-epple
e4650de303
Allow lens 5.2 (#1607) 2022-10-02 17:21:43 +02:00
Felix Yan
2323906080
Allow hspec 2.10 (#1609)
Builds fine and all tests pass.
2022-09-07 07:31:58 +02:00
Maxim Koltsov
f0e2316895
Merge pull request #1596 from haskell-servant/maksbotan/servant-auth-ghc9.2
servant-auth-swagger: allow base-4.16
2022-07-17 21:11:45 +03:00
Maxim Koltsov
43c57332dd
servant-auth-swagger: buildable on GHC 9 2022-07-17 20:48:52 +03:00
Maxim Koltsov
1833ef0d6e
servant-auth-swagger: allow base-4.16 2022-07-17 20:01:25 +03:00
Bart Schuurmans
489cbd59f4
servant-client: Run ClientEnv's makeClientRequest in IO (#1595)
* servant-client: Run ClientEnv's makeClientRequest in IO

* Add changelog.d entry for #1595
2022-07-01 13:25:13 +02:00
Ian Shipman
1fba9dc604
Only add a ? when query string is nonempty (#1589)
* Only add a ? when query string is nonempty

* Adds changelog entry
2022-05-16 16:50:10 +02:00
Gaël Deest
8ef5021a5f
Merge pull request #1588 from LightAndLight/master
Add HasSwagger instance for NamedRoutes
2022-05-13 07:41:12 +02:00
Tom Sydney Kerckhove
036102af58
Evaluate NoContent before (not) rendering it. (#1587)
* Evaluate NoContent before rendering it, so it shows up as covered in coverage reports

* failing test as well

* test that NoContent gets rendered if it is not an exception

Co-authored-by: Tom Sydney Kerckhove <syd@cs-syd.eu>
2022-05-04 14:40:26 +02:00
Isaac Elliott
59b5fe67cd servant-swagger: clean up imports 2022-05-03 11:43:30 +10:00
Isaac Elliott
ae8e1e6003 servant-swagger: tag NamedRoutes endpoints with datatype name 2022-05-03 11:43:27 +10:00
Isaac Elliott
cb310b8294 servant-swagger: add HasSwagger instance for NamedRoutes 2022-05-03 11:43:16 +10:00
Julian Arni
5e1569e9e2
Merge pull request #1580 from haskell-servant/jkarni/servant-auth-io-keyset
Allow IO in JWTSettings' validationKeys
2022-04-23 18:17:00 -03:00
Julian K. Arni
4e8fb045e2 Review fix 2022-04-20 21:07:08 +02:00
Julian K. Arni
4cc714d654 Changelog entry 2022-04-20 21:07:08 +02:00
Julian K. Arni
3006e90126 Allow IO in JWTSettings' validationKeys 2022-04-20 21:07:08 +02:00
Gaël Deest
c48a6702b7
Merge pull request #1582 from haskell-servant/named-routes-servant-docs
Add support for NamedRoutes in servant-docs
2022-04-19 13:13:50 +02:00
Gaël Deest
9c81b4927a Add support for NamedRoutes in servant-docs 2022-04-19 12:51:31 +02:00
Gaël Deest
117a2cc5e1
Merge pull request #1583 from haskell-servant/hspec-no-color
Disable hspec colored output in servant-swagger doctests
2022-04-19 12:41:15 +02:00
Gaël Deest
78280dc267 Disable hspec colored output in servant-swagger doctests
Colored output is the default since hspec 2.9.5.

This causes CI failures due to terminal escaping characters when running
the doctests on GitHub Actions.
2022-04-19 11:16:03 +02:00
Alp
c19ed0fb92
Major bound for servant-server's dependency on servant (#1574)
Reflecting a revision made on hackage for servant-server 0.19.1
2022-03-30 02:10:54 +02:00
Shea Levy
658585a7cd
Derive MonadMask for ClientM (#1572) 2022-03-26 17:03:01 +01:00
Gaël Deest
65de6f701c
Merge pull request #1556 from nbacquey/router_layout_captures
Display capture hints in router layout
2022-03-25 10:42:33 +01:00
Nicolas BACQUEY
a19cb84a0e Update changelog 2022-03-24 16:43:27 +01:00
Nicolas BACQUEY
9d66e16706 Add spec for serverLayout 2022-03-23 14:30:45 +01:00
Nicolas BACQUEY
77b92d0d7d Display capture hints in router layout
This commit introduces a `CaptureHint` type, which is passed as an extra
argument to the `CaptureRouter` and `CaptureAllRouter` constructors for
the `Router'` type.
`CaptureHint` values are then used in `routerLayout`, to display the
name and "type" of captured values (single or list), instead of just
"<capture>" previously.

N.B.:
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.
2022-03-23 14:30:45 +01:00
Maxim Koltsov
f5a91d20e1
Merge pull request #1568 from haskell-servant/maksbotan/stackage-deps
Allow hspec-2.9, lens-aeson-1.2
2022-03-22 23:43:22 +01:00
Maxim Koltsov
dd29f25f77
Allow lens-aeson 1.2 2022-03-22 23:22:02 +01:00
Maxim Koltsov
04f59c012b
Require servant-0.18.2 in servant-swagger
This version of servant adds Fragment, which servant-swagger adds
instance for.
2022-03-22 23:10:05 +01:00
Maxim Koltsov
256cec566f
Support hspec >= 2.9 in servant-swagger tests 2022-03-22 22:54:58 +01:00
Gaël Deest
276ca2ed01
Merge pull request #1569 from haskell-servant/url-encoding
Use toEncodedUrlPiece directly when encoding captures
2022-03-22 14:19:07 +01:00
Gaël Deest
c1c631eaff Add changelog entry 2022-03-22 11:56:18 +01:00
Gaël Deest
0e051ccfdf
Merge pull request #1557 from ysangkok/janus/newer-stack
Use Stack 2.7.5, cleanup allow-newer/CI
2022-03-22 11:36:17 +01:00
Gaël Deest
658217b021 Use toEncodedUrlPiece directly when encoding captures
Current implementation of captures uses the `toUrlPiece` method from the
`ToHttpApiData` typeclass, and encodes the resulting `Text` using `toEncodedUrlPiece`
when appending to the request path.

The problem with this approach is that the instance for `Text` percent-encodes
characters that are perfectly valid in URLs, such as `*`.

This patch makes direct use of `toEncodedUrlPiece`, which lets users implement
encoding according to their needs.

Closes #1511
2022-03-21 17:29:23 +01:00
Gaël Deest
af3dde1b1d
Merge pull request #1566 from haskell-servant/fix-operator-doc
Fix haddock documentation for (//) and (/:)
2022-03-21 16:14:47 +01:00
Maxim Koltsov
ced5f1a655
Allow hspec-2.9 2022-03-21 15:44:10 +01:00
Maxim Koltsov
626e1c3a7c
Relax more deps for Stackage (#1567) 2022-03-21 17:18:08 +03:00
Gaël Deest
0c80bc8f8e Fix haddock documentation for (//) and (/:)
The examples for these two operators weren't displayed properly due to invalid Haddock markup.
2022-03-21 14:18:49 +01:00
Maxim Koltsov
d52c5d08a0
servant-server 0.19.1 2022-03-21 14:13:52 +01:00
Maxim Koltsov
89b66a3634
Merge pull request #1555 from ysangkok/janus/ghc-92
Allow GHC 9.2 for all packages
2022-03-21 13:58:48 +01:00
Gaël Deest
3370b75622
Merge pull request #1565 from haskell-servant/re-export
Re-export Servant.API.Generic in Servant.API
2022-03-21 13:57:40 +01:00
Gaël Deest
9a99ef9a0b Re-export Servant.API.Generic in Servant.API 2022-03-21 13:31:33 +01:00
Maxim Koltsov
408352320e
Remove obsolete allow-newer 2022-03-21 11:45:49 +01:00
Janus Troelsen
010e6a72af Disable curl-mock for 9.2 because of generic-arbitrary 2022-03-13 20:35:40 -06:00
Janus Troelsen
39898676a8 Enable all packages on GHC 9.2 2022-03-13 19:58:24 -06:00
Janus Troelsen
bbd82a736f Use Stack 2.7.5, cleanup 2022-03-09 12:58:50 -06:00
Janus Troelsen
17e3eb1041 Allow GHC 9.2 for compatible packages 2022-03-08 08:59:35 -06:00
Gaël Deest
de923fc887
Merge pull request #1554 from ysangkok/repl-doctest
Use cabal-install to invoke doctest
2022-03-08 09:16:19 +01:00
Janus Troelsen
222ccf107c Use cabal-install to invoke doctest 2022-03-08 01:01:37 -06:00
Giorgio Marinelli
d05da71f09
Export encoding function for a query parameter value (#1549) 2022-03-01 15:22:25 +01:00
Marco Perone
cedab6572d
fix broken links (#1548) 2022-03-01 09:34:45 +01:00
Gaël Deest
15b364ae93
Merge pull request #1541 from mjdominus/master
Update documentation
2022-02-28 09:50:17 +01:00
Gaël Deest
8fccfccae0
Merge pull request #1546 from hasufell/PR/hasufell/issue-1545/monad-fail
Add `MonadFail` instance for `Handler` wrt #1545
2022-02-28 09:47:33 +01:00
Julian Ospald
181e51db8a
Add MonadFail instance for Handler wrt #1545 2022-02-26 22:31:56 +01:00
Mark Jason Dominus (陶敏修)
0e4d02ae75 Update copyright notice from 2018 to 2022 2022-02-25 14:44:13 -05:00
Mark Jason Dominus (陶敏修)
b4c4131778 Update error message in Makefile
The file this message refers to was renamed in
commit 53b3b939e4.
2022-02-25 14:44:13 -05:00
Mark Jason Dominus (陶敏修)
6d5c3023ce Discuss ghcup in tutorial installation instructions
The instructions as written will not work on Ubuntu systems,
which provide an extremely out-of-date Haskell toolchain.

Addresses issue https://github.com/haskell-servant/servant/issues/1540

https://github.com/haskell-servant/servant/issues/1540
2022-02-25 14:44:12 -05:00
Caroline GAUDREAU
7ef9730f77
Merge pull request #1538 from akhesaCaro/reverting
Reverting NamedRoutes cookbook
2022-02-18 12:37:05 +01:00
akhesaCaro
6da8488f9b Revert "removing Generic cookbook in favour of NamedRoutes"
This reverts commit 34aed1d289.
2022-02-18 12:14:28 +01:00
akhesaCaro
f4cd56446b Revert "introducing NamedRoutes cookbook"
This reverts commit 5c80214351.
2022-02-18 12:13:09 +01:00
Caroline GAUDREAU
50355d0125
Merge pull request #1534 from akhesaCaro/cookbook_namedRoutes
Cookbook named routes
2022-02-18 11:41:19 +01:00
akhesaCaro
34aed1d289 removing Generic cookbook in favour of NamedRoutes 2022-02-18 11:08:43 +01:00
akhesaCaro
5c80214351 introducing NamedRoutes cookbook 2022-02-18 11:08:36 +01:00
Gaël Deest
009dc06e76
Merge pull request #1535 from ysangkok/remove-unnecessary-constraints-and-allow-newer
Remove unnecessary constraint/allow-newer
2022-02-16 22:51:59 +01:00
Janus Troelsen
e2a9165229 Remove unnecessary constraint/allow-newer 2022-02-15 09:54:17 -06:00
Gaël Deest
d35b3e9b70
Merge pull request #1529 from purefunsolutions/fix-servant-client-ghcjs-for-servant-0.19
Fix servant-client-ghcjs for servant 0.19
2022-02-14 16:39:00 +01:00
Gaël Deest
002fa2107a
Merge pull request #1531 from gdeest/servant-auth-named-routes
servant-auth-server: Support NamedRoutes
2022-02-14 14:57:19 +01:00
Gaël Deest
bd9151b9de servant-auth-server: Support NamedRoutes
Trying to use `NamedRoutes` with `servant-auth-server` currently results
in hideous error messages such as:

```
app/Main.hs:50:7: error:
    • No instance for (Servant.Auth.Server.Internal.AddSetCookie.AddSetCookies
                         ('Servant.Auth.Server.Internal.AddSetCookie.S
                            ('Servant.Auth.Server.Internal.AddSetCookie.S
                               'Servant.Auth.Server.Internal.AddSetCookie.Z))
                         (AdminRoutes (Servant.Server.Internal.AsServerT Handler))
                         (ServerT
                            (Servant.Auth.Server.Internal.AddSetCookie.AddSetCookieApi
                               (Servant.Auth.Server.Internal.AddSetCookie.AddSetCookieApi
                                  (NamedRoutes AdminRoutes)))
                            Handler))
        arising from a use of 'serveWithContext'
    • In the expression: serveWithContext (Proxy @API) ctx RootAPI {..}
```

This is because we didn't teach it how to recurse along `NamedRoutes`
trees and sprinkle headers at the tip of each branch.

This commit adds a test case and fixes the issue. In the process, it
also implements `ThrowAll` for `NamedRoutes`, which was necessary for
the test to run, and should also prove convenient for users.
2022-02-14 14:28:46 +01:00
Mika Tammi
17b55634b3
servant-client-ghcjs: Fix performRequest function
Fix performRequest function to be compatible with the latest
servant-client-core RunClient typeclass
2022-02-11 20:55:34 +02:00
Mika Tammi
3158809631
servant-client-ghcjs: Bump base max-bound 2022-02-11 20:22:57 +02:00
Gaël Deest
cdd7c34add
Merge pull request #1526 from ysangkok/master
Allow newer hashable, lens, text
2022-02-07 10:00:58 +01:00
Gaël Deest
67322d8ab8
Merge pull request #1525 from k0001/fix-9.2.1
servant-server: Fix build on GHC 9.2.1
2022-02-07 09:57:23 +01:00
Janus Troelsen
67da8514a0 Allow newer hashable, lens, text 2022-02-06 16:12:25 -06:00
Renzo Carbonara
61d0d14b5c servant-server: Fix build on GHC 9.2.1
The issue is similar to the one in #1513:

```
src/Servant/Server/Internal.hs:824:10: error:
    • Uninferrable type variable k0 in
      type family equation right-hand side: (TypeError ...)
    • In the type instance declaration for ‘ServerT’
      In the instance declaration for
        ‘HasServer ((arr :: a -> b) :> sub) context’
    |
824 |     type ServerT (arr :> sub) _ = TypeError (PartialApplication HasServer arr)
    |
```

This fix is similar to the one in #1514.
2022-02-04 14:34:12 +02:00
Sven Tennie
a8f1a7603f
Update docs: #haskell-servant is now on libera.chat (#1503) 2022-02-03 12:40:00 +01:00
Gaël Deest
78034cd2b3
Merge pull request #1522 from peterbecich/github-actions-updates
minor updates to GitHub Actions
2022-02-03 10:20:23 +01:00
Clément Delafargue
6f12e38698
Fix NamedRoutes example in 0.19 changelog (#1523) 2022-02-03 09:56:19 +01:00
Peter Becich
9a3fd77a3a
minor updates to GitHub Actions 2022-02-02 23:50:10 -08:00
Gaël Deest
e14f445e2a
Merge pull request #1521 from gdeest/minor-releases
servant-auth 0.4.0.0 -> 0.4.1.0, servant-auth-server 0.4.6.0 -> 0.4.7.0
2022-02-02 16:14:21 +01:00
Gaël Deest
4caa1f563b servant-auth 0.4.0.0 -> 0.4.1.0, servant-auth-server 0.4.6.0 -> 0.4.7.0 2022-02-02 15:54:31 +01:00
Gaël Deest
e1b59dbb31
Merge pull request #1519 from haskell-servant/prepare-0.19
Changelog tweaks + servant-http-streams / servant-docs bump
2022-02-01 12:42:34 +01:00
Gaël Deest
b17d018d3f Changelog tweaks + servant-http-streams / servant-docs bump 2022-02-01 12:29:31 +01:00
Gaël Deest
e98ae8adba
Merge pull request #1517 from haskell-servant/prepare-0.19
Prepare 0.19 release
2022-02-01 10:28:15 +01:00
Gaël Deest
e4945740aa Prepare 0.19 release 2022-02-01 10:17:03 +01:00
Gaël Deest
7a770b5a1e
Merge pull request #1514 from guibou/fix_ghc92_build
Fix GHC 9.2 build
2022-01-25 11:42:10 +01:00
Guillaume Bouchard
22d5790e73 Fix GHC 9.2 build
Close #1513.

GHC 9.2 needs explicit kind signature here, I don't really understand
why.

This kind signature is correct and not too restritive, because `HasLink`
is technically defined `class HasLink endpoint` which means that it is
infered as `k -> Constraint`. In the instance signature, we have
`HasLink ((arr :: a -> b) :> sub)`, so here the `k` is the same kind as
the one of `:>` which is not polykinded.
2022-01-24 17:14:44 +01:00
Gaël Deest
75db4a5327
Merge pull request #1486 from haskell-servant/type-errors
Custom errors for HasClient, HasServer
2022-01-18 17:16:37 +01:00
Gaël Deest
75cb9ac246 Add comment about slightly incorrect error message 2022-01-18 16:25:11 +01:00
Gaël Deest
aab7e0d5dd Custom errors for HasClient, HasServer 2022-01-18 16:25:05 +01:00
Gaël Deest
3493d135f0
Merge pull request #1508 from haskell-servant/fix-servant-swagger-build
Fix servant-swagger Cabal
2022-01-18 11:15:10 +01:00
Gaël Deest
e8c301afc9 Add servant-swagger to stack.yaml 2022-01-18 11:07:38 +01:00
Gaël Deest
b56d681fde Relax doctest lower bound 2022-01-18 11:07:38 +01:00
Gaël Deest
b33442423e Re-adding Cabal-the-library as a dep
Fixes #1507.
2022-01-18 11:07:17 +01:00
Sven Tennie
c388c5e82c
Add HeadNoContent to Servant.API.Verbs (#1502)
As the head method isn't allowed to contain any response body, no
general Head Verb is added. (This may easily lead to wrong usages...)

(https://httpwg.org/specs/rfc7231.html#HEAD)
2022-01-06 13:02:57 +01:00
Matthieu Coudron
73c87bc2bc
bumped cabal-version field (#1498)
* bumped cabal-version field

Cabal supports two types of licenses, native and SPDX, which can be seen here hackage.haskell.org/package/Cabal-3.6.2.0/docs/Distribution-Types-PackageDescription.html#v:licenseRaw

Several packages use BSD-3-Clause as a license, in conjonction with cabal-version: >=1.10 which cabal parses as Right (UnknownLicense "BSD-3").
If I change teh cabal-version to cabal-version: 2.2 , cabal correctly identifdies the license License (ELicense (ELicenseId BSD_3_Clause)).

* changed license from cabal to spdx format

aka BSD3 -> BSD-3-Clause: next cabal may deprecate the old format
2022-01-04 22:06:23 +01:00
Giorgio Marinelli
29d2553e74
Derive HasClient good response status from Verb status (#1469) 2021-12-09 10:09:18 +01:00
antoine-fl
cb294aa2b3
Fix Request's Show instance (#1492) 2021-12-01 19:16:59 +01:00
Théophile Choutri
a975cfc361
Add details about AddHeaders instances (#1490)
* Add details about the instances of AddHeader

Also:

* Cleanup of extensions and imports
2021-11-30 23:52:06 +01:00
Caroline GAUDREAU
9a3979926d
Merge pull request #1475 from akhesaCaro/aeson_2
support Aeson 2
2021-11-26 17:25:56 +01:00
akhesacaro
05ef0dd1d3 Allow using aeson 1 (lax with min-bounds) 2021-11-26 17:14:31 +01:00
akhesacaro
62033db535 servant-auth-swagger: bump servant-swagger and swagger2 2021-11-18 11:56:38 +01:00
akhesacaro
d9d8fa7525 servant-swagger: remove obsolete files 2021-11-18 11:56:38 +01:00
akhesacaro
42ceb3916d changing servant-swagger info 2021-11-18 11:56:38 +01:00
akhesacaro
bcb484774e servant-swagger: bump aeson and cabal (aeson > 2) 2021-11-18 11:56:38 +01:00
akhesacaro
39fb875951 moving servant-swagger into the main servant repo 2021-11-18 11:56:38 +01:00
akhesacaro
efffc70919 fixing servant-auth (aeson 2.0 bump) 2021-11-18 11:56:38 +01:00
akhesacaro
8af80d35a0 bump jose min and max-bound (aeson 2.0 bump) 2021-11-18 11:56:38 +01:00
akhesacaro
e01188aaad min bound aeson 2 2021-11-18 11:56:32 +01:00
Gaël Deest
3ed24fdd90
Merge pull request #1289 from acondolu/master
Better errors for partially applied combinators
2021-11-18 10:51:30 +01:00
Gaël Deest
0e41e37c93
Merge pull request #1485 from haskell-servant/rename-proof
Rename proof to g{Client,Server,Link}Proof
2021-11-18 10:43:35 +01:00
Gaël Deest
f2bd982eaf Rename proof to g{Client,Server,Link}Proof 2021-11-18 10:25:36 +01:00
Gaël Deest
1bb0282abc
Merge pull request #1388 from gdeest/generic-apis
Improve API for composing generic routes
2021-11-18 10:21:59 +01:00
Gaël Deest
575aa70eca Cleanup 2021-11-18 10:11:45 +01:00
Gaël Deest
d81c8d9911 Add parameter-supplying operator
Renamed `(/:)` to `(//)`, and used `(/:)` for supplying parameters to
client functions.

Should close #1442.
2021-11-18 10:11:45 +01:00
Gaël Deest
6718752b4a Add (/:) operator 2021-11-18 10:11:31 +01:00
Gaël Deest
5f8aaec146 Fix client tests 2021-11-18 10:11:31 +01:00
Gaël Deest
fca59556dd Code reorganization
Move `HasServer (NamedRoutes routes)` instance

The instance has been moved to `Servant.Server.Internal`, as the
instances for other combinators. It is necessary so that the instance
can be re-exported from `Servant.Server` without circular imports.

Otherwise, users have to import `Servant.Server.Generic` manually ;
forgetting to do so will produce confusing error messages about the
missing instance.

Move `HasClient (NamedRoutes routes)` instance

Moved so that the instance is made available when importing
`Servant.Client`, avoiding possibly confusing errors when
`Servant.Client.Generic` isn't imported.
2021-11-18 10:09:58 +01:00
Gaël Deest
b033871dfc Implement HasLink instance for NamedRoutes 2021-11-18 10:09:58 +01:00
Gaël Deest
861cd4f997 Exclude quantified constraints code for GHCJS
QuantifiedConstraints isn't available for GHC 8.4 (where our GHCJS
version is still stuck).

We may need to take a drastic decision for GHCJS at some point.
2021-11-18 10:09:58 +01:00
Gaël Deest
5ead291f8d Implementation of HasClient
Follows the same design as `HasServer` in the previous commit.

A test has been added (which incidentally acts as a test for the
HasServer instance).
2021-11-18 10:09:58 +01:00
Gaël Deest
b0b02f1948 Implement HasServer (NamedRoutes routes)
We define `ServerT (NamedRoutes api) m` as `api (AsServerT m)`, so that
the server of an record-defined API is a record of handlers.

The implementation piggy backs on the instance for “vanilla” servant
types with `(:<|>)`, using the `GServantProduct` for converting backd
and forth between the record / vanilla servers.

The main difficulty is that GHC needs to know that this operation is
legit, which can be expressed as the fact that:

```
GToServant (Rep (ServerT (NamedRoutes api))) m ~
ServerT (GToServant (Rep (api AsApi))) m
```

plus a few additional constraints.

This is easy enough for `route`, as we know that `m ~ Handler`. But in
the case of `hoistServerWithContext`, the two involved monads are
unknown ; in other words, this constraint needs to hold `forall m.`

Switching `-XQuantifiedConstraints` on is not sufficient, as our
constraints involve type families (`Rep` and `ServerT`). Our trick is to
use an intermediary typeclass, `GServer`, as a provider of evidence (in
the form of a `Dict`) that our constraints are indeed satisfied for a
particular monad.

The only instance of `GServer` is defined along with it, so it is
practically invisible to users.
2021-11-18 10:09:58 +01:00
Gaël Deest
65e3070cac Add NamedRoutes combinator
Allows users to directly embed APIs defined as records of routes into
vanilla Servant API types.

E.g.:

```haskell
data MyRoutes mode = MyRoutes
  { version :: mode :- Get '[JSON] Int
  , …
  }

type API = "prefix" :> NamedRoutes MyRoutes :<|> …
```

APIs can thus be recursively defined directly with Generic record types.
2021-11-18 10:09:58 +01:00
Gaël Deest
67a37dc3f6 Fix build error on GHC 8.6 2021-11-17 15:29:22 +01:00
Caroline GAUDREAU
04e4de5260
Merge pull request #1357 from SupercedeTech/master
servant-docs: Add support of Pretty modifier for all verbs aliases
2021-11-17 14:42:24 +01:00
Andrea Condoluci
42b7d0eb9b Type-level errors for HasLink for invalid combinators 2021-11-15 21:40:36 +01:00
Théophile Choutri
f3d25bfdb3
Merge pull request #1479 from tchoutri/update-cabal-spdx-identifiers
Change the license value to a valid SPDX identifier
2021-11-01 10:39:54 +01:00
Théophile Choutri
4e4ad495ef Change the license value to a valid SPDX identifier 2021-10-31 22:37:56 +01:00
Maxim Koltsov
043d5a0e90
Merge pull request #1476 from haskell-servant/maksbotan/fix-servant-auth-tests
Fix tests for some servant-auth pkgs on GHC 9
2021-10-31 22:04:49 +01:00
Maxim Koltsov
70f6c49524
Get rid of Unicode in err404 example (#1478)
ServerError field errBody uses ByteString, whose IsString instance kills
Unicode, thus turning example into garbage. Changed it to simple ASCII
string, since Unicode art did not exactly correspond to 404 error
anyway.

Fixes #1371
2021-10-31 14:36:57 +03:00
Théophile Choutri
70b3721537
Merge pull request #1477 from josephcsible/ghc92
Enable FlexibleContexts in Servant.API.ContentTypes
2021-10-31 12:09:04 +01:00
Joseph C. Sible
fea40bd0fc Enable FlexibleContexts in Servant.API.ContentTypes
Starting with GHC 9.2, UndecidableInstances no longer implies FlexibleContexts.
Add this extension where it's needed to make compilation succeed.
2021-10-30 23:26:21 -04:00
Maxim Koltsov
ca6774d797 Update servant-auth cookbook deps 2021-10-30 21:29:17 +02:00
Maxim Koltsov
e2e9ce0596 Enable servant-auth cookbook 2021-10-30 21:26:44 +02:00
Maxim Koltsov
53b1d9d2b6 Enable tests for servant-auth-client
Fixes #1474
2021-10-30 21:01:01 +02:00
Maxim Koltsov
551d4936af Fix tests for some servant-auth pkgs on GHC 9
Turns out the tests broke because of base64-bytestring issue specific to
GHC-9 that was fixed in 1.2.1.0.

Fixes #1474
2021-10-30 20:43:35 +02:00
Caroline GAUDREAU
bd9e4b1090
Merge pull request #1471 from akhesaCaro/monorepo_servant_auth
repatriation of servant-auth in the main servant repo
2021-10-29 15:03:24 +02:00
akhesacaro
e05826a799 servant-auth-swagger: Excluding building against GHC 9.0
(need base > 4.15 but swagger exclude it)
2021-10-27 18:32:46 +02:00
akhesacaro
95033be30f server-auth-server: Excluding tests against GHC 9 2021-10-27 18:32:46 +02:00
akhesacaro
7c012d70d3 servant-auth-client: Excluding tests against GHC 9 2021-10-27 18:32:46 +02:00
akhesacaro
48d22a35b8 servant-auth: removing CI status in README, Servant attribution now 2021-10-27 18:32:38 +02:00
akhesacaro
8e7a775cdd servant-auth: removing unused files from former repo 2021-10-27 18:31:20 +02:00
akhesacaro
05674e4870 change servant-auth repo url in cabal files 2021-10-26 22:31:40 +02:00
akhesacaro
119e54a800 repatriation of servant-auth in the main servant repo 2021-10-26 16:27:09 +02:00
Caroline GAUDREAU
26b01f03f2
Merge pull request #1432 from GambolingPangolin/fixes-1418
Addresses problem with URL encodings
2021-10-24 09:24:57 +02:00
Gaël Deest
abc53b54e3
Merge pull request #1462 from haskell-servant/upgrade-ghcjs
Upgrade GHCJS
2021-10-11 13:40:39 +02:00
Gaël Deest
b0f8c89472
Merge pull request #1465 from haskell-servant/eyeinsky-master
Fix documentation hierarchy
2021-10-11 13:27:34 +02:00
Markus Läll
f92d2c7ad6 Fix typo 2021-10-11 13:02:06 +02:00
Markus Läll
43760caf97 Fix documentation hierarchy 2021-10-11 13:02:06 +02:00
Théophile Choutri
9df5195710
Merge pull request #1463 from sorki/srk/foreignTypo
servant-foreign: fix haddock/example typo
2021-10-11 11:32:29 +02:00
Gaël Deest
b7c6a95929 Fix tested-with fields in Cabal files
Also re-added `servant-client` to `cabal.ghcjs.project`, setting
`buildable: False` on tests as they don't run with GHCJS.
2021-10-11 10:35:40 +02:00
Richard Marko
51c8edb74d servant-foreign: fix haddock/example typo 2021-10-11 10:29:06 +02:00
Gaël Deest
e9ae1eeed8 Remove the old Github action 2021-10-10 22:59:36 +02:00
Gaël Deest
910a3ae7ec Upgrade GHCJS to 8.6
This allows us to deprecate GHCJS 8.4 (which makes sense, as vanilla GHC
< 8.6 is already deprecated).

We re-use GHCJS from reflex-platform, which unfortunately isn't
up-to-date with latest GHC and is only 8.6. The benefit of using
reflex-platform is that it provides nix expressions for GHCJS + a binary
nix cache.

reflex-platform patches text to use a JS-String based internal
representation for performance reasons, so we provide a few haskell
dependencies from reflex-platform as well:

- hashable
- attoparsec

As those rely on text's internal representation but have been patched
for reflex-platform.
2021-10-10 22:53:26 +02:00
Ian Shipman
d5e439e56b Updates changelog 2021-10-03 09:57:55 -05:00
Ian Shipman
9666f1956b Addresses problems with URL encodings
This changes the way URL encoding for query parameters is handled,
making it possible to correctly encode arbitrary binary data into query
parameter values.

Closes #1418
2021-10-03 09:57:55 -05:00
Théophile Choutri
48bc24768e
Merge pull request #1458 from tchoutri/master
Use GHC 8.10.7 for CI & Cabal metadata
2021-10-03 12:00:59 +02:00
Théophile Choutri
c011f12d24 Use GHC 8.10.7 for CI and in Cabal metadata
Sponsored by: Scrive AB
2021-10-02 23:51:25 +02:00
Caroline GAUDREAU
5115c41617
Merge pull request #1457 from akhesaCaro/nixshell_ghc9
Update to GHC 9 (sub tasks)
2021-10-02 19:29:28 +02:00
akhesacaro
9be55b3ba3 uncomment db-sqlite-simple cookbook to add it to the building plan 2021-10-02 18:13:24 +02:00
akhesacaro
61d097db44 uncomment uverb coobook and include it from building against GHC >= 9 2021-10-02 18:09:51 +02:00
akhesaCaro
2ea6664124 GHC9 mention in Nix README. 2021-10-02 17:48:45 +02:00
Caroline GAUDREAU
0b706aa6d1
Merge pull request #1452 from akhesaCaro/unsupport_old_ghc
Unsupport GHC < 8.6.5
2021-10-02 13:41:42 +02:00
akhesacaro
a4aacc9475 A new version of hashable isn't compitable with our ghcjs. A max bound version is needed in the Cabal file 2021-10-02 13:32:15 +02:00
akhesacaro
e5f1604a9d removing Makefile deprecated with its GHC version 2021-10-02 13:13:33 +02:00
akhesacaro
e56f0092d7 remove tested-with (GHC < 8.6.5) from cabal 2021-10-02 13:13:33 +02:00
akhesaCaro
6e5dffbb91 unsupporting GHC < 8.6.5, removing unecessary imports 2021-10-02 13:13:24 +02:00
akhesaCaro
1fa1878180 unsupporting GHC < 8.6.5 in the CI 2021-10-02 13:10:20 +02:00
akhesacaro
af7d281ef0 add missing dependencies into shell.nix 2021-10-02 13:10:20 +02:00
akhesaCaro
b1a9876dc9 unsupporting GHC < 8.6.5 in the nix-shell 2021-10-02 13:08:54 +02:00
Caroline GAUDREAU
8da966f057
Merge pull request #1455 from bChiquet/Document-Raw's-behaviour
Document Raw's behaviour when composing APIs
2021-10-01 17:32:01 +02:00
bChiquet
8b93af3d12 factor in @alp's feedbacks on PR #1455 2021-10-01 16:33:16 +02:00
bChiquet
29aa10176d Document Raw's behaviour when composing APIs 2021-10-01 16:33:16 +02:00
Caroline GAUDREAU
bf160cc1ad
Merge pull request #1456 from akhesaCaro/http_common_constraint
Fix CI by adding a constraint to http-common to make it build against ghc 8.2.2
2021-10-01 15:56:53 +02:00
akhesaCaro
993277e8f4 add a coinstraint to http-common to make it build against ghc 8.2.2 2021-10-01 15:15:59 +02:00
Felix Yan
3af3129f75
Allow transformers-compat 0.7 (#1436)
Builds fine and all tests pass.
2021-08-29 15:06:09 -05:00
Brandon Chinn
799537f82d
Add serveWithContextT, ServerContext (#1441)
servant-server: add serveWithContexT and ServerContext
2021-08-21 19:15:02 +02:00
Dan Fithian
47bd25266f
Servant docs curl (#1401)
servant-dosc: generate sample curl request
2021-08-19 13:11:00 +02:00
Paolo Capriotti
19ec395e66
Avoid using SOP constructors directly (#1434)
This is a followup to #1420. It uses `respond` and `matchUnion`, with
the help of some type annotations, instead of the NS constructors from
SOP.
2021-07-13 10:10:30 -05:00
Maxim Koltsov
21682f6b72
servant-foreign 0.15.4 2021-06-23 23:47:01 +02:00
Maxim Koltsov
e2b897d3c0
Prepare 0.18.3 release (#1430) 2021-06-24 00:38:46 +03:00
Maxim Koltsov
3e29b5194e
Merge pull request #1409 from haskell-servant/maksbotan/ghc-9
Update for GHC 9.0.1
2021-06-24 00:12:26 +03:00
Maxim Koltsov
f527f09ac3
continue-on-error for doctest on GHC 9 2021-06-23 23:06:15 +02:00
Maxim Koltsov
2eba8866b7
Fix doctest running in CI 2021-06-23 23:06:15 +02:00
Maxim Koltsov
6cf2da8b64
Update GHC 8.10 to 8.10.4 in GitHub actions 2021-06-23 23:06:15 +02:00
Maxim Koltsov
4c05338876
doctest 0.18 2021-06-23 23:06:15 +02:00
Maxim Koltsov
61111178f0
Support GHC-9.0.1 2021-06-23 23:06:07 +02:00
Felix Yan
cc67b9ec6e
Allow attoparsec 0.14 (#1408)
Builds fine and all tests pass.
2021-06-21 22:54:50 -05:00
Alp
0c961f6ebb
Fix #1405 (#1429)
Request bodies are not really supposed to be used in GET requests.
2021-06-21 22:54:29 -05:00
Alp
ba30dd1700
Merge pull request #1424 from haskell-servant/update-irc-link
Update IRC link in readme to point at libera
2021-06-16 11:44:52 +02:00
Paolo Capriotti
0f9cc7eeec
Add response header support to UVerb (#1420)
* Use type wrapped in Headers h to generate response

This avoids having to define MimeRender instances for Headers.
2021-06-10 17:10:50 +02:00
Samuel Gélineau
0cb2d603c4
use Capture Description if available (#1423)
* use Capture Description if available

* update golden/comprehensive.md

This is technically a breaking change, because if a Capture has both a
Description and a ToCapture instance, the Description now takes
precedence. Since this Description wasn't doing anything before, I am
guessing that most projects currently only use Description to describe
their endpoints and not their Captures, and thus that few people will be
affected by this breaking change.

* test the "no ToCapture instance" case

The case in which there is both a Description and a ToCapture instance
seems like a corner case. The more interesting cases are the one in
which there is a Description but no ToCapture instance, and the case in
which there is a ToCapture instance but no description.
2021-06-08 13:28:19 -05:00
Maxim Koltsov
da8e64b534
Allow lens-5.0 (#1426) 2021-06-06 00:37:35 +03:00
Nathan van Doorn
26f0f93874
Update IRC link in readme to point at libera 2021-05-26 09:05:50 +01:00
Maxim Koltsov
4016aafe66
CI: add ppa:hvr/ghc in ghcjs build (#1421) 2021-05-14 16:34:16 +03:00
Maxim Koltsov
507f0a4671
Allow hspec < 2.9
https://github.com/commercialhaskell/stackage/issues/6010
2021-05-14 12:34:04 +03:00
Gaël Deest
4a79cea3ff
Merge pull request #1415 from felixonmars/patch-1
Allow singleton-bool 0.1.6
2021-04-29 15:29:02 +02:00
fisx
448c444db6
Typo (#1416) 2021-04-23 10:37:48 +02:00
Felix Yan
3c520683ce
Allow singleton-bool 0.1.6
Builds fine and all tests pass.
2021-04-21 06:16:17 +08:00
Caroline GAUDREAU
ad76c47c2f
Merge pull request #1413 from akhesaCaro/cookbook_hoist_server_with_context
enabling hoist-server-with-context cookbook
2021-04-16 13:49:57 +02:00
akhesaCaro
97967d87d1 enabling hoist-server-with-context cookbook 2021-04-16 13:39:09 +02:00
Gaël Deest
4fe6997659
Merge pull request #1412 from akhesaCaro/cookbook_https
enabling https cookbook
2021-04-10 15:47:38 +02:00
akhesaCaro
bbd016df09 enabling https cookbook 2021-04-10 15:23:57 +02:00
Caroline GAUDREAU
486f89da04
Merge pull request #1410 from akhesaCaro/improve_nix_shell
pinning nixpkgs and adding missing dependencies to shell.nix file
2021-04-10 11:59:17 +02:00
akhesaCaro
4a7a1080a0 pinning nixpkgs and adding missing dependencies 2021-04-10 11:30:37 +02:00
Caroline GAUDREAU
bc6144716b
Merge pull request #1407 from akhesaCaro/using_derivingvia_uverb
Using DerivingVia in UVerb's cookbook
2021-04-09 16:43:12 +02:00
Gaël Deest
f30b72cc90 Add DeriveAnyClass to UVerb.lhs (not implied by DerivingVia on 8.6.5) 2021-04-09 16:19:51 +02:00
Gaël Deest
81a73dfcda Try excluding uverb cookbook from pre 8.6.1 builds 2021-04-09 15:59:02 +02:00
Caroline GAUDREAU
d06b65c4e6
Merge pull request #1390 from Profpatsch/document-servant-foreign
Document servant-foreign
2021-03-25 12:21:20 +01:00
Philip Patsch
e4865644c1 doc(servant-foreign): Document module
I spend some considerable time reverse engineering the module, so I
thought I’d write the documentation I would have liked to see.

The strategy here is that a user not necessarily has insight into how
servant works internally, or even how to write complex servant routes,
they just want to generate a list of endpoints and convert the `Req`
type into e.g. generated code in $language. Thus, they need to know
the semantics of all fields of Req, how they interact and how they
relate to a plain http route.

I made sure every `f` is replaced with `ftype`, so we have one
conventional way of referring to the foreign type argument everywhere.

Some enums are not set at all, they are marked as such.

`_reqBodyContentType` introduces a major restriction of the module, so
that is mentioned in the documentation for now, until the time it will
be fixed.

A few TODO’s describe places where types don’t make sense but would
introduce API-breaking changes, so these should probably be
simplified,
but bundled in one go.
2021-03-25 11:26:53 +01:00
Philip Patsch
07f7954cc6 chore(servant-foreign): remove dead type Frag
It is not used anywhere and also not exported.
2021-03-25 11:26:53 +01:00
Philip Patsch
a0265097e8 doc(servant-foreign): reorder imports
The imports were ordered in the worst possible way, with all
undocumented small type definitions coming first and the actual meat
of the module coming at the very end, mixed in with irrelevant
functions.

This inverses that toxic ordering, showing the main function
first (`listFromAPI`) and then the main data type (`Req`) and the main
class (`HasForeignType`).
2021-03-25 11:26:53 +01:00
Philip Patsch
c3a517cb4f doc(servant-foreign): Inflection docs & module docs 2021-03-25 11:26:53 +01:00
akhesaCaro
d4f7b0397d adding a compatibility warning in the cookbook 2021-03-23 14:10:14 +01:00
akhesaCaro
ba379287c8 reverting : removing DerivingVia extension (not compatible ghc < 8.6.1) 2021-03-23 14:09:49 +01:00
Gaël Deest
0743ca724d
Merge pull request #1403 from haskell-servant/ci-fix-followups
Try and improve caching on CI
2021-03-18 12:17:58 +01:00
Gaël Deest
53e943b5bb
Merge pull request #1397 from akhesaCaro/compiling_sqlite_simple_cookbook
Fixing Servant cookbooks part 1 (-testing + sqlite-simple)
2021-03-18 11:09:21 +01:00
akhesaCaro
269e546a6a sqlite-simple cookbook is working with sqlite-simple >= 0.4.5.0 2021-03-18 10:50:17 +01:00
akhesaCaro
dd1ab6dd36 fixing DocSpec tests to make them compile 2021-03-18 07:43:09 +01:00
Никита Размахнин
0ea692bb64 Add support of Pretty modifier for all verbs aliases
Minor import warning fix
2020-11-11 10:22:55 +03:00
224 changed files with 8445 additions and 833 deletions

14
.github/run-ghcjs-tests.sh vendored Executable file
View file

@ -0,0 +1,14 @@
#!/usr/bin/env bash
#
# cabal v2-test does not work with GHCJS
# See: https://github.com/haskell/cabal/issues/6175
#
# This invokes cabal-plan to figure out test binaries, and invokes them with node.
cabal-plan list-bins '*:test:*' | while read -r line
do
testpkg=$(echo "$line" | perl -pe 's/:.*//')
testexe=$(echo "$line" | awk '{ print $2 }')
echo "testing $textexe in package $textpkg"
(cd "$testpkg" && node "$testexe".jsexe/all.js)
done

View file

@ -13,14 +13,14 @@ jobs:
strategy:
matrix:
os: [ubuntu-latest]
cabal: ["3.2"]
cabal: ["3.6"]
ghc:
- "8.0.2"
- "8.2.2"
- "8.4.4"
- "8.6.5"
- "8.8.4"
- "8.10.2"
- "8.10.7"
- "9.0.2"
- "9.2.2"
- "9.4.2"
steps:
- uses: actions/checkout@v2
@ -49,7 +49,7 @@ jobs:
- name: Configure
run: |
cabal install --ignore-project -j2 doctest --constraint='doctest ^>=0.17'
cabal install --ignore-project -j2 doctest --constraint='doctest ^>=0.20'
- name: Build
run: |
@ -64,86 +64,70 @@ jobs:
# Necessary for doctest to be found in $PATH
export PATH="$HOME/.cabal/bin:$PATH"
# Filter out base-compat-batteries from .ghc.environment.*, as its modules
# conflict with those of base-compat.
#
# FIXME: This is an ugly hack. Ultimately, we'll want to use cabal-doctest
# (or cabal v2-doctest, if it ever lands) to provide a clean GHC environment.
# This might allow running doctests in GHCJS build as well.
perl -i -e 'while (<ARGV>) { print unless /package-id\s+(base-compat-batteries)-\d+(\.\d+)*/; }' .ghc.environment.*
DOCTEST="cabal repl --with-ghc=doctest --ghc-options=-w"
(cd servant && eval $DOCTEST)
(cd servant-client && eval $DOCTEST)
(cd servant-client-core && eval $DOCTEST)
(cd servant-http-streams && eval $DOCTEST)
(cd servant-docs && eval $DOCTEST)
(cd servant-foreign && eval $DOCTEST)
(cd servant-server && eval $DOCTEST)
(cd servant-machines && eval $DOCTEST)
(cd servant-conduit && eval $DOCTEST)
(cd servant-pipes && eval $DOCTEST)
(cd servant && doctest src)
(cd servant-client && doctest src)
(cd servant-client-core && doctest src)
(cd servant-http-streams && doctest src)
(cd servant-docs && doctest src)
(cd servant-foreign && doctest src)
(cd servant-server && doctest src)
(cd servant-machines && doctest src)
(cd servant-conduit && doctest src)
(cd servant-pipes && doctest src)
# stack:
# name: stack / ghc ${{ matrix.ghc }}
# runs-on: ubuntu-latest
# strategy:
# matrix:
# stack: ["2.7.5"]
# ghc: ["8.10.7"]
stack:
name: stack / ghc ${{ matrix.ghc }}
runs-on: ubuntu-latest
strategy:
matrix:
stack: ["2.3.1"]
ghc: ["8.8.4"]
# steps:
# - uses: actions/checkout@v2
steps:
- uses: actions/checkout@v2
# - uses: haskell/actions/setup@v1
# name: Setup Haskell Stack
# with:
# ghc-version: ${{ matrix.ghc }}
# stack-version: ${{ matrix.stack }}
- uses: haskell/actions/setup@v1
name: Setup Haskell Stack
with:
ghc-version: ${{ matrix.ghc }}
stack-version: ${{ matrix.stack }}
# - uses: actions/cache@v2.1.3
# name: Cache ~/.stack
# with:
# path: ~/.stack
# key: ${{ runner.os }}-${{ matrix.ghc }}-stack
- uses: actions/cache@v2.1.3
name: Cache ~/.stack
with:
path: ~/.stack
key: ${{ runner.os }}-${{ matrix.ghc }}-stack
# - name: Install dependencies
# run: |
# stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --only-dependencies
- name: Install dependencies
run: |
stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --only-dependencies
# - name: Build
# run: |
# stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks
- name: Build
run: |
stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks
- name: Test
run: |
stack test --system-ghc
# - name: Test
# run: |
# stack test --system-ghc
ghcjs:
name: ubuntu-18.04 / ghcjs 8.4
runs-on: "ubuntu-18.04"
name: ubuntu-latest / ghcjs 8.6
runs-on: "ubuntu-latest"
steps:
- uses: actions/checkout@v2
- name: "Setup PATH"
- uses: cachix/install-nix-action@v13
with:
extra_nix_config: |
trusted-public-keys = ryantrinkle.com-1:JJiAKaRv9mWgpVAz8dwewnZe0AzzEAzPkagE9SP5NWI=1aba6f367982bd6dd78ec2fda75ab246a62d32c5 cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=
substituters = https://nixcache.reflex-frp.org https://cache.nixos.org/
- name: Setup
run: |
echo "PATH=$HOME/.cabal/bin:/opt/ghcjs/8.4/bin:$PATH" >> $GITHUB_ENV
- name: Install ghcjs and cabal
run: |
sudo add-apt-repository ppa:hvr/ghcjs
sudo apt-get update -y
sudo apt-get install ghcjs-8.4
sudo apt-get install cabal-install
# Override cabal.project with the lightweight GHCJS one
cp cabal.ghcjs.project cabal.project
cat cabal.project
- name: Cabal update and freeze
run: |
cabal v2-update
cabal v2-freeze
nix-shell ghcjs.nix --run "cabal v2-update && cabal v2-freeze"
- uses: actions/cache@v2.1.3
name: Cache ~/.cabal/store and dist-newstyle
@ -151,23 +135,14 @@ jobs:
path: |
~/.cabal/store
dist-newstyle
key: ubuntu-18.04-ghcjs8.4-${{ hashFiles('cabal.project.freeze') }}
key: ${{ runner.os }}-ghcjs8.6-${{ hashFiles('cabal.project.freeze') }}
restore-keys: |
ubuntu-18.04-ghcjs8.4-
- name: Install cabal-plan and hspec-discover
run: |
cabal v2-install -w /opt/ghc/8.4.4/bin/ghc --ignore-project cabal-plan --constraint='cabal-plan ^>=0.6.0.0' --constraint='cabal-plan +exe'
cabal v2-install -w /opt/ghc/8.4.4/bin/ghc --ignore-project hspec-discover
${{ runner.os }}-ghcjs8.6-
- name: Build
run: |
cabal v2-build --ghcjs -w /opt/ghcjs/8.4/bin/ghcjs --enable-tests --enable-benchmarks all
nix-shell ghcjs.nix --run "cabal v2-build --ghcjs --enable-tests --enable-benchmarks all"
- name: Run tests
- name: Tests
run: |
# cabal v2-test does not work with GHCJS
# See: https://github.com/haskell/cabal/issues/6175
#
# This invokes cabal-plan to figure out test binaries, and invokes them with node.
cabal-plan list-bins '*:test:*' | while read -r line; do testpkg=$(echo "$line" | perl -pe 's/:.*//'); testexe=$(echo "$line" | awk '{ print $2 }'); echo "testing $textexe in package $textpkg"; (cd "$(pkgdir $testpkg)" && nodejs "$testexe".jsexe/all.js); done
nix-shell ghcjs.nix --run ".github/run-ghcjs-tests.sh"

2
.gitignore vendored
View file

@ -30,6 +30,8 @@ doc/_build
doc/venv
doc/tutorial/static/api.js
doc/tutorial/static/jq.js
shell.nix
.hspec-failures
# nix
result*

View file

@ -79,8 +79,10 @@ not been a timely response to a PR, you can ping the Maintainers group (with
We encourage people to experiment with new combinators and instances - it is
one of the most powerful ways of using `servant`, and a wonderful way of
getting to know it better. If you do write a new combinator, we would love to
know about it! Either hop on #servant on freenode and let us know, or open an
issue with the `news` tag (which we will close when we read it).
know about it! Either hop on
[#haskell-servant on libera.chat](https://web.libera.chat/#haskell-servant) and
let us know, or open an issue with the `news` tag (which we will close when we
read it).
As for adding them to the main repo: maintaining combinators can be expensive,
since official combinators must have instances for all classes (and new classes

View file

@ -1,32 +0,0 @@
# With common maintenance tasks
HC ?= ghc-8.4.4
all :
@echo "Don't try to make all at once!"
really-all :
$(MAKE) build-ghc
$(MAKE) build-ghc HC=ghc-8.0.2
$(MAKE) build-ghc HC=ghc-8.2.2
$(MAKE) build-ghc HC=ghc-8.6.5
$(MAKE) build-ghcjs
build-ghc :
cabal v2-build -w $(HC) all
build-ghcjs :
cabal v2-build --builddir=dist-newstyle-ghcjs --project-file=cabal.ghcjs.project all
packdeps :
packdeps */*.cabal
doctest : doctest-servant doctest-servant-server
perl -i -e 'while (<ARGV>) { print unless /package-id\s+base-compat-\d+(\.\d+)*/; }' .ghc.environment.*
doctest-servant :
(cd servant && doctest src)
(cd servant && doctest test/Servant/LinksSpec.hs)
doctest-servant-server :
(cd servant-server && doctest src)

View file

@ -13,7 +13,7 @@ The core documentation can be found [here](http://docs.servant.dev/).
Other blog posts, videos and slides can be found on the
[website](http://www.servant.dev/).
If you need help, drop by the IRC channel (#servant on freenode) or [mailing
If you need help, drop by the IRC channel (#haskell-servant on libera.chat) or [mailing
list](https://groups.google.com/forum/#!forum/haskell-servant).
## Contributing
@ -63,3 +63,9 @@ To compare with `reitit` (Clojure framework)
```
You can see the visualised results at https://www.techempower.com/benchmarks/#section=test
## Nix
A developer shell.nix file is provided in the `nix` directory
See [nix/README.md](nix/README.md)

View file

@ -2,8 +2,13 @@
packages:
servant/
servant-client/
servant-client-core/
-- we need to tell cabal we are using GHCJS
compiler: ghcjs
tests: True
-- Constraints so that reflex-platform provided packages are selected.
constraints: attoparsec == 0.13.2.2
constraints: hashable == 1.3.0.0

View file

@ -1,12 +1,18 @@
packages:
servant/
servant-auth/servant-auth
servant-auth/servant-auth-client
servant-auth/servant-auth-docs
servant-auth/servant-auth-server
servant-auth/servant-auth-swagger
servant-client/
servant-client-core/
servant-http-streams/
-- Tests failing with Cabal (TODO: investigate)
-- servant-docs/
servant-docs/
servant-foreign/
servant-server/
servant-swagger/
doc/tutorial/
-- servant streaming
@ -26,12 +32,12 @@ packages:
doc/cookbook/custom-errors
doc/cookbook/basic-streaming
doc/cookbook/db-postgres-pool
-- doc/cookbook/db-sqlite-simple
doc/cookbook/db-sqlite-simple
doc/cookbook/file-upload
doc/cookbook/generic
-- doc/cookbook/hoist-server-with-context
-- doc/cookbook/https
-- doc/cookbook/jwt-and-basic-auth/
doc/cookbook/hoist-server-with-context
doc/cookbook/https
doc/cookbook/jwt-and-basic-auth
doc/cookbook/pagination
-- doc/cookbook/sentry
-- Commented out because servant-quickcheck currently doesn't build.
@ -41,34 +47,8 @@ packages:
doc/cookbook/using-custom-monad
doc/cookbook/using-free-client
-- doc/cookbook/open-id-connect
doc/cookbook/managed-resource
tests: True
optimization: False
-- reorder-goals: True
constraints:
-- see https://github.com/haskell-infra/hackage-trustees/issues/119
foundation >=0.0.14,
memory <0.14.12 || >0.14.12
constraints: base-compat ^>=0.11
constraints: semigroups ^>=0.19
-- MonadFail
-- https://github.com/nurpax/sqlite-simple/issues/74
constraints: sqlite-simple < 0
-- allow-newer: sqlite-simple-0.4.16.0:semigroups
-- allow-newer: direct-sqlite-2.3.24:semigroups
-- needed for doctests
write-ghc-environment-files: always
-- https://github.com/chordify/haskell-servant-pagination/pull/12
allow-newer: servant-pagination-2.2.2:servant
allow-newer: servant-pagination-2.2.2:servant-server
-- https://github.com/haskell-servant/servant-multipart/pull/41
allow-newer: servant-multipart:servant
allow-newer: servant-multipart:servant-server
allow-newer: servant-multipart:servant-client-core
allow-newer: servant-js:servant

9
changelog.d/1432 Normal file
View file

@ -0,0 +1,9 @@
synopsis: Fixes encoding of URL parameters in servant-client
prs: #1432
issues: #1418
description: {
Some applications use query parameters to pass arbitrary (non-unicode) binary
data. This change modifies how servant-client handles query parameters, so
that application developers can use `ToHttpApiData` to marshal binary data into
query parameters.
}

11
changelog.d/1469 Normal file
View file

@ -0,0 +1,11 @@
synopsis: Derive HasClient good response status from Verb status
prs: #1469
description: {
`HasClient` instances for the `Verb` datatype use `runRequest` in
`clientWithRoute` definitions.
This means that a request performed with `runClientM` will be successful if and
only if the endpoint specify a response status code >=200 and <300.
This change replaces `runRequest` with `runRequestAcceptStatus` in `Verb`
instances for the `HasClient` class, deriving the good response status from
the `Verb` status.
}

9
changelog.d/1477 Normal file
View file

@ -0,0 +1,9 @@
synopsis: Enable FlexibleContexts in Servant.API.ContentTypes
prs: #1477
description: {
Starting with GHC 9.2, UndecidableInstances no longer implies FlexibleContexts.
Add this extension where it's needed to make compilation succeed.
}

10
changelog.d/1529 Normal file
View file

@ -0,0 +1,10 @@
synopsis: Fix performRequest in servant-client-ghcjs
prs: #1529
description: {
performRequest function in servant-client-ghcjs was not compatible with the
latest RunClient typeclass. Added the acceptStatus parameter and fixed the
functionality to match what servant-client provides.
}

81
changelog.d/1556 Normal file
View file

@ -0,0 +1,81 @@
synopsis: Display capture hints in router layout
prs: #1556
description: {
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.
Example:
For the following API
```haskell
type API =
"a" :> "d" :> Get '[JSON] NoContent
:<|> "b" :> Capture "x" Int :> Get '[JSON] Bool
:<|> "a" :> "e" :> Get '[JSON] Int
```
we previously got the following output:
```
/
├─ a/
│ ├─ d/
│ │ └─•
│ └─ e/
│ └─•
└─ b/
└─ <capture>/
├─•
└─•
```
now we get:
```
/
├─ a/
│ ├─ d/
│ │ └─•
│ └─ e/
│ └─•
└─ b/
└─ <x::Int>/
├─•
└─•
```
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.
CaptureHint values are then used in routerLayout, to display the name and type of captured values, instead of just `<capture>` previously.
N.B.:
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.
This PR also introduces Spec tests for the routerLayout function.
Warning:
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`.
In those cases, the fix is easy: it suffices to add `Typeable a` to the left-hand side of the quantification constraint.
For instance, the following code will no longer compile:
```haskell
type MyAPI a = Capture "foo" a :> Get '[JSON] ()
myServer :: forall a. Server (MyAPI a)
myServer = const $ return ()
myApi :: forall a. Proxy (MyAPI a)
myApi = Proxy
app :: forall a. (FromHttpApiData a) => Application
app = serve (myApi @a) (myServer @a)
```
Indeed, `app` should be replaced with:
```haskell
app :: forall a. (FromHttpApiData a, Typeable a) => Application
app = serve (myApi @a) (myServer @a)
```
}

13
changelog.d/1569 Normal file
View file

@ -0,0 +1,13 @@
synopsis: Encode captures using toEncodedUrlPiece
prs: #1569
issues: #1511
description: {
The `servant-client` library now makes direct use of `toEncodedUrlPiece` from `ToHttpApiData`
to encode captured values when building the request path. It gives user freedom to implement
URL-encoding however they need.
Previous behavior was to use `toUrlPiece` and URL-encode its output using `toEncodedUrlPiece`
from the `Text` instance of `ToHttpApiData`. The issue with this approach is that
`ToHttpApiData Text` is overly zealous and also encodes characters, such as `*`, which are perfectly valid in a URL.
}

2
changelog.d/1573 Normal file
View file

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

12
changelog.d/1580 Normal file
View file

@ -0,0 +1,12 @@
synopsis: Allow IO in validationKeys
prs: #1580
issues: #1579
description: {
Currently validationKeys are a fixed JWKSet. This does not work with OIDC
providers such as AWS Cognito or Okta, which regularly fetching jwks_uri to
discover new and expired keys.
This change alters the type of validationKeys from JWKSet to IO JWKSet.
}

2
changelog.d/1589 Normal file
View file

@ -0,0 +1,2 @@
synopsis: Only include question mark for nonempty query strings
prs: 1589

2
changelog.d/1595 Normal file
View file

@ -0,0 +1,2 @@
synopsis: Run ClientEnv's makeClientRequest in IO.
prs: #1595

10
changelog.d/1606 Normal file
View file

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

2
changelog.d/1638 Normal file
View file

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

8
changelog.d/1649 Normal file
View file

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

View file

@ -0,0 +1,16 @@
synopsis: Add sample cURL requests to generated documentation
prs: #1401
description: {
Add sample cURL requests to generated documentation.
Those supplying changes to the Request `header` field manually using
lenses will need to add a sample bytestring value.
`headers <>~ ["unicorn"]`
becomes
`headers <>~ [("unicorn", "sample value")]`
}

View file

@ -10,7 +10,7 @@ BUILDDIR = _build
# Put it first so that "make" without argument is like "make help".
help:
@if [ ! -d venv ]; then echo "WARNING: There is no venv directory, did you forget to 'virtualenv venv'. Check building-the-docs file."; fi
@if [ ! -d venv ]; then echo "WARNING: There is no venv directory, did you forget to 'virtualenv venv'. Check README.md."; fi
@if [ ! "z$$(which $(SPHINXBUILD))" = "z$$(pwd)/venv/bin/sphinx-build" ]; then echo "WARNING: Did you forgot to 'source venv/bin/activate'"; fi
@$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)

View file

@ -46,7 +46,7 @@ master_doc = 'index'
# General information about the project.
project = u'Servant'
copyright = u'2018, Servant Contributors'
copyright = u'2022, Servant Contributors'
author = u'Servant Contributors'
# The version info for the project you're documenting, acts as replacement for
@ -169,4 +169,3 @@ texinfo_documents = [
source_parsers = {
'.lhs': CommonMarkParser,
}

View file

@ -1,14 +1,14 @@
cabal-version: 2.2
name: cookbook-basic-auth
version: 0.1
synopsis: Basic Authentication cookbook example
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-basic-auth
main-is: BasicAuth.lhs

View file

@ -1,14 +1,14 @@
cabal-version: 2.2
name: cookbook-basic-streaming
version: 2.1
synopsis: Streaming in servant without streaming libs
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-basic-streaming
main-is: Streaming.lhs

View file

@ -24,7 +24,6 @@ Language extensions and imports:
import Control.Lens ((^.))
import Data.Aeson
import Data.Aeson.Text
import Data.Monoid ((<>))
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)

View file

@ -1,16 +1,19 @@
cabal-version: 2.2
name: cookbook-curl-mock
version: 0.1
synopsis: Generate curl mock requests cookbook example
homepage: http://docs.servant.dev
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbock-curl-mock
if impl(ghc >= 9.2)
-- generic-arbitrary is incompatible
buildable: False
main-is: CurlMock.lhs
build-depends: base == 4.*
, aeson

View file

@ -20,7 +20,6 @@ Extensions and imports:
import Data.Aeson
import Data.Proxy
import Data.Text
import Data.Semigroup
import GHC.Generics
import Network.Wai
import Network.Wai.Handler.Warp

View file

@ -1,14 +1,14 @@
cabal-version: 2.2
name: cookbook-custom-errors
version: 0.1
synopsis: Return custom error messages from combinators
homepage: http://docs.servant.dev
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-custom-errors
main-is: CustomErrors.lhs

View file

@ -1,13 +1,13 @@
cabal-version: 2.2
name: mysql-basics
version: 0.1.0.0
synopsis: Simple MySQL API cookbook example
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
executable run
hs-source-dirs: .

View file

@ -1,14 +1,14 @@
cabal-version: 2.2
name: cookbook-db-postgres-pool
version: 0.1
synopsis: Simple PostgreSQL connection pool cookbook example
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-db-postgres-pool
main-is: PostgresPool.lhs

View file

@ -1,14 +1,14 @@
cabal-version: 2.2
name: cookbook-db-sqlite-simple
version: 0.1
synopsis: Simple SQLite DB cookbook example
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-db-sqlite-simple
main-is: DBConnection.lhs
@ -23,7 +23,7 @@ executable cookbook-db-sqlite-simple
, http-types >= 0.12
, markdown-unlit >= 0.4
, http-client >= 0.5
, sqlite-simple >= 0.4
, sqlite-simple >= 0.4.5.0
, transformers
default-language: Haskell2010
ghc-options: -Wall -pgmL markdown-unlit

View file

@ -1,14 +1,14 @@
cabal-version: 2.2
name: cookbook-file-upload
version: 0.1
synopsis: File upload cookbook example
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-file-upload
main-is: FileUpload.lhs

View file

@ -1,14 +1,14 @@
cabal-version: 2.2
name: cookbook-generic
version: 0.1
synopsis: Using custom monad to pass a state between handlers
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-using-custom-monad
main-is: Generic.lhs

View file

@ -1,17 +1,17 @@
cabal-version: 2.2
name: cookbook-hoist-server-with-context
version: 0.0.1
synopsis: JWT and basic access authentication with a Custom Monad cookbook example
description: Using servant-auth to support both JWT-based and basic
authentication.
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
category: Servant
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-hoist-server-with-context
main-is: HoistServerWithContext.lhs
@ -24,7 +24,7 @@ executable cookbook-hoist-server-with-context
, servant
, servant-server
, servant-auth >= 0.3.2
, servant-auth-server
, servant-auth-server >= 0.4.4.0
, time
, warp >= 3.2
, wai >= 3.2

View file

@ -1,14 +1,14 @@
cabal-version: 2.2
name: cookbook-https
version: 0.1
synopsis: HTTPS cookbook example
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-https
main-is: Https.lhs
@ -17,7 +17,7 @@ executable cookbook-https
, servant-server
, wai >= 3.2
, warp >= 3.2
, warp-tls >= 3.2
, warp-tls >= 3.2.9
, markdown-unlit >= 0.4
default-language: Haskell2010
ghc-options: -Wall -pgmL markdown-unlit

View file

@ -6,8 +6,8 @@ how to solve many common problems with servant. If you're
interested in contributing examples of your own, feel free
to open an issue or a pull request on
`our github repository <https://github.com/haskell-servant/servant>`_
or even to just get in touch with us on the **#servant** IRC channel
on freenode or on
or even to just get in touch with us on the `**#haskell-servant** IRC channel
on libera.chat <https://web.libera.chat/#haskell-servant>_ or on
`the mailing list <https://groups.google.com/forum/#!forum/haskell-servant>`_.
The scope is very wide. Simple and fancy authentication schemes,
@ -37,3 +37,4 @@ you name it!
sentry/Sentry.lhs
testing/Testing.lhs
open-id-connect/OpenIdConnect.lhs
managed-resource/ManagedResource.lhs

View file

@ -1,17 +1,17 @@
cabal-version: 2.2
name: cookbook-jwt-and-basic-auth
version: 0.0.1
synopsis: JWT and basic access authentication cookbook example
description: Using servant-auth to support both JWT-based and basic
authentication.
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
category: Servant
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-jwt-and-basic-auth
main-is: JWTAndBasicAuth.lhs
@ -22,7 +22,7 @@ executable cookbook-jwt-and-basic-auth
, servant
, servant-client
, servant-server
, servant-auth ==0.3.*
, servant-auth == 0.4.*
, servant-auth-server >= 0.3.1.0
, warp >= 3.2
, wai >= 3.2

View file

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

View file

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

View file

@ -1,14 +1,14 @@
cabal-version: 2.2
name: open-id-connect
version: 0.1
synopsis: OpenId Connect with Servant example
homepage: http://haskell-servant.readthedocs.org/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >= 1.10
tested-with: GHC==8.4.4, GHC==8.6.5
tested-with: GHC==8.6.5
executable cookbook-openidconnect
main-is: OpenIdConnect.lhs

View file

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

View file

@ -1,14 +1,14 @@
cabal-version: 2.2
name: cookbook-pagination
version: 2.1
synopsis: Pagination with Servant example
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-pagination
main-is: Pagination.lhs

View file

@ -1,14 +1,14 @@
cabal-version: 2.2
name: cookbook-sentry
version: 0.1
synopsis: Collecting runtime exceptions using Sentry
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-sentry
main-is: Sentry.lhs

View file

@ -1,14 +1,14 @@
cabal-version: 2.2
name: cookbook-structuring-apis
version: 0.1
synopsis: Example that shows how APIs can be structured
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-structuring-apis
main-is: StructuringApis.lhs

View file

@ -1,16 +1,16 @@
cabal-version: 2.2
name: cookbook-testing
version: 0.0.1
synopsis: Common testing patterns in Servant apps
description: This recipe includes various strategies for writing tests for Servant.
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
category: Servant
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-testing
main-is: Testing.lhs

View file

@ -1,14 +1,14 @@
cabal-version: 2.2
name: cookbook-using-custom-monad
version: 0.1
synopsis: Using custom monad to pass a state between handlers
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-using-custom-monad
main-is: UsingCustomMonad.lhs

View file

@ -119,7 +119,7 @@ Now we can use `servant-client`'s internals to convert servant's `Request`
to http-client's `Request`, and we can inspect it:
```haskell
let req' = I.defaultMakeClientRequest burl req
req' <- I.defaultMakeClientRequest burl req
putStrLn $ "Making request: " ++ show req'
```

View file

@ -1,14 +1,14 @@
cabal-version: 2.2
name: cookbook-using-free-client
version: 0.1
synopsis: Using Free client
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC ==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
executable cookbook-using-free-client
main-is: UsingFreeClient.lhs

View file

@ -4,12 +4,19 @@ Servant allows you to talk about the exceptions you throw in your API
types. This is not limited to actual exceptions, you can write
handlers that respond with arbitrary open unions of types.
## Compatibility
:warning: This cookbook is compatible with GHC 8.6.1 or higher :warning:
## Preliminaries
```haskell
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@ -154,12 +161,8 @@ Example usage:
```haskell
data Foo = Foo Int Int Int
deriving (Show, Eq, GHC.Generic)
instance ToJSON Foo
instance HasStatus Foo where
type StatusOf Foo = 200
deriving (Show, Eq, GHC.Generic, ToJSON)
deriving HasStatus via WithStatus 200 Foo
data Bar = Bar
deriving (Show, Eq, GHC.Generic)
@ -196,7 +199,7 @@ parsers in the hope that the ones that should will always error out so
you can try until the right one returns a value.)
[servant-exceptions](https://github.com/ch1bo/servant-exceptions) is
another shot at at the problem. It is inspired by
another shot at the problem. It is inspired by
servant-checked-exceptions, so it may be worth taking a closer look.
The README claims that
[cardano-sl](https://github.com/input-output-hk/cardano-sl) also has

View file

@ -1,16 +1,16 @@
cabal-version: 2.2
name: cookbook-uverb
version: 0.0.1
synopsis: How to use the 'UVerb' type.
description: Listing alternative responses and exceptions in your API types.
homepage: http://docs.servant.dev/
license: BSD3
license: BSD-3-Clause
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
category: Servant
build-type: Simple
cabal-version: >=1.10
tested-with: GHC==8.6.5, GHC==8.8.4, GHC==8.10.1
tested-with: GHC==8.6.5, GHC==8.8.4, GHC==8.10.7
executable cookbook-uverb
main-is: UVerb.lhs
@ -28,6 +28,8 @@ executable cookbook-uverb
, swagger2
, wai
, warp
default-language: Haskell2010
if impl(ghc >= 9)
buildable: False
default-language: Haskell2010
ghc-options: -Wall -pgmL markdown-unlit
build-tool-depends: markdown-unlit:markdown-unlit

View file

@ -12,7 +12,7 @@ Helpful Links
`https://github.com/haskell-servant/servant/issues <https://github.com/haskell-servant/servant/issues>`_
- the irc channel:
``#servant`` on freenode
`#haskell-servant on libera.chat <https://web.libera.chat/#haskell-servant>`_
- the mailing list:
`groups.google.com/forum/#!forum/haskell-servant <https://groups.google.com/forum/#!forum/haskell-servant>`_

View file

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

View file

@ -389,3 +389,30 @@ One example for this is if you want to serve a directory of static files along
with the rest of your API. But you can plug in everything that is an
`Application`, e.g. a whole web application written in any of the web
frameworks that support `wai`.
Be mindful! The `servant-server`'s router works by pattern-matching the
different routes that are composed using `:<|>`. `Raw`, as an escape hatch,
matches any route that hasn't been matched by previous patterns. Therefore,
any subsequent route will be silently ignored.
``` haskell
type UserAPI14 = Raw
:<|> "users" :> Get '[JSON] [User]
-- In this situation, the /users endpoint
-- will not be reachable because the Raw
-- endpoint matches requests before
```
A simple way to avoid this pitfall is to either use `Raw` as the last
definition, or to always have it under a static path.
``` haskell
type UserAPI15 = "files" :> Raw
-- The raw endpoint is under the /files
-- static path, so it won't match /users.
:<|> "users" :> Get '[JSON] [User]
type UserAPI16 = "users" :> Get '[JSON] [User]
:<|> Raw
-- The Raw endpoint is matched last, so
-- it won't overlap another endpoint.
```

View file

@ -47,7 +47,6 @@ module Authentication where
import Data.Aeson (ToJSON)
import Data.ByteString (ByteString)
import Data.Map (Map, fromList)
import Data.Monoid ((<>))
import qualified Data.Map as Map
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text)
@ -133,7 +132,7 @@ combinator. Using `Context`, we can supply a function of type
handler. This will allow the handler to check authentication and return a `User`
to downstream handlers if successful.
In practice we wrap `BasicAuthData -> Handler` into a slightly
In practice we wrap `BasicAuthData -> Handler User` into a slightly
different function to better capture the semantics of basic authentication:
``` haskell ignore

View file

@ -6,46 +6,10 @@ This is an introductory tutorial to **servant**. Whilst browsing is fine, it mak
Any comments, issues or feedback about the tutorial can be submitted
to `servant's issue tracker <http://github.com/haskell-servant/servant/issues>`_.
cabal-install
--------
The whole tutorial is a `cabal <https://cabal.readthedocs.io/en/latest/>`_
project and can be built locally as follows:
.. code-block:: bash
$ git clone https://github.com/haskell-servant/servant.git
$ cd servant
# build
$ cabal new-build tutorial
# load in ghci to play with it
$ cabal new-repl tutorial
stack
--------
The servant `stack <https://docs.haskellstack.org/en/stable/README/>`_ template includes the working tutorial. To initialize this template, run:
.. code-block:: bash
$ stack new myproj servant
$ cd myproj
# build
$ stack build
# start server
$ stack exec myproj-exe
The code can be found in the `*.lhs` files under `doc/tutorial/` in the
repository. Feel free to edit it while you're reading this documentation and
see the effect of your changes.
`Nix <https://nixos.org/nix/>`_ users should feel free to take a look at
the `nix/shell.nix` file in the repository and use it to provision a suitable
environment to build and run the examples.
.. toctree::
:maxdepth: 1
install.rst
ApiType.lhs
Server.lhs
Client.lhs

68
doc/tutorial/install.rst Normal file
View file

@ -0,0 +1,68 @@
Install
========
cabal-install
--------
The whole tutorial is a `cabal <https://cabal.readthedocs.io/en/latest/>`_
project and can be built locally as follows:
.. code-block:: bash
$ git clone https://github.com/haskell-servant/servant.git
$ cd servant
# build
$ cabal new-build tutorial
# load in ghci to play with it
$ cabal new-repl tutorial
stack
--------
The servant `stack <https://docs.haskellstack.org/en/stable/README/>`_ template includes the working tutorial. To initialize this template, run:
.. code-block:: bash
$ stack new myproj servant
$ cd myproj
# build
$ stack build
# start server
$ stack exec myproj-exe
The code can be found in the `*.lhs` files under `doc/tutorial/` in the
repository. Feel free to edit it while you're reading this documentation and
see the effect of your changes.
nix
--------
`Nix <https://nixos.org/nix/>`_ users should feel free to take a look at
the `nix/shell.nix` file in the repository and use it to provision a suitable
environment to build and run the examples.
Note for Ubuntu users
--------
Ubuntu's packages for `ghc`, `cabal`, and `stack` are years out of date.
If the instructions above fail for you,
try replacing the Ubuntu packages with up-to-date versions.
First remove the installed versions:
.. code-block:: bash
# remove the obsolete versions
$ sudo apt remove ghc haskell-stack cabal-install
Then install fresh versions of the Haskell toolchain
using the `ghcup <https://www.haskell.org/ghcup/install/>`_ installer.
As of February 2022, one easy way to do this is by running a bootstrap script:
.. code-block:: bash
$ curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
The script is interactive and will prompt you for details about what
you want installed and where. To install manually,
see `the detailed instructions <https://www.haskell.org/ghcup/install/#manual-install>`_.

View file

@ -1,3 +1,4 @@
cabal-version: 2.2
name: tutorial
version: 0.10
synopsis: The servant tutorial
@ -6,18 +7,14 @@ description:
<http://docs.servant.dev/>
homepage: http://docs.servant.dev/
category: Servant, Documentation
license: BSD3
license: BSD-3-Clause
license-file: LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
tested-with:
GHC==8.0.2
GHC==8.2.2
GHC==8.4.4
GHC==8.6.5
GHC==8.8.3, GHC ==8.10.1
GHC==8.8.3, GHC ==8.10.7
extra-source-files:
static/index.html
static/ui.js
@ -67,10 +64,10 @@ library
, blaze-markup >= 0.8.0.0 && < 0.9
, cookie >= 0.4.3 && < 0.5
, js-jquery >= 3.3.1 && < 3.4
, lucid >= 2.9.11 && < 2.10
, random >= 1.1 && < 1.2
, lucid >= 2.9.11 && < 2.12
, random >= 1.1 && < 1.3
, servant-js >= 0.9 && < 0.10
, time >= 1.6.0.1 && < 1.10
, time >= 1.6.0.1 && < 1.13
-- For legacy tools, we need to specify build-depends too
build-depends: markdown-unlit >= 0.5.0 && <0.6

22
ghcjs.nix Normal file
View file

@ -0,0 +1,22 @@
let reflex-platform = import (builtins.fetchTarball
{ name = "reflex-platform";
url = "https://github.com/reflex-frp/reflex-platform/archive/1aba6f367982bd6dd78ec2fda75ab246a62d32c5.tar.gz";
}) {};
pkgs = import ./nix/nixpkgs.nix; in
pkgs.stdenv.mkDerivation {
name = "ghcjs-shell";
buildInputs =
[ (reflex-platform.ghcjs.ghcWithPackages (p: with p; [
attoparsec
hashable
]))
pkgs.cabal-install
pkgs.gmp
pkgs.haskellPackages.cabal-plan
pkgs.haskellPackages.hspec-discover
pkgs.nodejs
pkgs.perl
pkgs.zlib
];
}

View file

@ -21,3 +21,21 @@ a particular ghc version, e.g:
``` sh
$ nix-shell nix/shell.nix --argstr compiler ghcHEAD
```
**Possible GHC versions**
- `ghc865Binary`
- `ghc884`
- `ghc8104` - default
- `ghc901`
### Cabal users
GHC version can be chosen via the nix-shell parameter
`cabal build all`
### Stack version
Since the ghc version is set by the LTS version, it is preferable to use the `ghc8104` version parameter for the nix-shell.
`stack --no-nix --system-ghc <command>`

4
nix/nixpkgs.nix Normal file
View file

@ -0,0 +1,4 @@
import (builtins.fetchTarball {
url = "https://github.com/NixOS/nixpkgs/archive/refs/tags/21.05.tar.gz";
sha256 = "sha256:1ckzhh24mgz6jd1xhfgx0i9mijk6xjqxwsshnvq789xsavrmsc36";
}) {}

View file

@ -1,21 +1,20 @@
{ pkgs ? import <nixpkgs> {}
, compiler ? "ghc822"
{ compiler ? "ghc8104"
, tutorial ? false
, pkgs ? import ./nixpkgs.nix
}:
with pkgs;
with pkgs;
let
ghc = haskell.packages.${compiler}.ghcWithPackages (_: []);
docstuffs = python3.withPackages (ps: with ps; [ recommonmark sphinx sphinx_rtd_theme ]);
in
stdenv.mkDerivation {
name = "servant-dev";
buildInputs = [ ghc zlib python3 wget ]
++ (if tutorial then [docstuffs postgresql] else []);
shellHook = ''
eval $(grep export ${ghc}/bin/ghc)
export LD_LIBRARY_PATH="${zlib}/lib";
'';
}
let
ghc = haskell.packages.${compiler}.ghcWithPackages (_: []);
docstuffs = python3.withPackages (ps: with ps; [ recommonmark sphinx sphinx_rtd_theme ]);
in
stdenv.mkDerivation {
name = "servant-dev";
buildInputs = [ ghc zlib python3 wget cabal-install postgresql openssl stack haskellPackages.hspec-discover ]
++ (if tutorial then [docstuffs postgresql] else []);
shellHook = ''
eval $(grep export ${ghc}/bin/ghc)
export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:"${zlib}/lib";
'';
}

1
servant-auth/README.md Symbolic link
View file

@ -0,0 +1 @@
servant-auth-server/README.lhs

View file

@ -0,0 +1 @@
:set -isrc -itest -idoctest/ghci-wrapper/src

View file

@ -0,0 +1,26 @@
# Changelog
All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)
and this project adheres to [PVP Versioning](https://pvp.haskell.org/).
## [Unreleased]
## [0.4.1.0] - 2020-10-06
- Support generic Bearer token auth
## [0.4.0.0] - 2019-03-08
## Changed
- #145 Support servant-0.16 in tests @domenkozar
- #145 Drop GHC 7.10 support @domenkozar
## [0.3.3.0] - 2018-06-18
### Added
- Support for GHC 8.4 by @phadej
- Support for servant-0.14 by @phadej
- Changelog by @domenkozar

View file

@ -0,0 +1,31 @@
Copyright Julian K. Arni (c) 2015
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Julian K. Arni nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

View file

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

View file

@ -0,0 +1,80 @@
cabal-version: 2.2
name: servant-auth-client
version: 0.4.1.0
synopsis: servant-client/servant-auth compatibility
description: This package provides instances that allow generating clients from
<https://hackage.haskell.org/package/servant servant>
APIs that use
<https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
.
For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
category: Web, Servant, Authentication
homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
bug-reports: https://github.com/haskell-servant/servant/issues
author: Julian K. Arni
maintainer: jkarni@gmail.com
copyright: (c) Julian K. Arni
license: BSD-3-Clause
license-file: LICENSE
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
build-type: Simple
extra-source-files:
CHANGELOG.md
source-repository head
type: git
location: https://github.com/haskell-servant/servant
library
hs-source-dirs:
src
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
ghc-options: -Wall
build-depends:
base >= 4.10 && < 4.18
, bytestring >= 0.10.6.0 && < 0.12
, containers >= 0.5.6.2 && < 0.7
, servant-auth == 0.4.*
, servant >= 0.13 && < 0.20
, servant-client-core >= 0.13 && < 0.20
exposed-modules:
Servant.Auth.Client
Servant.Auth.Client.Internal
default-language: Haskell2010
test-suite spec
type: exitcode-stdio-1.0
main-is: Spec.hs
hs-source-dirs:
test
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
ghc-options: -Wall
build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
-- dependencies with bounds inherited from the library stanza
build-depends:
base
, servant-client
, servant-auth
, servant
, servant-auth-client
-- test dependencies
build-depends:
hspec >= 2.5.5 && < 2.10
, QuickCheck >= 2.11.3 && < 2.15
, aeson >= 1.3.1.1 && < 3
, bytestring >= 0.10.6.0 && < 0.12
, http-client >= 0.5.13.1 && < 0.8
, http-types >= 0.12.2 && < 0.13
, servant-auth-server >= 0.4.2.0 && < 0.5
, servant-server >= 0.13 && < 0.20
, time >= 1.5.0.1 && < 1.13
, transformers >= 0.4.2.0 && < 0.6
, wai >= 3.2.1.2 && < 3.3
, warp >= 3.2.25 && < 3.4
, jose >= 0.10 && < 0.11
other-modules:
Servant.Auth.ClientSpec
default-language: Haskell2010

View file

@ -0,0 +1,3 @@
module Servant.Auth.Client (Token(..), Bearer) where
import Servant.Auth.Client.Internal (Bearer, Token(..))

View file

@ -0,0 +1,64 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
#if __GLASGOW_HASKELL__ == 800
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
#endif
module Servant.Auth.Client.Internal where
import qualified Data.ByteString as BS
import Data.Monoid
import Data.Proxy (Proxy (..))
import Data.String (IsString)
import GHC.Exts (Constraint)
import GHC.Generics (Generic)
import Servant.API ((:>))
import Servant.Auth
import Servant.Client.Core
import Data.Sequence ((<|))
-- | A simple bearer token.
newtype Token = Token { getToken :: BS.ByteString }
deriving (Eq, Show, Read, Generic, IsString)
type family HasBearer xs :: Constraint where
HasBearer (Bearer ': xs) = ()
HasBearer (JWT ': xs) = ()
HasBearer (x ': xs) = HasBearer xs
HasBearer '[] = BearerAuthNotEnabled
class BearerAuthNotEnabled
-- | @'HasBearer' auths@ is nominally a redundant constraint, but ensures we're not
-- trying to send a token to an API that doesn't accept them.
instance (HasBearer auths, HasClient m api) => HasClient m (Auth auths a :> api) where
type Client m (Auth auths a :> api) = Token -> Client m api
clientWithRoute m _ req (Token token)
= clientWithRoute m (Proxy :: Proxy api)
$ req { requestHeaders = ("Authorization", headerVal) <| requestHeaders req }
where
headerVal = "Bearer " <> token
#if MIN_VERSION_servant_client_core(0,14,0)
hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy api) nt . cl
#endif
-- * Authentication combinators
-- | A Bearer token in the Authorization header:
--
-- @Authorization: Bearer <token>@
--
-- This can be any token recognized by the server, for example,
-- a JSON Web Token (JWT).
--
-- Note that, since the exact way the token is validated is not specified,
-- this combinator can only be used in the client. The server would not know
-- how to validate it, while the client does not care.
-- If you want to implement Bearer authentication in your server, you have to
-- choose a specific combinator, such as 'JWT'.
data Bearer

View file

@ -0,0 +1,161 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
module Servant.Auth.ClientSpec (spec) where
import Crypto.JOSE (JWK,
KeyMaterialGenParam (OctGenParam),
genJWK)
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.ByteString.Lazy as BSL
import Data.Time (UTCTime, defaultTimeLocale,
parseTimeOrError)
import GHC.Generics (Generic)
import Network.HTTP.Client (Manager, defaultManagerSettings,
newManager)
import Network.HTTP.Types (status401)
import Network.Wai.Handler.Warp (testWithApplication)
import Servant
import Servant.Client (BaseUrl (..), Scheme (Http),
ClientError (FailureResponse),
#if MIN_VERSION_servant_client(0,16,0)
ResponseF(..),
#elif MIN_VERSION_servant_client(0,13,0)
GenResponse(..),
#elif MIN_VERSION_servant_client(0,12,0)
Response(..),
#endif
client)
import System.IO.Unsafe (unsafePerformIO)
import Test.Hspec
import Test.QuickCheck
#if MIN_VERSION_servant_client(0,13,0)
import Servant.Client (mkClientEnv, runClientM)
#elif MIN_VERSION_servant_client(0,9,0)
import Servant.Client (ClientEnv (..), runClientM)
#else
import Control.Monad.Trans.Except (runExceptT)
#endif
#if !MIN_VERSION_servant_server(0,16,0)
#define ClientError ServantError
#endif
import Servant.Auth.Client
import Servant.Auth.Server
import Servant.Auth.Server.SetCookieOrphan ()
spec :: Spec
spec = describe "The JWT combinator" $ do
hasClientSpec
------------------------------------------------------------------------------
-- * HasClient {{{
hasClientSpec :: Spec
hasClientSpec = describe "HasClient" $ around (testWithApplication $ return app) $ do
let mkTok :: User -> Maybe UTCTime -> IO Token
mkTok user mexp = do
Right tok <- makeJWT user jwtCfg mexp
return $ Token $ BSL.toStrict tok
it "succeeds when the token does not have expiry" $ \port -> property $ \user -> do
tok <- mkTok user Nothing
v <- getIntClient tok mgr (BaseUrl Http "localhost" port "")
v `shouldBe` Right (length $ name user)
it "succeeds when the token is not expired" $ \port -> property $ \user -> do
tok <- mkTok user (Just future)
v <- getIntClient tok mgr (BaseUrl Http "localhost" port "")
v `shouldBe` Right (length $ name user)
it "fails when token is expired" $ \port -> property $ \user -> do
tok <- mkTok user (Just past)
#if MIN_VERSION_servant_client(0,16,0)
Left (FailureResponse _ (Response stat _ _ _))
#elif MIN_VERSION_servant_client(0,12,0)
Left (FailureResponse (Response stat _ _ _))
#elif MIN_VERSION_servant_client(0,11,0)
Left (FailureResponse _ stat _ _)
#else
Left (FailureResponse stat _ _)
#endif
<- getIntClient tok mgr (BaseUrl Http "localhost" port "")
stat `shouldBe` status401
getIntClient :: Token -> Manager -> BaseUrl -> IO (Either ClientError Int)
#if MIN_VERSION_servant(0,13,0)
getIntClient tok m burl = runClientM (client api tok) (mkClientEnv m burl)
#elif MIN_VERSION_servant(0,9,0)
getIntClient tok m burl = runClientM (client api tok) (ClientEnv m burl)
#else
getIntClient tok m burl = runExceptT $ client api tok m burl
#endif
-- }}}
------------------------------------------------------------------------------
-- * API and Server {{{
type API = Auth '[JWT] User :> Get '[JSON] Int
api :: Proxy API
api = Proxy
theKey :: JWK
theKey = unsafePerformIO . genJWK $ OctGenParam 256
{-# NOINLINE theKey #-}
mgr :: Manager
mgr = unsafePerformIO $ newManager defaultManagerSettings
{-# NOINLINE mgr #-}
app :: Application
app = serveWithContext api ctx server
where
ctx = cookieCfg :. jwtCfg :. EmptyContext
jwtCfg :: JWTSettings
jwtCfg = defaultJWTSettings theKey
cookieCfg :: CookieSettings
cookieCfg = defaultCookieSettings
server :: Server API
server = getInt
where
getInt :: AuthResult User -> Handler Int
getInt (Authenticated u) = return . length $ name u
getInt _ = throwAll err401
-- }}}
------------------------------------------------------------------------------
-- * Utils {{{
past :: UTCTime
past = parseTimeOrError True defaultTimeLocale "%Y-%m-%d" "1970-01-01"
future :: UTCTime
future = parseTimeOrError True defaultTimeLocale "%Y-%m-%d" "2070-01-01"
-- }}}
------------------------------------------------------------------------------
-- * Types {{{
data User = User
{ name :: String
, _id :: String
} deriving (Eq, Show, Read, Generic)
instance FromJWT User
instance ToJWT User
instance FromJSON User
instance ToJSON User
instance Arbitrary User where
arbitrary = User <$> arbitrary <*> arbitrary
-- }}}

View file

@ -0,0 +1 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

View file

@ -0,0 +1 @@
:set -isrc -itest -idoctest/ghci-wrapper/src

View file

@ -0,0 +1,14 @@
# Changelog
All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)
and this project adheres to [PVP Versioning](https://pvp.haskell.org/).
## [Unreleased]
## [0.2.10.0] - 2018-06-18
### Added
- Support for GHC 8.4 by @phadej
- Changelog by @domenkozar

View file

@ -0,0 +1,31 @@
Copyright Julian K. Arni (c) 2015
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Julian K. Arni nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

View file

@ -0,0 +1,33 @@
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wall #-}
module Main (main) where
#ifndef MIN_VERSION_cabal_doctest
#define MIN_VERSION_cabal_doctest(x,y,z) 0
#endif
#if MIN_VERSION_cabal_doctest(1,0,0)
import Distribution.Extra.Doctest ( defaultMainWithDoctests )
main :: IO ()
main = defaultMainWithDoctests "doctests"
#else
#ifdef MIN_VERSION_Cabal
-- If the macro is defined, we have new cabal-install,
-- but for some reason we don't have cabal-doctest in package-db
--
-- Probably we are running cabal sdist, when otherwise using new-build
-- workflow
#warning You are configuring this package without cabal-doctest installed. \
The doctests test-suite will not work as a result. \
To fix this, install cabal-doctest before configuring.
#endif
import Distribution.Simple
main :: IO ()
main = defaultMain
#endif

View file

@ -0,0 +1,84 @@
cabal-version: 2.2
name: servant-auth-docs
version: 0.2.10.0
synopsis: servant-docs/servant-auth compatibility
description: This package provides instances that allow generating docs from
<https://hackage.haskell.org/package/servant servant>
APIs that use
<https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
.
For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
category: Web, Servant, Authentication
homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
bug-reports: https://github.com/haskell-servant/servant/issues
author: Julian K. Arni
maintainer: jkarni@gmail.com
copyright: (c) Julian K. Arni
license: BSD-3-Clause
license-file: LICENSE
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
build-type: Custom
extra-source-files:
CHANGELOG.md
custom-setup
setup-depends:
base, Cabal, cabal-doctest >=1.0.6 && <1.1
source-repository head
type: git
location: https://github.com/haskell-servant/servant
library
hs-source-dirs:
src
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
ghc-options: -Wall
build-depends:
base >= 4.10 && < 4.18
, servant-docs >= 0.11.2 && < 0.13
, servant >= 0.13 && < 0.20
, servant-auth == 0.4.*
, lens >= 4.16.1 && <5.3
exposed-modules:
Servant.Auth.Docs
default-language: Haskell2010
test-suite doctests
type: exitcode-stdio-1.0
main-is: doctests.hs
build-depends:
base,
servant-auth-docs,
doctest >= 0.16 && < 0.21,
QuickCheck >= 2.11.3 && < 2.15,
template-haskell
ghc-options: -Wall -threaded
hs-source-dirs: test
default-language: Haskell2010
test-suite spec
type: exitcode-stdio-1.0
main-is: Spec.hs
hs-source-dirs:
test
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
ghc-options: -Wall
build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
-- dependencies with bounds inherited from the library stanza
build-depends:
base
, text
, servant-docs
, servant
, servant-auth
, lens
-- test dependencies
build-depends:
servant-auth-docs
, hspec >= 2.5.5 && < 2.10
, QuickCheck >= 2.11.3 && < 2.15
default-language: Haskell2010

View file

@ -0,0 +1,96 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.Auth.Docs
(
-- | The purpose of this package is provide the instance for 'servant-auth'
-- combinators needed for 'servant-docs' documentation generation.
--
-- >>> type API = Auth '[JWT, Cookie, BasicAuth] Int :> Get '[JSON] Int
-- >>> putStr $ markdown $ docs (Proxy :: Proxy API)
-- ## GET /
-- ...
-- ... Authentication
-- ...
-- This part of the API is protected by the following authentication mechanisms:
-- ...
-- * JSON Web Tokens ([JWTs](https://en.wikipedia.org/wiki/JSON_Web_Token))
-- * [Cookies](https://en.wikipedia.org/wiki/HTTP_cookie)
-- * [Basic Authentication](https://en.wikipedia.org/wiki/Basic_access_authentication)
-- ...
-- Clients must supply the following data
-- ...
-- One of the following:
-- ...
-- * A JWT Token signed with this server's key
-- * Cookies automatically set by browsers, plus a header
-- * Cookies automatically set by browsers, plus a header
-- ...
-- * Re-export
JWT
, BasicAuth
, Cookie
, Auth
) where
import Control.Lens ((%~), (&), (|>))
import Data.List (intercalate)
import Data.Monoid
import Data.Proxy (Proxy (Proxy))
import Servant.API hiding (BasicAuth)
import Servant.Auth
import Servant.Docs hiding (pretty)
import Servant.Docs.Internal (DocAuthentication (..), authInfo)
instance (AllDocs auths, HasDocs api) => HasDocs (Auth auths r :> api) where
docsFor _ (endpoint, action) =
docsFor (Proxy :: Proxy api) (endpoint, action & authInfo %~ (|> info))
where
(intro, reqData) = pretty $ allDocs (Proxy :: Proxy auths)
info = DocAuthentication intro reqData
pretty :: [(String, String)] -> (String, String)
pretty [] = error "shouldn't happen"
pretty [(i, d)] =
( "This part of the API is protected by " <> i
, d
)
pretty rs =
( "This part of the API is protected by the following authentication mechanisms:\n\n"
++ " * " <> intercalate "\n * " (fst <$> rs)
, "\nOne of the following:\n\n"
++ " * " <> intercalate "\n * " (snd <$> rs)
)
class AllDocs (x :: [*]) where
allDocs :: proxy x
-- intro, req
-> [(String, String)]
instance (OneDoc a, AllDocs as) => AllDocs (a ': as) where
allDocs _ = oneDoc (Proxy :: Proxy a) : allDocs (Proxy :: Proxy as)
instance AllDocs '[] where
allDocs _ = []
class OneDoc a where
oneDoc :: proxy a -> (String, String)
instance OneDoc JWT where
oneDoc _ =
("JSON Web Tokens ([JWTs](https://en.wikipedia.org/wiki/JSON_Web_Token))"
, "A JWT Token signed with this server's key")
instance OneDoc Cookie where
oneDoc _ =
("[Cookies](https://en.wikipedia.org/wiki/HTTP_cookie)"
, "Cookies automatically set by browsers, plus a header")
instance OneDoc BasicAuth where
oneDoc _ =
( "[Basic Authentication](https://en.wikipedia.org/wiki/Basic_access_authentication)"
, "Cookies automatically set by browsers, plus a header")
-- $setup
-- >>> instance ToSample Int where toSamples _ = singleSample 1729

View file

@ -0,0 +1 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

View file

@ -0,0 +1,12 @@
module Main where
import Build_doctests (flags, pkgs, module_sources)
import Data.Foldable (traverse_)
import Test.DocTest
main :: IO ()
main = do
traverse_ putStrLn args
doctest args
where
args = flags ++ pkgs ++ module_sources

View file

@ -0,0 +1 @@
:set -isrc -itest -idoctest/ghci-wrapper/src

View file

@ -0,0 +1,130 @@
# Changelog
All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)
and this project adheres to [PVP Versioning](https://pvp.haskell.org/).
## [Unreleased]
## [0.4.6.0] - 2020-10-06
## Changed
- expose verifyJWT and use it in two places [@domenkozar]
- support GHC 8.10 [@domenkozar]
- move ToJWT/FromJWT to servant-auth [@erewok]
- #165 fix AnySite with Cookie 3.5.0 [@odr]
## [0.4.5.1] - 2020-02-06
## Changed
- #158 servant 0.17 support [@phadej]
## [0.4.5.0] - 2019-12-28
## Changed
- #144 servant 0.16 support and drop GHC 7.10 support [@domenkozar]
- #148 removed unused constaint in HasServer instance for Auth
- #154 GHC 8.8 support [@phadej]
### Added
- #141 Support Stream combinator [@domenkozar]
- #143 Allow servant-0.16 [@phadej]
## [0.4.4.0] - 2019-03-02
### Added
- #141 Support Stream combinator [@domenkozar]
- #143 Allow servant-0.16 [@phadej]
## [0.4.3.0] - 2019-01-17
## Changed
- #117 Avoid running auth checks unnecessarily [@sopvop]
- #110 Get rid of crypto-api dependency [@domenkozar]
- #130 clearSession: improve cross-browser compatibility [@domenkozar]
- #136 weed out bytestring-conversion [@stephenirl]
## [0.4.2.0] - 2018-11-05
### Added
- `Headers hs a` instance for AddSetCookieApi [@domenkozar]
- GHC 8.6.x support [@domenkozar]
## [0.4.1.0] - 2018-10-05
### Added
- #125 Allow setting domain name for a cookie [@domenkozar]
## Changed
- bump http-api-data to 0.3.10 that includes Cookie orphan instances previously located in servant-auth-server [@phadej]
- #114 Export `HasSecurity` typeclass [@rockbmb]
## [0.4.0.1] - 2018-09-23
### Security
- #123 Session cookie did not apply SameSite attribute [@domenkozar]
### Added
- #112 HasLink instance for Auth combinator [@adetokunbo]
- #111 Documentation for using hoistServer [@mschristiansen]
- #107 Add utility functions for reading and writing a key to a file [@mschristiansen]
## [0.4.0.0] - 2018-06-17
### Added
- Support GHC 8.4 by @phadej and @domenkozar
- Support for servant-0.14 by @phadej
- #96 Support for jose-0.7 by @xaviershay
- #92 add `clearSession` for logout by @plredmond and @3noch
- #95 makeJWT: allow setting Alg via defaultJWTSettings by @domenkozar
- #89 Validate JWT against a JWKSet instead of JWK by @sopvop
### Changed
- #92 Rename CSRF to XSRF by @plredmond and @3noch
- #92 extract 'XsrfCookieSettings' from 'CookieSettings' and make XSRF checking optional
by @plredmond and @3noch
- #69 export SameSite by @domenkozar
- #102 Reuse Servant.Api.IsSecure instead of duplicating ADT by @domenkozar
### Deprecated
- #92 Renamed 'makeCsrfCookie' to 'makeXsrfCookie' and marked the former as deprecated
by @plredmond and @3noc
- #92 Made several changes to the structure of 'CookieSettings' which will require
attention by users who have modified the XSRF settings by @plredmond and @3noch
### Security
- #94 Force cookie expiration on serverside by @karshan
## [0.3.2.0] - 2018-02-21
### Added
- #76 Export wwwAuthenticatedErr and elaborate its annotation by @defanor
- Support for servant-0.14 by @phadej
### Changed
- Disable the readme executable for ghcjs builds by @hamishmack
- #84 Make AddSetCookieApi type family open by @qnikst
- #79 Make CSRF checks optional for GET requests by @harendra-kumar
## [0.3.1.0] - 2017-11-08
### Added
- Support for servant-0.12 by @phadej
## [0.3.0.0] - 2017-11-07
### Changed
- #47 'cookiePath' and 'xsrfCookiePath' added to 'CookieSettings' by @mchaver
## [0.2.8.0] - 2017-05-26
### Added
- #45 Support for servant-0.11 by @phadej
## [0.2.7.0] - 2017-02-11
### Changed
- #27 #41 'acceptLogin' and 'makeCsrfCookie' functions by @bts

View file

@ -0,0 +1,31 @@
Copyright Julian K. Arni (c) 2015
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Julian K. Arni nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

View file

@ -0,0 +1,291 @@
# servant-auth
These packages provides safe and easy-to-use authentication options for
`servant`. The same API can be protected via:
- basicauth
- cookies
- JWT tokens
| Package | Hackage |
| -------------------- | ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- |
| servant-auth | [![servant-auth](https://img.shields.io/hackage/v/servant-auth?style=flat-square&logo=haskell&label&labelColor=5D4F85)](https://hackage.haskell.org/package/servant-auth) |
| servant-auth-server | [![servant-auth-server](https://img.shields.io/hackage/v/servant-auth-server.svg?style=flat-square&logo=haskell&label&labelColor=5D4F85)](https://hackage.haskell.org/package/servant-auth-server) |
| servant-auth-client | [![servant-auth-client](https://img.shields.io/hackage/v/servant-auth-client.svg?style=flat-square&logo=haskell&label&labelColor=5D4F85)](https://hackage.haskell.org/package/servant-auth-client) |
| servant-auth-swagger | [![servant-auth-swagger](https://img.shields.io/hackage/v/servant-auth-swagger.svg?style=flat-square&logo=haskell&label&labelColor=5D4F85)](https://hackage.haskell.org/package/servant-auth-swagger) |
| servant-auth-docs | [![servant-auth-docs](https://img.shields.io/hackage/v/servant-auth-docs.svg?style=flat-square&logo=haskell&label&labelColor=5D4F85)](https://hackage.haskell.org/package/servant-auth-docs) |
## How it works
First some imports:
~~~ haskell
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
import Control.Concurrent (forkIO)
import Control.Monad (forever)
import Control.Monad.Trans (liftIO)
import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic)
import Network.Wai.Handler.Warp (run)
import System.Environment (getArgs)
import Servant
import Servant.Auth.Server
import Servant.Auth.Server.SetCookieOrphan ()
~~~
`servant-auth` library introduces a combinator `Auth`:
~~~ haskell
data Auth (auths :: [*]) val
~~~
What `Auth [Auth1, Auth2] Something :> API` means is that `API` is protected by
*either* `Auth1` *or* `Auth2`, and the result of authentication will be of type
`AuthResult Something`, where :
~~~ haskell
data AuthResult val
= BadPassword
| NoSuchUser
| Authenticated val
| Indefinite
~~~
Your handlers will get a value of type `AuthResult Something`, and can decide
what to do with it.
~~~ haskell
data User = User { name :: String, email :: String }
deriving (Eq, Show, Read, Generic)
instance ToJSON User
instance ToJWT User
instance FromJSON User
instance FromJWT User
data Login = Login { username :: String, password :: String }
deriving (Eq, Show, Read, Generic)
instance ToJSON Login
instance FromJSON Login
type Protected
= "name" :> Get '[JSON] String
:<|> "email" :> Get '[JSON] String
-- | 'Protected' will be protected by 'auths', which we still have to specify.
protected :: Servant.Auth.Server.AuthResult User -> Server Protected
-- If we get an "Authenticated v", we can trust the information in v, since
-- it was signed by a key we trust.
protected (Servant.Auth.Server.Authenticated user) = return (name user) :<|> return (email user)
-- Otherwise, we return a 401.
protected _ = throwAll err401
type Unprotected =
"login"
:> ReqBody '[JSON] Login
:> Verb 'POST 204 '[JSON] (Headers '[ Header "Set-Cookie" SetCookie
, Header "Set-Cookie" SetCookie]
NoContent)
:<|> Raw
unprotected :: CookieSettings -> JWTSettings -> Server Unprotected
unprotected cs jwts = checkCreds cs jwts :<|> serveDirectory "example/static"
type API auths = (Servant.Auth.Server.Auth auths User :> Protected) :<|> Unprotected
server :: CookieSettings -> JWTSettings -> Server (API auths)
server cs jwts = protected :<|> unprotected cs jwts
~~~
The code is common to all authentications. In order to pick one or more specific
authentication methods, all we need to do is provide the expect configuration
parameters.
## API tokens
The following example illustrates how to protect an API with tokens.
~~~ haskell
-- In main, we fork the server, and allow new tokens to be created in the
-- command line for the specified user name and email.
mainWithJWT :: IO ()
mainWithJWT = do
-- We generate the key for signing tokens. This would generally be persisted,
-- and kept safely
myKey <- generateKey
-- Adding some configurations. All authentications require CookieSettings to
-- be in the context.
let jwtCfg = defaultJWTSettings myKey
cfg = defaultCookieSettings :. jwtCfg :. EmptyContext
--- Here we actually make concrete
api = Proxy :: Proxy (API '[JWT])
_ <- forkIO $ run 7249 $ serveWithContext api cfg (server defaultCookieSettings jwtCfg)
putStrLn "Started server on localhost:7249"
putStrLn "Enter name and email separated by a space for a new token"
forever $ do
xs <- words <$> getLine
case xs of
[name', email'] -> do
etoken <- makeJWT (User name' email') jwtCfg Nothing
case etoken of
Left e -> putStrLn $ "Error generating token:t" ++ show e
Right v -> putStrLn $ "New token:\t" ++ show v
_ -> putStrLn "Expecting a name and email separated by spaces"
~~~
And indeed:
~~~ bash
./readme JWT
Started server on localhost:7249
Enter name and email separated by a space for a new token
alice alice@gmail.com
New token: "eyJhbGciOiJIUzI1NiJ9.eyJkYXQiOnsiZW1haWwiOiJhbGljZUBnbWFpbC5jb20iLCJuYW1lIjoiYWxpY2UifX0.xzOIrx_A9VOKzVO-R1c1JYKBqK9risF625HOxpBzpzE"
curl localhost:7249/name -v
* Hostname was NOT found in DNS cache
* Trying 127.0.0.1...
* Connected to localhost (127.0.0.1) port 7249 (#0)
> GET /name HTTP/1.1
> User-Agent: curl/7.35.0
> Host: localhost:7249
> Accept: */*
>
< HTTP/1.1 401 Unauthorized
< Transfer-Encoding: chunked
< Date: Wed, 07 Sep 2016 20:17:17 GMT
* Server Warp/3.2.7 is not blacklisted
< Server: Warp/3.2.7
<
* Connection #0 to host localhost left intact
curl -H "Authorization: Bearer eyJhbGciOiJIUzI1NiJ9.eyJkYXQiOnsiZW1haWwiOiJhbGljZUBnbWFpbC5jb20iLCJuYW1lIjoiYWxpY2UifX0.xzOIrx_A9VOKzVO-R1c1JYKBqK9risF625HOxpBzpzE" \
localhost:7249/name -v
* Hostname was NOT found in DNS cache
* Trying 127.0.0.1...
* Connected to localhost (127.0.0.1) port 7249 (#0)
> GET /name HTTP/1.1
> User-Agent: curl/7.35.0
> Host: localhost:7249
> Accept: */*
> Authorization: Bearer eyJhbGciOiJIUzI1NiJ9.eyJkYXQiOnsiZW1haWwiOiJhbGljZUBnbWFpbC5jb20iLCJuYW1lIjoiYWxpY2UifX0.xzOIrx_A9VOKzVO-R1c1JYKBqK9risF625HOxpBzpzE
>
< HTTP/1.1 200 OK
< Transfer-Encoding: chunked
< Date: Wed, 07 Sep 2016 20:16:11 GMT
* Server Warp/3.2.7 is not blacklisted
< Server: Warp/3.2.7
< Content-Type: application/json
< Set-Cookie: JWT-Cookie=eyJhbGciOiJIUzI1NiJ9.eyJkYXQiOnsiZW1haWwiOiJhbGljZUBnbWFpbC5jb20iLCJuYW1lIjoiYWxpY2UifX0.xzOIrx_A9VOKzVO-R1c1JYKBqK9risF625HOxpBzpzE; HttpOnly; Secure
< Set-Cookie: XSRF-TOKEN=TWcdPnHr2QHcVyTw/TTBLQ==; Secure
<
* Connection #0 to host localhost left intact
"alice"%
~~~
## Cookies
What if, in addition to API tokens, we want to expose our API to browsers? All
we need to do is say so!
~~~ haskell
mainWithCookies :: IO ()
mainWithCookies = do
-- We *also* need a key to sign the cookies
myKey <- generateKey
-- Adding some configurations. 'Cookie' requires, in addition to
-- CookieSettings, JWTSettings (for signing), so everything is just as before
let jwtCfg = defaultJWTSettings myKey
cfg = defaultCookieSettings :. jwtCfg :. EmptyContext
--- Here is the actual change
api = Proxy :: Proxy (API '[Cookie])
run 7249 $ serveWithContext api cfg (server defaultCookieSettings jwtCfg)
-- Here is the login handler
checkCreds :: CookieSettings
-> JWTSettings
-> Login
-> Handler (Headers '[ Header "Set-Cookie" SetCookie
, Header "Set-Cookie" SetCookie]
NoContent)
checkCreds cookieSettings jwtSettings (Login "Ali Baba" "Open Sesame") = do
-- Usually you would ask a database for the user info. This is just a
-- regular servant handler, so you can follow your normal database access
-- patterns (including using 'enter').
let usr = User "Ali Baba" "ali@email.com"
mApplyCookies <- liftIO $ acceptLogin cookieSettings jwtSettings usr
case mApplyCookies of
Nothing -> throwError err401
Just applyCookies -> return $ applyCookies NoContent
checkCreds _ _ _ = throwError err401
~~~
### XSRF and the frontend
XSRF protection works by requiring that there be a header of the same value as
a distinguished cookie that is set by the server on each request. What the
cookie and header name are can be configured (see `xsrfCookieName` and
`xsrfHeaderName` in `CookieSettings`), but by default they are "XSRF-TOKEN" and
"X-XSRF-TOKEN". This means that, if your client is a browser and you're using
cookies, Javascript on the client must set the header of each request by
reading the cookie. For jQuery, and with the default values, that might be:
~~~ javascript
var token = (function() {
r = document.cookie.match(new RegExp('XSRF-TOKEN=([^;]+)'))
if (r) return r[1];
})();
$.ajaxPrefilter(function(opts, origOpts, xhr) {
xhr.setRequestHeader('X-XSRF-TOKEN', token);
}
~~~
I *believe* nothing at all needs to be done if you're using Angular's `$http`
directive, but I haven't tested this.
XSRF protection can be disabled just for `GET` requests by setting
`xsrfExcludeGet = False`. You might want this if you're relying on the browser
to navigate between pages that require cookie authentication.
XSRF protection can be completely disabled by setting `cookieXsrfSetting =
Nothing` in `CookieSettings`. This is not recommended! If your cookie
authenticated web application runs any javascript, it's recommended to send the
XSRF header. However, if your web application runs no javascript, disabling
XSRF entirely may be required.
# Note on this README
This README is a literate haskell file. Here is 'main', allowing you to pick
between the examples above.
~~~ haskell
main :: IO ()
main = do
args <- getArgs
let usage = "Usage: readme (JWT|Cookie)"
case args of
["JWT"] -> mainWithJWT
["Cookie"] -> mainWithCookies
e -> putStrLn $ "Arguments: \"" ++ unwords e ++ "\" not understood\n" ++ usage
~~~

View file

@ -0,0 +1 @@
README.lhs

View file

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

View file

@ -0,0 +1,134 @@
cabal-version: 2.2
name: servant-auth-server
version: 0.4.7.0
synopsis: servant-server/servant-auth compatibility
description: This package provides the required instances for using the @Auth@ combinator
in your 'servant' server.
.
Both cookie- and token- (REST API) based authentication is provided.
.
For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
category: Web, Servant, Authentication
homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
bug-reports: https://github.com/haskell-servant/servant/issues
author: Julian K. Arni
maintainer: jkarni@gmail.com
copyright: (c) Julian K. Arni
license: BSD-3-Clause
license-file: LICENSE
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
build-type: Simple
extra-source-files:
CHANGELOG.md
source-repository head
type: git
location: https://github.com/haskell-servant/servant
library
hs-source-dirs:
src
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
ghc-options: -Wall
build-depends:
base >= 4.10 && < 4.18
, aeson >= 1.0.0.1 && < 3
, base64-bytestring >= 1.0.0.1 && < 2
, blaze-builder >= 0.4.1.0 && < 0.5
, bytestring >= 0.10.6.0 && < 0.12
, case-insensitive >= 1.2.0.11 && < 1.3
, cookie >= 0.4.4 && < 0.5
, data-default-class >= 0.1.2.0 && < 0.2
, entropy >= 0.4.1.3 && < 0.5
, http-types >= 0.12.2 && < 0.13
, jose >= 0.10 && < 0.11
, lens >= 4.16.1 && < 5.3
, memory >= 0.14.16 && < 0.19
, monad-time >= 0.3.1.0 && < 0.4
, mtl ^>= 2.2.2 || ^>= 2.3.1
, servant >= 0.13 && < 0.20
, servant-auth == 0.4.*
, servant-server >= 0.13 && < 0.20
, tagged >= 0.8.4 && < 0.9
, text >= 1.2.3.0 && < 2.1
, time >= 1.5.0.1 && < 1.13
, unordered-containers >= 0.2.9.0 && < 0.3
, wai >= 3.2.1.2 && < 3.3
if impl(ghc >= 9)
build-depends:
-- base64-bytestring 1.2.1.0 contains important fix for GHC-9, lower versions
-- produce wrong results, thus corrupring JWT via jose package.
-- See: https://github.com/haskell/base64-bytestring/pull/46
base64-bytestring >= 1.2.1.0
exposed-modules:
Servant.Auth.Server
Servant.Auth.Server.Internal
Servant.Auth.Server.Internal.AddSetCookie
Servant.Auth.Server.Internal.BasicAuth
Servant.Auth.Server.Internal.Class
Servant.Auth.Server.Internal.ConfigTypes
Servant.Auth.Server.Internal.Cookie
Servant.Auth.Server.Internal.FormLogin
Servant.Auth.Server.Internal.JWT
Servant.Auth.Server.Internal.ThrowAll
Servant.Auth.Server.Internal.Types
Servant.Auth.Server.SetCookieOrphan
default-language: Haskell2010
test-suite readme
type: exitcode-stdio-1.0
main-is: README.lhs
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
ghc-options: -Wall -pgmL markdown-unlit
build-tool-depends: markdown-unlit:markdown-unlit
build-depends:
base
, servant-auth
, servant-auth-server
, servant-server
, aeson
, mtl
, warp
default-language: Haskell2010
if impl(ghcjs)
buildable: False
test-suite spec
type: exitcode-stdio-1.0
main-is: Spec.hs
hs-source-dirs:
test
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
ghc-options: -Wall
build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
-- dependencies with bounds inherited from the library stanza
build-depends:
base
, aeson
, bytestring
, case-insensitive
, jose
, lens
, mtl
, time
, http-types
, wai
, servant
, servant-server
, transformers
-- test dependencies
build-depends:
servant-auth-server
, hspec >= 2.5.5 && < 2.10
, QuickCheck >= 2.11.3 && < 2.15
, http-client >= 0.5.13.1 && < 0.8
, lens-aeson >= 1.0.2 && < 1.3
, warp >= 3.2.25 && < 3.4
, wreq >= 0.5.2.1 && < 0.6
other-modules:
Servant.Auth.ServerSpec
default-language: Haskell2010

View file

@ -0,0 +1,180 @@
module Servant.Auth.Server
(
-- | This package provides implementations for some common authentication
-- methods. Authentication yields a trustworthy (because generated by the
-- server) value of an some arbitrary type:
--
-- > type MyApi = Protected
-- >
-- > type Protected = Auth '[JWT, Cookie] User :> Get '[JSON] UserAccountDetails
-- >
-- > server :: Server Protected
-- > server (Authenticated usr) = ... -- here we know the client really is
-- > -- who she claims to be
-- > server _ = throwAll err401
--
-- Additional configuration happens via 'Context'.
--
-- == Example for Custom Handler
-- To use a custom 'Servant.Server.Handler' it is necessary to use
-- 'Servant.Server.hoistServerWithContext' instead of
-- 'Servant.Server.hoistServer' and specify the 'Context'.
--
-- Below is an example of passing 'CookieSettings' and 'JWTSettings' in the
-- 'Context' to create a specialized function equivalent to
-- 'Servant.Server.hoistServer' for an API that includes cookie
-- authentication.
--
-- > hoistServerWithAuth
-- > :: HasServer api '[CookieSettings, JWTSettings]
-- > => Proxy api
-- > -> (forall x. m x -> n x)
-- > -> ServerT api m
-- > -> ServerT api n
-- > hoistServerWithAuth api =
-- > hoistServerWithContext api (Proxy :: Proxy '[CookieSettings, JWTSettings])
----------------------------------------------------------------------------
-- * Auth
-- | Basic types
Auth
, AuthResult(..)
, AuthCheck(..)
----------------------------------------------------------------------------
-- * JWT
-- | JSON Web Tokens (JWT) are a compact and secure way of transferring
-- information between parties. In this library, they are signed by the
-- server (or by some other party posessing the relevant key), and used to
-- indicate the bearer's identity or authorization.
--
-- Arbitrary information can be encoded - just declare instances for the
-- 'FromJWT' and 'ToJWT' classes. Don't go overboard though - be aware that
-- usually you'll be trasmitting this information on each request (and
-- response!).
--
-- Note that, while the tokens are signed, they are not encrypted. Do not put
-- any information you do not wish the client to know in them!
-- ** Combinator
-- | Re-exported from 'servant-auth'
, JWT
-- ** Classes
, FromJWT(..)
, ToJWT(..)
-- ** Related types
, IsMatch(..)
-- ** Settings
, JWTSettings(..)
, defaultJWTSettings
-- ** Create check
, jwtAuthCheck
----------------------------------------------------------------------------
-- * Cookie
-- | Cookies are also a method of identifying and authenticating a user. They
-- are particular common when the client is a browser
-- ** Combinator
-- | Re-exported from 'servant-auth'
, Cookie
-- ** Settings
, CookieSettings(..)
, XsrfCookieSettings(..)
, defaultCookieSettings
, defaultXsrfCookieSettings
, makeSessionCookie
, makeSessionCookieBS
, makeXsrfCookie
, makeCsrfCookie
, makeCookie
, makeCookieBS
, acceptLogin
, clearSession
-- ** Related types
, IsSecure(..)
, SameSite(..)
, AreAuths
----------------------------------------------------------------------------
-- * BasicAuth
-- ** Combinator
-- | Re-exported from 'servant-auth'
, BasicAuth
-- ** Classes
, FromBasicAuthData(..)
-- ** Settings
, BasicAuthCfg
-- ** Related types
, BasicAuthData(..)
, IsPasswordCorrect(..)
-- ** Authentication request
, wwwAuthenticatedErr
----------------------------------------------------------------------------
-- * Utilies
, ThrowAll(throwAll)
, generateKey
, generateSecret
, fromSecret
, writeKey
, readKey
, makeJWT
, verifyJWT
-- ** Re-exports
, Default(def)
, SetCookie
) where
import Prelude hiding (readFile, writeFile)
import Data.ByteString (ByteString, writeFile, readFile)
import Data.Default.Class (Default (def))
import Servant.Auth
import Servant.Auth.JWT
import Servant.Auth.Server.Internal ()
import Servant.Auth.Server.Internal.BasicAuth
import Servant.Auth.Server.Internal.Class
import Servant.Auth.Server.Internal.ConfigTypes
import Servant.Auth.Server.Internal.Cookie
import Servant.Auth.Server.Internal.JWT
import Servant.Auth.Server.Internal.ThrowAll
import Servant.Auth.Server.Internal.Types
import Crypto.JOSE as Jose
import Servant (BasicAuthData (..))
import Web.Cookie (SetCookie)
-- | Generate a key suitable for use with 'defaultConfig'.
generateKey :: IO Jose.JWK
generateKey = Jose.genJWK $ Jose.OctGenParam 256
-- | Generate a bytestring suitable for use with 'fromSecret'.
generateSecret :: MonadRandom m => m ByteString
generateSecret = Jose.getRandomBytes 256
-- | Restores a key from a bytestring.
fromSecret :: ByteString -> Jose.JWK
fromSecret = Jose.fromOctets
-- | Writes a secret to a file. Can for instance be used from the REPL
-- to persist a key to a file, which can then be included with the
-- application. Restore the key using 'readKey'.
writeKey :: FilePath -> IO ()
writeKey fp = writeFile fp =<< generateSecret
-- | Reads a key from a file.
readKey :: FilePath -> IO Jose.JWK
readKey fp = fromSecret <$> readFile fp

View file

@ -0,0 +1,70 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.Auth.Server.Internal where
import Control.Monad.Trans (liftIO)
import Servant ((:>), Handler, HasServer (..),
Proxy (..),
HasContextEntry(getContextEntry))
import Servant.Auth
import Servant.Auth.JWT (ToJWT)
import Servant.Auth.Server.Internal.AddSetCookie
import Servant.Auth.Server.Internal.Class
import Servant.Auth.Server.Internal.Cookie
import Servant.Auth.Server.Internal.ConfigTypes
import Servant.Auth.Server.Internal.JWT
import Servant.Auth.Server.Internal.Types
import Servant.Server.Internal (DelayedIO, addAuthCheck, withRequest)
instance ( n ~ 'S ('S 'Z)
, HasServer (AddSetCookiesApi n api) ctxs, AreAuths auths ctxs v
, HasServer api ctxs -- this constraint is needed to implement hoistServer
, AddSetCookies n (ServerT api Handler) (ServerT (AddSetCookiesApi n api) Handler)
, ToJWT v
, HasContextEntry ctxs CookieSettings
, HasContextEntry ctxs JWTSettings
) => HasServer (Auth auths v :> api) ctxs where
type ServerT (Auth auths v :> api) m = AuthResult v -> ServerT api m
#if MIN_VERSION_servant_server(0,12,0)
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
#endif
route _ context subserver =
route (Proxy :: Proxy (AddSetCookiesApi n api))
context
(fmap go subserver `addAuthCheck` authCheck)
where
authCheck :: DelayedIO (AuthResult v, SetCookieList ('S ('S 'Z)))
authCheck = withRequest $ \req -> liftIO $ do
authResult <- runAuthCheck (runAuths (Proxy :: Proxy auths) context) req
cookies <- makeCookies authResult
return (authResult, cookies)
jwtSettings :: JWTSettings
jwtSettings = getContextEntry context
cookieSettings :: CookieSettings
cookieSettings = getContextEntry context
makeCookies :: AuthResult v -> IO (SetCookieList ('S ('S 'Z)))
makeCookies authResult = do
xsrf <- makeXsrfCookie cookieSettings
fmap (Just xsrf `SetCookieCons`) $
case authResult of
(Authenticated v) -> do
ejwt <- makeSessionCookie cookieSettings jwtSettings v
case ejwt of
Nothing -> return $ Nothing `SetCookieCons` SetCookieNil
Just jwt -> return $ Just jwt `SetCookieCons` SetCookieNil
_ -> return $ Nothing `SetCookieCons` SetCookieNil
go :: (AuthResult v -> ServerT api Handler)
-> (AuthResult v, SetCookieList n)
-> ServerT (AddSetCookiesApi n api) Handler
go fn (authResult, cookies) = addSetCookies cookies $ fn authResult

View file

@ -0,0 +1,106 @@
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE CPP #-}
module Servant.Auth.Server.Internal.AddSetCookie where
import Blaze.ByteString.Builder (toByteString)
import qualified Data.ByteString as BS
import Data.Tagged (Tagged (..))
import qualified Network.HTTP.Types as HTTP
import Network.Wai (mapResponseHeaders)
import Servant
import Servant.API.Generic
import Servant.Server.Generic
import Web.Cookie
-- What are we doing here? Well, the idea is to add headers to the response,
-- but the headers come from the authentication check. In order to do that, we
-- tweak a little the general theme of recursing down the API tree; this time,
-- we recurse down a variation of it that adds headers to all the endpoints.
-- This involves the usual type-level checks.
--
-- TODO: If the endpoints already have headers, this will not work as is.
data Nat = Z | S Nat
type family AddSetCookiesApi (n :: Nat) a where
AddSetCookiesApi ('S 'Z) a = AddSetCookieApi a
AddSetCookiesApi ('S n) a = AddSetCookiesApi n (AddSetCookieApi a)
type family AddSetCookieApiVerb a where
AddSetCookieApiVerb (Headers ls a) = Headers (Header "Set-Cookie" SetCookie ': ls) a
AddSetCookieApiVerb a = Headers '[Header "Set-Cookie" SetCookie] a
type family AddSetCookieApi a :: *
type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b
type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b
type instance AddSetCookieApi (NamedRoutes api) = AddSetCookieApi (ToServantApi api)
type instance AddSetCookieApi (Verb method stat ctyps a)
= Verb method stat ctyps (AddSetCookieApiVerb a)
type instance AddSetCookieApi Raw = Raw
#if MIN_VERSION_servant_server(0,15,0)
type instance AddSetCookieApi (Stream method stat framing ctyps a)
= Stream method stat framing ctyps (AddSetCookieApiVerb a)
#endif
type instance AddSetCookieApi (Headers hs a) = AddSetCookieApiVerb (Headers hs a)
data SetCookieList (n :: Nat) :: * where
SetCookieNil :: SetCookieList 'Z
SetCookieCons :: Maybe SetCookie -> SetCookieList n -> SetCookieList ('S n)
class AddSetCookies (n :: Nat) orig new where
addSetCookies :: SetCookieList n -> orig -> new
instance {-# OVERLAPS #-} AddSetCookies ('S n) oldb newb
=> AddSetCookies ('S n) (a -> oldb) (a -> newb) where
addSetCookies cookies oldfn = addSetCookies cookies . oldfn
instance AddSetCookies 'Z orig orig where
addSetCookies _ = id
instance {-# OVERLAPPABLE #-}
( Functor m
, AddSetCookies n (m old) (m cookied)
, AddHeader "Set-Cookie" SetCookie cookied new
) => AddSetCookies ('S n) (m old) (m new) where
addSetCookies (mCookie `SetCookieCons` rest) oldVal =
case mCookie of
Nothing -> noHeader <$> addSetCookies rest oldVal
Just cookie -> addHeader cookie <$> addSetCookies rest oldVal
instance {-# OVERLAPS #-}
(AddSetCookies ('S n) a a', AddSetCookies ('S n) b b')
=> AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where
addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b
instance {-# OVERLAPS #-}
( AddSetCookies ('S n) (ServerT (ToServantApi api) m) cookiedApi
, Generic (api (AsServerT m))
, GServantProduct (Rep (api (AsServerT m)))
, ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m
)
=> AddSetCookies ('S n) (api (AsServerT m)) cookiedApi where
addSetCookies cookies = addSetCookies cookies . toServant
-- | for @servant <0.11@
instance
AddSetCookies ('S n) Application Application where
addSetCookies cookies r request respond
= r request $ respond . mapResponseHeaders (++ mkHeaders cookies)
-- | for @servant >=0.11@
instance
AddSetCookies ('S n) (Tagged m Application) (Tagged m Application) where
addSetCookies cookies r = Tagged $ \request respond ->
unTagged r request $ respond . mapResponseHeaders (++ mkHeaders cookies)
mkHeaders :: SetCookieList x -> [HTTP.Header]
mkHeaders x = ("Set-Cookie",) <$> mkCookies x
where
mkCookies :: forall y. SetCookieList y -> [BS.ByteString]
mkCookies SetCookieNil = []
mkCookies (SetCookieCons Nothing rest) = mkCookies rest
mkCookies (SetCookieCons (Just y) rest)
= toByteString (renderSetCookie y) : mkCookies rest

View file

@ -0,0 +1,59 @@
{-# LANGUAGE CPP #-}
module Servant.Auth.Server.Internal.BasicAuth where
#if !MIN_VERSION_servant_server(0,16,0)
#define ServerError ServantErr
#endif
import qualified Data.ByteString as BS
import Servant (BasicAuthData (..),
ServerError (..), err401)
import Servant.Server.Internal.BasicAuth (decodeBAHdr,
mkBAChallengerHdr)
import Servant.Auth.Server.Internal.Types
-- | A 'ServerError' that asks the client to authenticate via Basic
-- Authentication, should be invoked by an application whenever
-- appropriate. The argument is the realm.
wwwAuthenticatedErr :: BS.ByteString -> ServerError
wwwAuthenticatedErr realm = err401 { errHeaders = [mkBAChallengerHdr realm] }
-- | A type holding the configuration for Basic Authentication.
-- It is defined as a type family with no arguments, so that
-- it can be instantiated to whatever type you need to
-- authenticate your users (use @type instance BasicAuthCfg = ...@).
--
-- Note that the instantiation is application-wide,
-- i.e. there can be only one instance.
-- As a consequence, it should not be instantiated in a library.
--
-- Basic Authentication expects an element of type 'BasicAuthCfg'
-- to be in the 'Context'; that element is then passed automatically
-- to the instance of 'FromBasicAuthData' together with the
-- authentication data obtained from the client.
--
-- If you do not need a configuration for Basic Authentication,
-- you can use just @BasicAuthCfg = ()@, and recall to also
-- add @()@ to the 'Context'.
-- A basic but more interesting example is to take as 'BasicAuthCfg'
-- a list of authorised username/password pairs:
--
-- > deriving instance Eq BasicAuthData
-- > type instance BasicAuthCfg = [BasicAuthData]
-- > instance FromBasicAuthData User where
-- > fromBasicAuthData authData authCfg =
-- > if elem authData authCfg then ...
type family BasicAuthCfg
class FromBasicAuthData a where
-- | Whether the username exists and the password is correct.
-- Note that, rather than passing a 'Pass' to the function, we pass a
-- function that checks an 'EncryptedPass'. This is to make sure you don't
-- accidentally do something untoward with the password, like store it.
fromBasicAuthData :: BasicAuthData -> BasicAuthCfg -> IO (AuthResult a)
basicAuthCheck :: FromBasicAuthData usr => BasicAuthCfg -> AuthCheck usr
basicAuthCheck cfg = AuthCheck $ \req -> case decodeBAHdr req of
Nothing -> return Indefinite
Just baData -> fromBasicAuthData baData cfg

View file

@ -0,0 +1,72 @@
{-# LANGUAGE UndecidableInstances #-}
module Servant.Auth.Server.Internal.Class where
import Servant.Auth
import Data.Monoid
import Servant hiding (BasicAuth)
import Servant.Auth.JWT
import Servant.Auth.Server.Internal.Types
import Servant.Auth.Server.Internal.ConfigTypes
import Servant.Auth.Server.Internal.BasicAuth
import Servant.Auth.Server.Internal.Cookie
import Servant.Auth.Server.Internal.JWT (jwtAuthCheck)
-- | @IsAuth a ctx v@ indicates that @a@ is an auth type that expects all
-- elements of @ctx@ to be the in the Context and whose authentication check
-- returns an @AuthCheck v@.
class IsAuth a v where
type family AuthArgs a :: [*]
runAuth :: proxy a -> proxy v -> Unapp (AuthArgs a) (AuthCheck v)
instance FromJWT usr => IsAuth Cookie usr where
type AuthArgs Cookie = '[CookieSettings, JWTSettings]
runAuth _ _ = cookieAuthCheck
instance FromJWT usr => IsAuth JWT usr where
type AuthArgs JWT = '[JWTSettings]
runAuth _ _ = jwtAuthCheck
instance FromBasicAuthData usr => IsAuth BasicAuth usr where
type AuthArgs BasicAuth = '[BasicAuthCfg]
runAuth _ _ = basicAuthCheck
-- * Helper
class AreAuths (as :: [*]) (ctxs :: [*]) v where
runAuths :: proxy as -> Context ctxs -> AuthCheck v
instance AreAuths '[] ctxs v where
runAuths _ _ = mempty
instance ( AuthCheck v ~ App (AuthArgs a) (Unapp (AuthArgs a) (AuthCheck v))
, IsAuth a v
, AreAuths as ctxs v
, AppCtx ctxs (AuthArgs a) (Unapp (AuthArgs a) (AuthCheck v))
) => AreAuths (a ': as) ctxs v where
runAuths _ ctxs = go <> runAuths (Proxy :: Proxy as) ctxs
where
go = appCtx (Proxy :: Proxy (AuthArgs a))
ctxs
(runAuth (Proxy :: Proxy a) (Proxy :: Proxy v))
type family Unapp ls res where
Unapp '[] res = res
Unapp (arg1 ': rest) res = arg1 -> Unapp rest res
type family App ls res where
App '[] res = res
App (arg1 ': rest) (arg1 -> res) = App rest res
-- | @AppCtx@ applies the function @res@ to the arguments in @ls@ by taking the
-- values from the Context provided.
class AppCtx ctx ls res where
appCtx :: proxy ls -> Context ctx -> res -> App ls res
instance ( HasContextEntry ctxs ctx
, AppCtx ctxs rest res
) => AppCtx ctxs (ctx ': rest) (ctx -> res) where
appCtx _ ctx fn = appCtx (Proxy :: Proxy rest) ctx $ fn $ getContextEntry ctx
instance AppCtx ctx '[] res where
appCtx _ _ r = r

View file

@ -0,0 +1,127 @@
module Servant.Auth.Server.Internal.ConfigTypes
( module Servant.Auth.Server.Internal.ConfigTypes
, Servant.API.IsSecure(..)
) where
import Crypto.JOSE as Jose
import Crypto.JWT as Jose
import qualified Data.ByteString as BS
import Data.Default.Class
import Data.Time
import GHC.Generics (Generic)
import Servant.API (IsSecure(..))
data IsMatch = Matches | DoesNotMatch
deriving (Eq, Show, Read, Generic, Ord)
data IsPasswordCorrect = PasswordCorrect | PasswordIncorrect
deriving (Eq, Show, Read, Generic, Ord)
-- The @SameSite@ attribute of cookies determines whether cookies will be sent
-- on cross-origin requests.
--
-- See <https://tools.ietf.org/html/draft-west-first-party-cookies-07 this document>
-- for more information.
data SameSite = AnySite | SameSiteStrict | SameSiteLax
deriving (Eq, Show, Read, Generic, Ord)
-- | @JWTSettings@ are used to generate cookies, and to verify JWTs.
data JWTSettings = JWTSettings
{
-- | Key used to sign JWT.
signingKey :: Jose.JWK
-- | Algorithm used to sign JWT.
, jwtAlg :: Maybe Jose.Alg
-- | Keys used to validate JWT.
, validationKeys :: IO Jose.JWKSet
-- | An @aud@ predicate. The @aud@ is a string or URI that identifies the
-- intended recipient of the JWT.
, audienceMatches :: Jose.StringOrURI -> IsMatch
} deriving (Generic)
-- | A @JWTSettings@ where the audience always matches.
defaultJWTSettings :: Jose.JWK -> JWTSettings
defaultJWTSettings k = JWTSettings
{ signingKey = k
, jwtAlg = Nothing
, validationKeys = pure $ Jose.JWKSet [k]
, audienceMatches = const Matches }
-- | The policies to use when generating cookies.
--
-- If *both* 'cookieMaxAge' and 'cookieExpires' are @Nothing@, browsers will
-- treat the cookie as a *session cookie*. These will be deleted when the
-- browser is closed.
--
-- Note that having the setting @Secure@ may cause testing failures if you are
-- not testing over HTTPS.
data CookieSettings = CookieSettings
{
-- | 'Secure' means browsers will only send cookies over HTTPS. Default:
-- @Secure@.
cookieIsSecure :: !IsSecure
-- | How long from now until the cookie expires. Default: @Nothing@.
, cookieMaxAge :: !(Maybe DiffTime)
-- | At what time the cookie expires. Default: @Nothing@.
, cookieExpires :: !(Maybe UTCTime)
-- | The URL path and sub-paths for which this cookie is used. Default: @Just "/"@.
, cookiePath :: !(Maybe BS.ByteString)
-- | Domain name, if set cookie also allows subdomains. Default: @Nothing@.
, cookieDomain :: !(Maybe BS.ByteString)
-- | 'SameSite' settings. Default: @SameSiteLax@.
, cookieSameSite :: !SameSite
-- | What name to use for the cookie used for the session.
, sessionCookieName :: !BS.ByteString
-- | The optional settings to use for XSRF protection. Default: @Just def@.
, cookieXsrfSetting :: !(Maybe XsrfCookieSettings)
} deriving (Eq, Show, Generic)
instance Default CookieSettings where
def = defaultCookieSettings
defaultCookieSettings :: CookieSettings
defaultCookieSettings = CookieSettings
{ cookieIsSecure = Secure
, cookieMaxAge = Nothing
, cookieExpires = Nothing
, cookiePath = Just "/"
, cookieDomain = Nothing
, cookieSameSite = SameSiteLax
, sessionCookieName = "JWT-Cookie"
, cookieXsrfSetting = Just def
}
-- | The policies to use when generating and verifying XSRF cookies
data XsrfCookieSettings = XsrfCookieSettings
{
-- | What name to use for the cookie used for XSRF protection.
xsrfCookieName :: !BS.ByteString
-- | What path to use for the cookie used for XSRF protection. Default @Just "/"@.
, xsrfCookiePath :: !(Maybe BS.ByteString)
-- | What name to use for the header used for XSRF protection.
, xsrfHeaderName :: !BS.ByteString
-- | Exclude GET request method from XSRF protection.
, xsrfExcludeGet :: !Bool
} deriving (Eq, Show, Generic)
instance Default XsrfCookieSettings where
def = defaultXsrfCookieSettings
defaultXsrfCookieSettings :: XsrfCookieSettings
defaultXsrfCookieSettings = XsrfCookieSettings
{ xsrfCookieName = "XSRF-TOKEN"
, xsrfCookiePath = Just "/"
, xsrfHeaderName = "X-XSRF-TOKEN"
, xsrfExcludeGet = False
}
------------------------------------------------------------------------------
-- Internal {{{
jwtSettingsToJwtValidationSettings :: JWTSettings -> Jose.JWTValidationSettings
jwtSettingsToJwtValidationSettings s
= defaultJWTValidationSettings (toBool <$> audienceMatches s)
where
toBool Matches = True
toBool DoesNotMatch = False
-- }}}

View file

@ -0,0 +1,183 @@
{-# LANGUAGE CPP #-}
module Servant.Auth.Server.Internal.Cookie where
import Blaze.ByteString.Builder (toByteString)
import Control.Monad (MonadPlus(..), guard)
import Control.Monad.Except
import Control.Monad.Reader
import qualified Crypto.JOSE as Jose
import qualified Crypto.JWT as Jose
import Data.ByteArray (constEq)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as BS64
import qualified Data.ByteString.Lazy as BSL
import Data.CaseInsensitive (mk)
import Data.Maybe (fromMaybe)
import Data.Time.Calendar (Day(..))
import Data.Time.Clock (UTCTime(..), secondsToDiffTime)
import Network.HTTP.Types (methodGet)
import Network.HTTP.Types.Header(hCookie)
import Network.Wai (Request, requestHeaders, requestMethod)
import Servant (AddHeader, addHeader)
import System.Entropy (getEntropy)
import Web.Cookie
import Servant.Auth.JWT (FromJWT (decodeJWT), ToJWT)
import Servant.Auth.Server.Internal.ConfigTypes
import Servant.Auth.Server.Internal.JWT (makeJWT, verifyJWT)
import Servant.Auth.Server.Internal.Types
cookieAuthCheck :: FromJWT usr => CookieSettings -> JWTSettings -> AuthCheck usr
cookieAuthCheck ccfg jwtSettings = do
req <- ask
jwtCookie <- maybe mempty return $ do
cookies' <- lookup hCookie $ requestHeaders req
let cookies = parseCookies cookies'
-- Apply the XSRF check if enabled.
guard $ fromMaybe True $ do
xsrfCookieCfg <- xsrfCheckRequired ccfg req
return $ xsrfCookieAuthCheck xsrfCookieCfg req cookies
-- session cookie *must* be HttpOnly and Secure
lookup (sessionCookieName ccfg) cookies
verifiedJWT <- liftIO $ verifyJWT jwtSettings jwtCookie
case verifiedJWT of
Nothing -> mzero
Just v -> return v
xsrfCheckRequired :: CookieSettings -> Request -> Maybe XsrfCookieSettings
xsrfCheckRequired cookieSettings req = do
xsrfCookieCfg <- cookieXsrfSetting cookieSettings
let disableForGetReq = xsrfExcludeGet xsrfCookieCfg && requestMethod req == methodGet
guard $ not disableForGetReq
return xsrfCookieCfg
xsrfCookieAuthCheck :: XsrfCookieSettings -> Request -> [(BS.ByteString, BS.ByteString)] -> Bool
xsrfCookieAuthCheck xsrfCookieCfg req cookies = fromMaybe False $ do
xsrfCookie <- lookup (xsrfCookieName xsrfCookieCfg) cookies
xsrfHeader <- lookup (mk $ xsrfHeaderName xsrfCookieCfg) $ requestHeaders req
return $ xsrfCookie `constEq` xsrfHeader
-- | Makes a cookie to be used for XSRF.
makeXsrfCookie :: CookieSettings -> IO SetCookie
makeXsrfCookie cookieSettings = case cookieXsrfSetting cookieSettings of
Just xsrfCookieSettings -> makeRealCookie xsrfCookieSettings
Nothing -> return $ noXsrfTokenCookie cookieSettings
where
makeRealCookie xsrfCookieSettings = do
xsrfValue <- BS64.encode <$> getEntropy 32
return
$ applyXsrfCookieSettings xsrfCookieSettings
$ applyCookieSettings cookieSettings
$ def{ setCookieValue = xsrfValue }
-- | Alias for 'makeXsrfCookie'.
makeCsrfCookie :: CookieSettings -> IO SetCookie
makeCsrfCookie = makeXsrfCookie
{-# DEPRECATED makeCsrfCookie "Use makeXsrfCookie instead" #-}
-- | Makes a cookie with session information.
makeSessionCookie :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe SetCookie)
makeSessionCookie cookieSettings jwtSettings v = do
ejwt <- makeJWT v jwtSettings (cookieExpires cookieSettings)
case ejwt of
Left _ -> return Nothing
Right jwt -> return
$ Just
$ applySessionCookieSettings cookieSettings
$ applyCookieSettings cookieSettings
$ def{ setCookieValue = BSL.toStrict jwt }
noXsrfTokenCookie :: CookieSettings -> SetCookie
noXsrfTokenCookie cookieSettings =
applyCookieSettings cookieSettings $ def{ setCookieName = "NO-XSRF-TOKEN", setCookieValue = "" }
applyCookieSettings :: CookieSettings -> SetCookie -> SetCookie
applyCookieSettings cookieSettings setCookie = setCookie
{ setCookieMaxAge = cookieMaxAge cookieSettings
, setCookieExpires = cookieExpires cookieSettings
, setCookiePath = cookiePath cookieSettings
, setCookieDomain = cookieDomain cookieSettings
, setCookieSecure = case cookieIsSecure cookieSettings of
Secure -> True
NotSecure -> False
}
applyXsrfCookieSettings :: XsrfCookieSettings -> SetCookie -> SetCookie
applyXsrfCookieSettings xsrfCookieSettings setCookie = setCookie
{ setCookieName = xsrfCookieName xsrfCookieSettings
, setCookiePath = xsrfCookiePath xsrfCookieSettings
, setCookieHttpOnly = False
}
applySessionCookieSettings :: CookieSettings -> SetCookie -> SetCookie
applySessionCookieSettings cookieSettings setCookie = setCookie
{ setCookieName = sessionCookieName cookieSettings
, setCookieSameSite = case cookieSameSite cookieSettings of
AnySite -> anySite
SameSiteStrict -> Just sameSiteStrict
SameSiteLax -> Just sameSiteLax
, setCookieHttpOnly = True
}
where
#if MIN_VERSION_cookie(0,4,5)
anySite = Just sameSiteNone
#else
anySite = Nothing
#endif
-- | For a JWT-serializable session, returns a function that decorates a
-- provided response object with XSRF and session cookies. This should be used
-- when a user successfully authenticates with credentials.
acceptLogin :: ( ToJWT session
, AddHeader "Set-Cookie" SetCookie response withOneCookie
, AddHeader "Set-Cookie" SetCookie withOneCookie withTwoCookies )
=> CookieSettings
-> JWTSettings
-> session
-> IO (Maybe (response -> withTwoCookies))
acceptLogin cookieSettings jwtSettings session = do
mSessionCookie <- makeSessionCookie cookieSettings jwtSettings session
case mSessionCookie of
Nothing -> pure Nothing
Just sessionCookie -> do
xsrfCookie <- makeXsrfCookie cookieSettings
return $ Just $ addHeader sessionCookie . addHeader xsrfCookie
-- | Arbitrary cookie expiry time set back in history after unix time 0
expireTime :: UTCTime
expireTime = UTCTime (ModifiedJulianDay 50000) 0
-- | Adds headers to a response that clears all session cookies
-- | using max-age and expires cookie attributes.
clearSession :: ( AddHeader "Set-Cookie" SetCookie response withOneCookie
, AddHeader "Set-Cookie" SetCookie withOneCookie withTwoCookies )
=> CookieSettings
-> response
-> withTwoCookies
clearSession cookieSettings = addHeader clearedSessionCookie . addHeader clearedXsrfCookie
where
-- According to RFC6265 max-age takes precedence, but IE/Edge ignore it completely so we set both
cookieSettingsExpires = cookieSettings
{ cookieExpires = Just expireTime
, cookieMaxAge = Just (secondsToDiffTime 0)
}
clearedSessionCookie = applySessionCookieSettings cookieSettingsExpires $ applyCookieSettings cookieSettingsExpires def
clearedXsrfCookie = case cookieXsrfSetting cookieSettings of
Just xsrfCookieSettings -> applyXsrfCookieSettings xsrfCookieSettings $ applyCookieSettings cookieSettingsExpires def
Nothing -> noXsrfTokenCookie cookieSettingsExpires
makeSessionCookieBS :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe BS.ByteString)
makeSessionCookieBS a b c = fmap (toByteString . renderSetCookie) <$> makeSessionCookie a b c
-- | Alias for 'makeSessionCookie'.
makeCookie :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe SetCookie)
makeCookie = makeSessionCookie
{-# DEPRECATED makeCookie "Use makeSessionCookie instead" #-}
-- | Alias for 'makeSessionCookieBS'.
makeCookieBS :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe BS.ByteString)
makeCookieBS = makeSessionCookieBS
{-# DEPRECATED makeCookieBS "Use makeSessionCookieBS instead" #-}

View file

@ -0,0 +1,3 @@
module Servant.Auth.Server.Internal.FormLogin where

View file

@ -0,0 +1,68 @@
module Servant.Auth.Server.Internal.JWT where
import Control.Lens
import Control.Monad (MonadPlus(..), guard)
import Control.Monad.Reader
import qualified Crypto.JOSE as Jose
import qualified Crypto.JWT as Jose
import Data.ByteArray (constEq)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Maybe (fromMaybe)
import Data.Time (UTCTime)
import Network.Wai (requestHeaders)
import Servant.Auth.JWT (FromJWT(..), ToJWT(..))
import Servant.Auth.Server.Internal.ConfigTypes
import Servant.Auth.Server.Internal.Types
-- | A JWT @AuthCheck@. You likely won't need to use this directly unless you
-- are protecting a @Raw@ endpoint.
jwtAuthCheck :: FromJWT usr => JWTSettings -> AuthCheck usr
jwtAuthCheck jwtSettings = do
req <- ask
token <- maybe mempty return $ do
authHdr <- lookup "Authorization" $ requestHeaders req
let bearer = "Bearer "
(mbearer, rest) = BS.splitAt (BS.length bearer) authHdr
guard (mbearer `constEq` bearer)
return rest
verifiedJWT <- liftIO $ verifyJWT jwtSettings token
case verifiedJWT of
Nothing -> mzero
Just v -> return v
-- | Creates a JWT containing the specified data. The data is stored in the
-- @dat@ claim. The 'Maybe UTCTime' argument indicates the time at which the
-- token expires.
makeJWT :: ToJWT a
=> a -> JWTSettings -> Maybe UTCTime -> IO (Either Jose.Error BSL.ByteString)
makeJWT v cfg expiry = Jose.runJOSE $ do
bestAlg <- Jose.bestJWSAlg $ signingKey cfg
let alg = fromMaybe bestAlg $ jwtAlg cfg
ejwt <- Jose.signClaims (signingKey cfg)
(Jose.newJWSHeader ((), alg))
(addExp $ encodeJWT v)
return $ Jose.encodeCompact ejwt
where
addExp claims = case expiry of
Nothing -> claims
Just e -> claims & Jose.claimExp ?~ Jose.NumericDate e
verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a)
verifyJWT jwtCfg input = do
keys <- validationKeys jwtCfg
verifiedJWT <- Jose.runJOSE $ do
unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)
Jose.verifyClaims
(jwtSettingsToJwtValidationSettings jwtCfg)
keys
unverifiedJWT
return $ case verifiedJWT of
Left (_ :: Jose.JWTError) -> Nothing
Right v -> case decodeJWT v of
Left _ -> Nothing
Right v' -> Just v'

View file

@ -0,0 +1,58 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
module Servant.Auth.Server.Internal.ThrowAll where
#if !MIN_VERSION_servant_server(0,16,0)
#define ServerError ServantErr
#endif
import Control.Monad.Error.Class
import Data.Tagged (Tagged (..))
import Servant ((:<|>) (..), ServerError(..), NamedRoutes(..))
import Servant.API.Generic
import Servant.Server.Generic
import Servant.Server
import Network.HTTP.Types
import Network.Wai
import qualified Data.ByteString.Char8 as BS
class ThrowAll a where
-- | 'throwAll' is a convenience function to throw errors across an entire
-- sub-API
--
--
-- > throwAll err400 :: Handler a :<|> Handler b :<|> Handler c
-- > == throwError err400 :<|> throwError err400 :<|> err400
throwAll :: ServerError -> a
instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where
throwAll e = throwAll e :<|> throwAll e
instance
( ThrowAll (ToServant api (AsServerT m)) , GenericServant api (AsServerT m)) =>
ThrowAll (api (AsServerT m)) where
throwAll = fromServant . throwAll
-- Really this shouldn't be necessary - ((->) a) should be an instance of
-- MonadError, no?
instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where
throwAll e = const $ throwAll e
instance {-# OVERLAPPABLE #-} (MonadError ServerError m) => ThrowAll (m a) where
throwAll = throwError
-- | for @servant <0.11@
instance {-# OVERLAPPING #-} ThrowAll Application where
throwAll e _req respond
= respond $ responseLBS (mkStatus (errHTTPCode e) (BS.pack $ errReasonPhrase e))
(errHeaders e)
(errBody e)
-- | for @servant >=0.11@
instance {-# OVERLAPPING #-} MonadError ServerError m => ThrowAll (Tagged m Application) where
throwAll e = Tagged $ \_req respond ->
respond $ responseLBS (mkStatus (errHTTPCode e) (BS.pack $ errReasonPhrase e))
(errHeaders e)
(errBody e)

View file

@ -0,0 +1,113 @@
{-# LANGUAGE CPP #-}
module Servant.Auth.Server.Internal.Types where
import Control.Applicative
import Control.Monad (MonadPlus(..), ap)
import Control.Monad.Reader
import Control.Monad.Time
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup (..))
import Data.Time (getCurrentTime)
import GHC.Generics (Generic)
import Network.Wai (Request)
import qualified Control.Monad.Fail as Fail
-- | The result of an authentication attempt.
data AuthResult val
= BadPassword
| NoSuchUser
-- | Authentication succeeded.
| Authenticated val
-- | If an authentication procedure cannot be carried out - if for example it
-- expects a password and username in a header that is not present -
-- @Indefinite@ is returned. This indicates that other authentication
-- methods should be tried.
| Indefinite
deriving (Eq, Show, Read, Generic, Ord, Functor, Traversable, Foldable)
instance Semigroup (AuthResult val) where
Indefinite <> y = y
x <> _ = x
instance Monoid (AuthResult val) where
mempty = Indefinite
mappend = (<>)
instance Applicative AuthResult where
pure = return
(<*>) = ap
instance Monad AuthResult where
return = Authenticated
Authenticated v >>= f = f v
BadPassword >>= _ = BadPassword
NoSuchUser >>= _ = NoSuchUser
Indefinite >>= _ = Indefinite
instance Alternative AuthResult where
empty = mzero
(<|>) = mplus
instance MonadPlus AuthResult where
mzero = mempty
mplus = (<>)
-- | An @AuthCheck@ is the function used to decide the authentication status
-- (the 'AuthResult') of a request. Different @AuthCheck@s may be combined as a
-- Monoid or Alternative; the semantics of this is that the *first*
-- non-'Indefinite' result from left to right is used and the rest are ignored.
newtype AuthCheck val = AuthCheck
{ runAuthCheck :: Request -> IO (AuthResult val) }
deriving (Generic, Functor)
instance Semigroup (AuthCheck val) where
AuthCheck f <> AuthCheck g = AuthCheck $ \x -> do
fx <- f x
case fx of
Indefinite -> g x
r -> pure r
instance Monoid (AuthCheck val) where
mempty = AuthCheck $ const $ return mempty
mappend = (<>)
instance Applicative AuthCheck where
pure = return
(<*>) = ap
instance Monad AuthCheck where
return = AuthCheck . return . return . return
AuthCheck ac >>= f = AuthCheck $ \req -> do
aresult <- ac req
case aresult of
Authenticated usr -> runAuthCheck (f usr) req
BadPassword -> return BadPassword
NoSuchUser -> return NoSuchUser
Indefinite -> return Indefinite
#if !MIN_VERSION_base(4,13,0)
fail = Fail.fail
#endif
instance Fail.MonadFail AuthCheck where
fail _ = AuthCheck . const $ return Indefinite
instance MonadReader Request AuthCheck where
ask = AuthCheck $ \x -> return (Authenticated x)
local f (AuthCheck check) = AuthCheck $ \req -> check (f req)
instance MonadIO AuthCheck where
liftIO action = AuthCheck $ const $ Authenticated <$> action
instance MonadTime AuthCheck where
currentTime = liftIO getCurrentTime
instance Alternative AuthCheck where
empty = mzero
(<|>) = mplus
instance MonadPlus AuthCheck where
mzero = mempty
mplus = (<>)

View file

@ -0,0 +1,3 @@
module Servant.Auth.Server.SetCookieOrphan
{-# DEPRECATED "instance exists in http-api-data-0.3.9. This module will be removed in next major release." #-}
() where

Some files were not shown because too many files have changed in this diff Show more