servant-auth-server-0.3.2.0: servant-server/servant-auth compatibility

Safe HaskellNone
LanguageHaskell2010

Servant.Auth.Server

Contents

Synopsis

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 err401

Additional configuration happens via Context.

Auth

Basic types

data Auth auths val :: [*] -> * -> * #

Instances

type ServerT * ((:>) * (Auth auths v) api) m 
type ServerT * ((:>) * (Auth auths v) api) m = AuthResult v -> ServerT * api m

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 - Indefinite is returned. This indicates that other authentication methods should be tried.

Instances

Monad AuthResult Source # 

Methods

(>>=) :: AuthResult a -> (a -> AuthResult b) -> AuthResult b #

(>>) :: AuthResult a -> AuthResult b -> AuthResult b #

return :: a -> AuthResult a #

fail :: String -> AuthResult a #

Functor AuthResult Source # 

Methods

fmap :: (a -> b) -> AuthResult a -> AuthResult b #

(<$) :: a -> AuthResult b -> AuthResult a #

Applicative AuthResult Source # 

Methods

pure :: a -> AuthResult a #

(<*>) :: AuthResult (a -> b) -> AuthResult a -> AuthResult b #

(*>) :: AuthResult a -> AuthResult b -> AuthResult b #

(<*) :: AuthResult a -> AuthResult b -> AuthResult a #

Foldable AuthResult Source # 

Methods

fold :: Monoid m => AuthResult m -> m #

foldMap :: Monoid m => (a -> m) -> AuthResult a -> m #

foldr :: (a -> b -> b) -> b -> AuthResult a -> b #

foldr' :: (a -> b -> b) -> b -> AuthResult a -> b #

foldl :: (b -> a -> b) -> b -> AuthResult a -> b #

foldl' :: (b -> a -> b) -> b -> AuthResult a -> b #

foldr1 :: (a -> a -> a) -> AuthResult a -> a #

foldl1 :: (a -> a -> a) -> AuthResult a -> a #

toList :: AuthResult a -> [a] #

null :: AuthResult a -> Bool #

length :: AuthResult a -> Int #

elem :: Eq a => a -> AuthResult a -> Bool #

maximum :: Ord a => AuthResult a -> a #

minimum :: Ord a => AuthResult a -> a #

sum :: Num a => AuthResult a -> a #

product :: Num a => AuthResult a -> a #

Traversable AuthResult Source # 

Methods

traverse :: Applicative f => (a -> f b) -> AuthResult a -> f (AuthResult b) #

sequenceA :: Applicative f => AuthResult (f a) -> f (AuthResult a) #

mapM :: Monad m => (a -> m b) -> AuthResult a -> m (AuthResult b) #

sequence :: Monad m => AuthResult (m a) -> m (AuthResult a) #

Alternative AuthResult Source # 
MonadPlus AuthResult Source # 
Eq val => Eq (AuthResult val) Source # 

Methods

(==) :: AuthResult val -> AuthResult val -> Bool #

(/=) :: AuthResult val -> AuthResult val -> Bool #

Ord val => Ord (AuthResult val) Source # 

Methods

compare :: AuthResult val -> AuthResult val -> Ordering #

(<) :: AuthResult val -> AuthResult val -> Bool #

(<=) :: AuthResult val -> AuthResult val -> Bool #

(>) :: AuthResult val -> AuthResult val -> Bool #

(>=) :: AuthResult val -> AuthResult val -> Bool #

max :: AuthResult val -> AuthResult val -> AuthResult val #

min :: AuthResult val -> AuthResult val -> AuthResult val #

Read val => Read (AuthResult val) Source # 
Show val => Show (AuthResult val) Source # 

Methods

showsPrec :: Int -> AuthResult val -> ShowS #

show :: AuthResult val -> String #

showList :: [AuthResult val] -> ShowS #

Generic (AuthResult val) Source # 

Associated Types

type Rep (AuthResult val) :: * -> * #

Methods

from :: AuthResult val -> Rep (AuthResult val) x #

to :: Rep (AuthResult val) x -> AuthResult val #

Monoid (AuthResult val) Source # 

Methods

mempty :: AuthResult val #

mappend :: AuthResult val -> AuthResult val -> AuthResult val #

mconcat :: [AuthResult val] -> AuthResult val #

