Safe Haskell | None |
---|---|
Language | Haskell98 |
Synopsis
- data AuthenticateConfig = AuthenticateConfig {}
- isAuthAdmin :: Lens' AuthenticateConfig (UserId -> IO Bool)
- usernameAcceptable :: Lens' AuthenticateConfig (Username -> Maybe CoreError)
- requireEmail :: Lens' AuthenticateConfig Bool
- data HappstackAuthenticateI18N = HappstackAuthenticateI18N
- newtype UserId = UserId {}
- unUserId :: Functor f => (Integer -> f Integer) -> UserId -> f UserId
- rUserId :: Boomerang e tok (Integer :- r) (UserId :- r)
- succUserId :: UserId -> UserId
- jsonOptions :: Options
- toJSONResponse :: (RenderMessage HappstackAuthenticateI18N e, ToJSON a) => Either e a -> Response
- toJSONSuccess :: ToJSON a => a -> Response
- toJSONError :: forall e. RenderMessage HappstackAuthenticateI18N e => e -> Response
- newtype Username = Username {
- _unUsername :: Text
- unUsername :: Iso' Username Text
- rUsername :: forall tok e r. Boomerang e tok ((:-) Text r) ((:-) Username r)
- usernamePolicy :: Username -> Maybe CoreError
- newtype Email = Email {}
- unEmail :: Iso' Email Text
- data User = User {}
- userId :: Lens' User UserId
- username :: Lens' User Username
- email :: Lens' User (Maybe Email)
- type UserIxs = '[UserId, Username, Email]
- type IxUser = IxSet UserIxs User
- newtype SharedSecret = SharedSecret {}
- unSharedSecret :: Iso' SharedSecret Text
- data SimpleAddress = SimpleAddress {}
- genSharedSecret :: MonadIO m => m SharedSecret
- genSharedSecretDevURandom :: IO SharedSecret
- genSharedSecretSysRandom :: IO SharedSecret
- type SharedSecrets = Map UserId SharedSecret
- initialSharedSecrets :: SharedSecrets
- data CoreError
- data NewAccountMode
- data AuthenticateState = AuthenticateState {}
- sharedSecrets :: Lens' AuthenticateState SharedSecrets
- users :: Lens' AuthenticateState IxUser
- nextUserId :: Lens' AuthenticateState UserId
- defaultSessionTimeout :: Lens' AuthenticateState Int
- newAccountMode :: Lens' AuthenticateState NewAccountMode
- initialAuthenticateState :: AuthenticateState
- data SetSharedSecret = SetSharedSecret UserId SharedSecret
- newtype GetSharedSecret = GetSharedSecret UserId
- newtype SetDefaultSessionTimeout = SetDefaultSessionTimeout Int
- data GetDefaultSessionTimeout = GetDefaultSessionTimeout
- newtype SetNewAccountMode = SetNewAccountMode NewAccountMode
- data GetNewAccountMode = GetNewAccountMode
- newtype CreateUser = CreateUser User
- data CreateAnonymousUser = CreateAnonymousUser
- newtype UpdateUser = UpdateUser User
- newtype DeleteUser = DeleteUser UserId
- newtype GetUserByUsername = GetUserByUsername Username
- newtype GetUserByUserId = GetUserByUserId UserId
- newtype GetUserByEmail = GetUserByEmail Email
- data GetAuthenticateState = GetAuthenticateState
- getOrGenSharedSecret :: MonadIO m => AcidState AuthenticateState -> UserId -> m SharedSecret
- data Token = Token {}
- tokenUser :: Lens' Token User
- tokenIsAuthAdmin :: Lens' Token Bool
- type TokenText = Text
- issueToken :: MonadIO m => AcidState AuthenticateState -> AuthenticateConfig -> User -> m TokenText
- decodeAndVerifyToken :: MonadIO m => AcidState AuthenticateState -> UTCTime -> TokenText -> m (Maybe (Token, JWT VerifiedJWT))
- authCookieName :: String
- addTokenCookie :: Happstack m => AcidState AuthenticateState -> AuthenticateConfig -> User -> m TokenText
- deleteTokenCookie :: Happstack m => m ()
- getTokenCookie :: Happstack m => AcidState AuthenticateState -> m (Maybe (Token, JWT VerifiedJWT))
- getTokenHeader :: Happstack m => AcidState AuthenticateState -> m (Maybe (Token, JWT VerifiedJWT))
- getToken :: Happstack m => AcidState AuthenticateState -> m (Maybe (Token, JWT VerifiedJWT))
- getUserId :: Happstack m => AcidState AuthenticateState -> m (Maybe UserId)
- newtype AuthenticationMethod = AuthenticationMethod {}
- unAuthenticationMethod :: Iso' AuthenticationMethod Text
- rAuthenticationMethod :: forall tok e r. Boomerang e tok ((:-) Text r) ((:-) AuthenticationMethod r)
- type AuthenticationHandler = [Text] -> RouteT AuthenticateURL (ServerPartT IO) Response
- type AuthenticationHandlers = Map AuthenticationMethod AuthenticationHandler
- data AuthenticateURL
- rAuthenticationMethods :: forall tok e r. Boomerang e tok ((:-) (Maybe (AuthenticationMethod, [Text])) r) ((:-) AuthenticateURL r)
- rControllers :: forall tok e r. Boomerang e tok r ((:-) AuthenticateURL r)
- systemFromAddress :: Lens' AuthenticateConfig (Maybe SimpleAddress)
- systemReplyToAddress :: Lens' AuthenticateConfig (Maybe SimpleAddress)
- systemSendmailPath :: Lens' AuthenticateConfig (Maybe FilePath)
- authenticateURL :: Router () (AuthenticateURL :- ())
- nestAuthenticationMethod :: PathInfo methodURL => AuthenticationMethod -> RouteT methodURL m a -> RouteT AuthenticateURL m a
Documentation
data AuthenticateConfig Source #
Various configuration options that apply to all authentication methods
AuthenticateConfig | |
|
Instances
isAuthAdmin :: Lens' AuthenticateConfig (UserId -> IO Bool) Source #
data HappstackAuthenticateI18N Source #
Instances
a UserId
uniquely identifies a user.
Instances
Enum UserId | |
Defined in Data.UserId | |
Eq UserId | |
Data UserId | |
Defined in Data.UserId gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> UserId -> c UserId # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c UserId # toConstr :: UserId -> Constr # dataTypeOf :: UserId -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c UserId) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserId) # gmapT :: (forall b. Data b => b -> b) -> UserId -> UserId # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UserId -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UserId -> r # gmapQ :: (forall d. Data d => d -> u) -> UserId -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> UserId -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> UserId -> m UserId # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> UserId -> m UserId # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> UserId -> m UserId # | |
Ord UserId | |
Read UserId | |
Show UserId | |
Generic UserId | |
SafeCopy UserId | |
ToJSON UserId | |
Defined in Data.UserId | |
FromJSON UserId | |
Serialize UserId | |
PathInfo UserId | |
Defined in Data.UserId toPathSegments :: UserId -> [Text] # | |
Indexable UserIxs User Source # | |
type Rep UserId | |
Defined in Data.UserId |
succUserId :: UserId -> UserId #
get the next UserId
jsonOptions :: Options Source #
when creating JSON field names, drop the first character. Since we are using lens, the leading character should always be _.
toJSONResponse :: (RenderMessage HappstackAuthenticateI18N e, ToJSON a) => Either e a -> Response Source #
convert a value to a JSON encoded Response
toJSONError :: forall e. RenderMessage HappstackAuthenticateI18N e => e -> Response Source #
convert an error to a JSON encoded Response
FIXME: I18N
an arbitrary, but unique string that the user uses to identify themselves
Instances
an Email
address. No validation in performed.
Instances
Eq Email Source # | |
Data Email Source # | |
Defined in Happstack.Authenticate.Core gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Email -> c Email # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Email # dataTypeOf :: Email -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Email) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Email) # gmapT :: (forall b. Data b => b -> b) -> Email -> Email # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Email -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Email -> r # gmapQ :: (forall d. Data d => d -> u) -> Email -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Email -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Email -> m Email # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Email -> m Email # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Email -> m Email # | |
Ord Email Source # | |
Read Email Source # | |
Show Email Source # | |
Generic Email Source # | |
SafeCopy Email Source # | |
ToJSON Email Source # | |
Defined in Happstack.Authenticate.Core | |
FromJSON Email Source # | |
PathInfo Email Source # | |
Defined in Happstack.Authenticate.Core toPathSegments :: Email -> [Text] # | |
Indexable UserIxs User Source # | |
type Rep Email Source # | |
Defined in Happstack.Authenticate.Core |
A unique User
Instances
Eq User Source # | |
Data User Source # | |
Defined in Happstack.Authenticate.Core gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> User -> c User # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c User # dataTypeOf :: User -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c User) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c User) # gmapT :: (forall b. Data b => b -> b) -> User -> User # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> User -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> User -> r # gmapQ :: (forall d. Data d => d -> u) -> User -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> User -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> User -> m User # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> User -> m User # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> User -> m User # | |
Ord User Source # | |
Read User Source # | |
Show User Source # | |
Generic User Source # | |
SafeCopy User Source # | |
ToJSON User Source # | |
Defined in Happstack.Authenticate.Core | |
FromJSON User Source # | |
Indexable UserIxs User Source # | |
type Rep User Source # | |
Defined in Happstack.Authenticate.Core type Rep User = D1 (MetaData "User" "Happstack.Authenticate.Core" "happstack-authenticate-2.4.0.3-EWiQK3JTFpjLhW6KbXCBsH" False) (C1 (MetaCons "User" PrefixI True) (S1 (MetaSel (Just "_userId") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 UserId) :*: (S1 (MetaSel (Just "_username") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Username) :*: S1 (MetaSel (Just "_email") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe Email))))) |
newtype SharedSecret Source #
The shared secret is used to encrypt a users data on a per-user basis. We can invalidate a JWT value by changing the shared secret.
data SimpleAddress Source #
Instances
genSharedSecret :: MonadIO m => m SharedSecret Source #
Generate a Salt
from 128 bits of data from /dev/urandom
, with the
system RNG as a fallback. This is the function used to generate salts by
makePassword
.
genSharedSecretDevURandom :: IO SharedSecret Source #
Generate a SharedSecret
from /dev/urandom
.
see: genSharedSecret
genSharedSecretSysRandom :: IO SharedSecret Source #
Generate a SharedSecret
from Random
.
see: genSharedSecret
type SharedSecrets = Map UserId SharedSecret Source #
A map which stores the SharedSecret
for each UserId
initialSharedSecrets :: SharedSecrets Source #
An empty SharedSecrets
the CoreError
type is used to represent errors in a language
agnostic manner. The errors are translated into human readable form
via the I18N translations.
HandlerNotFound | |
URLDecodeFailed | |
UsernameAlreadyExists | |
AuthorizationRequired | |
Forbidden | |
JSONDecodeFailed | |
InvalidUserId | |
UsernameNotAcceptable | |
InvalidEmail | |
TextError Text |
Instances
data NewAccountMode Source #
This value is used to configure the type of new user registrations permitted for this system.
OpenRegistration | new users can create their own accounts |
ModeratedRegistration | new users can apply to create their own accounts, but a moderator must approve them before they are active |
ClosedRegistration | only the admin can create a new account |
Instances
data AuthenticateState Source #
this acid-state value contains the state common to all authentication methods
AuthenticateState | |
|
Instances
initialAuthenticateState :: AuthenticateState Source #
a reasonable initial AuthenticateState
newtype SetDefaultSessionTimeout Source #
Instances
data GetDefaultSessionTimeout Source #
Instances
newtype SetNewAccountMode Source #
Instances
SafeCopy SetNewAccountMode Source # | |
Defined in Happstack.Authenticate.Core | |
UpdateEvent SetNewAccountMode Source # | |
Defined in Happstack.Authenticate.Core | |
Method SetNewAccountMode Source # | |
Defined in Happstack.Authenticate.Core type MethodResult SetNewAccountMode :: Type # type MethodState SetNewAccountMode :: Type # methodTag :: SetNewAccountMode -> Tag # | |
type MethodState SetNewAccountMode Source # | |
Defined in Happstack.Authenticate.Core | |
type MethodResult SetNewAccountMode Source # | |
Defined in Happstack.Authenticate.Core |
data GetNewAccountMode Source #
Instances
SafeCopy GetNewAccountMode Source # | |
Defined in Happstack.Authenticate.Core | |
QueryEvent GetNewAccountMode Source # | |
Defined in Happstack.Authenticate.Core | |
Method GetNewAccountMode Source # | |
Defined in Happstack.Authenticate.Core type MethodResult GetNewAccountMode :: Type # type MethodState GetNewAccountMode :: Type # methodTag :: GetNewAccountMode -> Tag # | |
type MethodState GetNewAccountMode Source # | |
Defined in Happstack.Authenticate.Core | |
type MethodResult GetNewAccountMode Source # | |
Defined in Happstack.Authenticate.Core |
newtype CreateUser Source #
Instances
SafeCopy CreateUser Source # | |
Defined in Happstack.Authenticate.Core version :: Version CreateUser # kind :: Kind CreateUser # getCopy :: Contained (Get CreateUser) # putCopy :: CreateUser -> Contained Put # internalConsistency :: Consistency CreateUser # objectProfile :: Profile CreateUser # errorTypeName :: Proxy CreateUser -> String # | |
UpdateEvent CreateUser Source # | |
Defined in Happstack.Authenticate.Core | |
Method CreateUser Source # | |
Defined in Happstack.Authenticate.Core type MethodResult CreateUser :: Type # type MethodState CreateUser :: Type # methodTag :: CreateUser -> Tag # | |
type MethodState CreateUser Source # | |
Defined in Happstack.Authenticate.Core | |
type MethodResult CreateUser Source # | |
Defined in Happstack.Authenticate.Core |
data CreateAnonymousUser Source #
Instances
SafeCopy CreateAnonymousUser Source # | |
Defined in Happstack.Authenticate.Core | |
UpdateEvent CreateAnonymousUser Source # | |
Defined in Happstack.Authenticate.Core | |
Method CreateAnonymousUser Source # | |
Defined in Happstack.Authenticate.Core type MethodResult CreateAnonymousUser :: Type # type MethodState CreateAnonymousUser :: Type # methodTag :: CreateAnonymousUser -> Tag # | |
type MethodState CreateAnonymousUser Source # | |
Defined in Happstack.Authenticate.Core | |
type MethodResult CreateAnonymousUser Source # | |
Defined in Happstack.Authenticate.Core |
newtype UpdateUser Source #
Instances
SafeCopy UpdateUser Source # | |
Defined in Happstack.Authenticate.Core version :: Version UpdateUser # kind :: Kind UpdateUser # getCopy :: Contained (Get UpdateUser) # putCopy :: UpdateUser -> Contained Put # internalConsistency :: Consistency UpdateUser # objectProfile :: Profile UpdateUser # errorTypeName :: Proxy UpdateUser -> String # | |
UpdateEvent UpdateUser Source # | |
Defined in Happstack.Authenticate.Core | |
Method UpdateUser Source # | |
Defined in Happstack.Authenticate.Core type MethodResult UpdateUser :: Type # type MethodState UpdateUser :: Type # methodTag :: UpdateUser -> Tag # | |
type MethodState UpdateUser Source # | |
Defined in Happstack.Authenticate.Core | |
type MethodResult UpdateUser Source # | |
Defined in Happstack.Authenticate.Core |
newtype DeleteUser Source #
Instances
SafeCopy DeleteUser Source # | |
Defined in Happstack.Authenticate.Core version :: Version DeleteUser # kind :: Kind DeleteUser # getCopy :: Contained (Get DeleteUser) # putCopy :: DeleteUser -> Contained Put # internalConsistency :: Consistency DeleteUser # objectProfile :: Profile DeleteUser # errorTypeName :: Proxy DeleteUser -> String # | |
UpdateEvent DeleteUser Source # | |
Defined in Happstack.Authenticate.Core | |
Method DeleteUser Source # | |
Defined in Happstack.Authenticate.Core type MethodResult DeleteUser :: Type # type MethodState DeleteUser :: Type # methodTag :: DeleteUser -> Tag # | |
type MethodState DeleteUser Source # | |
Defined in Happstack.Authenticate.Core | |
type MethodResult DeleteUser Source # | |
Defined in Happstack.Authenticate.Core |
newtype GetUserByUsername Source #
Instances
SafeCopy GetUserByUsername Source # | |
Defined in Happstack.Authenticate.Core | |
QueryEvent GetUserByUsername Source # | |
Defined in Happstack.Authenticate.Core | |
Method GetUserByUsername Source # | |
Defined in Happstack.Authenticate.Core type MethodResult GetUserByUsername :: Type # type MethodState GetUserByUsername :: Type # methodTag :: GetUserByUsername -> Tag # | |
type MethodState GetUserByUsername Source # | |
Defined in Happstack.Authenticate.Core | |
type MethodResult GetUserByUsername Source # | |
Defined in Happstack.Authenticate.Core |
newtype GetUserByUserId Source #
Instances
SafeCopy GetUserByUserId Source # | |
Defined in Happstack.Authenticate.Core | |
QueryEvent GetUserByUserId Source # | |
Defined in Happstack.Authenticate.Core | |
Method GetUserByUserId Source # | |
Defined in Happstack.Authenticate.Core type MethodResult GetUserByUserId :: Type # type MethodState GetUserByUserId :: Type # methodTag :: GetUserByUserId -> Tag # | |
type MethodState GetUserByUserId Source # | |
Defined in Happstack.Authenticate.Core | |
type MethodResult GetUserByUserId Source # | |
Defined in Happstack.Authenticate.Core |
newtype GetUserByEmail Source #
Instances
SafeCopy GetUserByEmail Source # | |
Defined in Happstack.Authenticate.Core | |
QueryEvent GetUserByEmail Source # | |
Defined in Happstack.Authenticate.Core | |
Method GetUserByEmail Source # | |
Defined in Happstack.Authenticate.Core type MethodResult GetUserByEmail :: Type # type MethodState GetUserByEmail :: Type # methodTag :: GetUserByEmail -> Tag # | |
type MethodState GetUserByEmail Source # | |
Defined in Happstack.Authenticate.Core | |
type MethodResult GetUserByEmail Source # | |
Defined in Happstack.Authenticate.Core |
data GetAuthenticateState Source #
Instances
SafeCopy GetAuthenticateState Source # | |
Defined in Happstack.Authenticate.Core | |
QueryEvent GetAuthenticateState Source # | |
Defined in Happstack.Authenticate.Core | |
Method GetAuthenticateState Source # | |
Defined in Happstack.Authenticate.Core type MethodResult GetAuthenticateState :: Type # type MethodState GetAuthenticateState :: Type # methodTag :: GetAuthenticateState -> Tag # | |
type MethodState GetAuthenticateState Source # | |
Defined in Happstack.Authenticate.Core | |
type MethodResult GetAuthenticateState Source # | |
Defined in Happstack.Authenticate.Core |
getOrGenSharedSecret :: MonadIO m => AcidState AuthenticateState -> UserId -> m SharedSecret Source #
get the SharedSecret
for UserId
. Generate one if they don't have one yet.
The Token
type represents the encrypted data used to identify a
user.
Token | |
|
Instances
Eq Token Source # | |
Data Token Source # | |
Defined in Happstack.Authenticate.Core gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Token -> c Token # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Token # dataTypeOf :: Token -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Token) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Token) # gmapT :: (forall b. Data b => b -> b) -> Token -> Token # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r # gmapQ :: (forall d. Data d => d -> u) -> Token -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Token -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Token -> m Token # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Token -> m Token # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Token -> m Token # | |
Ord Token Source # | |
Read Token Source # | |
Show Token Source # | |
Generic Token Source # | |
ToJSON Token Source # | |
Defined in Happstack.Authenticate.Core | |
FromJSON Token Source # | |
type Rep Token Source # | |
Defined in Happstack.Authenticate.Core type Rep Token = D1 (MetaData "Token" "Happstack.Authenticate.Core" "happstack-authenticate-2.4.0.3-EWiQK3JTFpjLhW6KbXCBsH" False) (C1 (MetaCons "Token" PrefixI True) (S1 (MetaSel (Just "_tokenUser") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 User) :*: S1 (MetaSel (Just "_tokenIsAuthAdmin") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool))) |
:: MonadIO m | |
=> AcidState AuthenticateState | |
-> AuthenticateConfig | |
-> User | the user |
-> m TokenText |
decodeAndVerifyToken :: MonadIO m => AcidState AuthenticateState -> UTCTime -> TokenText -> m (Maybe (Token, JWT VerifiedJWT)) Source #
addTokenCookie :: Happstack m => AcidState AuthenticateState -> AuthenticateConfig -> User -> m TokenText Source #
create a Token
for User
and add a Cookie
to the Response
see also: issueToken
getTokenCookie :: Happstack m => AcidState AuthenticateState -> m (Maybe (Token, JWT VerifiedJWT)) Source #
getTokenHeader :: Happstack m => AcidState AuthenticateState -> m (Maybe (Token, JWT VerifiedJWT)) Source #
get, decode, and verify the Token
from the Authorization
HTTP header
getToken :: Happstack m => AcidState AuthenticateState -> m (Maybe (Token, JWT VerifiedJWT)) Source #
get, decode, and verify the Token
looking first in the
Authorization
header and then in Cookie
.
see also: getTokenHeader
, getTokenCookie
newtype AuthenticationMethod Source #
AuthenticationMethod
is used by the routing system to select which
authentication backend should handle this request.
Instances
rAuthenticationMethod :: forall tok e r. Boomerang e tok ((:-) Text r) ((:-) AuthenticationMethod r) Source #
type AuthenticationHandler = [Text] -> RouteT AuthenticateURL (ServerPartT IO) Response Source #
data AuthenticateURL Source #
Instances
rAuthenticationMethods :: forall tok e r. Boomerang e tok ((:-) (Maybe (AuthenticationMethod, [Text])) r) ((:-) AuthenticateURL r) Source #
rControllers :: forall tok e r. Boomerang e tok r ((:-) AuthenticateURL r) Source #
authenticateURL :: Router () (AuthenticateURL :- ()) Source #
a Router
for AuthenicateURL
nestAuthenticationMethod :: PathInfo methodURL => AuthenticationMethod -> RouteT methodURL m a -> RouteT AuthenticateURL m a Source #
helper function which converts a URL for an authentication
backend into an AuthenticateURL
.