happstack-authenticate-2.6.0: Happstack Authentication Library
Safe HaskellNone
LanguageHaskell2010

Happstack.Authenticate.Core

Synopsis

Documentation

data AuthenticateConfig Source #

Various configuration options that apply to all authentication methods

Constructors

AuthenticateConfig 

Fields

Instances

Instances details
Generic AuthenticateConfig Source # 
Instance details

Defined in Happstack.Authenticate.Core

Associated Types

type Rep AuthenticateConfig :: Type -> Type #

type Rep AuthenticateConfig Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep AuthenticateConfig = D1 ('MetaData "AuthenticateConfig" "Happstack.Authenticate.Core" "happstack-authenticate-2.6.0-H4Cz7jjbqfUGLgvBipYkvR" 'False) (C1 ('MetaCons "AuthenticateConfig" 'PrefixI 'True) (((S1 ('MetaSel ('Just "_isAuthAdmin") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (UserId -> IO Bool)) :*: S1 ('MetaSel ('Just "_usernameAcceptable") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Username -> Maybe CoreError))) :*: (S1 ('MetaSel ('Just "_requireEmail") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool) :*: S1 ('MetaSel ('Just "_systemFromAddress") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe SimpleAddress)))) :*: ((S1 ('MetaSel ('Just "_systemReplyToAddress") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe SimpleAddress)) :*: S1 ('MetaSel ('Just "_systemSendmailPath") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe FilePath))) :*: (S1 ('MetaSel ('Just "_postLoginRedirect") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: S1 ('MetaSel ('Just "_createUserCallback") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (User -> IO ())))))))

newtype UserId #

a UserId uniquely identifies a user.

Constructors

UserId 

Fields

Instances

Instances details
Enum UserId 
Instance details

Defined in Data.UserId

Eq UserId 
Instance details

Defined in Data.UserId

Methods

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

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

Data UserId 
Instance details

Defined in Data.UserId

Methods

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 :: forall r r'. (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 
Instance details

Defined in Data.UserId

Read UserId 
Instance details

Defined in Data.UserId

Show UserId 
Instance details

Defined in Data.UserId

Generic UserId 
Instance details

Defined in Data.UserId

Associated Types

type Rep UserId :: Type -> Type #

Methods

from :: UserId -> Rep UserId x #

to :: Rep UserId x -> UserId #

SafeCopy UserId 
Instance details

Defined in Data.UserId

ToJSON UserId 
Instance details

Defined in Data.UserId

FromJSON UserId 
Instance details

Defined in Data.UserId

Serialize UserId 
Instance details

Defined in Data.UserId

PathInfo UserId 
Instance details

Defined in Data.UserId

Indexable UserIxs User Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep UserId 
Instance details

Defined in Data.UserId

type Rep UserId = D1 ('MetaData "UserId" "Data.UserId" "userid-0.1.3.6-JcFBnIuavOjCPWw8Cc2pFu" 'True) (C1 ('MetaCons "UserId" 'PrefixI 'True) (S1 ('MetaSel ('Just "_unUserId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Integer)))

unUserId :: Functor f => (Integer -> f Integer) -> UserId -> f UserId #

rUserId :: forall tok e r. Boomerang e tok (Integer :- r) (UserId :- r) #

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

toJSONSuccess :: ToJSON a => 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

newtype Username Source #

an arbitrary, but unique string that the user uses to identify themselves

Constructors

Username 

Fields

Instances

Instances details
Eq Username Source # 
Instance details

Defined in Happstack.Authenticate.Core

Data Username Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Username -> c Username #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Username #

toConstr :: Username -> Constr #

dataTypeOf :: Username -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Username) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Username) #

gmapT :: (forall b. Data b => b -> b) -> Username -> Username #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Username -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Username -> r #

gmapQ :: (forall d. Data d => d -> u) -> Username -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Username -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Username -> m Username #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Username -> m Username #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Username -> m Username #

Ord Username Source # 
Instance details

Defined in Happstack.Authenticate.Core

Read Username Source # 
Instance details

Defined in Happstack.Authenticate.Core

Show Username Source # 
Instance details

Defined in Happstack.Authenticate.Core

Generic Username Source # 
Instance details

Defined in Happstack.Authenticate.Core

Associated Types

type Rep Username :: Type -> Type #

Methods

from :: Username -> Rep Username x #

to :: Rep Username x -> Username #

SafeCopy Username Source # 
Instance details

Defined in Happstack.Authenticate.Core

ToJSON Username Source # 
Instance details

Defined in Happstack.Authenticate.Core

FromJSON Username Source # 
Instance details

Defined in Happstack.Authenticate.Core

PathInfo Username Source # 
Instance details

Defined in Happstack.Authenticate.Core

Indexable UserIxs User Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep Username Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep Username = D1 ('MetaData "Username" "Happstack.Authenticate.Core" "happstack-authenticate-2.6.0-H4Cz7jjbqfUGLgvBipYkvR" 'True) (C1 ('MetaCons "Username" 'PrefixI 'True) (S1 ('MetaSel ('Just "_unUsername") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

rUsername :: forall tok e r. Boomerang e tok ((:-) Text r) ((:-) Username r) Source #

usernamePolicy :: Username -> Maybe CoreError Source #

a very basic policy for userAcceptable

Enforces:

Username can not be empty

newtype Email Source #

an Email address. No validation in performed.

Constructors

Email 

Fields

Instances

Instances details
Eq Email Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

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

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

Data Email Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

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 #

toConstr :: Email -> Constr #

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 :: forall r r'. (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 # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

compare :: Email -> Email -> Ordering #

(<) :: Email -> Email -> Bool #

(<=) :: Email -> Email -> Bool #

(>) :: Email -> Email -> Bool #

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

max :: Email -> Email -> Email #

min :: Email -> Email -> Email #

Read Email Source # 
Instance details

Defined in Happstack.Authenticate.Core

Show Email Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

showsPrec :: Int -> Email -> ShowS #

show :: Email -> String #

showList :: [Email] -> ShowS #

Generic Email Source # 
Instance details

Defined in Happstack.Authenticate.Core

Associated Types

type Rep Email :: Type -> Type #

Methods

from :: Email -> Rep Email x #

to :: Rep Email x -> Email #

SafeCopy Email Source # 
Instance details

Defined in Happstack.Authenticate.Core

ToJSON Email Source # 
Instance details

Defined in Happstack.Authenticate.Core

FromJSON Email Source # 
Instance details

Defined in Happstack.Authenticate.Core

PathInfo Email Source # 
Instance details

Defined in Happstack.Authenticate.Core

Indexable UserIxs User Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep Email Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep Email = D1 ('MetaData "Email" "Happstack.Authenticate.Core" "happstack-authenticate-2.6.0-H4Cz7jjbqfUGLgvBipYkvR" 'True) (C1 ('MetaCons "Email" 'PrefixI 'True) (S1 ('MetaSel ('Just "_unEmail") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

data User Source #

A unique User

Constructors

User 

Instances

Instances details
Eq User Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

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

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

Data User Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

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 #

toConstr :: User -> Constr #

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 :: forall r r'. (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 # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

compare :: User -> User -> Ordering #

(<) :: User -> User -> Bool #

(<=) :: User -> User -> Bool #

(>) :: User -> User -> Bool #

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

max :: User -> User -> User #

min :: User -> User -> User #

Read User Source # 
Instance details

Defined in Happstack.Authenticate.Core

Show User Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

showsPrec :: Int -> User -> ShowS #

show :: User -> String #

showList :: [User] -> ShowS #

Generic User Source # 
Instance details

Defined in Happstack.Authenticate.Core

Associated Types

type Rep User :: Type -> Type #

Methods

from :: User -> Rep User x #

to :: Rep User x -> User #

SafeCopy User Source # 
Instance details

Defined in Happstack.Authenticate.Core

ToJSON User Source # 
Instance details

Defined in Happstack.Authenticate.Core

FromJSON User Source # 
Instance details

Defined in Happstack.Authenticate.Core

Indexable UserIxs User Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep User Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep User = D1 ('MetaData "User" "Happstack.Authenticate.Core" "happstack-authenticate-2.6.0-H4Cz7jjbqfUGLgvBipYkvR" '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.

Constructors

SharedSecret 

Instances

Instances details
Eq SharedSecret Source # 
Instance details

Defined in Happstack.Authenticate.Core

Data SharedSecret Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SharedSecret -> c SharedSecret #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SharedSecret #

toConstr :: SharedSecret -> Constr #

dataTypeOf :: SharedSecret -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c SharedSecret) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SharedSecret) #

gmapT :: (forall b. Data b => b -> b) -> SharedSecret -> SharedSecret #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SharedSecret -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SharedSecret -> r #

gmapQ :: (forall d. Data d => d -> u) -> SharedSecret -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> SharedSecret -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> SharedSecret -> m SharedSecret #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SharedSecret -> m SharedSecret #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SharedSecret -> m SharedSecret #

Ord SharedSecret Source # 
Instance details

Defined in Happstack.Authenticate.Core

Read SharedSecret Source # 
Instance details

Defined in Happstack.Authenticate.Core

Show SharedSecret Source # 
Instance details

Defined in Happstack.Authenticate.Core

Generic SharedSecret Source # 
Instance details

Defined in Happstack.Authenticate.Core

Associated Types

type Rep SharedSecret :: Type -> Type #

SafeCopy SharedSecret Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep SharedSecret Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep SharedSecret = D1 ('MetaData "SharedSecret" "Happstack.Authenticate.Core" "happstack-authenticate-2.6.0-H4Cz7jjbqfUGLgvBipYkvR" 'True) (C1 ('MetaCons "SharedSecret" 'PrefixI 'True) (S1 ('MetaSel ('Just "_unSharedSecret") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

data SimpleAddress Source #

Constructors

SimpleAddress 

Instances

Instances details
Eq SimpleAddress Source # 
Instance details

Defined in Happstack.Authenticate.Core

Data SimpleAddress Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SimpleAddress -> c SimpleAddress #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SimpleAddress #

toConstr :: SimpleAddress -> Constr #

dataTypeOf :: SimpleAddress -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c SimpleAddress) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SimpleAddress) #

gmapT :: (forall b. Data b => b -> b) -> SimpleAddress -> SimpleAddress #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SimpleAddress -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SimpleAddress -> r #

gmapQ :: (forall d. Data d => d -> u) -> SimpleAddress -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> SimpleAddress -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> SimpleAddress -> m SimpleAddress #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SimpleAddress -> m SimpleAddress #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SimpleAddress -> m SimpleAddress #

Ord SimpleAddress Source # 
Instance details

Defined in Happstack.Authenticate.Core

Read SimpleAddress Source # 
Instance details

Defined in Happstack.Authenticate.Core

Show SimpleAddress Source # 
Instance details

Defined in Happstack.Authenticate.Core

Generic SimpleAddress Source # 
Instance details

Defined in Happstack.Authenticate.Core

Associated Types

type Rep SimpleAddress :: Type -> Type #

SafeCopy SimpleAddress Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep SimpleAddress Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep SimpleAddress = D1 ('MetaData "SimpleAddress" "Happstack.Authenticate.Core" "happstack-authenticate-2.6.0-H4Cz7jjbqfUGLgvBipYkvR" 'False) (C1 ('MetaCons "SimpleAddress" 'PrefixI 'True) (S1 ('MetaSel ('Just "_saName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: S1 ('MetaSel ('Just "_saEmail") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Email)))

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.

type SharedSecrets = Map UserId SharedSecret Source #

A map which stores the SharedSecret for each UserId

data CoreError Source #

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.

Instances

Instances details
Eq CoreError Source # 
Instance details

Defined in Happstack.Authenticate.Core

Data CoreError Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> CoreError -> c CoreError #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c CoreError #

toConstr :: CoreError -> Constr #

dataTypeOf :: CoreError -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c CoreError) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CoreError) #

gmapT :: (forall b. Data b => b -> b) -> CoreError -> CoreError #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CoreError -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CoreError -> r #

gmapQ :: (forall d. Data d => d -> u) -> CoreError -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> CoreError -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> CoreError -> m CoreError #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> CoreError -> m CoreError #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> CoreError -> m CoreError #

Ord CoreError Source # 
Instance details

Defined in Happstack.Authenticate.Core

Read CoreError Source # 
Instance details

Defined in Happstack.Authenticate.Core

Show CoreError Source # 
Instance details

Defined in Happstack.Authenticate.Core

Generic CoreError Source # 
Instance details

Defined in Happstack.Authenticate.Core

Associated Types

type Rep CoreError :: Type -> Type #

SafeCopy CoreError Source # 
Instance details

Defined in Happstack.Authenticate.Core

ToJSON CoreError Source # 
Instance details

Defined in Happstack.Authenticate.Core

FromJSON CoreError Source # 
Instance details

Defined in Happstack.Authenticate.Core

ToJExpr CoreError Source # 
Instance details

Defined in Happstack.Authenticate.Core

RenderMessage HappstackAuthenticateI18N CoreError Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep CoreError Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep CoreError = D1 ('MetaData "CoreError" "Happstack.Authenticate.Core" "happstack-authenticate-2.6.0-H4Cz7jjbqfUGLgvBipYkvR" 'False) (((C1 ('MetaCons "HandlerNotFound" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "URLDecodeFailed" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "UsernameAlreadyExists" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "AuthorizationRequired" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Forbidden" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "JSONDecodeFailed" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "InvalidUserId" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "UsernameNotAcceptable" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "InvalidEmail" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TextError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text))))))

data NewAccountMode Source #

This value is used to configure the type of new user registrations permitted for this system.

Constructors

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

Instances details
Eq NewAccountMode Source # 
Instance details

Defined in Happstack.Authenticate.Core

Show NewAccountMode Source # 
Instance details

Defined in Happstack.Authenticate.Core

Generic NewAccountMode Source # 
Instance details

Defined in Happstack.Authenticate.Core

Associated Types

type Rep NewAccountMode :: Type -> Type #

SafeCopy NewAccountMode Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep NewAccountMode Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep NewAccountMode = D1 ('MetaData "NewAccountMode" "Happstack.Authenticate.Core" "happstack-authenticate-2.6.0-H4Cz7jjbqfUGLgvBipYkvR" 'False) (C1 ('MetaCons "OpenRegistration" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "ModeratedRegistration" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ClosedRegistration" 'PrefixI 'False) (U1 :: Type -> Type)))

data AuthenticateState Source #

this acid-state value contains the state common to all authentication methods

Instances

Instances details
Eq AuthenticateState Source # 
Instance details

Defined in Happstack.Authenticate.Core

Show AuthenticateState Source # 
Instance details

Defined in Happstack.Authenticate.Core

Generic AuthenticateState Source # 
Instance details

Defined in Happstack.Authenticate.Core

Associated Types

type Rep AuthenticateState :: Type -> Type #

SafeCopy AuthenticateState Source # 
Instance details

Defined in Happstack.Authenticate.Core

IsAcidic AuthenticateState Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep AuthenticateState Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep AuthenticateState = D1 ('MetaData "AuthenticateState" "Happstack.Authenticate.Core" "happstack-authenticate-2.6.0-H4Cz7jjbqfUGLgvBipYkvR" 'False) (C1 ('MetaCons "AuthenticateState" 'PrefixI 'True) ((S1 ('MetaSel ('Just "_sharedSecrets") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SharedSecrets) :*: S1 ('MetaSel ('Just "_users") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 IxUser)) :*: (S1 ('MetaSel ('Just "_nextUserId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 UserId) :*: (S1 ('MetaSel ('Just "_defaultSessionTimeout") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Just "_newAccountMode") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NewAccountMode)))))

getOrGenSharedSecret :: MonadIO m => AcidState AuthenticateState -> UserId -> m SharedSecret Source #

get the SharedSecret for UserId. Generate one if they don't have one yet.

data Token Source #

The Token type represents the encrypted data used to identify a user.

Constructors

Token 

Instances

Instances details
Eq Token Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

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

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

Data Token Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

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 #

toConstr :: Token -> Constr #

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 :: forall r r'. (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 # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

compare :: Token -> Token -> Ordering #

(<) :: Token -> Token -> Bool #

(<=) :: Token -> Token -> Bool #

(>) :: Token -> Token -> Bool #

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

max :: Token -> Token -> Token #

min :: Token -> Token -> Token #

Read Token Source # 
Instance details

Defined in Happstack.Authenticate.Core

Show Token Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

showsPrec :: Int -> Token -> ShowS #

show :: Token -> String #

showList :: [Token] -> ShowS #

Generic Token Source # 
Instance details

Defined in Happstack.Authenticate.Core

Associated Types

type Rep Token :: Type -> Type #

Methods

from :: Token -> Rep Token x #

to :: Rep Token x -> Token #

ToJSON Token Source # 
Instance details

Defined in Happstack.Authenticate.Core

FromJSON Token Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep Token Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep Token = D1 ('MetaData "Token" "Happstack.Authenticate.Core" "happstack-authenticate-2.6.0-H4Cz7jjbqfUGLgvBipYkvR" 'False) (C1 ('MetaCons "Token" 'PrefixI 'True) (S1 ('MetaSel ('Just "_tokenUser") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 User) :*: S1 ('MetaSel ('Just "_tokenIsAuthAdmin") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool)))

type TokenText = Text Source #

TokenText is the encrypted form of the Token which is passed between the server and the client.

issueToken Source #

Arguments

:: MonadIO m 
=> AcidState AuthenticateState 
-> AuthenticateConfig 
-> User

the user

-> m TokenText 

create a Token for User

The isAuthAdmin paramater is a function which will be called to determine if UserId is a user who should be given Administrator privileges. This includes the ability to things such as set the OpenId realm, change the registeration mode, etc.

decodeAndVerifyToken :: MonadIO m => AcidState AuthenticateState -> UTCTime -> TokenText -> m (Maybe (Token, JWT VerifiedJWT)) Source #

decode and verify the TokenText. If successful, return the Token otherwise Nothing.

authCookieName :: String Source #

name of the Cookie used to hold the TokenText

getTokenCookie :: Happstack m => AcidState AuthenticateState -> m (Maybe (Token, JWT VerifiedJWT)) Source #

get, decode, and verify the Token from the Cookie.

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

getUserId :: Happstack m => AcidState AuthenticateState -> m (Maybe UserId) Source #

get the UserId

calls getToken but returns only the UserId

newtype AuthenticationMethod Source #

AuthenticationMethod is used by the routing system to select which authentication backend should handle this request.

Instances

Instances details
Eq AuthenticationMethod Source # 
Instance details

Defined in Happstack.Authenticate.Core

Data AuthenticationMethod Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> AuthenticationMethod -> c AuthenticationMethod #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c AuthenticationMethod #

toConstr :: AuthenticationMethod -> Constr #

dataTypeOf :: AuthenticationMethod -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c AuthenticationMethod) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AuthenticationMethod) #

gmapT :: (forall b. Data b => b -> b) -> AuthenticationMethod -> AuthenticationMethod #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> AuthenticationMethod -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> AuthenticationMethod -> r #

gmapQ :: (forall d. Data d => d -> u) -> AuthenticationMethod -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> AuthenticationMethod -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> AuthenticationMethod -> m AuthenticationMethod #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> AuthenticationMethod -> m AuthenticationMethod #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> AuthenticationMethod -> m AuthenticationMethod #

Ord AuthenticationMethod Source # 
Instance details

Defined in Happstack.Authenticate.Core

Read AuthenticationMethod Source # 
Instance details

Defined in Happstack.Authenticate.Core

Show AuthenticationMethod Source # 
Instance details

Defined in Happstack.Authenticate.Core

Generic AuthenticationMethod Source # 
Instance details

Defined in Happstack.Authenticate.Core

Associated Types

type Rep AuthenticationMethod :: Type -> Type #

SafeCopy AuthenticationMethod Source # 
Instance details

Defined in Happstack.Authenticate.Core

ToJSON AuthenticationMethod Source # 
Instance details

Defined in Happstack.Authenticate.Core

FromJSON AuthenticationMethod Source # 
Instance details

Defined in Happstack.Authenticate.Core

PathInfo AuthenticationMethod Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep AuthenticationMethod Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep AuthenticationMethod = D1 ('MetaData "AuthenticationMethod" "Happstack.Authenticate.Core" "happstack-authenticate-2.6.0-H4Cz7jjbqfUGLgvBipYkvR" 'True) (C1 ('MetaCons "AuthenticationMethod" 'PrefixI 'True) (S1 ('MetaSel ('Just "_unAuthenticationMethod") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

data AuthenticateURL Source #

Instances

Instances details
Eq AuthenticateURL Source # 
Instance details

Defined in Happstack.Authenticate.Core

Data AuthenticateURL Source # 
Instance details

Defined in Happstack.Authenticate.Core

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> AuthenticateURL -> c AuthenticateURL #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c AuthenticateURL #

toConstr :: AuthenticateURL -> Constr #

dataTypeOf :: AuthenticateURL -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c AuthenticateURL) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AuthenticateURL) #

gmapT :: (forall b. Data b => b -> b) -> AuthenticateURL -> AuthenticateURL #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> AuthenticateURL -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> AuthenticateURL -> r #

gmapQ :: (forall d. Data d => d -> u) -> AuthenticateURL -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> AuthenticateURL -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> AuthenticateURL -> m AuthenticateURL #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> AuthenticateURL -> m AuthenticateURL #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> AuthenticateURL -> m AuthenticateURL #

Ord AuthenticateURL Source # 
Instance details

Defined in Happstack.Authenticate.Core

Read AuthenticateURL Source # 
Instance details

Defined in Happstack.Authenticate.Core

Show AuthenticateURL Source # 
Instance details

Defined in Happstack.Authenticate.Core

Generic AuthenticateURL Source # 
Instance details

Defined in Happstack.Authenticate.Core

Associated Types

type Rep AuthenticateURL :: Type -> Type #

PathInfo AuthenticateURL Source # 
Instance details

Defined in Happstack.Authenticate.Core

(Functor m, Monad m) => EmbedAsChild (Partial' m) PartialMsgs Source # 
Instance details

Defined in Happstack.Authenticate.OpenId.Partials

(Functor m, Monad m) => EmbedAsChild (Partial' m) PartialMsgs Source # 
Instance details

Defined in Happstack.Authenticate.Password.Partials

(Functor m, Monad m) => EmbedAsAttr (Partial' m) (Attr Text PartialMsgs) Source # 
Instance details

Defined in Happstack.Authenticate.OpenId.Partials

(Functor m, Monad m) => EmbedAsAttr (Partial' m) (Attr Text PartialMsgs) Source # 
Instance details

Defined in Happstack.Authenticate.Password.Partials

(Functor m, MonadIO m) => IntegerSupply (RouteT AuthenticateURL m) Source # 
Instance details

Defined in Happstack.Authenticate.Route

type Rep AuthenticateURL Source # 
Instance details

Defined in Happstack.Authenticate.Core

type Rep AuthenticateURL = D1 ('MetaData "AuthenticateURL" "Happstack.Authenticate.Core" "happstack-authenticate-2.6.0-H4Cz7jjbqfUGLgvBipYkvR" 'False) (C1 ('MetaCons "AuthenticationMethods" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (AuthenticationMethod, [Text])))) :+: C1 ('MetaCons "Controllers" 'PrefixI 'False) (U1 :: Type -> Type))

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.