type Rep (AuthResult val) Source # 
type Rep (AuthResult val) = D1 (MetaData "AuthResult" "Servant.Auth.Server.Internal.Types" "servant-auth-server-0.3.2.0-2KI0XaNMvwT4925DYuC2HP" False) ((:+:) ((:+:) (C1 (MetaCons "BadPassword" PrefixI False) U1) (C1 (MetaCons "NoSuchUser" PrefixI False) U1)) ((:+:) (C1 (MetaCons "Authenticated" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 val))) (C1 (MetaCons "Indefinite" PrefixI False) U1)))

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 # 

Methods

(>>=) :: AuthCheck a -> (a -> AuthCheck b) -> AuthCheck b #

(>>) :: AuthCheck a -> AuthCheck b -> AuthCheck b #

return :: a -> AuthCheck a #

fail :: String -> AuthCheck a #

Functor AuthCheck Source # 

Methods

fmap :: (a -> b) -> AuthCheck a -> AuthCheck b #

(<$) :: a -> AuthCheck b -> AuthCheck a #

Applicative AuthCheck Source # 

Methods

pure :: a -> AuthCheck a #

(<*>) :: AuthCheck (a -> b) -> AuthCheck a -> AuthCheck b #

(*>) :: AuthCheck a -> AuthCheck b -> AuthCheck b #

(<*) :: AuthCheck a -> AuthCheck b -> AuthCheck a #

MonadIO AuthCheck Source # 

Methods

liftIO :: IO a -> AuthCheck a #

Alternative AuthCheck Source # 

Methods

empty :: AuthCheck a #

(<|>) :: AuthCheck a -> AuthCheck a -> AuthCheck a #

some :: AuthCheck a -> AuthCheck [a] #

many :: AuthCheck a -> AuthCheck [a] #

MonadPlus AuthCheck Source # 

Methods

mzero :: AuthCheck a #

mplus :: AuthCheck a -> AuthCheck a -> AuthCheck a #

MonadTime AuthCheck Source # 
MonadReader Request AuthCheck Source # 

Methods

ask :: AuthCheck Request

local :: (Request -> Request) -> AuthCheck a -> AuthCheck a

reader :: (Request -> a) -> AuthCheck a

Generic (AuthCheck val) Source # 

Associated Types

type Rep (AuthCheck val) :: * -> * #

Methods

from :: AuthCheck val -> Rep (AuthCheck val) x #

to :: Rep (AuthCheck val) x -> AuthCheck val #

Monoid (AuthCheck val) Source # 

Methods

mempty :: AuthCheck val #

mappend :: AuthCheck val -> AuthCheck val -> AuthCheck val #

mconcat :: [AuthCheck val] -> AuthCheck val #

type Rep (AuthCheck val) Source # 
type Rep (AuthCheck val) = D1 (MetaData "AuthCheck" "Servant.Auth.Server.Internal.Types" "servant-auth-server-0.3.2.0-2KI0XaNMvwT4925DYuC2HP" True) (C1 (MetaCons "AuthCheck" PrefixI True) (S1 (MetaSel (Just Symbol "runAuthCheck") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Request -> IO (AuthResult val)))))

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'

data JWT :: * #

Instances

FromJWT usr => IsAuth JWT usr Source # 

Associated Types

type AuthArgs JWT :: [*] Source #

Methods

runAuth :: proxy JWT -> proxy usr -> Unapp (AuthArgs JWT) (AuthCheck usr) Source #

type AuthArgs JWT Source # 
type AuthArgs JWT = (:) * JWTSettings ([] *)

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.

Methods

decodeJWT :: ClaimsSet -> Either Text a Source #

decodeJWT :: FromJSON a => ClaimsSet -> Either Text a Source #

class ToJWT a where Source #

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.

Methods

encodeJWT :: a -> ClaimsSet Source #

encodeJWT :: ToJSON a => a -> ClaimsSet Source #

Related types

data IsMatch Source #

Constructors

Matches 
DoesNotMatch 

Instances

Eq IsMatch Source # 

Methods

(==) :: IsMatch -> IsMatch -> Bool #

(/=) :: IsMatch -> IsMatch -> Bool #

Ord IsMatch Source # 
Read IsMatch Source # 
Show IsMatch Source # 
Generic IsMatch Source # 

Associated Types

type Rep IsMatch :: * -> * #

Methods

from :: IsMatch -> Rep IsMatch x #

to :: Rep IsMatch x -> IsMatch #

type Rep IsMatch Source # 
type Rep IsMatch = D1 (MetaData "IsMatch" "Servant.Auth.Server.Internal.ConfigTypes" "servant-auth-server-0.3.2.0-2KI0XaNMvwT4925DYuC2HP" False) ((:+:) (C1 (MetaCons "Matches" PrefixI False) U1) (C1 (MetaCons "DoesNotMatch" PrefixI False) U1))

