diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,9 +7,19 @@ ## [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 diff --git a/README.lhs b/README.lhs --- a/README.lhs +++ b/README.lhs @@ -1,6 +1,6 @@ # servant-auth -[![Build Status](https://travis-ci.org/haskell-servant/servant-auth.svg?branch=master)](https://travis-ci.org/haskell-servant/servant-auth) +![CI](https://github.com/haskell-servant/servant-auth/workflows/CI/badge.svg) These packages provides safe and easy-to-use authentication options for `servant`. The same API can be protected via: diff --git a/servant-auth-server.cabal b/servant-auth-server.cabal --- a/servant-auth-server.cabal +++ b/servant-auth-server.cabal @@ -1,5 +1,5 @@ name: servant-auth-server -version: 0.4.5.1 +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. @@ -15,7 +15,7 @@ copyright: (c) Julian K. Arni license: BSD3 license-file: LICENSE -tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.1 +tested-with: GHC == 8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.1, GHC==8.10.2 build-type: Simple cabal-version: >= 1.10 extra-source-files: @@ -31,9 +31,9 @@ default-extensions: AutoDeriveTypeable 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.9 && < 4.14 - , aeson >= 1.3.1.1 && < 1.5 - , base64-bytestring >= 1.0.0.1 && < 1.1 + base >= 4.10 && < 4.15 + , 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 @@ -42,13 +42,13 @@ , 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 && < 4.19 + , lens >= 4.16.1 && < 4.20 , memory >= 0.14.16 && < 0.16 , monad-time >= 0.3.1.0 && < 0.4 , mtl >= 2.2.2 && < 2.3 - , servant >= 0.13 && < 0.18 - , servant-auth == 0.3.* - , servant-server >= 0.13 && < 0.18 + , 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 @@ -119,7 +119,7 @@ build-depends: servant-auth-server , hspec >= 2.5.5 && < 2.8 - , QuickCheck >= 2.11.3 && < 2.14 + , QuickCheck >= 2.11.3 && < 2.15 , http-client >= 0.5.13.1 && < 0.7 , lens-aeson >= 1.0.2 && < 1.2 , warp >= 3.2.25 && < 3.4 diff --git a/src/Servant/Auth/Server.hs b/src/Servant/Auth/Server.hs --- a/src/Servant/Auth/Server.hs +++ b/src/Servant/Auth/Server.hs @@ -132,6 +132,7 @@ , writeKey , readKey , makeJWT + , verifyJWT -- ** Re-exports , Default(def) @@ -142,6 +143,7 @@ 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 diff --git a/src/Servant/Auth/Server/Internal.hs b/src/Servant/Auth/Server/Internal.hs --- a/src/Servant/Auth/Server/Internal.hs +++ b/src/Servant/Auth/Server/Internal.hs @@ -9,6 +9,7 @@ Proxy (..), HasContextEntry(getContextEntry)) import Servant.Auth +import Servant.Auth.JWT (ToJWT) import Servant.Auth.Server.Internal.AddSetCookie import Servant.Auth.Server.Internal.Class diff --git a/src/Servant/Auth/Server/Internal/BasicAuth.hs b/src/Servant/Auth/Server/Internal/BasicAuth.hs --- a/src/Servant/Auth/Server/Internal/BasicAuth.hs +++ b/src/Servant/Auth/Server/Internal/BasicAuth.hs @@ -19,6 +19,31 @@ 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 diff --git a/src/Servant/Auth/Server/Internal/Class.hs b/src/Servant/Auth/Server/Internal/Class.hs --- a/src/Servant/Auth/Server/Internal/Class.hs +++ b/src/Servant/Auth/Server/Internal/Class.hs @@ -5,11 +5,12 @@ 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 +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 diff --git a/src/Servant/Auth/Server/Internal/Cookie.hs b/src/Servant/Auth/Server/Internal/Cookie.hs --- a/src/Servant/Auth/Server/Internal/Cookie.hs +++ b/src/Servant/Auth/Server/Internal/Cookie.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Servant.Auth.Server.Internal.Cookie where import Blaze.ByteString.Builder (toByteString) @@ -20,14 +21,14 @@ 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 (FromJWT (decodeJWT), ToJWT, - makeJWT) +import Servant.Auth.Server.Internal.JWT (makeJWT, verifyJWT) import Servant.Auth.Server.Internal.Types cookieAuthCheck :: FromJWT usr => CookieSettings -> JWTSettings -> AuthCheck usr -cookieAuthCheck ccfg jwtCfg = do +cookieAuthCheck ccfg jwtSettings = do req <- ask jwtCookie <- maybe mempty return $ do cookies' <- lookup hCookie $ requestHeaders req @@ -38,16 +39,10 @@ return $ xsrfCookieAuthCheck xsrfCookieCfg req cookies -- session cookie *must* be HttpOnly and Secure lookup (sessionCookieName ccfg) cookies - verifiedJWT <- liftIO $ runExceptT $ do - unverifiedJWT <- Jose.decodeCompact $ BSL.fromStrict jwtCookie - Jose.verifyClaims (jwtSettingsToJwtValidationSettings jwtCfg) - (validationKeys jwtCfg) - unverifiedJWT + verifiedJWT <- liftIO $ verifyJWT jwtSettings jwtCookie case verifiedJWT of - Left (_ :: Jose.JWTError) -> mzero - Right v -> case decodeJWT v of - Left _ -> mzero - Right v' -> return v' + Nothing -> mzero + Just v -> return v xsrfCheckRequired :: CookieSettings -> Request -> Maybe XsrfCookieSettings xsrfCheckRequired cookieSettings req = do @@ -120,11 +115,17 @@ applySessionCookieSettings cookieSettings setCookie = setCookie { setCookieName = sessionCookieName cookieSettings , setCookieSameSite = case cookieSameSite cookieSettings of - AnySite -> Nothing + 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 diff --git a/src/Servant/Auth/Server/Internal/JWT.hs b/src/Servant/Auth/Server/Internal/JWT.hs --- a/src/Servant/Auth/Server/Internal/JWT.hs +++ b/src/Servant/Auth/Server/Internal/JWT.hs @@ -16,37 +16,15 @@ 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 --- 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 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 config = do +jwtAuthCheck jwtSettings = do req <- ask token <- maybe mempty return $ do authHdr <- lookup "Authorization" $ requestHeaders req @@ -54,18 +32,10 @@ (mbearer, rest) = BS.splitAt (BS.length bearer) authHdr guard (mbearer `constEq` bearer) return rest - verifiedJWT <- liftIO $ runExceptT $ do - unverifiedJWT <- Jose.decodeCompact $ BSL.fromStrict token - Jose.verifyClaims (jwtSettingsToJwtValidationSettings config) - (validationKeys config) - unverifiedJWT + verifiedJWT <- liftIO $ verifyJWT jwtSettings token case verifiedJWT of - Left (_ :: Jose.JWTError) -> mzero - Right v -> case decodeJWT v of - Left _ -> mzero - Right v' -> return v' - - + 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 @@ -84,3 +54,18 @@ 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'