{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Snap.Snaplet.CustomAuth.Handlers where
import Control.Error.Util hiding (err)
import Control.Lens hiding (un)
import Control.Monad.Trans
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Control.Monad.State
import qualified Data.Configurator as C
import qualified Data.HashMap.Lazy as M
import Data.Maybe
import Data.Monoid
import qualified Data.Text as T
import Data.Text.Encoding
import Snap
import Data.Map
import Snap.Snaplet.CustomAuth.Types hiding (name)
import Snap.Snaplet.CustomAuth.AuthManager
import Snap.Snaplet.CustomAuth.OAuth2.Internal
import Snap.Snaplet.CustomAuth.User (setUser, recoverSession, currentUser, isSessionDefined)
import Snap.Snaplet.CustomAuth.Util (getParamText)
setFailure'
:: Handler b (AuthManager u e b) ()
-> AuthFailure e
-> Handler b (AuthManager u e b) ()
setFailure' :: Handler b (AuthManager u e b) ()
-> AuthFailure e -> Handler b (AuthManager u e b) ()
setFailure' Handler b (AuthManager u e b) ()
action AuthFailure e
err =
((AuthManager u e b -> AuthManager u e b)
-> Handler b (AuthManager u e b) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AuthManager u e b -> AuthManager u e b)
-> Handler b (AuthManager u e b) ())
-> (AuthManager u e b -> AuthManager u e b)
-> Handler b (AuthManager u e b) ()
forall a b. (a -> b) -> a -> b
$ \AuthManager u e b
s -> AuthManager u e b
s { authFailData :: Maybe (AuthFailure e)
authFailData = AuthFailure e -> Maybe (AuthFailure e)
forall a. a -> Maybe a
Just AuthFailure e
err }) Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handler b (AuthManager u e b) ()
action
loginUser
:: IAuthBackend u i e b
=> Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ()
loginUser :: Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ()
loginUser Handler b (AuthManager u e b) ()
loginFail Handler b (AuthManager u e b) ()
loginSucc = do
ByteString
usrName <- (AuthManager u e b -> ByteString)
-> Handler b (AuthManager u e b) ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AuthManager u e b -> ByteString
forall u e b. AuthManager u e b -> ByteString
userField
ByteString
pwdName <- (AuthManager u e b -> ByteString)
-> Handler b (AuthManager u e b) ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AuthManager u e b -> ByteString
forall u e b. AuthManager u e b -> ByteString
passwordField
Either (AuthFailure e) u
res <- ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) u
-> Handler b (AuthManager u e b) (Either (AuthFailure e) u)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) u
-> Handler b (AuthManager u e b) (Either (AuthFailure e) u))
-> ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) u
-> Handler b (AuthManager u e b) (Either (AuthFailure e) u)
forall a b. (a -> b) -> a -> b
$ do
Text
userName <- AuthFailure e
-> MaybeT (Handler b (AuthManager u e b)) Text
-> ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) Text
forall (m :: * -> *) a b.
Monad m =>
a -> MaybeT m b -> ExceptT a m b
noteT (LoginFailure -> AuthFailure e
forall e. LoginFailure -> AuthFailure e
Login LoginFailure
UsernameMissing) (MaybeT (Handler b (AuthManager u e b)) Text
-> ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) Text)
-> MaybeT (Handler b (AuthManager u e b)) Text
-> ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) Text
forall a b. (a -> b) -> a -> b
$ Handler b (AuthManager u e b) (Maybe Text)
-> MaybeT (Handler b (AuthManager u e b)) Text
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Handler b (AuthManager u e b) (Maybe Text)
-> MaybeT (Handler b (AuthManager u e b)) Text)
-> Handler b (AuthManager u e b) (Maybe Text)
-> MaybeT (Handler b (AuthManager u e b)) Text
forall a b. (a -> b) -> a -> b
$
((Maybe ByteString -> Maybe Text)
-> Handler b (AuthManager u e b) (Maybe ByteString)
-> Handler b (AuthManager u e b) (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe ByteString -> Maybe Text)
-> Handler b (AuthManager u e b) (Maybe ByteString)
-> Handler b (AuthManager u e b) (Maybe Text))
-> ((ByteString -> Text) -> Maybe ByteString -> Maybe Text)
-> (ByteString -> Text)
-> Handler b (AuthManager u e b) (Maybe ByteString)
-> Handler b (AuthManager u e b) (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ByteString -> Text
decodeUtf8 (Handler b (AuthManager u e b) (Maybe ByteString)
-> Handler b (AuthManager u e b) (Maybe Text))
-> Handler b (AuthManager u e b) (Maybe ByteString)
-> Handler b (AuthManager u e b) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ByteString -> Handler b (AuthManager u e b) (Maybe ByteString)
forall (m :: * -> *).
MonadSnap m =>
ByteString -> m (Maybe ByteString)
getParam ByteString
usrName
Text
passwd <- AuthFailure e
-> MaybeT (Handler b (AuthManager u e b)) Text
-> ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) Text
forall (m :: * -> *) a b.
Monad m =>
a -> MaybeT m b -> ExceptT a m b
noteT (LoginFailure -> AuthFailure e
forall e. LoginFailure -> AuthFailure e
Login LoginFailure
PasswordMissing) (MaybeT (Handler b (AuthManager u e b)) Text
-> ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) Text)
-> MaybeT (Handler b (AuthManager u e b)) Text
-> ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) Text
forall a b. (a -> b) -> a -> b
$ Handler b (AuthManager u e b) (Maybe Text)
-> MaybeT (Handler b (AuthManager u e b)) Text
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Handler b (AuthManager u e b) (Maybe Text)
-> MaybeT (Handler b (AuthManager u e b)) Text)
-> Handler b (AuthManager u e b) (Maybe Text)
-> MaybeT (Handler b (AuthManager u e b)) Text
forall a b. (a -> b) -> a -> b
$
((Maybe ByteString -> Maybe Text)
-> Handler b (AuthManager u e b) (Maybe ByteString)
-> Handler b (AuthManager u e b) (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe ByteString -> Maybe Text)
-> Handler b (AuthManager u e b) (Maybe ByteString)
-> Handler b (AuthManager u e b) (Maybe Text))
-> ((ByteString -> Text) -> Maybe ByteString -> Maybe Text)
-> (ByteString -> Text)
-> Handler b (AuthManager u e b) (Maybe ByteString)
-> Handler b (AuthManager u e b) (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ByteString -> Text
decodeUtf8 (Handler b (AuthManager u e b) (Maybe ByteString)
-> Handler b (AuthManager u e b) (Maybe Text))
-> Handler b (AuthManager u e b) (Maybe ByteString)
-> Handler b (AuthManager u e b) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ByteString -> Handler b (AuthManager u e b) (Maybe ByteString)
forall (m :: * -> *).
MonadSnap m =>
ByteString -> m (Maybe ByteString)
getParam ByteString
pwdName
Maybe u
usr <- (e -> AuthFailure e)
-> ExceptT e (Handler b (AuthManager u e b)) (Maybe u)
-> ExceptT
(AuthFailure e) (Handler b (AuthManager u e b)) (Maybe u)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT e -> AuthFailure e
forall e. e -> AuthFailure e
UserError (ExceptT e (Handler b (AuthManager u e b)) (Maybe u)
-> ExceptT
(AuthFailure e) (Handler b (AuthManager u e b)) (Maybe u))
-> ExceptT e (Handler b (AuthManager u e b)) (Maybe u)
-> ExceptT
(AuthFailure e) (Handler b (AuthManager u e b)) (Maybe u)
forall a b. (a -> b) -> a -> b
$ Handler b (AuthManager u e b) (Either e (Maybe u))
-> ExceptT e (Handler b (AuthManager u e b)) (Maybe u)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Handler b (AuthManager u e b) (Either e (Maybe u))
-> ExceptT e (Handler b (AuthManager u e b)) (Maybe u))
-> Handler b (AuthManager u e b) (Either e (Maybe u))
-> ExceptT e (Handler b (AuthManager u e b)) (Maybe u)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Handler b (AuthManager u e b) (Either e (Maybe u))
forall u i e b.
IAuthBackend u i e b =>
Text -> Text -> Handler b (AuthManager u e b) (Either e (Maybe u))
login Text
userName Text
passwd
Handler b (AuthManager u e b) ()
-> ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b (AuthManager u e b) ()
-> ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) ())
-> Handler b (AuthManager u e b) ()
-> ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) ()
forall a b. (a -> b) -> a -> b
$ Handler b (AuthManager u e b) ()
-> (u -> Handler b (AuthManager u e b) ())
-> Maybe u
-> Handler b (AuthManager u e b) ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Handler b (AuthManager u e b) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) u -> Handler b (AuthManager u e b) ()
forall u b e. UserData u => u -> Handler b (AuthManager u e b) ()
setUser Maybe u
usr
Either (AuthFailure e) u
-> ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) u
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
hoistEither (Either (AuthFailure e) u
-> ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) u)
-> Either (AuthFailure e) u
-> ExceptT (AuthFailure e) (Handler b (AuthManager u e b)) u
forall a b. (a -> b) -> a -> b
$ AuthFailure e -> Maybe u -> Either (AuthFailure e) u
forall a b. a -> Maybe b -> Either a b
note (LoginFailure -> AuthFailure e
forall e. LoginFailure -> AuthFailure e
Login LoginFailure
WrongPasswordOrUsername) Maybe u
usr
(AuthFailure e -> Handler b (AuthManager u e b) ())
-> (u -> Handler b (AuthManager u e b) ())
-> Either (AuthFailure e) u
-> Handler b (AuthManager u e b) ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Handler b (AuthManager u e b) ()
-> AuthFailure e -> Handler b (AuthManager u e b) ()
forall b u e.
Handler b (AuthManager u e b) ()
-> AuthFailure e -> Handler b (AuthManager u e b) ()
setFailure' Handler b (AuthManager u e b) ()
loginFail) (Handler b (AuthManager u e b) ()
-> u -> Handler b (AuthManager u e b) ()
forall a b. a -> b -> a
const Handler b (AuthManager u e b) ()
loginSucc) Either (AuthFailure e) u
res
logoutUser
:: IAuthBackend u i e b
=> Handler b (AuthManager u e b) ()
logoutUser :: Handler b (AuthManager u e b) ()
logoutUser = do
ByteString
sesName <- (AuthManager u e b -> ByteString)
-> Handler b (AuthManager u e b) ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AuthManager u e b -> ByteString
forall u e b. AuthManager u e b -> ByteString
sessionCookieName
MaybeT (Handler b (AuthManager u e b)) ()
-> Handler b (AuthManager u e b) (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (Handler b (AuthManager u e b)) ()
-> Handler b (AuthManager u e b) (Maybe ()))
-> MaybeT (Handler b (AuthManager u e b)) ()
-> Handler b (AuthManager u e b) (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
Cookie
ses <- Handler b (AuthManager u e b) (Maybe Cookie)
-> MaybeT (Handler b (AuthManager u e b)) Cookie
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Handler b (AuthManager u e b) (Maybe Cookie)
-> MaybeT (Handler b (AuthManager u e b)) Cookie)
-> Handler b (AuthManager u e b) (Maybe Cookie)
-> MaybeT (Handler b (AuthManager u e b)) Cookie
forall a b. (a -> b) -> a -> b
$ ByteString -> Handler b (AuthManager u e b) (Maybe Cookie)
forall (m :: * -> *). MonadSnap m => ByteString -> m (Maybe Cookie)
getCookie ByteString
sesName
Handler b (AuthManager u e b) ()
-> MaybeT (Handler b (AuthManager u e b)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b (AuthManager u e b) ()
-> MaybeT (Handler b (AuthManager u e b)) ())
-> Handler b (AuthManager u e b) ()
-> MaybeT (Handler b (AuthManager u e b)) ()
forall a b. (a -> b) -> a -> b
$ Cookie -> Handler b (AuthManager u e b) ()
forall (m :: * -> *). MonadSnap m => Cookie -> m ()
expireCookie Cookie
ses Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Handler b (AuthManager u e b) ()
forall u i e b.
IAuthBackend u i e b =>
Text -> Handler b (AuthManager u e b) ()
logout (ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Cookie -> ByteString
cookieValue Cookie
ses)
(AuthManager u e b -> AuthManager u e b)
-> Handler b (AuthManager u e b) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AuthManager u e b -> AuthManager u e b)
-> Handler b (AuthManager u e b) ())
-> (AuthManager u e b -> AuthManager u e b)
-> Handler b (AuthManager u e b) ()
forall a b. (a -> b) -> a -> b
$ \AuthManager u e b
mgr -> AuthManager u e b
mgr { activeUser :: UserData u => Maybe u
activeUser = UserData u => Maybe u
forall a. Maybe a
Nothing }
combinedLoginRecover
:: IAuthBackend u i e b
=> Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) (Maybe u)
combinedLoginRecover :: Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) (Maybe u)
combinedLoginRecover Handler b (AuthManager u e b) ()
loginFail = do
Bool
sesActive <- Handler b (AuthManager u e b) Bool
forall b u e. Handler b (AuthManager u e b) Bool
isSessionDefined
Maybe u
usr <- MaybeT (Handler b (AuthManager u e b)) u
-> Handler b (AuthManager u e b) (Maybe u)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (Handler b (AuthManager u e b)) u
-> Handler b (AuthManager u e b) (Maybe u))
-> MaybeT (Handler b (AuthManager u e b)) u
-> Handler b (AuthManager u e b) (Maybe u)
forall a b. (a -> b) -> a -> b
$ do
Bool -> MaybeT (Handler b (AuthManager u e b)) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
sesActive
Handler b (AuthManager u e b) ()
-> MaybeT (Handler b (AuthManager u e b)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Handler b (AuthManager u e b) ()
forall u i e b.
IAuthBackend u i e b =>
Handler b (AuthManager u e b) ()
recoverSession
Handler b (AuthManager u e b) (Maybe u)
-> MaybeT (Handler b (AuthManager u e b)) u
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT Handler b (AuthManager u e b) (Maybe u)
forall u b e. UserData u => Handler b (AuthManager u e b) (Maybe u)
currentUser
Maybe (AuthFailure e)
err <- (AuthManager u e b -> Maybe (AuthFailure e))
-> Handler b (AuthManager u e b) (Maybe (AuthFailure e))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AuthManager u e b -> Maybe (AuthFailure e)
forall u e b. AuthManager u e b -> Maybe (AuthFailure e)
authFailData
Handler b (AuthManager u e b) (Maybe u)
-> (AuthFailure e -> Handler b (AuthManager u e b) (Maybe u))
-> Maybe (AuthFailure e)
-> Handler b (AuthManager u e b) (Maybe u)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Handler b (AuthManager u e b) (Maybe u)
-> (u -> Handler b (AuthManager u e b) (Maybe u))
-> Maybe u
-> Handler b (AuthManager u e b) (Maybe u)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Handler b (AuthManager u e b) (Maybe u)
forall i.
IAuthBackend u i e b =>
Handler b (AuthManager u e b) (Maybe u)
combinedLogin (Maybe u -> Handler b (AuthManager u e b) (Maybe u)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe u -> Handler b (AuthManager u e b) (Maybe u))
-> (u -> Maybe u) -> u -> Handler b (AuthManager u e b) (Maybe u)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> Maybe u
forall a. a -> Maybe a
Just) Maybe u
usr)
(Handler b (AuthManager u e b) (Maybe u)
-> AuthFailure e -> Handler b (AuthManager u e b) (Maybe u)
forall a b. a -> b -> a
const (Handler b (AuthManager u e b) (Maybe u)
-> AuthFailure e -> Handler b (AuthManager u e b) (Maybe u))
-> Handler b (AuthManager u e b) (Maybe u)
-> AuthFailure e
-> Handler b (AuthManager u e b) (Maybe u)
forall a b. (a -> b) -> a -> b
$ Handler b (AuthManager u e b) ()
loginFail Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) (Maybe u)
-> Handler b (AuthManager u e b) (Maybe u)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe u -> Handler b (AuthManager u e b) (Maybe u)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe u
forall a. Maybe a
Nothing) Maybe (AuthFailure e)
err
where
combinedLogin :: Handler b (AuthManager u e b) (Maybe u)
combinedLogin = MaybeT (Handler b (AuthManager u e b)) u
-> Handler b (AuthManager u e b) (Maybe u)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (Handler b (AuthManager u e b)) u
-> Handler b (AuthManager u e b) (Maybe u))
-> MaybeT (Handler b (AuthManager u e b)) u
-> Handler b (AuthManager u e b) (Maybe u)
forall a b. (a -> b) -> a -> b
$ do
ByteString
usrName <- (AuthManager u e b -> ByteString)
-> MaybeT (Handler b (AuthManager u e b)) ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AuthManager u e b -> ByteString
forall u e b. AuthManager u e b -> ByteString
userField
ByteString
pwdName <- (AuthManager u e b -> ByteString)
-> MaybeT (Handler b (AuthManager u e b)) ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AuthManager u e b -> ByteString
forall u e b. AuthManager u e b -> ByteString
passwordField
Params
params <- Handler b (AuthManager u e b) Params
-> MaybeT (Handler b (AuthManager u e b)) Params
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b (AuthManager u e b) Params
-> MaybeT (Handler b (AuthManager u e b)) Params)
-> Handler b (AuthManager u e b) Params
-> MaybeT (Handler b (AuthManager u e b)) Params
forall a b. (a -> b) -> a -> b
$ (Request -> Params)
-> Handler b (AuthManager u e b) Request
-> Handler b (AuthManager u e b) Params
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Request -> Params
rqParams Handler b (AuthManager u e b) Request
forall (m :: * -> *). MonadSnap m => m Request
getRequest
Bool
-> MaybeT (Handler b (AuthManager u e b)) ()
-> MaybeT (Handler b (AuthManager u e b)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((ByteString -> Params -> Bool) -> Params -> ByteString -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Params -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member Params
params) [ByteString
usrName, ByteString
pwdName]) (MaybeT (Handler b (AuthManager u e b)) ()
-> MaybeT (Handler b (AuthManager u e b)) ())
-> MaybeT (Handler b (AuthManager u e b)) ()
-> MaybeT (Handler b (AuthManager u e b)) ()
forall a b. (a -> b) -> a -> b
$ do
Handler b (AuthManager u e b) ()
-> MaybeT (Handler b (AuthManager u e b)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b (AuthManager u e b) ()
-> MaybeT (Handler b (AuthManager u e b)) ())
-> Handler b (AuthManager u e b) ()
-> MaybeT (Handler b (AuthManager u e b)) ()
forall a b. (a -> b) -> a -> b
$ Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ()
forall u i e b.
IAuthBackend u i e b =>
Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ()
loginUser Handler b (AuthManager u e b) ()
loginFail (Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ())
-> Handler b (AuthManager u e b) ()
-> Handler b (AuthManager u e b) ()
forall a b. (a -> b) -> a -> b
$ () -> Handler b (AuthManager u e b) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Handler b (AuthManager u e b) (Maybe u)
-> MaybeT (Handler b (AuthManager u e b)) u
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT Handler b (AuthManager u e b) (Maybe u)
forall u b e. UserData u => Handler b (AuthManager u e b) (Maybe u)
currentUser
createAccount
:: IAuthBackend u i e b
=> Handler b (AuthManager u e b) (Either (Either e CreateFailure) u)
createAccount :: Handler b (AuthManager u e b) (Either (Either e CreateFailure) u)
createAccount = do
ByteString
usrName <- (ByteString
"_new" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> Handler b (AuthManager u e b) ByteString
-> Handler b (AuthManager u e b) ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AuthManager u e b -> ByteString)
-> Handler b (AuthManager u e b) ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AuthManager u e b -> ByteString
forall u e b. AuthManager u e b -> ByteString
userField
ByteString
pwdName <- (ByteString
"_new" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> Handler b (AuthManager u e b) ByteString
-> Handler b (AuthManager u e b) ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AuthManager u e b -> ByteString)
-> Handler b (AuthManager u e b) ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AuthManager u e b -> ByteString
forall u e b. AuthManager u e b -> ByteString
passwordField
let pwdAgainName :: ByteString
pwdAgainName = ByteString
pwdName ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"_again"
Either (Either e CreateFailure) (Text, i)
usr <- ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) (Text, i)
-> Handler
b (AuthManager u e b) (Either (Either e CreateFailure) (Text, i))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) (Text, i)
-> Handler
b (AuthManager u e b) (Either (Either e CreateFailure) (Text, i)))
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) (Text, i)
-> Handler
b (AuthManager u e b) (Either (Either e CreateFailure) (Text, i))
forall a b. (a -> b) -> a -> b
$ do
Text
name <- Either e CreateFailure
-> MaybeT (Handler b (AuthManager u e b)) Text
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) Text
forall (m :: * -> *) a b.
Monad m =>
a -> MaybeT m b -> ExceptT a m b
noteT (CreateFailure -> Either e CreateFailure
forall a b. b -> Either a b
Right CreateFailure
MissingName) (MaybeT (Handler b (AuthManager u e b)) Text
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) Text)
-> MaybeT (Handler b (AuthManager u e b)) Text
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) Text
forall a b. (a -> b) -> a -> b
$ Handler b (AuthManager u e b) (Maybe Text)
-> MaybeT (Handler b (AuthManager u e b)) Text
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Handler b (AuthManager u e b) (Maybe Text)
-> MaybeT (Handler b (AuthManager u e b)) Text)
-> Handler b (AuthManager u e b) (Maybe Text)
-> MaybeT (Handler b (AuthManager u e b)) Text
forall a b. (a -> b) -> a -> b
$
ByteString -> Handler b (AuthManager u e b) (Maybe Text)
forall (f :: * -> *). MonadSnap f => ByteString -> f (Maybe Text)
getParamText ByteString
usrName
Text
passwd <- Either e CreateFailure
-> MaybeT (Handler b (AuthManager u e b)) Text
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) Text
forall (m :: * -> *) a b.
Monad m =>
a -> MaybeT m b -> ExceptT a m b
noteT (CreateFailure -> Either e CreateFailure
forall a b. b -> Either a b
Right (CreateFailure -> Either e CreateFailure)
-> CreateFailure -> Either e CreateFailure
forall a b. (a -> b) -> a -> b
$ PasswordFailure -> CreateFailure
PasswordFailure PasswordFailure
Missing) (MaybeT (Handler b (AuthManager u e b)) Text
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) Text)
-> MaybeT (Handler b (AuthManager u e b)) Text
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) Text
forall a b. (a -> b) -> a -> b
$ Handler b (AuthManager u e b) (Maybe Text)
-> MaybeT (Handler b (AuthManager u e b)) Text
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Handler b (AuthManager u e b) (Maybe Text)
-> MaybeT (Handler b (AuthManager u e b)) Text)
-> Handler b (AuthManager u e b) (Maybe Text)
-> MaybeT (Handler b (AuthManager u e b)) Text
forall a b. (a -> b) -> a -> b
$
ByteString -> Handler b (AuthManager u e b) (Maybe Text)
forall (f :: * -> *). MonadSnap f => ByteString -> f (Maybe Text)
getParamText ByteString
pwdName
Bool
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) ()
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
passwd) (ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) ()
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) ())
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) ()
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) ()
forall a b. (a -> b) -> a -> b
$ Either e CreateFailure
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (CreateFailure -> Either e CreateFailure
forall a b. b -> Either a b
Right (CreateFailure -> Either e CreateFailure)
-> CreateFailure -> Either e CreateFailure
forall a b. (a -> b) -> a -> b
$ PasswordFailure -> CreateFailure
PasswordFailure PasswordFailure
Missing)
Either e CreateFailure
-> MaybeT (Handler b (AuthManager u e b)) ()
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) ()
forall (m :: * -> *) a b.
Monad m =>
a -> MaybeT m b -> ExceptT a m b
noteT (CreateFailure -> Either e CreateFailure
forall a b. b -> Either a b
Right (CreateFailure -> Either e CreateFailure)
-> CreateFailure -> Either e CreateFailure
forall a b. (a -> b) -> a -> b
$ PasswordFailure -> CreateFailure
PasswordFailure PasswordFailure
Mismatch) (MaybeT (Handler b (AuthManager u e b)) ()
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) ())
-> MaybeT (Handler b (AuthManager u e b)) ()
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) ()
forall a b. (a -> b) -> a -> b
$ Bool -> MaybeT (Handler b (AuthManager u e b)) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT (Handler b (AuthManager u e b)) ())
-> MaybeT (Handler b (AuthManager u e b)) Bool
-> MaybeT (Handler b (AuthManager u e b)) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
(Handler b (AuthManager u e b) (Maybe Bool)
-> MaybeT (Handler b (AuthManager u e b)) Bool
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Handler b (AuthManager u e b) (Maybe Bool)
-> MaybeT (Handler b (AuthManager u e b)) Bool)
-> Handler b (AuthManager u e b) (Maybe Bool)
-> MaybeT (Handler b (AuthManager u e b)) Bool
forall a b. (a -> b) -> a -> b
$ ((Maybe Text -> Maybe Bool)
-> Handler b (AuthManager u e b) (Maybe Text)
-> Handler b (AuthManager u e b) (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe Text -> Maybe Bool)
-> Handler b (AuthManager u e b) (Maybe Text)
-> Handler b (AuthManager u e b) (Maybe Bool))
-> ((Text -> Bool) -> Maybe Text -> Maybe Bool)
-> (Text -> Bool)
-> Handler b (AuthManager u e b) (Maybe Text)
-> Handler b (AuthManager u e b) (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> Maybe Text -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
passwd) (ByteString -> Handler b (AuthManager u e b) (Maybe Text)
forall (f :: * -> *). MonadSnap f => ByteString -> f (Maybe Text)
getParamText ByteString
pwdAgainName))
i
userId <- (e
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) i)
-> (i
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) i)
-> Either e i
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) i
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either e CreateFailure
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) i
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Either e CreateFailure
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) i)
-> (e -> Either e CreateFailure)
-> e
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e CreateFailure
forall a b. a -> Either a b
Left) i
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) i
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e i
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) i)
-> ExceptT
(Either e CreateFailure)
(Handler b (AuthManager u e b))
(Either e i)
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) i
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
(Handler b (AuthManager u e b) (Either e i)
-> ExceptT
(Either e CreateFailure)
(Handler b (AuthManager u e b))
(Either e i)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b (AuthManager u e b) (Either e i)
-> ExceptT
(Either e CreateFailure)
(Handler b (AuthManager u e b))
(Either e i))
-> Handler b (AuthManager u e b) (Either e i)
-> ExceptT
(Either e CreateFailure)
(Handler b (AuthManager u e b))
(Either e i)
forall a b. (a -> b) -> a -> b
$ Maybe u -> Text -> Handler b (AuthManager u e b) (Either e i)
forall u i e b.
IAuthBackend u i e b =>
Maybe u -> Text -> Handler b (AuthManager u e b) (Either e i)
preparePasswordCreate Maybe u
forall a. Maybe a
Nothing Text
passwd)
(Text, i)
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) (Text, i)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, i
userId)
Either (Either e CreateFailure) u
res <- ExceptT (Either e CreateFailure) (Handler b (AuthManager u e b)) u
-> Handler
b (AuthManager u e b) (Either (Either e CreateFailure) u)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (Either e CreateFailure) (Handler b (AuthManager u e b)) u
-> Handler
b (AuthManager u e b) (Either (Either e CreateFailure) u))
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) u
-> Handler
b (AuthManager u e b) (Either (Either e CreateFailure) u)
forall a b. (a -> b) -> a -> b
$ do
(Text
name, i
userId) <- Either (Either e CreateFailure) (Text, i)
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) (Text, i)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
hoistEither Either (Either e CreateFailure) (Text, i)
usr
u
u <- Handler b (AuthManager u e b) (Either (Either e CreateFailure) u)
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) u
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Handler b (AuthManager u e b) (Either (Either e CreateFailure) u)
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) u)
-> Handler
b (AuthManager u e b) (Either (Either e CreateFailure) u)
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) u
forall a b. (a -> b) -> a -> b
$ Text
-> i
-> Handler
b (AuthManager u e b) (Either (Either e CreateFailure) u)
forall u i e b.
IAuthBackend u i e b =>
Text
-> i
-> Handler
b (AuthManager u e b) (Either (Either e CreateFailure) u)
create Text
name i
userId
Handler b (AuthManager u e b) ()
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b (AuthManager u e b) ()
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) ())
-> Handler b (AuthManager u e b) ()
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) ()
forall a b. (a -> b) -> a -> b
$ u -> Handler b (AuthManager u e b) ()
forall u b e. UserData u => u -> Handler b (AuthManager u e b) ()
setUser u
u
u
-> ExceptT
(Either e CreateFailure) (Handler b (AuthManager u e b)) u
forall (m :: * -> *) a. Monad m => a -> m a
return u
u
case (Either (Either e CreateFailure) (Text, i)
usr, Either (Either e CreateFailure) u
res) of
(Right (Text, i)
i, Left Either e CreateFailure
_) -> i -> Handler b (AuthManager u e b) ()
forall u i e b.
IAuthBackend u i e b =>
i -> Handler b (AuthManager u e b) ()
cancelPrepare (i -> Handler b (AuthManager u e b) ())
-> i -> Handler b (AuthManager u e b) ()
forall a b. (a -> b) -> a -> b
$ (Text, i) -> i
forall a b. (a, b) -> b
snd (Text, i)
i
(Either (Either e CreateFailure) (Text, i),
Either (Either e CreateFailure) u)
_ -> () -> Handler b (AuthManager u e b) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Either e CreateFailure -> Handler b (AuthManager u e b) ())
-> (u -> Handler b (AuthManager u e b) ())
-> Either (Either e CreateFailure) u
-> Handler b (AuthManager u e b) ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Handler b (AuthManager u e b) ()
-> AuthFailure e -> Handler b (AuthManager u e b) ()
forall b u e.
Handler b (AuthManager u e b) ()
-> AuthFailure e -> Handler b (AuthManager u e b) ()
setFailure' (() -> Handler b (AuthManager u e b) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (AuthFailure e -> Handler b (AuthManager u e b) ())
-> (Either e CreateFailure -> AuthFailure e)
-> Either e CreateFailure
-> Handler b (AuthManager u e b) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> AuthFailure e)
-> (CreateFailure -> AuthFailure e)
-> Either e CreateFailure
-> AuthFailure e
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> AuthFailure e
forall e. e -> AuthFailure e
UserError CreateFailure -> AuthFailure e
forall e. CreateFailure -> AuthFailure e
Create) (Handler b (AuthManager u e b) ()
-> u -> Handler b (AuthManager u e b) ()
forall a b. a -> b -> a
const (Handler b (AuthManager u e b) ()
-> u -> Handler b (AuthManager u e b) ())
-> Handler b (AuthManager u e b) ()
-> u
-> Handler b (AuthManager u e b) ()
forall a b. (a -> b) -> a -> b
$ () -> Handler b (AuthManager u e b) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Either (Either e CreateFailure) u
res
Either (Either e CreateFailure) u
-> Handler
b (AuthManager u e b) (Either (Either e CreateFailure) u)
forall (m :: * -> *) a. Monad m => a -> m a
return Either (Either e CreateFailure) u
res
authInit
:: IAuthBackend u i e b
=> Maybe (OAuth2Settings u i e b)
-> AuthSettings
-> SnapletInit b (AuthManager u e b)
authInit :: Maybe (OAuth2Settings u i e b)
-> AuthSettings -> SnapletInit b (AuthManager u e b)
authInit Maybe (OAuth2Settings u i e b)
oa AuthSettings
s = Text
-> Text
-> Maybe (IO FilePath)
-> Initializer b (AuthManager u e b) (AuthManager u e b)
-> SnapletInit b (AuthManager u e b)
forall b v.
Text
-> Text
-> Maybe (IO FilePath)
-> Initializer b v v
-> SnapletInit b v
makeSnaplet (Getting Text AuthSettings Text -> AuthSettings -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text AuthSettings Text
Lens' AuthSettings Text
authName AuthSettings
s) Text
"Custom auth" Maybe (IO FilePath)
forall a. Maybe a
Nothing (Initializer b (AuthManager u e b) (AuthManager u e b)
-> SnapletInit b (AuthManager u e b))
-> Initializer b (AuthManager u e b) (AuthManager u e b)
-> SnapletInit b (AuthManager u e b)
forall a b. (a -> b) -> a -> b
$ do
Config
cfg <- Initializer b (AuthManager u e b) Config
forall (m :: * -> * -> * -> *) b v.
(Monad (m b v), MonadSnaplet m) =>
m b v Config
getSnapletUserConfig
ByteString
un <- IO ByteString -> Initializer b (AuthManager u e b) ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Initializer b (AuthManager u e b) ByteString)
-> IO ByteString -> Initializer b (AuthManager u e b) ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Config -> Text -> IO ByteString
forall a. Configured a => a -> Config -> Text -> IO a
C.lookupDefault ByteString
"_login" Config
cfg Text
"userField"
ByteString
pn <- IO ByteString -> Initializer b (AuthManager u e b) ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Initializer b (AuthManager u e b) ByteString)
-> IO ByteString -> Initializer b (AuthManager u e b) ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Config -> Text -> IO ByteString
forall a. Configured a => a -> Config -> Text -> IO a
C.lookupDefault ByteString
"_password" Config
cfg Text
"passwordField"
ByteString
scn <- IO ByteString -> Initializer b (AuthManager u e b) ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Initializer b (AuthManager u e b) ByteString)
-> IO ByteString -> Initializer b (AuthManager u e b) ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Config -> Text -> IO ByteString
forall a. Configured a => a -> Config -> Text -> IO a
C.lookupDefault ByteString
"_session" Config
cfg Text
"sessionCookieName"
HashMap Text Provider
ps <- Initializer b (AuthManager u e b) (HashMap Text Provider)
-> (OAuth2Settings u i e b
-> Initializer b (AuthManager u e b) (HashMap Text Provider))
-> Maybe (OAuth2Settings u i e b)
-> Initializer b (AuthManager u e b) (HashMap Text Provider)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HashMap Text Provider
-> Initializer b (AuthManager u e b) (HashMap Text Provider)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap Text Provider
forall k v. HashMap k v
M.empty) OAuth2Settings u i e b
-> Initializer b (AuthManager u e b) (HashMap Text Provider)
forall u i e b.
IAuthBackend u i e b =>
OAuth2Settings u i e b
-> Initializer b (AuthManager u e b) (HashMap Text Provider)
oauth2Init Maybe (OAuth2Settings u i e b)
oa
AuthManager u e b
-> Initializer b (AuthManager u e b) (AuthManager u e b)
forall (m :: * -> *) a. Monad m => a -> m a
return (AuthManager u e b
-> Initializer b (AuthManager u e b) (AuthManager u e b))
-> AuthManager u e b
-> Initializer b (AuthManager u e b) (AuthManager u e b)
forall a b. (a -> b) -> a -> b
$ AuthManager :: forall u e b i.
IAuthBackend u i e b =>
(UserData u => Maybe u)
-> Maybe NominalDiffTime
-> ByteString
-> ByteString
-> ByteString
-> SnapletLens (Snaplet b) SessionManager
-> Maybe Text
-> Maybe (AuthFailure e)
-> HashMap Text Provider
-> AuthManager u e b
AuthManager
{ activeUser :: UserData u => Maybe u
activeUser = UserData u => Maybe u
forall a. Maybe a
Nothing
, cookieLifetime :: Maybe NominalDiffTime
cookieLifetime = AuthSettings
s AuthSettings
-> Getting
(Maybe NominalDiffTime) AuthSettings (Maybe NominalDiffTime)
-> Maybe NominalDiffTime
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe NominalDiffTime) AuthSettings (Maybe NominalDiffTime)
Lens' AuthSettings (Maybe NominalDiffTime)
authCookieLifetime
, sessionCookieName :: ByteString
sessionCookieName = ByteString
scn
, userField :: ByteString
userField = ByteString
un
, passwordField :: ByteString
passwordField = ByteString
pn
, stateStore' :: SnapletLens (Snaplet b) SessionManager
stateStore' = SnapletLens (Snaplet b) SessionManager
-> (OAuth2Settings u i e b
-> SnapletLens (Snaplet b) SessionManager)
-> Maybe (OAuth2Settings u i e b)
-> SnapletLens (Snaplet b) SessionManager
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> SnapletLens (Snaplet b) SessionManager
forall a. HasCallStack => FilePath -> a
error FilePath
"oauth2 hooks not defined") OAuth2Settings u i e b -> SnapletLens (Snaplet b) SessionManager
forall u i e b.
OAuth2Settings u i e b -> SnapletLens (Snaplet b) SessionManager
stateStore Maybe (OAuth2Settings u i e b)
oa
, oauth2Provider :: Maybe Text
oauth2Provider = Maybe Text
forall a. Maybe a
Nothing
, authFailData :: Maybe (AuthFailure e)
authFailData = Maybe (AuthFailure e)
forall a. Maybe a
Nothing
, providers :: HashMap Text Provider
providers = HashMap Text Provider
ps
}
isLoggedIn :: UserData u => Handler b (AuthManager u e b) Bool
isLoggedIn :: Handler b (AuthManager u e b) Bool
isLoggedIn = Maybe u -> Bool
forall a. Maybe a -> Bool
isJust (Maybe u -> Bool)
-> Handler b (AuthManager u e b) (Maybe u)
-> Handler b (AuthManager u e b) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler b (AuthManager u e b) (Maybe u)
forall u b e. UserData u => Handler b (AuthManager u e b) (Maybe u)
currentUser
getAuthFailData
:: Handler b (AuthManager u e b) (Maybe (AuthFailure e))
getAuthFailData :: Handler b (AuthManager u e b) (Maybe (AuthFailure e))
getAuthFailData = Handler b (AuthManager u e b) (AuthManager u e b)
forall s (m :: * -> *). MonadState s m => m s
get Handler b (AuthManager u e b) (AuthManager u e b)
-> (AuthManager u e b
-> Handler b (AuthManager u e b) (Maybe (AuthFailure e)))
-> Handler b (AuthManager u e b) (Maybe (AuthFailure e))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (AuthFailure e)
-> Handler b (AuthManager u e b) (Maybe (AuthFailure e))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (AuthFailure e)
-> Handler b (AuthManager u e b) (Maybe (AuthFailure e)))
-> (AuthManager u e b -> Maybe (AuthFailure e))
-> AuthManager u e b
-> Handler b (AuthManager u e b) (Maybe (AuthFailure e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthManager u e b -> Maybe (AuthFailure e)
forall u e b. AuthManager u e b -> Maybe (AuthFailure e)
authFailData
resetAuthFailData
:: Handler b (AuthManager u e b) ()
resetAuthFailData :: Handler b (AuthManager u e b) ()
resetAuthFailData = (AuthManager u e b -> AuthManager u e b)
-> Handler b (AuthManager u e b) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AuthManager u e b -> AuthManager u e b)
-> Handler b (AuthManager u e b) ())
-> (AuthManager u e b -> AuthManager u e b)
-> Handler b (AuthManager u e b) ()
forall a b. (a -> b) -> a -> b
$ \AuthManager u e b
mgr -> AuthManager u e b
mgr { authFailData :: Maybe (AuthFailure e)
authFailData = Maybe (AuthFailure e)
forall a. Maybe a
Nothing }