Settings

data JWTSettings Source #

JWTSettings are used to generate cookies, and to verify JWTs.

Constructors

JWTSettings 

Fields

  • key :: JWK
     
  • audienceMatches :: StringOrURI -> IsMatch

    An aud predicate. The aud is a string or URI that identifies the intended recipient of the JWT.

Instances

Generic JWTSettings Source # 

Associated Types

type Rep JWTSettings :: * -> * #

type Rep JWTSettings Source # 
type Rep JWTSettings = D1 (MetaData "JWTSettings" "Servant.Auth.Server.Internal.ConfigTypes" "servant-auth-server-0.3.2.0-2KI0XaNMvwT4925DYuC2HP" False) (C1 (MetaCons "JWTSettings" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "key") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 JWK)) (S1 (MetaSel (Just Symbol "audienceMatches") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (StringOrURI -> IsMatch)))))

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'

data Cookie :: * #

Instances

FromJWT usr => IsAuth Cookie usr Source # 

Associated Types

type AuthArgs Cookie :: [*] Source #

Methods

runAuth :: proxy Cookie -> proxy usr -> Unapp (AuthArgs Cookie) (AuthCheck usr) Source #

type AuthArgs Cookie Source # 
type AuthArgs Cookie = (:) * CookieSettings ((:) * JWTSettings ([] *))

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

Eq CookieSettings Source # 
Show CookieSettings Source # 
Generic CookieSettings Source # 

Associated Types

type Rep CookieSettings :: * -> * #

Default CookieSettings Source # 

Methods

def :: CookieSettings #

type Rep CookieSettings Source # 

makeSessionCookie :: ToJWT v => CookieSettings -> JWTSettings -> v -> IO (Maybe SetCookie) Source #

Makes a cookie with session information.

makeCsrfCookie :: CookieSettings -> IO SetCookie Source #

Makes a cookie to be used for CSRF.

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 CSRF and session cookies. This should be used when a user successfully authenticates with credentials.

Related types

data IsSecure Source #

Constructors

Secure 
NotSecure 

Instances

Eq IsSecure Source # 
Ord IsSecure Source # 
Read IsSecure Source # 
Show IsSecure Source # 
Generic IsSecure Source # 

Associated Types

type Rep IsSecure :: * -> * #

Methods

from :: IsSecure -> Rep IsSecure x #

to :: Rep IsSecure x -> IsSecure #

type Rep IsSecure Source # 
type Rep IsSecure = D1 (MetaData "IsSecure" "Servant.Auth.Server.Internal.ConfigTypes" "servant-auth-server-0.3.2.0-2KI0XaNMvwT4925DYuC2HP" False) ((:+:) (C1 (MetaCons "Secure" PrefixI False) U1) (C1 (MetaCons "NotSecure" PrefixI False) U1))

class AreAuths as ctxs v Source #

Minimal complete definition

runAuths

Instances

AreAuths ([] *) ctxs v Source # 

Methods

runAuths :: proxy [*] -> Context ctxs -> AuthCheck v Source #

