repatriation of servant-auth in the main servant repo

2021-10-26 16:08:30 +02:00 · 2021-10-26 16:08:30 +02:00 · 119e54a800
commit 119e54a800
parent 26b01f03f2
61 changed files with 3334 additions and 0 deletions
--- a/cabal.project
+++ b/cabal.project
@ -1,5 +1,11 @@
 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/
--- a/servant-auth/README.md
+++ b/servant-auth/README.md
@ -0,0 +1 @@
+servant-auth-server/README.lhs
--- a/servant-auth/RELEASE.md
+++ b/servant-auth/RELEASE.md
@ -0,0 +1,7 @@
+- update changelog
+- bump version in cabal file 
+- stack sdist servant-auth-server
+- git commit -m "v0.4.0.0"
+- git tag -s servant-auth-server-0.4.0.0
+- git push --tags
+- stack upload servant-auth-server
--- a/servant-auth/servant-auth-client/.ghci
+++ b/servant-auth/servant-auth-client/.ghci
@ -0,0 +1 @@
+:set -isrc -itest -idoctest/ghci-wrapper/src
--- a/servant-auth/servant-auth-client/CHANGELOG.md
+++ b/servant-auth/servant-auth-client/CHANGELOG.md
@ -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
--- a/servant-auth/servant-auth-client/LICENSE
+++ b/servant-auth/servant-auth-client/LICENSE
@ -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.
+
--- a/servant-auth/servant-auth-client/Setup.hs
+++ b/servant-auth/servant-auth-client/Setup.hs
@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
--- a/servant-auth/servant-auth-client/servant-auth-client.cabal
+++ b/servant-auth/servant-auth-client/servant-auth-client.cabal
@ -0,0 +1,80 @@
+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 <http://github.com/haskell-servant/servant-auth#readme README>.
+category:       Web, Servant, Authentication
+homepage:       http://github.com/haskell-servant/servant-auth#readme
+bug-reports:    https://github.com/haskell-servant/servant-auth/issues
+author:         Julian K. Arni
+maintainer:     jkarni@gmail.com
+copyright:      (c) Julian K. Arni
+license:        BSD3
+license-file:   LICENSE
+tested-with:    GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
+build-type:     Simple
+cabal-version:  >= 1.10
+extra-source-files:
+    CHANGELOG.md
+
+source-repository head
+  type: git
+  location: https://github.com/haskell-servant/servant-auth
+
+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.16
+    , bytestring          >= 0.10.6.0 && < 0.11
+    , containers          >= 0.5.6.2  && < 0.7
+    , servant-auth        == 0.4.*
+    , servant             >= 0.13     && < 0.19
+    , servant-client-core >= 0.13     && < 0.19
+
+  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.9
+
+  -- 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.9
+    , QuickCheck           >= 2.11.3   && < 2.15
+    , aeson                >= 1.3.1.1  && < 1.6
+    , bytestring           >= 0.10.6.0 && < 0.11
+    , 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.19
+    , 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.7.0.0  && < 0.9
+  other-modules:
+      Servant.Auth.ClientSpec
+  default-language: Haskell2010
--- a/servant-auth/servant-auth-client/src/Servant/Auth/Client.hs
+++ b/servant-auth/servant-auth-client/src/Servant/Auth/Client.hs
@ -0,0 +1,3 @@
+module Servant.Auth.Client (Token(..), Bearer) where
+
+import Servant.Auth.Client.Internal (Bearer, Token(..))
--- a/servant-auth/servant-auth-client/src/Servant/Auth/Client/Internal.hs
+++ b/servant-auth/servant-auth-client/src/Servant/Auth/Client/Internal.hs
@ -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
--- a/servant-auth/servant-auth-client/test/Servant/Auth/ClientSpec.hs
+++ b/servant-auth/servant-auth-client/test/Servant/Auth/ClientSpec.hs
@ -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
+
+-- }}}
--- a/servant-auth/servant-auth-client/test/Spec.hs
+++ b/servant-auth/servant-auth-client/test/Spec.hs
@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
--- a/servant-auth/servant-auth-docs/.ghci
+++ b/servant-auth/servant-auth-docs/.ghci
@ -0,0 +1 @@
+:set -isrc -itest -idoctest/ghci-wrapper/src
--- a/servant-auth/servant-auth-docs/CHANGELOG.md
+++ b/servant-auth/servant-auth-docs/CHANGELOG.md
@ -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
--- a/servant-auth/servant-auth-docs/LICENSE
+++ b/servant-auth/servant-auth-docs/LICENSE
@ -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.
+
--- a/servant-auth/servant-auth-docs/Setup.hs
+++ b/servant-auth/servant-auth-docs/Setup.hs
@ -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
--- a/servant-auth/servant-auth-docs/servant-auth-docs.cabal
+++ b/servant-auth/servant-auth-docs/servant-auth-docs.cabal
@ -0,0 +1,84 @@
+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 <http://github.com/haskell-servant/servant-auth#readme README>.
+category:       Web, Servant, Authentication
+homepage:       http://github.com/haskell-servant/servant-auth#readme
+bug-reports:    https://github.com/haskell-servant/servant-auth/issues
+author:         Julian K. Arni
+maintainer:     jkarni@gmail.com
+copyright:      (c) Julian K. Arni
+license:        BSD3
+license-file:   LICENSE
+tested-with:    GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
+build-type:     Custom
+cabal-version:  >= 1.10
+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-auth
+
+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.16
+    , servant-docs >= 0.11.2  && < 0.12
+    , servant      >= 0.13    && < 0.19
+    , servant-auth == 0.4.*
+    , lens         >= 4.16.1  && <5.1
+  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.19,
+    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.9
+
+  -- 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.9
+    , QuickCheck        >= 2.11.3 && < 2.15
+
+  default-language: Haskell2010
--- a/servant-auth/servant-auth-docs/src/Servant/Auth/Docs.hs
+++ b/servant-auth/servant-auth-docs/src/Servant/Auth/Docs.hs
@ -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
--- a/servant-auth/servant-auth-docs/test/Spec.hs
+++ b/servant-auth/servant-auth-docs/test/Spec.hs
@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
--- a/servant-auth/servant-auth-docs/test/doctests.hs
+++ b/servant-auth/servant-auth-docs/test/doctests.hs
@ -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
--- a/servant-auth/servant-auth-server/.ghci
+++ b/servant-auth/servant-auth-server/.ghci
@ -0,0 +1 @@
+:set -isrc -itest -idoctest/ghci-wrapper/src
--- a/servant-auth/servant-auth-server/CHANGELOG.md
+++ b/servant-auth/servant-auth-server/CHANGELOG.md
@ -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
--- a/servant-auth/servant-auth-server/LICENSE
+++ b/servant-auth/servant-auth-server/LICENSE
@ -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.
+
--- a/servant-auth/servant-auth-server/README.lhs
+++ b/servant-auth/servant-auth-server/README.lhs
@ -0,0 +1,293 @@
+# servant-auth
+
+[![build status](https://img.shields.io/github/workflow/status/haskell-servant/servant-auth/CI/master?style=flat-square&logo=github&label=build%20status)](https://github.com/haskell-servant/servant-auth/actions?query=workflow%3ACI)
+
+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
+
+~~~
--- a/servant-auth/servant-auth-server/README.md
+++ b/servant-auth/servant-auth-server/README.md
@ -0,0 +1 @@
+README.lhs
--- a/servant-auth/servant-auth-server/Setup.hs
+++ b/servant-auth/servant-auth-server/Setup.hs
@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
--- a/servant-auth/servant-auth-server/servant-auth-server.cabal
+++ b/servant-auth/servant-auth-server/servant-auth-server.cabal
@ -0,0 +1,129 @@
+name:           servant-auth-server
+version: 0.4.6.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 <http://github.com/haskell-servant/servant-auth#readme README>.
+category:       Web, Servant, Authentication
+homepage:       http://github.com/haskell-servant/servant-auth#readme
+bug-reports:    https://github.com/haskell-servant/servant-auth/issues
+author:         Julian K. Arni
+maintainer:     jkarni@gmail.com
+copyright:      (c) Julian K. Arni
+license:        BSD3
+license-file:   LICENSE
+tested-with:    GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
+build-type:     Simple
+cabal-version:  >= 1.10
+extra-source-files:
+    CHANGELOG.md
+
+source-repository head
+  type: git
+  location: https://github.com/haskell-servant/servant-auth
+
+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.16
+    , aeson                   >= 1.3.1.1  && < 1.6
+    , base64-bytestring       >= 1.0.0.1  && < 1.2
+    , blaze-builder           >= 0.4.1.0  && < 0.5
+    , bytestring              >= 0.10.6.0 && < 0.11
+    , 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.7.0.0  && < 0.9
+    , lens                    >= 4.16.1   && < 5.1
+    , memory                  >= 0.14.16  && < 0.17
+    , monad-time              >= 0.3.1.0  && < 0.4
+    , mtl                     >= 2.2.2    && < 2.3
+    , servant                 >= 0.13     && < 0.19
+    , servant-auth            == 0.4.*
+    , servant-server          >= 0.13     && < 0.19
+    , tagged                  >= 0.8.4    && < 0.9
+    , text                    >= 1.2.3.0  && < 1.3
+    , time                    >= 1.5.0.1  && < 1.10
+    , unordered-containers    >= 0.2.9.0  && < 0.3
+    , wai                     >= 3.2.1.2  && < 3.3
+  if !impl(ghc >= 8.0)
+    build-depends:
+      semigroups >= 0.18.5 && <0.20
+  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.8
+
+  -- 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.8
+    , QuickCheck  >= 2.11.3    && < 2.15
+    , http-client >= 0.5.13.1  && < 0.8
+    , lens-aeson  >= 1.0.2     && < 1.2
+    , warp        >= 3.2.25    && < 3.4
+    , wreq        >= 0.5.2.1   && < 0.6
+  other-modules:
+      Servant.Auth.ServerSpec
+  default-language: Haskell2010
--- a/servant-auth/servant-auth-server/src/Servant/Auth/Server.hs
+++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server.hs
@ -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
--- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal.hs
+++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal.hs
@ -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
--- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/AddSetCookie.hs
+++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/AddSetCookie.hs
@ -0,0 +1,94 @@
+{-# 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           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 (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
+
+-- | 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
--- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/BasicAuth.hs
+++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/BasicAuth.hs
@ -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
--- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Class.hs
+++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Class.hs
@ -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
--- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs
+++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs
@ -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  :: 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 = 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
+-- }}}
--- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Cookie.hs
+++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Cookie.hs
@ -0,0 +1,182 @@
+{-# LANGUAGE CPP #-}
+module Servant.Auth.Server.Internal.Cookie where
+
+import           Blaze.ByteString.Builder (toByteString)
+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" #-}
--- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/FormLogin.hs
+++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/FormLogin.hs
@ -0,0 +1,3 @@
+module Servant.Auth.Server.Internal.FormLogin where
+
+
--- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs
+++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs
@ -0,0 +1,71 @@
+module Servant.Auth.Server.Internal.JWT where
+
+import           Control.Lens
+import           Control.Monad.Except
+import           Control.Monad.Reader
+import qualified Crypto.JOSE          as Jose
+import qualified Crypto.JWT           as Jose
+import           Data.Aeson           (FromJSON, Result (..), ToJSON, fromJSON,
+                                       toJSON)
+import           Data.ByteArray       (constEq)
+import qualified Data.ByteString      as BS
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.HashMap.Strict  as HM
+import           Data.Maybe           (fromMaybe)
+import qualified Data.Text            as T
+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 = runExceptT $ 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
+  verifiedJWT <- liftIO $ runExceptT $ do
+    unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)
+    Jose.verifyClaims
+      (jwtSettingsToJwtValidationSettings jwtCfg)
+      (validationKeys jwtCfg)
+      unverifiedJWT
+  return $ case verifiedJWT of
+    Left (_ :: Jose.JWTError) -> Nothing
+    Right v -> case decodeJWT v of
+      Left _ -> Nothing
+      Right v' -> Just v'
--- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs
+++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs
@ -0,0 +1,49 @@
+{-# 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(..))
+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
+
+-- 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)
--- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Types.hs
+++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Types.hs
@ -0,0 +1,112 @@
+{-# LANGUAGE CPP #-}
+module Servant.Auth.Server.Internal.Types where
+
+import Control.Applicative
+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 = (<>)
--- a/servant-auth/servant-auth-server/src/Servant/Auth/Server/SetCookieOrphan.hs
+++ b/servant-auth/servant-auth-server/src/Servant/Auth/Server/SetCookieOrphan.hs
@ -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
--- a/servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs
+++ b/servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs
@ -0,0 +1,600 @@
+{-# LANGUAGE CPP #-}
+module Servant.Auth.ServerSpec (spec) where
+
+#if !MIN_VERSION_servant_server(0,16,0)
+#define ServerError ServantErr
+#endif
+
+import           Control.Lens
+import           Control.Monad.Except                (runExceptT)
+import           Control.Monad.IO.Class              (liftIO)
+import           Crypto.JOSE                         (Alg (HS256, None), Error,
+                                                      JWK, JWSHeader,
+                                                      KeyMaterialGenParam (OctGenParam),
+                                                      ToCompact, encodeCompact,
+                                                      genJWK, newJWSHeader)
+import           Crypto.JWT                          (Audience (..), ClaimsSet,
+                                                      NumericDate (NumericDate),
+                                                      SignedJWT,
+                                                      claimAud, claimNbf,
+                                                      signClaims,
+                                                      emptyClaimsSet,
+                                                      unregisteredClaims)
+import           Data.Aeson                          (FromJSON, ToJSON, Value,
+                                                      toJSON, encode)
+import           Data.Aeson.Lens                     (_JSON)
+import qualified Data.ByteString                     as BS
+import qualified Data.ByteString.Lazy                as BSL
+import           Data.CaseInsensitive                (mk)
+import           Data.Foldable                       (find)
+import           Data.Monoid
+import           Data.Time
+import           Data.Time.Clock                     (getCurrentTime)
+import           GHC.Generics                        (Generic)
+import           Network.HTTP.Client                 (cookie_http_only,
+                                                      cookie_name, cookie_value,
+                                                      cookie_expiry_time,
+                                                      destroyCookieJar)
+import           Network.HTTP.Types                  (Status, status200,
+                                                      status401)
+import           Network.Wai                         (responseLBS)
+import           Network.Wai.Handler.Warp            (testWithApplication)
+import           Network.Wreq                        (Options, auth, basicAuth,
+                                                      cookieExpiryTime, cookies,
+                                                      defaults, get, getWith, postWith,
+                                                      header, oauth2Bearer,
+                                                      responseBody,
+                                                      responseCookieJar,
+                                                      responseHeader,
+                                                      responseStatus)
+import           Network.Wreq.Types                  (Postable(..))
+import           Servant                             hiding (BasicAuth,
+                                                      IsSecure (..), header)
+import           Servant.Auth.Server
+import           Servant.Auth.Server.Internal.Cookie (expireTime)
+import           Servant.Auth.Server.SetCookieOrphan ()
+#if MIN_VERSION_servant_server(0,15,0)
+import qualified Servant.Types.SourceT             as S
+#endif
+import           System.IO.Unsafe                    (unsafePerformIO)
+import           Test.Hspec
+import           Test.QuickCheck
+import qualified Network.HTTP.Client as HCli
+
+
+
+spec :: Spec
+spec = do
+  authSpec
+  cookieAuthSpec
+  jwtAuthSpec
+  throwAllSpec
+  basicAuthSpec
+
+------------------------------------------------------------------------------
+-- * Auth {{{
+
+authSpec :: Spec
+authSpec
+  = describe "The Auth combinator"
+  $ around (testWithApplication . return $ app jwtAndCookieApi) $ do
+
+  it "returns a 401 if all authentications are Indefinite" $ \port -> do
+    get (url port) `shouldHTTPErrorWith` status401
+
+  it "succeeds if one authentication suceeds" $ \port -> property $
+                                                \(user :: User) -> do
+    jwt <- makeJWT user jwtCfg Nothing
+    opts <- addJwtToHeader jwt
+    resp <- getWith opts (url port)
+    resp ^? responseBody . _JSON `shouldBe` Just (length $ name user)
+
+  it "fails (403) if one authentication fails" $ const $
+    pendingWith "Authentications don't yet fail, only are Indefinite"
+
+  it "doesn't clobber pre-existing response headers" $ \port -> property $
+                                                \(user :: User) -> do
+    jwt <- makeJWT user jwtCfg Nothing
+    opts <- addJwtToHeader jwt
+    resp <- getWith opts (url port ++ "/header")
+    resp ^. responseHeader "Blah" `shouldBe` "1797"
+    resp ^. responseHeader "Set-Cookie" `shouldSatisfy` (/= "")
+
+  context "Raw" $ do
+
+    it "gets the response body" $ \port -> property $ \(user :: User) -> do
+      jwt <- makeJWT user jwtCfg Nothing
+      opts <- addJwtToHeader jwt
+      resp <- getWith opts (url port ++ "/raw")
+      resp ^. responseBody `shouldBe` "how are you?"
+
+    it "doesn't clobber pre-existing reponse headers" $ \port -> property $
+                                                \(user :: User) -> do
+      jwt <- makeJWT user jwtCfg Nothing
+      opts <- addJwtToHeader jwt
+      resp <- getWith opts (url port ++ "/raw")
+      resp ^. responseHeader "hi" `shouldBe` "there"
+      resp ^. responseHeader "Set-Cookie" `shouldSatisfy` (/= "")
+
+
+  context "Setting cookies" $ do
+
+    it "sets cookies that it itself accepts" $ \port -> property $ \user -> do
+      jwt <- createJWT theKey (newJWSHeader ((), HS256))
+        (claims $ toJSON user)
+      opts' <- addJwtToCookie cookieCfg jwt
+      let opts = addCookie (opts' & header (mk (xsrfField xsrfHeaderName cookieCfg)) .~ ["blah"])
+                           (xsrfField xsrfCookieName cookieCfg <> "=blah")
+      resp <- getWith opts (url port)
+      let (cookieJar:_) = resp ^.. responseCookieJar
+          Just xxsrf = find (\x -> cookie_name x == xsrfField xsrfCookieName cookieCfg)
+                     $ destroyCookieJar cookieJar
+          opts2 = defaults
+            & cookies .~ Just cookieJar
+            & header (mk (xsrfField xsrfHeaderName cookieCfg)) .~ [cookie_value xxsrf]
+      resp2 <- getWith opts2 (url port)
+      resp2 ^? responseBody . _JSON `shouldBe` Just (length $ name user)
+
+    it "uses the Expiry from the configuration" $ \port -> property $ \(user :: User) -> do
+      jwt <- createJWT theKey (newJWSHeader ((), HS256))
+        (claims $ toJSON user)
+      opts' <- addJwtToCookie cookieCfg jwt
+      let opts = addCookie (opts' & header (mk (xsrfField xsrfHeaderName cookieCfg)) .~ ["blah"])
+                           (xsrfField xsrfCookieName cookieCfg <> "=blah")
+      resp <- getWith opts (url port)
+      let (cookieJar:_) = resp ^.. responseCookieJar
+          Just xxsrf = find (\x -> cookie_name x == xsrfField xsrfCookieName cookieCfg)
+                     $ destroyCookieJar cookieJar
+      xxsrf ^. cookieExpiryTime `shouldBe` future
+
+    it "sets the token cookie as HttpOnly" $ \port -> property $ \(user :: User) -> do
+      jwt <- createJWT theKey (newJWSHeader ((), HS256))
+        (claims $ toJSON user)
+      opts' <- addJwtToCookie cookieCfg jwt
+      let opts = addCookie (opts' & header (mk (xsrfField xsrfHeaderName cookieCfg)) .~ ["blah"])
+                           (xsrfField xsrfCookieName cookieCfg <> "=blah")
+      resp <- getWith opts (url port)
+      let (cookieJar:_) = resp ^.. responseCookieJar
+          Just token = find (\x -> cookie_name x == sessionCookieName cookieCfg)
+                     $ destroyCookieJar cookieJar
+      cookie_http_only token `shouldBe` True
+
+
+
+-- }}}
+------------------------------------------------------------------------------
+-- * Cookie Auth {{{
+
+cookieAuthSpec :: Spec
+cookieAuthSpec
+  = describe "The Auth combinator" $ do
+      describe "With XSRF check" $
+       around (testWithApplication . return $ app cookieOnlyApi) $ do
+
+        it "fails if XSRF header and cookie don't match" $ \port -> property
+                                                         $ \(user :: User) -> do
+          jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)
+          opts' <- addJwtToCookie cookieCfg jwt
+          let opts = addCookie (opts' & header (mk (xsrfField xsrfHeaderName cookieCfg)) .~ ["blah"])
+                               (xsrfField xsrfCookieName cookieCfg <> "=blerg")
+          getWith opts (url port) `shouldHTTPErrorWith` status401
+
+        it "fails with no XSRF header or cookie" $ \port -> property
+                                                         $ \(user :: User) -> do
+          jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)
+          opts <- addJwtToCookie cookieCfg jwt
+          getWith opts (url port) `shouldHTTPErrorWith` status401
+
+        it "succeeds if XSRF header and cookie match, and JWT is valid" $ \port -> property
+                                                                        $ \(user :: User) -> do
+          jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)
+          opts' <- addJwtToCookie cookieCfg jwt
+          let opts = addCookie (opts' & header (mk (xsrfField xsrfHeaderName cookieCfg)) .~ ["blah"])
+                               (xsrfField xsrfCookieName cookieCfg <> "=blah")
+          resp <- getWith opts (url port)
+          resp ^? responseBody . _JSON `shouldBe` Just (length $ name user)
+
+        it "sets and clears the right cookies" $ \port -> property
+                                               $ \(user :: User) -> do
+          let optsFromResp resp =
+                let jar = resp ^. responseCookieJar
+                    Just xsrfCookieValue = cookie_value <$> find (\c -> cookie_name c == xsrfField xsrfCookieName cookieCfg) (destroyCookieJar jar)
+                in defaults
+                    & cookies .~ Just jar -- real cookie jars aren't updated by being replaced
+                    & header (mk (xsrfField xsrfHeaderName cookieCfg)) .~ [xsrfCookieValue]
+
+          resp <- postWith defaults (url port ++ "/login") user
+          (resp ^. responseCookieJar) `shouldMatchCookieNames`
+            [ sessionCookieName cookieCfg
+            , xsrfField xsrfCookieName cookieCfg
+            ]
+          let loggedInOpts = optsFromResp resp
+
+          resp <- getWith loggedInOpts (url port)
+          resp ^? responseBody . _JSON `shouldBe` Just (length $ name user)
+
+          -- logout
+          resp <- getWith loggedInOpts (url port ++ "/logout")
+
+          -- assert cookies were expired
+          now <- getCurrentTime
+          let assertCookie c = now >= cookie_expiry_time c
+          all assertCookie (destroyCookieJar (resp ^. responseCookieJar)) `shouldBe` True
+
+          let loggedOutOpts = optsFromResp resp
+          getWith loggedOutOpts (url port) `shouldHTTPErrorWith` status401
+
+      describe "With no XSRF check for GET requests" $ let
+            noXsrfGet xsrfCfg = xsrfCfg { xsrfExcludeGet = True }
+            cookieCfgNoXsrfGet = cookieCfg { cookieXsrfSetting = fmap noXsrfGet $ cookieXsrfSetting cookieCfg }
+       in around (testWithApplication . return $ appWithCookie cookieOnlyApi cookieCfgNoXsrfGet) $ do
+
+        it "succeeds with no XSRF header or cookie for GET" $ \port -> property
+                                                            $ \(user :: User) -> do
+          jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)
+          opts <- addJwtToCookie cookieCfgNoXsrfGet jwt
+          resp <- getWith opts (url port)
+          resp ^? responseBody . _JSON `shouldBe` Just (length $ name user)
+
+        it "fails with no XSRF header or cookie for POST" $ \port -> property
+                                                          $ \(user :: User) number -> do
+          jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)
+          opts <- addJwtToCookie cookieCfgNoXsrfGet jwt
+          postWith opts (url port) (toJSON (number :: Int)) `shouldHTTPErrorWith` status401
+
+      describe "With no XSRF check at all" $ let
+            cookieCfgNoXsrf = cookieCfg { cookieXsrfSetting = Nothing }
+       in around (testWithApplication . return $ appWithCookie cookieOnlyApi cookieCfgNoXsrf) $ do
+
+        it "succeeds with no XSRF header or cookie for GET" $ \port -> property
+                                                            $ \(user :: User) -> do
+          jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)
+          opts <- addJwtToCookie cookieCfgNoXsrf jwt
+          resp <- getWith opts (url port)
+          resp ^? responseBody . _JSON `shouldBe` Just (length $ name user)
+
+        it "succeeds with no XSRF header or cookie for POST" $ \port -> property
+                                                             $ \(user :: User) number -> do
+          jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)
+          opts <- addJwtToCookie cookieCfgNoXsrf jwt
+          resp <- postWith opts (url port) $ toJSON (number :: Int)
+          resp ^? responseBody . _JSON `shouldBe` Just number
+
+        it "sets and clears the right cookies" $ \port -> property
+                                               $ \(user :: User) -> do
+          let optsFromResp resp = defaults
+                & cookies .~ Just (resp ^. responseCookieJar) -- real cookie jars aren't updated by being replaced
+
+          resp <- postWith defaults (url port ++ "/login") user
+          (resp ^. responseCookieJar) `shouldMatchCookieNames`
+            [ sessionCookieName cookieCfg
+            , "NO-XSRF-TOKEN"
+            ]
+          let loggedInOpts = optsFromResp resp
+
+          resp <- getWith (loggedInOpts) (url port)
+          resp ^? responseBody . _JSON `shouldBe` Just (length $ name user)
+
+          resp <- getWith loggedInOpts (url port ++ "/logout")
+          (resp ^. responseCookieJar) `shouldMatchCookieNameValues`
+            [ (sessionCookieName cookieCfg, "value")
+            , ("NO-XSRF-TOKEN", "")
+            ]
+
+          -- assert cookies were expired
+          now <- getCurrentTime
+          let assertCookie c = now >= cookie_expiry_time c
+          all assertCookie (destroyCookieJar (resp ^. responseCookieJar)) `shouldBe` True
+
+          let loggedOutOpts = optsFromResp resp
+
+          getWith loggedOutOpts (url port) `shouldHTTPErrorWith` status401
+
+-- }}}
+------------------------------------------------------------------------------
+-- * JWT Auth {{{
+
+jwtAuthSpec :: Spec
+jwtAuthSpec
+  = describe "The JWT combinator"
+  $ around (testWithApplication . return $ app jwtOnlyApi) $ do
+
+  it "fails if 'aud' does not match predicate" $ \port -> property $
+                                                \(user :: User) -> do
+    jwt <- createJWT theKey (newJWSHeader ((), HS256))
+      (claims (toJSON user) & claimAud .~ Just (Audience ["boo"]))
+    opts <- addJwtToHeader (jwt >>= (return . encodeCompact))
+    getWith opts (url port) `shouldHTTPErrorWith` status401
+
+  it "succeeds if 'aud' does match predicate" $ \port -> property $
+                                                \(user :: User) -> do
+    jwt <- createJWT theKey (newJWSHeader ((), HS256))
+      (claims (toJSON user) & claimAud .~ Just (Audience ["anythingElse"]))
+    opts <- addJwtToHeader (jwt >>= (return . encodeCompact))
+    resp <- getWith opts (url port)
+    resp ^. responseStatus `shouldBe` status200
+
+  it "fails if 'nbf' is set to a future date" $ \port -> property $
+                                                \(user :: User) -> do
+    jwt <- createJWT theKey (newJWSHeader ((), HS256))
+      (claims (toJSON user) & claimNbf .~ Just (NumericDate future))
+    opts <- addJwtToHeader (jwt >>= (return . encodeCompact))
+    getWith opts (url port) `shouldHTTPErrorWith` status401
+
+  it "fails if 'exp' is set to a past date" $ \port -> property $
+                                              \(user :: User) -> do
+    jwt <- makeJWT user jwtCfg (Just past)
+    opts <- addJwtToHeader jwt
+    getWith opts (url port) `shouldHTTPErrorWith` status401
+
+  it "succeeds if 'exp' is set to a future date" $ \port -> property $
+                                                   \(user :: User) -> do
+    jwt <- makeJWT user jwtCfg (Just future)
+    opts <- addJwtToHeader jwt
+    resp <- getWith opts (url port)
+    resp ^. responseStatus `shouldBe` status200
+
+  it "fails if JWT is not signed" $ \port -> property $ \(user :: User) -> do
+    jwt <- createJWT theKey (newJWSHeader ((), None))
+                               (claims $ toJSON user)
+    opts <- addJwtToHeader (jwt >>= (return . encodeCompact))
+    getWith opts (url port) `shouldHTTPErrorWith` status401
+
+  it "fails if JWT does not use expected algorithm" $ const $
+    pendingWith "Need https://github.com/frasertweedale/hs-jose/issues/19"
+
+  it "fails if data is not valid JSON" $ \port -> do
+    jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims "{{")
+    opts <- addJwtToHeader (jwt >>= (return .encodeCompact))
+    getWith opts (url port) `shouldHTTPErrorWith` status401
+
+  it "suceeds as wreq's oauth2Bearer" $ \port -> property $ \(user :: User) -> do
+    jwt <- createJWT theKey (newJWSHeader ((), HS256))
+                               (claims $ toJSON user)
+    resp <- case jwt >>= (return . encodeCompact) of
+      Left (e :: Error) -> fail $ show e
+      Right v -> getWith (defaults & auth ?~ oauth2Bearer (BSL.toStrict v)) (url port)
+    resp ^. responseStatus `shouldBe` status200
+
+-- }}}
+------------------------------------------------------------------------------
+-- * Basic Auth {{{
+
+basicAuthSpec :: Spec
+basicAuthSpec = describe "The BasicAuth combinator"
+  $ around (testWithApplication . return $ app basicAuthApi) $ do
+
+  it "succeeds with the correct password and username" $ \port -> do
+    resp <- getWith (defaults & auth ?~ basicAuth "ali" "Open sesame") (url port)
+    resp ^. responseStatus `shouldBe` status200
+
+  it "fails with non-existent user" $ \port -> do
+    getWith (defaults & auth ?~ basicAuth "thief" "Open sesame") (url port)
+      `shouldHTTPErrorWith` status401
+
+  it "fails with incorrect password" $ \port -> do
+    getWith (defaults & auth ?~ basicAuth "ali" "phatic") (url port)
+      `shouldHTTPErrorWith` status401
+
+  it "fails with no auth header" $ \port -> do
+    get (url port) `shouldHTTPErrorWith` status401
+
+-- }}}
+------------------------------------------------------------------------------
+-- * ThrowAll {{{
+
+throwAllSpec :: Spec
+throwAllSpec = describe "throwAll" $ do
+
+  it "works for plain values" $ do
+    let t :: Either ServerError Int :<|> Either ServerError Bool :<|> Either ServerError String
+        t = throwAll err401
+    t `shouldBe` throwError err401 :<|> throwError err401 :<|> throwError err401
+
+  it "works for function types" $ property $ \i -> do
+    let t :: Int -> (Either ServerError Bool :<|> Either ServerError String)
+        t = throwAll err401
+        expected _ = throwError err401 :<|> throwError err401
+    t i `shouldBe` expected i
+
+-- }}}
+------------------------------------------------------------------------------
+-- * API and Server {{{
+
+type API auths
+    = Auth auths User :>
+        ( Get '[JSON] Int
+       :<|> ReqBody '[JSON] Int :> Post '[JSON] Int
+       :<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int)
+#if MIN_VERSION_servant_server(0,15,0)
+       :<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)
+#endif
+       :<|> "raw" :> Raw
+        )
+      :<|> "login" :> ReqBody '[JSON] User :> Post '[JSON] (Headers '[ Header "Set-Cookie" SetCookie
+                                                                     , Header "Set-Cookie" SetCookie ] NoContent)
+      :<|> "logout" :> Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie
+                                             , Header "Set-Cookie" SetCookie ] NoContent)
+
+jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT])
+jwtOnlyApi = Proxy
+
+cookieOnlyApi :: Proxy (API '[Cookie])
+cookieOnlyApi = Proxy
+
+basicAuthApi :: Proxy (API '[BasicAuth])
+basicAuthApi = Proxy
+
+jwtAndCookieApi :: Proxy (API '[Servant.Auth.Server.JWT, Cookie])
+jwtAndCookieApi = Proxy
+
+theKey :: JWK
+theKey = unsafePerformIO . genJWK $ OctGenParam 256
+{-# NOINLINE theKey #-}
+
+
+cookieCfg :: CookieSettings
+cookieCfg = def
+  { cookieExpires = Just future
+  , cookieIsSecure = NotSecure
+  , sessionCookieName = "RuncibleSpoon"
+  , cookieXsrfSetting = pure $ def
+    { xsrfCookieName = "TheyDinedOnMince"
+    , xsrfHeaderName = "AndSlicesOfQuince"
+    }
+  }
+xsrfField :: (XsrfCookieSettings -> a) -> CookieSettings -> a
+xsrfField f = maybe (error "expected XsrfCookieSettings for test") f . cookieXsrfSetting
+
+jwtCfg :: JWTSettings
+jwtCfg = (defaultJWTSettings theKey) { audienceMatches = \x ->
+    if x == "boo" then DoesNotMatch else Matches }
+
+instance FromBasicAuthData User where
+  fromBasicAuthData (BasicAuthData usr pwd) _
+    = return $ if usr == "ali" && pwd == "Open sesame"
+      then Authenticated $ User "ali" "ali@the-thieves-den.com"
+      else Indefinite
+
+-- Could be anything, really, but since this is already in the cfg we don't
+-- have to add it
+type instance BasicAuthCfg = JWK
+
+appWithCookie :: AreAuths auths '[CookieSettings, JWTSettings, JWK] User
+  => Proxy (API auths) -> CookieSettings -> Application
+appWithCookie api ccfg = serveWithContext api ctx $ server ccfg
+  where
+    ctx = ccfg :. jwtCfg :. theKey :. EmptyContext
+
+-- | Takes a proxy parameter indicating which authentication systems to enable.
+app :: AreAuths auths '[CookieSettings, JWTSettings, JWK] User
+  => Proxy (API auths) -> Application
+app api = appWithCookie api cookieCfg
+
+server :: CookieSettings -> Server (API auths)
+server ccfg =
+    (\authResult -> case authResult of
+        Authenticated usr -> getInt usr
+                        :<|> postInt usr
+                        :<|> getHeaderInt
+#if MIN_VERSION_servant_server(0,15,0)
+                        :<|> return (S.source ["bytestring"])
+#endif
+                        :<|> raw
+        Indefinite -> throwAll err401
+        _ -> throwAll err403
+    )
+    :<|> getLogin
+    :<|> getLogout
+  where
+    getInt :: User -> Handler Int
+    getInt usr = return . length $ name usr
+
+    postInt :: User -> Int -> Handler Int
+    postInt _ = return
+
+    getHeaderInt :: Handler (Headers '[Header "Blah" Int] Int)
+    getHeaderInt = return $ addHeader 1797 17
+
+    getLogin :: User -> Handler (Headers '[ Header "Set-Cookie" SetCookie
+                                          , Header "Set-Cookie" SetCookie ] NoContent)
+    getLogin user = do
+        maybeApplyCookies <- liftIO $ acceptLogin ccfg jwtCfg user
+        case maybeApplyCookies of
+          Just applyCookies -> return $ applyCookies NoContent
+          Nothing -> error "cookies failed to apply"
+
+    getLogout :: Handler (Headers '[ Header "Set-Cookie" SetCookie
+                                   , Header "Set-Cookie" SetCookie ] NoContent)
+    getLogout = return $ clearSession ccfg NoContent
+
+    raw :: Server Raw
+    raw =
+#if MIN_VERSION_servant_server(0,11,0)
+      Tagged $
+#endif
+      \_req respond ->
+        respond $ responseLBS status200 [("hi", "there")] "how are you?"
+
+-- }}}
+------------------------------------------------------------------------------
+-- * 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"
+
+addJwtToHeader :: Either Error BSL.ByteString -> IO Options
+addJwtToHeader jwt = case jwt of
+  Left e -> fail $ show e
+  Right v -> return
+    $ defaults & header "Authorization" .~ ["Bearer " <> BSL.toStrict v]
+
+createJWT :: JWK -> JWSHeader () -> ClaimsSet -> IO (Either Error Crypto.JWT.SignedJWT)
+createJWT k a b = runExceptT $ signClaims k a b
+
+addJwtToCookie :: ToCompact a => CookieSettings -> Either Error a -> IO Options
+addJwtToCookie ccfg jwt = case jwt >>= (return . encodeCompact) of
+  Left e -> fail $ show e
+  Right v -> return
+    $ defaults & header "Cookie" .~ [sessionCookieName ccfg <> "=" <> BSL.toStrict v]
+
+addCookie :: Options -> BS.ByteString -> Options
+addCookie opts cookie' = opts & header "Cookie" %~ \c -> case c of
+                        [h] -> [cookie' <> "; " <> h]
+                        []  -> [cookie']
+                        _   -> error "expecting single cookie header"
+
+
+shouldHTTPErrorWith :: IO a -> Status -> Expectation
+shouldHTTPErrorWith act stat = act `shouldThrow` \e -> case e of
+#if MIN_VERSION_http_client(0,5,0)
+  HCli.HttpExceptionRequest _ (HCli.StatusCodeException resp _)
+    -> HCli.responseStatus resp == stat
+#else
+  HCli.StatusCodeException x _ _ -> x == stat
+#endif
+  _ -> False
+
+shouldMatchCookieNames :: HCli.CookieJar -> [BS.ByteString] -> Expectation
+shouldMatchCookieNames cj patterns
+    = fmap cookie_name (destroyCookieJar cj)
+    `shouldMatchList` patterns
+
+shouldMatchCookieNameValues :: HCli.CookieJar -> [(BS.ByteString, BS.ByteString)] -> Expectation
+shouldMatchCookieNameValues cj patterns
+    = fmap ((,) <$> cookie_name <*> cookie_value) (destroyCookieJar cj)
+    `shouldMatchList` patterns
+
+url :: Int -> String
+url port = "http://localhost:" <> show port
+
+claims :: Value -> ClaimsSet
+claims val = emptyClaimsSet & unregisteredClaims . at "dat" .~ Just val
+-- }}}
+------------------------------------------------------------------------------
+-- * 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
+
+instance Postable User where
+  postPayload user request = return $ request
+    { HCli.requestBody = HCli.RequestBodyLBS $ encode user
+    , HCli.requestHeaders = (mk "Content-Type", "application/json") : HCli.requestHeaders request
+    }
+
+
+-- }}}
--- a/servant-auth/servant-auth-server/test/Spec.hs
+++ b/servant-auth/servant-auth-server/test/Spec.hs
@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
--- a/servant-auth/servant-auth-swagger/.ghci
+++ b/servant-auth/servant-auth-swagger/.ghci
@ -0,0 +1 @@
+:set -isrc -itest -idoctest/ghci-wrapper/src
--- a/servant-auth/servant-auth-swagger/CHANGELOG.md
+++ b/servant-auth/servant-auth-swagger/CHANGELOG.md
@ -0,0 +1,24 @@
+# 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.1] - 2020-10-06
+
+### Changed
+
+- Support GHC 8.10 @domenkozar
+- Fix build with swagger 2.5.x @domenkozar
+
+## [0.2.10.0] - 2018-06-18
+
+### Added
+
+- Support for GHC 8.4 by @phadej
+- Changelog by @domenkozar
+- #93: Add Cookie in SwaggerSpec API by @domenkozar
+- #42: Add dummy AllHasSecurity Cookie instance by @sordina
--- a/servant-auth/servant-auth-swagger/LICENSE
+++ b/servant-auth/servant-auth-swagger/LICENSE
@ -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.
+
--- a/servant-auth/servant-auth-swagger/Setup.hs
+++ b/servant-auth/servant-auth-swagger/Setup.hs
@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
--- a/servant-auth/servant-auth-swagger/servant-auth-swagger.cabal
+++ b/servant-auth/servant-auth-swagger/servant-auth-swagger.cabal
@ -0,0 +1,70 @@
+name:           servant-auth-swagger
+version:        0.2.10.1
+synopsis:       servant-swagger/servant-auth compatibility
+description:    This package provides instances that allow generating swagger2 schemas 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 <http://github.com/haskell-servant/servant-auth#readme README>.
+category:       Web, Servant, Authentication
+homepage:       http://github.com/haskell-servant/servant-auth#readme
+bug-reports:    https://github.com/haskell-servant/servant-auth/issues
+author:         Julian K. Arni
+maintainer:     jkarni@gmail.com
+copyright:      (c) Julian K. Arni
+license:        BSD3
+license-file:   LICENSE
+tested-with:    GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
+build-type:     Simple
+cabal-version:  >= 1.10
+extra-source-files:
+    CHANGELOG.md
+
+source-repository head
+  type: git
+  location: https://github.com/haskell-servant/servant-auth
+
+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.16
+    , text            >= 1.2.3.0 && < 1.3
+    , servant-swagger >= 1.1.5   && < 1.8
+    , swagger2        >= 2.2.2   && < 2.7
+    , servant         >= 0.13    && < 0.19
+    , servant-auth    == 0.4.*
+    , lens            >= 4.16.1  && < 5.1
+  exposed-modules:
+      Servant.Auth.Swagger
+  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.9
+  -- dependencies with bounds inherited from the library stanza
+  build-depends:
+      base
+    , text
+    , servant-swagger
+    , swagger2
+    , servant
+    , servant-auth
+    , lens
+
+  -- test dependencies
+  build-depends:
+      servant-auth-swagger
+    , hspec      >= 2.5.5  && < 2.9
+    , QuickCheck >= 2.11.3 && < 2.15
+  other-modules:
+      Servant.Auth.SwaggerSpec
+  default-language: Haskell2010
--- a/servant-auth/servant-auth-swagger/src/Servant/Auth/Swagger.hs
+++ b/servant-auth/servant-auth-swagger/src/Servant/Auth/Swagger.hs
@ -0,0 +1,87 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE CPP #-}
+module Servant.Auth.Swagger
+  (
+  -- | The purpose of this package is provide the instance for 'servant-auth'
+  -- combinators needed for 'servant-swagger' documentation generation.
+  --
+  -- Currently only JWT and BasicAuth are supported.
+
+  -- * Re-export
+    JWT
+  , BasicAuth
+  , Auth
+
+  -- * Needed to define instances of @HasSwagger@
+  , HasSecurity (..)
+  ) where
+
+import Control.Lens    ((&), (<>~))
+import Data.Proxy      (Proxy (Proxy))
+import Data.Swagger    (ApiKeyLocation (..), ApiKeyParams (..),
+                        SecurityRequirement (..), SecurityScheme (..), 
+#if MIN_VERSION_swagger2(2,6,0)
+                        SecurityDefinitions(..),
+#endif
+                        SecuritySchemeType (..), allOperations, security,
+                        securityDefinitions)
+import GHC.Exts        (fromList)
+import Servant.API     hiding (BasicAuth)
+import Servant.Auth
+import Servant.Swagger
+
+import qualified Data.Text as T
+
+instance (AllHasSecurity xs, HasSwagger api) => HasSwagger (Auth xs r :> api) where
+  toSwagger _
+    = toSwagger (Proxy :: Proxy api)
+        & securityDefinitions <>~ mkSec (fromList secs)
+        & allOperations.security <>~ secReqs
+    where
+      secs = securities (Proxy :: Proxy xs)
+      secReqs = [ SecurityRequirement (fromList [(s,[])]) | (s,_) <- secs]
+      mkSec =
+#if MIN_VERSION_swagger2(2,6,0)
+        SecurityDefinitions
+#else
+        id
+#endif
+
+
+class HasSecurity x where
+  securityName :: Proxy x -> T.Text
+  securityScheme :: Proxy x -> SecurityScheme
+
+instance HasSecurity BasicAuth where
+  securityName _ = "BasicAuth"
+  securityScheme _ = SecurityScheme type_ (Just desc)
+    where
+      type_ = SecuritySchemeBasic
+      desc  = "Basic access authentication"
+
+instance HasSecurity JWT where
+  securityName _ = "JwtSecurity"
+  securityScheme _ = SecurityScheme type_ (Just desc)
+    where
+      type_ = SecuritySchemeApiKey (ApiKeyParams "Authorization" ApiKeyHeader)
+      desc  = "JSON Web Token-based API key"
+
+class AllHasSecurity (x :: [*]) where
+  securities :: Proxy x -> [(T.Text,SecurityScheme)]
+
+instance {-# OVERLAPPABLE #-} (HasSecurity x, AllHasSecurity xs) => AllHasSecurity (x ': xs) where
+  securities _ = (securityName px, securityScheme px) : securities pxs
+    where
+      px :: Proxy x
+      px = Proxy
+      pxs :: Proxy xs
+      pxs = Proxy
+
+instance {-# OVERLAPPING #-} AllHasSecurity xs => AllHasSecurity (Cookie ': xs) where
+  securities _ = securities pxs
+    where
+      pxs :: Proxy xs
+      pxs = Proxy
+
+instance AllHasSecurity '[] where
+  securities _ = []
--- a/servant-auth/servant-auth-swagger/test/Servant/Auth/SwaggerSpec.hs
+++ b/servant-auth/servant-auth-swagger/test/Servant/Auth/SwaggerSpec.hs
@ -0,0 +1,38 @@
+{-# LANGUAGE CPP #-}
+module Servant.Auth.SwaggerSpec (spec) where
+
+import Control.Lens
+import Data.Proxy
+import Servant.API
+import Servant.Auth
+import Servant.Auth.Swagger
+import Data.Swagger
+import Servant.Swagger
+import Test.Hspec
+
+spec :: Spec
+spec = describe "HasSwagger instance" $ do
+
+  let swag = toSwagger (Proxy :: Proxy API)
+
+  it "adds security definitions at the top level" $ do
+#if MIN_VERSION_swagger2(2,6,0)
+    let (SecurityDefinitions secDefs) = swag ^. securityDefinitions
+#else
+    let secDefs = swag ^. securityDefinitions
+#endif
+    length secDefs `shouldSatisfy` (> 0)
+
+  it "adds security at sub-apis" $ do
+    swag ^. security `shouldBe` []
+    show (swag ^. paths . at "/secure") `shouldContain` "JwtSecurity"
+    show (swag ^. paths . at "/insecure") `shouldNotContain` "JwtSecurity"
+
+-- * API
+
+type API =   "secure" :> Auth '[JWT, Cookie] Int :> SecureAPI
+        :<|> "insecure" :> InsecureAPI
+
+type SecureAPI = Get '[JSON] Int :<|> ReqBody '[JSON] Int :> Post '[JSON] Int
+
+type InsecureAPI = SecureAPI
--- a/servant-auth/servant-auth-swagger/test/Spec.hs
+++ b/servant-auth/servant-auth-swagger/test/Spec.hs
@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
--- a/servant-auth/servant-auth.project
+++ b/servant-auth/servant-auth.project
@ -0,0 +1,6 @@
+packages:
+  servant-auth
+  servant-auth-client
+  servant-auth-docs
+  servant-auth-server
+  servant-auth-swagger
--- a/servant-auth/servant-auth/.ghci
+++ b/servant-auth/servant-auth/.ghci
@ -0,0 +1 @@
+:set -isrc -itest -idoctest/ghci-wrapper/src
--- a/servant-auth/servant-auth/CHANGELOG.md
+++ b/servant-auth/servant-auth/CHANGELOG.md
@ -0,0 +1,20 @@
+# 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.0.0] - 2020-10-06
+
+- Support for GHC 8.10 by @domenkozar
+- Support servant 0.18 by @domenkozar
+- Move `ToJWT/FromJWT` from servant-auth-server
+
+## [0.3.2.0] - 2018-06-18
+
+### Added
+- Support for GHC 8.4 by @phadej
+- Changelog by @domenkozar
--- a/servant-auth/servant-auth/LICENSE
+++ b/servant-auth/servant-auth/LICENSE
@ -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.
+
--- a/servant-auth/servant-auth/Setup.hs
+++ b/servant-auth/servant-auth/Setup.hs
@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
--- a/servant-auth/servant-auth/servant-auth.cabal
+++ b/servant-auth/servant-auth/servant-auth.cabal
@ -0,0 +1,46 @@
+name:           servant-auth
+version:        0.4.0.0
+synopsis:       Authentication combinators for servant
+description:    This package provides an @Auth@ combinator for 'servant'. This combinator
+                allows using different authentication schemes in a straightforward way,
+                and possibly in conjunction with one another.
+                .
+                'servant-auth' additionally provides concrete authentication schemes, such
+                as Basic Access Authentication, JSON Web Tokens, and Cookies.
+                .
+                For more details on how to use this, see the <http://github.com/haskell-servant/servant-auth#readme README>.
+category:       Web, Servant, Authentication
+homepage:       http://github.com/haskell-servant/servant-auth#readme
+bug-reports:    https://github.com/haskell-servant/servant-auth/issues
+author:         Julian K. Arni
+maintainer:     jkarni@gmail.com
+copyright:      (c) Julian K. Arni
+license:        BSD3
+license-file:   LICENSE
+tested-with:    GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
+build-type:     Simple
+cabal-version:  >= 1.10
+extra-source-files:
+    CHANGELOG.md
+
+source-repository head
+  type: git
+  location: https://github.com/haskell-servant/servant-auth
+
+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.16
+    , aeson                   >= 1.3.1.1  && < 1.6
+    , jose                    >= 0.7.0.0  && < 0.9
+    , lens                    >= 4.16.1   && < 5.1
+    , servant                 >= 0.15     && < 0.19
+    , text                    >= 1.2.3.0  && < 1.3
+    , unordered-containers    >= 0.2.9.0  && < 0.3
+  exposed-modules:
+      Servant.Auth
+      Servant.Auth.JWT
+  default-language: Haskell2010
--- a/servant-auth/servant-auth/src/Servant/Auth.hs
+++ b/servant-auth/servant-auth/src/Servant/Auth.hs
@ -0,0 +1,54 @@
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE TypeOperators              #-}
+module Servant.Auth where
+
+import           Data.Proxy          (Proxy(..))
+import           Servant.API         ((:>))
+import           Servant.Links       (HasLink (..))
+
+-- * Authentication
+
+-- | @Auth [auth1, auth2] val :> api@ represents an API protected *either* by
+-- @auth1@ or @auth2@
+data Auth (auths :: [*]) val
+
+-- | A @HasLink@ instance for @Auth@
+instance HasLink sub => HasLink (Auth (tag :: [*]) value :> sub) where
+#if MIN_VERSION_servant(0,14,0)
+  type MkLink (Auth (tag :: [*]) value :> sub) a = MkLink sub a
+  toLink toA _ = toLink toA (Proxy :: Proxy sub)
+#else
+  type MkLink (Auth (tag :: [*]) value :> sub) = MkLink sub
+  toLink _ = toLink (Proxy :: Proxy sub)
+#endif
+
+-- ** Combinators
+
+-- | A JSON Web Token (JWT) in the the Authorization header:
+--
+--    @Authorization: Bearer \<token\>@
+--
+-- Note that while the token is signed, it is not encrypted. Therefore do not
+-- keep in it any information you would not like the client to know.
+--
+-- JWTs are described in IETF's <https://tools.ietf.org/html/rfc7519 RFC 7519>
+data JWT
+
+-- | A cookie. The content cookie itself is a JWT. Another cookie is also used,
+-- the contents of which are expected to be send back to the server in a
+-- header, for XSRF protection.
+data Cookie
+
+
+-- We could use 'servant''s BasicAuth, but then we don't get control over the
+-- documentation, and we'd have to polykind everything. (Also, we don't
+-- currently depend on servant!)
+--
+-- | Basic Auth.
+data BasicAuth
+
+-- | Login via a form.
+data FormLogin form
--- a/servant-auth/servant-auth/src/Servant/Auth/JWT.hs
+++ b/servant-auth/servant-auth/src/Servant/Auth/JWT.hs
@ -0,0 +1,33 @@
+module Servant.Auth.JWT where
+
+import           Control.Lens         ((^.))
+import qualified Crypto.JWT           as Jose
+import           Data.Aeson           (FromJSON, Result (..), ToJSON, fromJSON,
+                                       toJSON)
+import qualified Data.HashMap.Strict  as HM
+import qualified Data.Text            as T
+
+
+-- This should probably also be from ClaimSet
+--
+-- | How to decode data from a JWT.
+--
+-- The default implementation assumes the data is stored in the unregistered
+-- @dat@ claim, and uses the @FromJSON@ instance to decode value from there.
+class FromJWT a where
+  decodeJWT :: Jose.ClaimsSet -> Either T.Text a
+  default decodeJWT :: FromJSON a => Jose.ClaimsSet -> Either T.Text a
+  decodeJWT m = case HM.lookup "dat" (m ^. Jose.unregisteredClaims) of
+    Nothing -> Left "Missing 'dat' claim"
+    Just v  -> case fromJSON v of
+      Error e -> Left $ T.pack e
+      Success a -> Right a
+
+-- | How to encode data from a JWT.
+--
+-- The default implementation stores data in the unregistered @dat@ claim, and
+-- uses the type's @ToJSON@ instance to encode the data.
+class ToJWT a where
+  encodeJWT :: a -> Jose.ClaimsSet
+  default encodeJWT :: ToJSON a => a -> Jose.ClaimsSet
+  encodeJWT a = Jose.addClaim "dat" (toJSON a) Jose.emptyClaimsSet
--- a/servant-auth/servant-auth/test/Spec.hs
+++ b/servant-auth/servant-auth/test/Spec.hs
@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
--- a/servant-auth/stack-lts16.yaml
+++ b/servant-auth/stack-lts16.yaml
@ -0,0 +1,7 @@
+resolver: lts-16.31
+packages:
+- servant-auth
+- servant-auth-server
+- servant-auth-client
+- servant-auth-docs
+- servant-auth-swagger
--- a/servant-auth/stack-lts17.yaml
+++ b/servant-auth/stack-lts17.yaml
@ -0,0 +1,7 @@
+resolver: lts-17.5
+packages:
+- servant-auth
+- servant-auth-server
+- servant-auth-client
+- servant-auth-docs
+- servant-auth-swagger
--- a/servant-auth/stack.yaml
+++ b/servant-auth/stack.yaml
@ -0,0 +1,7 @@
+resolver: nightly-2021-06-01
+packages:
+- servant-auth
+- servant-auth-server
+- servant-auth-client
+- servant-auth-docs
+- servant-auth-swagger
				`@ -0,0 +1 @@`
				`:set -isrc -itest -idoctest/ghci-wrapper/src`
				`@ -0,0 +1,3 @@`
				`module Servant.Auth.Server.Internal.FormLogin where`