{-# 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 }

-- Recover if session token is present.  Login if login+password are
-- present.
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

-- Account with password login
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 }