((~) * (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 Source # 

Methods

runAuths :: proxy ((* ': a) as) -> Context ctxs -> AuthCheck v Source #

BasicAuth

Combinator

Re-exported from 'servant-auth'

data BasicAuth :: * #

Instances

FromBasicAuthData usr => IsAuth BasicAuth usr Source # 

Associated Types

type AuthArgs BasicAuth :: [*] Source #

Methods

runAuth :: proxy BasicAuth -> proxy usr -> Unapp (AuthArgs BasicAuth) (AuthCheck usr) Source #

type AuthArgs BasicAuth Source # 

Classes

class FromBasicAuthData a where Source #

Minimal complete definition

fromBasicAuthData

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 IsPasswordCorrect Source #

Instances

Eq IsPasswordCorrect Source # 
Ord IsPasswordCorrect Source # 
Read IsPasswordCorrect Source # 
Show IsPasswordCorrect Source # 
Generic IsPasswordCorrect Source # 
type Rep IsPasswordCorrect Source # 
type Rep IsPasswordCorrect = D1 (MetaData "IsPasswordCorrect" "Servant.Auth.Server.Internal.ConfigTypes" "servant-auth-server-0.3.2.0-2KI0XaNMvwT4925DYuC2HP" False) ((:+:) (C1 (MetaCons "PasswordCorrect" PrefixI False) U1) (C1 (MetaCons "PasswordIncorrect" PrefixI False) U1))

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

throwAll

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 servant <0.11

Methods

throwAll :: ServantErr -> Application Source #

MonadError ServantErr m => ThrowAll (m a) Source # 

Methods

throwAll :: ServantErr -> m a Source #

ThrowAll b => ThrowAll (a -> b) Source # 

Methods

throwAll :: ServantErr -> a -> b Source #

(ThrowAll a, ThrowAll b) => ThrowAll ((:<|>) a b) Source # 

Methods

throwAll :: ServantErr -> a :<|> b Source #

MonadError ServantErr m => ThrowAll (Tagged (* -> *) m Application) Source #

for servant >=0.11

Methods

throwAll :: ServantErr -> Tagged (* -> *) m Application Source #

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

class Default a where #

Methods

def :: a #

Instances

Default Double 

Methods

def :: Double #

Default Float 

Methods

def :: Float #

Default Int 

Methods

def :: Int #

Default Int8 

Methods

def :: Int8 #

Default Int16 

Methods

def :: Int16 #

Default Int32 

Methods

def :: Int32 #

Default Int64 

Methods

def :: Int64 #

Default Integer 

Methods

def :: Integer #

Default Ordering 

Methods

def :: Ordering #

Default Word 

Methods

def :: Word #

Default Word8 

Methods

def :: Word8 #

Default Word16 

Methods

def :: Word16 #

Default Word32 

Methods

def :: Word32 #

Default Word64 

Methods

def :: Word64 #

Default () 

Methods

def :: () #

Default CShort 

Methods

def :: CShort #

Default CUShort 

Methods

def :: CUShort #

Default CInt 

Methods

def :: CInt #

Default CUInt 

Methods

def :: CUInt #

Default CLong 

Methods

def :: CLong #

Default CULong 

Methods

def :: CULong #

Default CLLong 

Methods

def :: CLLong #

Default CULLong 

Methods

def :: CULLong #

Default CFloat 

Methods

def :: CFloat #

Default CDouble 

Methods

def :: CDouble #

Default CPtrdiff 

Methods

def :: CPtrdiff #

Default CSize 

Methods

def :: CSize #

Default CSigAtomic 

Methods

def :: CSigAtomic #

Default CClock 

Methods

def :: CClock #

Default CTime 

Methods

def :: CTime #

Default CUSeconds 

Methods

def :: CUSeconds #

Default CSUSeconds 

Methods

def :: CSUSeconds #

Default CIntPtr 

Methods

def :: CIntPtr #

Default CUIntPtr 

Methods

def :: CUIntPtr #

Default CIntMax 

Methods

def :: CIntMax #

Default CUIntMax 

Methods

def :: CUIntMax #

Default All 

Methods

def :: All #

Default Any 

Methods

def :: Any #

Default SetCookie 

Methods

def :: SetCookie #

Default CookieSettings # 

Methods

def :: CookieSettings #

Default [a] 

Methods

def :: [a] #

Default (Maybe a) 

Methods

def :: Maybe a #

Integral a => Default (Ratio a) 

Methods

def :: Ratio a #

Default a => Default (IO a) 

Methods

def :: IO a #

(Default a, RealFloat a) => Default (Complex a) 

Methods

def :: Complex a #

Default a => Default (Dual a) 

Methods

def :: Dual a #

Default (Endo a) 

Methods

def :: Endo a #

Num a => Default (Sum a) 

Methods

def :: Sum a #

Num a => Default (Product a) 

Methods

def :: Product a #

Default (First a) 

Methods

def :: First a #

Default (Last a) 

Methods

def :: Last a #

Default r => Default (e -> r) 

Methods

def :: e -> r #

(Default a, Default b) => Default (a, b) 

Methods

def :: (a, b) #

(Default a, Default b, Default c) => Default (a, b, c) 

Methods

def :: (a, b, c) #

(Default a, Default b, Default c, Default d) => Default (a, b, c, d) 

Methods

def :: (a, b, c, d) #

(Default a, Default b, Default c, Default d, Default e) => Default (a, b, c, d, e) 

Methods

def :: (a, b, c, d, e) #

(Default a, Default b, Default c, Default d, Default e, Default f) => Default (a, b, c, d, e, f) 

Methods

def :: (a, b, c, d, e, f) #

(Default a, Default b, Default c, Default d, Default e, Default f, Default g) => Default (a, b, c, d, e, f, g) 

Methods

def :: (a, b, c, d, e, f, g) #