| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Servant.Auth.Server
Contents
- data Auth (auths :: [*]) val :: [*] -> * -> *
- data AuthResult val
- = BadPassword
- | NoSuchUser
- | Authenticated val
- | Indefinite
- newtype AuthCheck val = AuthCheck {
- runAuthCheck :: Request -> IO (AuthResult val)
- data JWT :: *
- class FromJWT a where
- class ToJWT a where
- data IsMatch
- data JWTSettings = JWTSettings {
- signingKey :: JWK
- jwtAlg :: Maybe Alg
- validationKeys :: JWKSet
- audienceMatches :: StringOrURI -> IsMatch
- defaultJWTSettings :: JWK -> JWTSettings
- jwtAuthCheck :: FromJWT usr => JWTSettings -> AuthCheck usr
- data Cookie :: *
- data CookieSettings = CookieSettings {
- cookieIsSecure :: !IsSecure
- cookieMaxAge :: !(Maybe DiffTime)
- cookieExpires :: !(Maybe UTCTime)
- cookiePath :: !(Maybe ByteString)
- cookieSameSite :: !SameSite
- sessionCookieName :: !ByteString
- cookieXsrfSetting :: !(Maybe XsrfCookieSettings)
- data XsrfCookieSettings = XsrfCookieSettings {}
- defaultCookieSettings :: CookieSettings
- defaultXsrfCookieSettings :: XsrfCookieSettings
- makeSessionCookie :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe SetCookie)
- makeSessionCookieBS :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe ByteString)
- makeXsrfCookie :: CookieSettings -> IO SetCookie
- makeCsrfCookie :: CookieSettings -> IO SetCookie
- makeCookie :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe SetCookie)
- makeCookieBS :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe ByteString)
- acceptLogin :: (ToJWT session, AddHeader "Set-Cookie" SetCookie response withOneCookie, AddHeader "Set-Cookie" SetCookie withOneCookie withTwoCookies) => CookieSettings -> JWTSettings -> session -> IO (Maybe (response -> withTwoCookies))
- clearSession :: (AddHeader "Set-Cookie" SetCookie response withOneCookie, AddHeader "Set-Cookie" SetCookie withOneCookie withTwoCookies) => CookieSettings -> response -> withTwoCookies
- data IsSecure :: *
- data SameSite
- class AreAuths (as :: [*]) (ctxs :: [*]) v
- data BasicAuth :: *
- class FromBasicAuthData a where
- type family BasicAuthCfg
- data BasicAuthData :: * = BasicAuthData {}
- data IsPasswordCorrect
- wwwAuthenticatedErr :: ByteString -> ServantErr
- class ThrowAll a where
- generateKey :: IO JWK
- makeJWT :: ToJWT a => a -> JWTSettings -> Maybe UTCTime -> IO (Either Error ByteString)
- class Default a where
- data SetCookie :: *
Documentation
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 err401Additional configuration happens via Context.
Auth
Basic types
data Auth (auths :: [*]) val :: [*] -> * -> * #
Auth [auth1, auth2] val :> api represents an API protected *either* by
auth1 or auth2
data AuthResult val Source #
The result of an authentication attempt.
Constructors
| BadPassword | |
| NoSuchUser | |
| Authenticated val | Authentication succeeded. |
| Indefinite | If an authentication procedure cannot be carried out - if for example it
expects a password and username in a header that is not present -
|
Instances
| Monad AuthResult Source # | |
| Functor AuthResult Source # | |
| Applicative AuthResult Source # | |
| Foldable AuthResult Source # | |
| Traversable AuthResult Source # | |
| Alternative AuthResult Source # | |
| MonadPlus AuthResult Source # | |
| Eq val => Eq (AuthResult val) Source # | |
| Ord val => Ord (AuthResult val) Source # | |
| Read val => Read (AuthResult val) Source # | |
| Show val => Show (AuthResult val) Source # | |
| Generic (AuthResult val) Source # | |
| Semigroup (AuthResult val) Source # | |
| Monoid (AuthResult val) Source # | |
| type Rep (AuthResult val) Source # | |
newtype AuthCheck val Source #
An AuthCheck is the function used to decide the authentication status
(the AuthResult) of a request. Different AuthChecks 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.
Constructors
| AuthCheck | |
Fields
| |
Instances
| Monad AuthCheck Source # | |
| Functor AuthCheck Source # | |
| Applicative AuthCheck Source # | |
| Alternative AuthCheck Source # | |
| MonadPlus AuthCheck Source # | |
| MonadIO AuthCheck Source # | |
| MonadTime AuthCheck Source # | |
| MonadReader Request AuthCheck Source # | |
| Generic (AuthCheck val) Source # | |
| Semigroup (AuthCheck val) Source # | |
| Monoid (AuthCheck val) Source # | |
| type Rep (AuthCheck val) Source # | |
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'
Classes
class FromJWT a where Source #
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.
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.
Related types
Constructors
| Matches | |
| DoesNotMatch |
Settings
data JWTSettings Source #
JWTSettings are used to generate cookies, and to verify JWTs.
Constructors
| JWTSettings | |
Fields
| |
Instances
| Generic JWTSettings Source # | |
| type Rep JWTSettings Source # | |
defaultJWTSettings :: JWK -> JWTSettings Source #
A JWTSettings where the audience always matches.
Create check
jwtAuthCheck :: FromJWT usr => JWTSettings -> AuthCheck usr Source #
A JWT AuthCheck. You likely won't need to use this directly unless you
are protecting a Raw endpoint.
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'
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.
Settings
data CookieSettings Source #
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.
Constructors
| CookieSettings | |
Fields
| |
Instances
data XsrfCookieSettings Source #
The policies to use when generating and verifying XSRF cookies
Constructors
| XsrfCookieSettings | |
Fields
| |
makeSessionCookie :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe SetCookie) Source #
Makes a cookie with session information.
makeSessionCookieBS :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe ByteString) Source #
makeXsrfCookie :: CookieSettings -> IO SetCookie Source #
Makes a cookie to be used for XSRF.
makeCsrfCookie :: CookieSettings -> IO SetCookie Source #
Deprecated: Use makeXsrfCookie instead
Alias for makeXsrfCookie.
makeCookie :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe SetCookie) Source #
Deprecated: Use makeSessionCookie instead
Alias for makeSessionCookie.
makeCookieBS :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe ByteString) Source #
Deprecated: Use makeSessionCookieBS instead
Alias for makeSessionCookieBS.
acceptLogin :: (ToJWT session, AddHeader "Set-Cookie" SetCookie response withOneCookie, AddHeader "Set-Cookie" SetCookie withOneCookie withTwoCookies) => CookieSettings -> JWTSettings -> session -> IO (Maybe (response -> withTwoCookies)) Source #
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.
clearSession :: (AddHeader "Set-Cookie" SetCookie response withOneCookie, AddHeader "Set-Cookie" SetCookie withOneCookie withTwoCookies) => CookieSettings -> response -> withTwoCookies Source #
Adds headers to a response that clears all session cookies.
Related types
Was this request made over an SSL connection?
Note that this value will not tell you if the client originally
made this request over SSL, but rather whether the current
connection is SSL. The distinction lies with reverse proxies.
In many cases, the client will connect to a load balancer over SSL,
but connect to the WAI handler without SSL. In such a case,
the handlers would get NotSecure, but from a user perspective,
there is a secure connection.
Constructors
| AnySite | |
| SameSiteStrict | |
| SameSiteLax |
BasicAuth
Combinator
Re-exported from 'servant-auth'
Basic Auth.
Classes
class FromBasicAuthData a where Source #
Minimal complete definition
Methods
fromBasicAuthData :: BasicAuthData -> BasicAuthCfg -> IO (AuthResult a) Source #
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.
Settings
type family BasicAuthCfg Source #
Related types
data BasicAuthData :: * #
A simple datatype to hold data required to decorate a request
Constructors
| BasicAuthData | |
Fields | |
data IsPasswordCorrect Source #
Constructors
| PasswordCorrect | |
| PasswordIncorrect |
Authentication request
wwwAuthenticatedErr :: ByteString -> ServantErr Source #
A ServantErr that asks the client to authenticate via Basic
Authentication, should be invoked by an application whenever
appropriate. The argument is the realm.
Utilies
class ThrowAll a where Source #
Minimal complete definition
Methods
throwAll :: ServantErr -> a Source #
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
Instances
| ThrowAll Application Source # | for |
| MonadError ServantErr m => ThrowAll (m a) Source # | |
| ThrowAll b => ThrowAll (a -> b) Source # | |
| (ThrowAll a, ThrowAll b) => ThrowAll ((:<|>) a b) Source # | |
| MonadError ServantErr m => ThrowAll (Tagged (* -> *) m Application) Source # | for |
generateKey :: IO JWK Source #
Generate a key suitable for use with defaultConfig.
makeJWT :: ToJWT a => a -> JWTSettings -> Maybe UTCTime -> IO (Either Error ByteString) Source #
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.
Re-exports
A class for types with a default value.
Instances
Data type representing the key-value pair to use for a cookie, as well as configuration options for it.
Creating a SetCookie
SetCookie does not export a constructor; instead, use defaultSetCookie and override values (see http://www.yesodweb.com/book/settings-types for details):
import Web.Cookie :set -XOverloadedStrings let cookie =defaultSetCookie{setCookieName= "cookieName",setCookieValue= "cookieValue" }
Cookie Configuration
Cookies have several configuration options; a brief summary of each option is given below. For more information, see RFC 6265 or Wikipedia.