diff --git a/README.lhs b/README.lhs --- a/README.lhs +++ b/README.lhs @@ -2,10 +2,20 @@ [![Build Status](https://travis-ci.org/haskell-servant/servant-auth.svg?branch=master)](https://travis-ci.org/haskell-servant/servant-auth) -This package provides safe and easy-to-use authentication options for -`servant`. The same API can be protected via login and cookies, or API tokens, -without much extra work. +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 | [![Hackage](https://img.shields.io/hackage/v/servant-auth.svg)](https://hackage.haskell.org/package/servant-auth) | +| servant-auth-server | [![Hackage](https://img.shields.io/hackage/v/servant-auth-server.svg)](https://hackage.haskell.org/package/servant-auth-server) | +| servant-auth-client | [![Hackage](https://img.shields.io/hackage/v/servant-auth-client.svg)](https://hackage.haskell.org/package/servant-auth-client) | +| servant-auth-swagger | [![Hackage](https://img.shields.io/hackage/v/servant-auth-swagger.svg)](https://hackage.haskell.org/package/servant-auth-swagger) | +| servant-auth-docs | [![Hackage](https://img.shields.io/hackage/v/servant-auth-docs.svg)](https://hackage.haskell.org/package/servant-auth-docs) | ## How it works 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.0.0 +version: 0.4.0.1 synopsis: servant-server/servant-auth compatibility description: This package provides the required instances for using the @Auth@ combinator in your 'servant' server. 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 @@ -14,6 +14,25 @@ -- > 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 @@ -108,6 +127,10 @@ -- * Utilies , ThrowAll(throwAll) , generateKey + , generateSecret + , fromSecret + , writeKey + , readKey , makeJWT -- ** Re-exports @@ -115,6 +138,8 @@ , 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.Server.Internal () @@ -134,3 +159,21 @@ -- | 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 diff --git a/src/Servant/Auth/Server/Internal/AddSetCookie.hs b/src/Servant/Auth/Server/Internal/AddSetCookie.hs --- a/src/Servant/Auth/Server/Internal/AddSetCookie.hs +++ b/src/Servant/Auth/Server/Internal/AddSetCookie.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE UndecidableInstances #-} @@ -28,7 +27,7 @@ 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 (Headers ls a) = Headers (Header "Set-Cookie" SetCookie ': ls) a AddSetCookieApiVerb a = Headers '[Header "Set-Cookie" SetCookie] a type family AddSetCookieApi a :: * @@ -47,7 +46,7 @@ instance {-# OVERLAPS #-} AddSetCookies ('S n) oldb newb => AddSetCookies ('S n) (a -> oldb) (a -> newb) where - addSetCookies cookies oldfn = \val -> addSetCookies cookies $ oldfn val + addSetCookies cookies oldfn = addSetCookies cookies . oldfn instance AddSetCookies 'Z orig orig where addSetCookies _ = id @@ -71,15 +70,13 @@ instance AddSetCookies ('S n) Application Application where addSetCookies cookies r request respond - = r request (\response -> respond - $ mapResponseHeaders (++ mkHeaders cookies) response) + = 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 (\response -> respond - $ mapResponseHeaders (++ mkHeaders cookies) response) + unTagged r request $ respond . mapResponseHeaders (++ mkHeaders cookies) mkHeaders :: SetCookieList x -> [HTTP.Header] mkHeaders x = ("Set-Cookie",) <$> mkCookies x 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 @@ -7,11 +7,10 @@ import qualified Crypto.JWT as Jose import Crypto.Util (constTimeEq) import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Base64 as BS64 import qualified Data.ByteString.Lazy as BSL import Data.CaseInsensitive (mk) -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (fromMaybe) import Network.HTTP.Types (methodGet) import Network.HTTP.Types.Header(hCookie) import Network.Wai (Request, requestHeaders, requestMethod) @@ -117,6 +116,10 @@ applySessionCookieSettings :: CookieSettings -> SetCookie -> SetCookie applySessionCookieSettings cookieSettings setCookie = setCookie { setCookieName = sessionCookieName cookieSettings + , setCookieSameSite = case cookieSameSite cookieSettings of + AnySite -> Nothing + SameSiteStrict -> Just sameSiteStrict + SameSiteLax -> Just sameSiteLax , setCookieHttpOnly = True } 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 @@ -83,4 +83,4 @@ where addExp claims = case expiry of Nothing -> claims - Just e -> claims & Jose.claimExp .~ Just (Jose.NumericDate e) + Just e -> claims & Jose.claimExp ?~ Jose.NumericDate e