    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE FlexibleContexts          #-}
    {-# LANGUAGE OverloadedStrings         #-}
    {-# LANGUAGE Rank2Types                #-}

    ------------------------------------------------------------------------------
    -- | Pre-packaged Handlers that deal with form submissions and standard
    --   use-cases involving authentication.

    module Snap.Snaplet.Auth.Handlers where

    ------------------------------------------------------------------------------
    import           Control.Applicative
    import           Control.Monad.State
    import           Control.Monad.Trans.Maybe
    import           Data.ByteString (ByteString)
    import           Data.Maybe
    import           Data.Serialize hiding (get)
    import           Data.Time
    import           Data.Text.Encoding (decodeUtf8)
    import           Data.Text (Text, null, strip)
    import           Prelude hiding (null)
    import           Web.ClientSession
    ------------------------------------------------------------------------------
    import           Snap.Core
    import           Snap.Snaplet
    import           Snap.Snaplet.Auth.AuthManager
    import           Snap.Snaplet.Auth.Types
    import           Snap.Snaplet.Session
    ------------------------------------------------------------------------------

                             ----------------------------
                             -- Higher level functions --
                             ----------------------------

    ------------------------------------------------------------------------------
    -- | Create a new user from just a username and password
    --
    createUser :: Text              -- ^ Username
               -> ByteString        -- ^ Password
               -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    createUser :: Text
    -> ByteString
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    createUser unm :: Text
    unm pwd :: ByteString
    pwd
      | Text -> Bool
    null (Text -> Bool) -> Text -> Bool
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    strip Text
    unm = Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ AuthFailure -> Either AuthFailure AuthUser
    forall a b. a -> Either a b
    Left AuthFailure
    UsernameMissing
      | Bool
    otherwise = do
         Bool
    uExists <- Text -> Handler b (AuthManager b) Bool
    forall b. Text -> Handler b (AuthManager b) Bool
    usernameExists Text
    unm
         if Bool
    uExists then Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ AuthFailure -> Either AuthFailure AuthUser
    forall a b. a -> Either a b
    Left AuthFailure
    DuplicateLogin
                    else (forall r.
     IAuthBackend r =>
     r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b v a.
    (forall r. IAuthBackend r => r -> Handler b (AuthManager v) a)
    -> Handler b (AuthManager v) a
    withBackend ((forall r.
      IAuthBackend r =>
      r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> (forall r.
        IAuthBackend r =>
        r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ \r :: r
    r -> IO (Either AuthFailure AuthUser)
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either AuthFailure AuthUser)
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> IO (Either AuthFailure AuthUser)
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ r -> Text -> ByteString -> IO (Either AuthFailure AuthUser)
    forall r.
    IAuthBackend r =>
    r -> Text -> ByteString -> IO (Either AuthFailure AuthUser)
    buildAuthUser r
    r Text
    unm ByteString
    pwd

    ------------------------------------------------------------------------------
    -- | Check whether a user with the given username exists.
    --
    usernameExists :: Text          -- ^ The username to be checked
                   -> Handler b (AuthManager b) Bool
    usernameExists :: Text -> Handler b (AuthManager b) Bool
    usernameExists username :: Text
    username =
        (forall r. IAuthBackend r => r -> Handler b (AuthManager b) Bool)
    -> Handler b (AuthManager b) Bool
    forall b v a.
    (forall r. IAuthBackend r => r -> Handler b (AuthManager v) a)
    -> Handler b (AuthManager v) a
    withBackend ((forall r. IAuthBackend r => r -> Handler b (AuthManager b) Bool)
     -> Handler b (AuthManager b) Bool)
    -> (forall r.
        IAuthBackend r =>
        r -> Handler b (AuthManager b) Bool)
    -> Handler b (AuthManager b) Bool
    forall a b. (a -> b) -> a -> b
    $ \r :: r
    r -> IO Bool -> Handler b (AuthManager b) Bool
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> Handler b (AuthManager b) Bool)
    -> IO Bool -> Handler b (AuthManager b) Bool
    forall a b. (a -> b) -> a -> b
    $ Maybe AuthUser -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe AuthUser -> Bool) -> IO (Maybe AuthUser) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> r -> Text -> IO (Maybe AuthUser)
    forall r. IAuthBackend r => r -> Text -> IO (Maybe AuthUser)
    lookupByLogin r
    r Text
    username

    ------------------------------------------------------------------------------
    -- | Lookup a user by her username, check given password and perform login
    --
    loginByUsername :: Text             -- ^ Username/login for user
                    -> Password         -- ^ Should be ClearText
                    -> Bool             -- ^ Set remember token?
                    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    loginByUsername :: Text
    -> Password
    -> Bool
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    loginByUsername _ (Encrypted _) _ = Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ AuthFailure -> Either AuthFailure AuthUser
    forall a b. a -> Either a b
    Left AuthFailure
    EncryptedPassword
    loginByUsername unm :: Text
    unm pwd :: Password
    pwd shouldRemember :: Bool
    shouldRemember = do
        Key
    sk <- (AuthManager b -> Key) -> Handler b (AuthManager b) Key
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> Key
    forall b. AuthManager b -> Key
    siteKey
        ByteString
    cn <- (AuthManager b -> ByteString)
    -> Handler b (AuthManager b) ByteString
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> ByteString
    forall b. AuthManager b -> ByteString
    rememberCookieName
        Maybe ByteString
    cd <- (AuthManager b -> Maybe ByteString)
    -> Handler b (AuthManager b) (Maybe ByteString)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> Maybe ByteString
    forall b. AuthManager b -> Maybe ByteString
    rememberCookieDomain
        Maybe Int
    rp <- (AuthManager b -> Maybe Int)
    -> Handler b (AuthManager b) (Maybe Int)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> Maybe Int
    forall b. AuthManager b -> Maybe Int
    rememberPeriod
        (forall r.
     IAuthBackend r =>
     r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b v a.
    (forall r. IAuthBackend r => r -> Handler b (AuthManager v) a)
    -> Handler b (AuthManager v) a
    withBackend ((forall r.
      IAuthBackend r =>
      r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> (forall r.
        IAuthBackend r =>
        r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ Key
    -> ByteString
    -> Maybe ByteString
    -> Maybe Int
    -> r
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall t b.
    IAuthBackend t =>
    Key
    -> ByteString
    -> Maybe ByteString
    -> Maybe Int
    -> t
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    loginByUsername' Key
    sk ByteString
    cn Maybe ByteString
    cd Maybe Int
    rp

      where
        --------------------------------------------------------------------------
        loginByUsername' :: (IAuthBackend t) =>
                            Key
                         -> ByteString
                         -> Maybe ByteString
                         -> Maybe Int
                         -> t
                         -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
        loginByUsername' :: Key
    -> ByteString
    -> Maybe ByteString
    -> Maybe Int
    -> t
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    loginByUsername' sk :: Key
    sk cn :: ByteString
    cn cd :: Maybe ByteString
    cd rp :: Maybe Int
    rp r :: t
    r =
            IO (Maybe AuthUser) -> Handler b (AuthManager b) (Maybe AuthUser)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (t -> Text -> IO (Maybe AuthUser)
    forall r. IAuthBackend r => r -> Text -> IO (Maybe AuthUser)
    lookupByLogin t
    r Text
    unm) Handler b (AuthManager b) (Maybe AuthUser)
    -> (Maybe AuthUser
        -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
            Handler b (AuthManager b) (Either AuthFailure AuthUser)
    -> (AuthUser
        -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Maybe AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $! AuthFailure -> Either AuthFailure AuthUser
    forall a b. a -> Either a b
    Left AuthFailure
    UserNotFound) AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    found

          where
            ----------------------------------------------------------------------
            found :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    found user :: AuthUser
    user = AuthUser
    -> Password
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b.
    AuthUser
    -> Password
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    checkPasswordAndLogin AuthUser
    user Password
    pwd Handler b (AuthManager b) (Either AuthFailure AuthUser)
    -> (Either AuthFailure AuthUser
        -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                         (AuthFailure
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> (AuthUser
        -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> (AuthFailure -> Either AuthFailure AuthUser)
    -> AuthFailure
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AuthFailure -> Either AuthFailure AuthUser
    forall a b. a -> Either a b
    Left) AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    matched

            ----------------------------------------------------------------------
            matched :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    matched user :: AuthUser
    user
                | Bool
    shouldRemember = do
                      ByteString
    token <- (AuthManager b -> RNG) -> Handler b (AuthManager b) RNG
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> RNG
    forall b. AuthManager b -> RNG
    randomNumberGenerator Handler b (AuthManager b) RNG
    -> (RNG -> Handler b (AuthManager b) ByteString)
    -> Handler b (AuthManager b) ByteString
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                               IO ByteString -> Handler b (AuthManager b) ByteString
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> Handler b (AuthManager b) ByteString)
    -> (RNG -> IO ByteString)
    -> RNG
    -> Handler b (AuthManager b) ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> RNG -> IO ByteString
    randomToken 64

                      Key
    -> ByteString
    -> Maybe ByteString
    -> Maybe Int
    -> ByteString
    -> Handler b (AuthManager b) ()
    forall t (m :: * -> *).
    (Serialize t, MonadSnap m) =>
    Key -> ByteString -> Maybe ByteString -> Maybe Int -> t -> m ()
    setRememberToken Key
    sk ByteString
    cn Maybe ByteString
    cd Maybe Int
    rp ByteString
    token

                      let user' :: AuthUser
    user' = AuthUser
    user {
                                    userRememberToken :: Maybe Text
    userRememberToken = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (ByteString -> Text
    decodeUtf8 ByteString
    token)
                                  }

                      AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b.
    AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    saveUser AuthUser
    user'
                      Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $! AuthUser -> Either AuthFailure AuthUser
    forall a b. b -> Either a b
    Right AuthUser
    user'

                | Bool
    otherwise = Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ AuthUser -> Either AuthFailure AuthUser
    forall a b. b -> Either a b
    Right AuthUser
    user

    ------------------------------------------------------------------------------
    -- | Remember user from the remember token if possible and perform login
    --
    loginByRememberToken :: Handler b (AuthManager b) (Either AuthFailure AuthUser)
    loginByRememberToken :: Handler b (AuthManager b) (Either AuthFailure AuthUser)
    loginByRememberToken = (forall r.
     IAuthBackend r =>
     r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b v a.
    (forall r. IAuthBackend r => r -> Handler b (AuthManager v) a)
    -> Handler b (AuthManager v) a
    withBackend ((forall r.
      IAuthBackend r =>
      r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> (forall r.
        IAuthBackend r =>
        r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ \impl :: r
    impl -> do
        Key
    key         <- (AuthManager b -> Key) -> Handler b (AuthManager b) Key
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> Key
    forall b. AuthManager b -> Key
    siteKey
        ByteString
    cookieName_ <- (AuthManager b -> ByteString)
    -> Handler b (AuthManager b) ByteString
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> ByteString
    forall b. AuthManager b -> ByteString
    rememberCookieName
        Maybe Int
    period      <- (AuthManager b -> Maybe Int)
    -> Handler b (AuthManager b) (Maybe Int)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> Maybe Int
    forall b. AuthManager b -> Maybe Int
    rememberPeriod

        Maybe AuthUser
    res <- MaybeT (Handler b (AuthManager b)) AuthUser
    -> Handler b (AuthManager b) (Maybe AuthUser)
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT (Handler b (AuthManager b)) AuthUser
     -> Handler b (AuthManager b) (Maybe AuthUser))
    -> MaybeT (Handler b (AuthManager b)) AuthUser
    -> Handler b (AuthManager b) (Maybe AuthUser)
    forall a b. (a -> b) -> a -> b
    $ do
            ByteString
    token <- Handler b (AuthManager b) (Maybe ByteString)
    -> MaybeT (Handler b (AuthManager b)) ByteString
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (Handler b (AuthManager b) (Maybe ByteString)
     -> MaybeT (Handler b (AuthManager b)) ByteString)
    -> Handler b (AuthManager b) (Maybe ByteString)
    -> MaybeT (Handler b (AuthManager b)) ByteString
    forall a b. (a -> b) -> a -> b
    $ Key
    -> ByteString
    -> Maybe Int
    -> Handler b (AuthManager b) (Maybe ByteString)
    forall t (m :: * -> *).
    (Serialize t, MonadSnap m) =>
    Key -> ByteString -> Maybe Int -> m (Maybe t)
    getRememberToken Key
    key ByteString
    cookieName_ Maybe Int
    period
            Handler b (AuthManager b) (Maybe AuthUser)
    -> MaybeT (Handler b (AuthManager b)) AuthUser
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (Handler b (AuthManager b) (Maybe AuthUser)
     -> MaybeT (Handler b (AuthManager b)) AuthUser)
    -> Handler b (AuthManager b) (Maybe AuthUser)
    -> MaybeT (Handler b (AuthManager b)) AuthUser
    forall a b. (a -> b) -> a -> b
    $ IO (Maybe AuthUser) -> Handler b (AuthManager b) (Maybe AuthUser)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe AuthUser) -> Handler b (AuthManager b) (Maybe AuthUser))
    -> IO (Maybe AuthUser)
    -> Handler b (AuthManager b) (Maybe AuthUser)
    forall a b. (a -> b) -> a -> b
    $ r -> Text -> IO (Maybe AuthUser)
    forall r. IAuthBackend r => r -> Text -> IO (Maybe AuthUser)
    lookupByRememberToken r
    impl (Text -> IO (Maybe AuthUser)) -> Text -> IO (Maybe AuthUser)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Text
    decodeUtf8 ByteString
    token
        case Maybe AuthUser
    res of
          Nothing -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ AuthFailure -> Either AuthFailure AuthUser
    forall a b. a -> Either a b
    Left (AuthFailure -> Either AuthFailure AuthUser)
    -> AuthFailure -> Either AuthFailure AuthUser
    forall a b. (a -> b) -> a -> b
    $ String -> AuthFailure
    AuthError
                       "loginByRememberToken: no remember token"
          Just user :: AuthUser
    user -> do
            AuthUser -> Handler b (AuthManager b) (Either AuthFailure ())
    forall b.
    AuthUser -> Handler b (AuthManager b) (Either AuthFailure ())
    forceLogin AuthUser
    user
            Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ AuthUser -> Either AuthFailure AuthUser
    forall a b. b -> Either a b
    Right AuthUser
    user

    ------------------------------------------------------------------------------
    -- | Logout the active user
    --
    logout :: Handler b (AuthManager b) ()
    logout :: Handler b (AuthManager b) ()
    logout = do
        SnapletLens b SessionManager
    s <- (AuthManager b -> SnapletLens b SessionManager)
    -> Handler b (AuthManager b) (SnapletLens b SessionManager)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> SnapletLens b SessionManager
    forall b. AuthManager b -> SnapletLens b SessionManager
    session
        SnapletLens b SessionManager
    -> Handler b SessionManager () -> Handler b (AuthManager b) ()
    forall (m :: * -> * -> * -> *) b v' a v.
    MonadSnaplet m =>
    SnapletLens b v' -> m b v' a -> m b v a
    withTop SnapletLens b SessionManager
    s (Handler b SessionManager () -> Handler b (AuthManager b) ())
    -> Handler b SessionManager () -> Handler b (AuthManager b) ()
    forall a b. (a -> b) -> a -> b
    $ SnapletLens b SessionManager
    -> Handler b SessionManager () -> Handler b SessionManager ()
    forall b v a.
    SnapletLens b SessionManager -> Handler b v a -> Handler b v a
    withSession SnapletLens b SessionManager
    s Handler b SessionManager ()
    forall b. Handler b SessionManager ()
    removeSessionUserId
        ByteString
    rc <- (AuthManager b -> ByteString)
    -> Handler b (AuthManager b) ByteString
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> ByteString
    forall b. AuthManager b -> ByteString
    rememberCookieName
        Maybe ByteString
    rd <- (AuthManager b -> Maybe ByteString)
    -> Handler b (AuthManager b) (Maybe ByteString)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> Maybe ByteString
    forall b. AuthManager b -> Maybe ByteString
    rememberCookieDomain
        ByteString -> Maybe ByteString -> Handler b (AuthManager b) ()
    forall (m :: * -> *).
    MonadSnap m =>
    ByteString -> Maybe ByteString -> m ()
    expireSecureCookie ByteString
    rc Maybe ByteString
    rd
        (AuthManager b -> AuthManager b) -> Handler b (AuthManager b) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((AuthManager b -> AuthManager b) -> Handler b (AuthManager b) ())
    -> (AuthManager b -> AuthManager b) -> Handler b (AuthManager b) ()
    forall a b. (a -> b) -> a -> b
    $ \mgr :: AuthManager b
    mgr -> AuthManager b
    mgr { activeUser :: Maybe AuthUser
    activeUser = Maybe AuthUser
    forall a. Maybe a
    Nothing }

    ------------------------------------------------------------------------------
    -- | Return the current user; trying to remember from cookie if possible.
    --
    currentUser :: Handler b (AuthManager b) (Maybe AuthUser)
    currentUser :: Handler b (AuthManager b) (Maybe AuthUser)
    currentUser = Handler b (AuthManager b) (Maybe AuthUser)
    -> Handler b (AuthManager b) (Maybe AuthUser)
    forall b.
    Handler b (AuthManager b) (Maybe AuthUser)
    -> Handler b (AuthManager b) (Maybe AuthUser)
    cacheOrLookup (Handler b (AuthManager b) (Maybe AuthUser)
     -> Handler b (AuthManager b) (Maybe AuthUser))
    -> Handler b (AuthManager b) (Maybe AuthUser)
    -> Handler b (AuthManager b) (Maybe AuthUser)
    forall a b. (a -> b) -> a -> b
    $ (forall r.
     IAuthBackend r =>
     r -> Handler b (AuthManager b) (Maybe AuthUser))
    -> Handler b (AuthManager b) (Maybe AuthUser)
    forall b v a.
    (forall r. IAuthBackend r => r -> Handler b (AuthManager v) a)
    -> Handler b (AuthManager v) a
    withBackend ((forall r.
      IAuthBackend r =>
      r -> Handler b (AuthManager b) (Maybe AuthUser))
     -> Handler b (AuthManager b) (Maybe AuthUser))
    -> (forall r.
        IAuthBackend r =>
        r -> Handler b (AuthManager b) (Maybe AuthUser))
    -> Handler b (AuthManager b) (Maybe AuthUser)
    forall a b. (a -> b) -> a -> b
    $ \r :: r
    r -> do
        SnapletLens b SessionManager
    s   <- (AuthManager b -> SnapletLens b SessionManager)
    -> Handler b (AuthManager b) (SnapletLens b SessionManager)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> SnapletLens b SessionManager
    forall b. AuthManager b -> SnapletLens b SessionManager
    session
        Maybe UserId
    uid <- SnapletLens b SessionManager
    -> Handler b SessionManager (Maybe UserId)
    -> Handler b (AuthManager b) (Maybe UserId)
    forall (m :: * -> * -> * -> *) b v' a v.
    MonadSnaplet m =>
    SnapletLens b v' -> m b v' a -> m b v a
    withTop SnapletLens b SessionManager
    s Handler b SessionManager (Maybe UserId)
    forall b. Handler b SessionManager (Maybe UserId)
    getSessionUserId
        case Maybe UserId
    uid of
          Nothing -> (AuthFailure -> Maybe AuthUser)
    -> (AuthUser -> Maybe AuthUser)
    -> Either AuthFailure AuthUser
    -> Maybe AuthUser
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe AuthUser -> AuthFailure -> Maybe AuthUser
    forall a b. a -> b -> a
    const Maybe AuthUser
    forall a. Maybe a
    Nothing) AuthUser -> Maybe AuthUser
    forall a. a -> Maybe a
    Just (Either AuthFailure AuthUser -> Maybe AuthUser)
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    -> Handler b (AuthManager b) (Maybe AuthUser)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b. Handler b (AuthManager b) (Either AuthFailure AuthUser)
    loginByRememberToken
          Just uid' :: UserId
    uid' -> IO (Maybe AuthUser) -> Handler b (AuthManager b) (Maybe AuthUser)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe AuthUser) -> Handler b (AuthManager b) (Maybe AuthUser))
    -> IO (Maybe AuthUser)
    -> Handler b (AuthManager b) (Maybe AuthUser)
    forall a b. (a -> b) -> a -> b
    $ r -> UserId -> IO (Maybe AuthUser)
    forall r. IAuthBackend r => r -> UserId -> IO (Maybe AuthUser)
    lookupByUserId r
    r UserId
    uid'

    ------------------------------------------------------------------------------
    -- | Convenience wrapper around 'rememberUser' that returns a bool result
    --
    isLoggedIn :: Handler b (AuthManager b) Bool
    isLoggedIn :: Handler b (AuthManager b) Bool
    isLoggedIn = Maybe AuthUser -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe AuthUser -> Bool)
    -> Handler b (AuthManager b) (Maybe AuthUser)
    -> Handler b (AuthManager b) Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handler b (AuthManager b) (Maybe AuthUser)
    forall b. Handler b (AuthManager b) (Maybe AuthUser)
    currentUser

    ------------------------------------------------------------------------------
    -- | Create or update a given user
    --
    saveUser :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    saveUser :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    saveUser u :: AuthUser
    u
        | Text -> Bool
    null (Text -> Bool) -> Text -> Bool
    forall a b. (a -> b) -> a -> b
    $ AuthUser -> Text
    userLogin AuthUser
    u = Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ AuthFailure -> Either AuthFailure AuthUser
    forall a b. a -> Either a b
    Left AuthFailure
    UsernameMissing
        | Bool
    otherwise = (forall r.
     IAuthBackend r =>
     r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b v a.
    (forall r. IAuthBackend r => r -> Handler b (AuthManager v) a)
    -> Handler b (AuthManager v) a
    withBackend ((forall r.
      IAuthBackend r =>
      r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> (forall r.
        IAuthBackend r =>
        r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ \r :: r
    r -> IO (Either AuthFailure AuthUser)
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either AuthFailure AuthUser)
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> IO (Either AuthFailure AuthUser)
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ r -> AuthUser -> IO (Either AuthFailure AuthUser)
    forall r.
    IAuthBackend r =>
    r -> AuthUser -> IO (Either AuthFailure AuthUser)
    save r
    r AuthUser
    u

    ------------------------------------------------------------------------------
    -- | Destroy the given user
    --
    destroyUser :: AuthUser -> Handler b (AuthManager b) ()
    destroyUser :: AuthUser -> Handler b (AuthManager b) ()
    destroyUser u :: AuthUser
    u = (forall r. IAuthBackend r => r -> Handler b (AuthManager b) ())
    -> Handler b (AuthManager b) ()
    forall b v a.
    (forall r. IAuthBackend r => r -> Handler b (AuthManager v) a)
    -> Handler b (AuthManager v) a
    withBackend ((forall r. IAuthBackend r => r -> Handler b (AuthManager b) ())
     -> Handler b (AuthManager b) ())
    -> (forall r. IAuthBackend r => r -> Handler b (AuthManager b) ())
    -> Handler b (AuthManager b) ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> Handler b (AuthManager b) ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Handler b (AuthManager b) ())
    -> (r -> IO ()) -> r -> Handler b (AuthManager b) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (r -> AuthUser -> IO ()) -> AuthUser -> r -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip r -> AuthUser -> IO ()
    forall r. IAuthBackend r => r -> AuthUser -> IO ()
    destroy AuthUser
    u

                          -----------------------------------
                          --  Lower level helper functions --
                          -----------------------------------

    ------------------------------------------------------------------------------
    -- | Mutate an 'AuthUser', marking failed authentication
    --
    -- This will save the user to the backend.
    --
    markAuthFail :: AuthUser
                 -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    markAuthFail :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    markAuthFail u :: AuthUser
    u = (forall r.
     IAuthBackend r =>
     r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b v a.
    (forall r. IAuthBackend r => r -> Handler b (AuthManager v) a)
    -> Handler b (AuthManager v) a
    withBackend ((forall r.
      IAuthBackend r =>
      r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> (forall r.
        IAuthBackend r =>
        r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ \r :: r
    r -> do
        Maybe (Int, NominalDiffTime)
    lo <- (AuthManager b -> Maybe (Int, NominalDiffTime))
    -> Handler b (AuthManager b) (Maybe (Int, NominalDiffTime))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> Maybe (Int, NominalDiffTime)
    forall b. AuthManager b -> Maybe (Int, NominalDiffTime)
    lockout
        AuthUser -> Handler b (AuthManager b) AuthUser
    forall (m :: * -> *). Monad m => AuthUser -> m AuthUser
    incFailCtr AuthUser
    u Handler b (AuthManager b) AuthUser
    -> (AuthUser -> Handler b (AuthManager b) AuthUser)
    -> Handler b (AuthManager b) AuthUser
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe (Int, NominalDiffTime)
    -> AuthUser -> Handler b (AuthManager b) AuthUser
    forall (m :: * -> *).
    MonadIO m =>
    Maybe (Int, NominalDiffTime) -> AuthUser -> m AuthUser
    checkLockout Maybe (Int, NominalDiffTime)
    lo Handler b (AuthManager b) AuthUser
    -> (AuthUser
        -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO (Either AuthFailure AuthUser)
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either AuthFailure AuthUser)
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> (AuthUser -> IO (Either AuthFailure AuthUser))
    -> AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . r -> AuthUser -> IO (Either AuthFailure AuthUser)
    forall r.
    IAuthBackend r =>
    r -> AuthUser -> IO (Either AuthFailure AuthUser)
    save r
    r

      where
        --------------------------------------------------------------------------
        incFailCtr :: AuthUser -> m AuthUser
    incFailCtr u' :: AuthUser
    u' = AuthUser -> m AuthUser
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AuthUser -> m AuthUser) -> AuthUser -> m AuthUser
    forall a b. (a -> b) -> a -> b
    $ AuthUser
    u' {
                          userFailedLoginCount :: Int
    userFailedLoginCount = AuthUser -> Int
    userFailedLoginCount AuthUser
    u' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1
                        }

        --------------------------------------------------------------------------
        checkLockout :: Maybe (Int, NominalDiffTime) -> AuthUser -> m AuthUser
    checkLockout lo :: Maybe (Int, NominalDiffTime)
    lo u' :: AuthUser
    u' =
            case Maybe (Int, NominalDiffTime)
    lo of
              Nothing          -> AuthUser -> m AuthUser
    forall (m :: * -> *) a. Monad m => a -> m a
    return AuthUser
    u'
              Just (mx :: Int
    mx, wait :: NominalDiffTime
    wait)  ->
                  if AuthUser -> Int
    userFailedLoginCount AuthUser
    u' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    mx
                    then do
                      UTCTime
    now <- IO UTCTime -> m UTCTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
                      let reopen :: UTCTime
    reopen = NominalDiffTime -> UTCTime -> UTCTime
    addUTCTime NominalDiffTime
    wait UTCTime
    now
                      AuthUser -> m AuthUser
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AuthUser -> m AuthUser) -> AuthUser -> m AuthUser
    forall a b. (a -> b) -> a -> b
    $! AuthUser
    u' { userLockedOutUntil :: Maybe UTCTime
    userLockedOutUntil = UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just UTCTime
    reopen }
                    else AuthUser -> m AuthUser
    forall (m :: * -> *) a. Monad m => a -> m a
    return AuthUser
    u'

    ------------------------------------------------------------------------------
    -- | Mutate an 'AuthUser', marking successful authentication
    --
    -- This will save the user to the backend.
    --
    markAuthSuccess :: AuthUser
                    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    markAuthSuccess :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    markAuthSuccess u :: AuthUser
    u = (forall r.
     IAuthBackend r =>
     r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b v a.
    (forall r. IAuthBackend r => r -> Handler b (AuthManager v) a)
    -> Handler b (AuthManager v) a
    withBackend ((forall r.
      IAuthBackend r =>
      r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> (forall r.
        IAuthBackend r =>
        r -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ \r :: r
    r ->
                            AuthUser -> Handler b (AuthManager b) AuthUser
    forall (m :: * -> *). Monad m => AuthUser -> m AuthUser
    incLoginCtr AuthUser
    u     Handler b (AuthManager b) AuthUser
    -> (AuthUser -> Handler b (AuthManager b) AuthUser)
    -> Handler b (AuthManager b) AuthUser
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                            AuthUser -> Handler b (AuthManager b) AuthUser
    forall (m :: * -> *). MonadSnap m => AuthUser -> m AuthUser
    updateIp          Handler b (AuthManager b) AuthUser
    -> (AuthUser -> Handler b (AuthManager b) AuthUser)
    -> Handler b (AuthManager b) AuthUser
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                            AuthUser -> Handler b (AuthManager b) AuthUser
    forall (m :: * -> *). MonadIO m => AuthUser -> m AuthUser
    updateLoginTS     Handler b (AuthManager b) AuthUser
    -> (AuthUser -> Handler b (AuthManager b) AuthUser)
    -> Handler b (AuthManager b) AuthUser
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                            AuthUser -> Handler b (AuthManager b) AuthUser
    forall (m :: * -> *). Monad m => AuthUser -> m AuthUser
    resetFailCtr      Handler b (AuthManager b) AuthUser
    -> (AuthUser
        -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                            IO (Either AuthFailure AuthUser)
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either AuthFailure AuthUser)
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> (AuthUser -> IO (Either AuthFailure AuthUser))
    -> AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . r -> AuthUser -> IO (Either AuthFailure AuthUser)
    forall r.
    IAuthBackend r =>
    r -> AuthUser -> IO (Either AuthFailure AuthUser)
    save r
    r
      where
        --------------------------------------------------------------------------
        incLoginCtr :: AuthUser -> m AuthUser
    incLoginCtr u' :: AuthUser
    u' = AuthUser -> m AuthUser
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AuthUser -> m AuthUser) -> AuthUser -> m AuthUser
    forall a b. (a -> b) -> a -> b
    $ AuthUser
    u' { userLoginCount :: Int
    userLoginCount = AuthUser -> Int
    userLoginCount AuthUser
    u' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1 }

        --------------------------------------------------------------------------
        updateIp :: AuthUser -> m AuthUser
    updateIp u' :: AuthUser
    u' = do
            ByteString
    ip <- Request -> ByteString
    rqClientAddr (Request -> ByteString) -> m Request -> m ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m Request
    forall (m :: * -> *). MonadSnap m => m Request
    getRequest
            AuthUser -> m AuthUser
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AuthUser -> m AuthUser) -> AuthUser -> m AuthUser
    forall a b. (a -> b) -> a -> b
    $ AuthUser
    u' { userLastLoginIp :: Maybe ByteString
    userLastLoginIp = AuthUser -> Maybe ByteString
    userCurrentLoginIp AuthUser
    u'
                        , userCurrentLoginIp :: Maybe ByteString
    userCurrentLoginIp = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    ip }

        --------------------------------------------------------------------------
        updateLoginTS :: AuthUser -> m AuthUser
    updateLoginTS u' :: AuthUser
    u' = do
            UTCTime
    now <- IO UTCTime -> m UTCTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
            AuthUser -> m AuthUser
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AuthUser -> m AuthUser) -> AuthUser -> m AuthUser
    forall a b. (a -> b) -> a -> b
    $
              AuthUser
    u' { userCurrentLoginAt :: Maybe UTCTime
    userCurrentLoginAt = UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just UTCTime
    now
                 , userLastLoginAt :: Maybe UTCTime
    userLastLoginAt = AuthUser -> Maybe UTCTime
    userCurrentLoginAt AuthUser
    u' }

        --------------------------------------------------------------------------
        resetFailCtr :: AuthUser -> m AuthUser
    resetFailCtr u' :: AuthUser
    u' = AuthUser -> m AuthUser
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AuthUser -> m AuthUser) -> AuthUser -> m AuthUser
    forall a b. (a -> b) -> a -> b
    $ AuthUser
    u' { userFailedLoginCount :: Int
    userFailedLoginCount = 0
                                      , userLockedOutUntil :: Maybe UTCTime
    userLockedOutUntil = Maybe UTCTime
    forall a. Maybe a
    Nothing }

    ------------------------------------------------------------------------------
    -- | Authenticate and log the user into the current session if successful.
    --
    -- This is a mid-level function exposed to allow roll-your-own ways of looking
    -- up a user from the database.
    --
    -- This function will:
    --
    -- 1. Check the password
    --
    -- 2. Login the user into the current session
    --
    -- 3. Mark success/failure of the authentication trial on the user record
    --
    checkPasswordAndLogin
      :: AuthUser               -- ^ An existing user, somehow looked up from db
      -> Password               -- ^ A ClearText password
      -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    checkPasswordAndLogin :: AuthUser
    -> Password
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    checkPasswordAndLogin u :: AuthUser
    u pw :: Password
    pw =
        case AuthUser -> Maybe UTCTime
    userLockedOutUntil AuthUser
    u of
          Just x :: UTCTime
    x -> do
            UTCTime
    now <- IO UTCTime -> Handler b (AuthManager b) UTCTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
            if UTCTime
    now UTCTime -> UTCTime -> Bool
    forall a. Ord a => a -> a -> Bool
    > UTCTime
    x
              then AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b.
    AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    auth AuthUser
    u
              else Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> (AuthFailure -> Either AuthFailure AuthUser)
    -> AuthFailure
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AuthFailure -> Either AuthFailure AuthUser
    forall a b. a -> Either a b
    Left (AuthFailure
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> AuthFailure
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ UTCTime -> AuthFailure
    LockedOut UTCTime
    x
          Nothing -> AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b.
    AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    auth AuthUser
    u

      where
        auth :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
        auth :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    auth user :: AuthUser
    user =
          case AuthUser -> Password -> Maybe AuthFailure
    authenticatePassword AuthUser
    user Password
    pw of
            Just e :: AuthFailure
    e -> do
              AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b.
    AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    markAuthFail AuthUser
    user
              Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ AuthFailure -> Either AuthFailure AuthUser
    forall a b. a -> Either a b
    Left AuthFailure
    e

            Nothing -> do
              AuthUser -> Handler b (AuthManager b) (Either AuthFailure ())
    forall b.
    AuthUser -> Handler b (AuthManager b) (Either AuthFailure ())
    forceLogin AuthUser
    user
              (AuthManager b -> AuthManager b) -> Handler b (AuthManager b) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\mgr :: AuthManager b
    mgr -> AuthManager b
    mgr { activeUser :: Maybe AuthUser
    activeUser = AuthUser -> Maybe AuthUser
    forall a. a -> Maybe a
    Just AuthUser
    user })
              AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b.
    AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    markAuthSuccess AuthUser
    user

    ------------------------------------------------------------------------------
    -- | Login and persist the given 'AuthUser' in the active session
    --
    -- Meant to be used if you have other means of being sure that the person is
    -- who she says she is.
    --
    forceLogin :: AuthUser       -- ^ An existing user, somehow looked up from db
               -> Handler b (AuthManager b) (Either AuthFailure ())
    forceLogin :: AuthUser -> Handler b (AuthManager b) (Either AuthFailure ())
    forceLogin u :: AuthUser
    u = do
        SnapletLens b SessionManager
    s <- (AuthManager b -> SnapletLens b SessionManager)
    -> Handler b (AuthManager b) (SnapletLens b SessionManager)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> SnapletLens b SessionManager
    forall b. AuthManager b -> SnapletLens b SessionManager
    session
        SnapletLens b SessionManager
    -> Handler b (AuthManager b) (Either AuthFailure ())
    -> Handler b (AuthManager b) (Either AuthFailure ())
    forall b v a.
    SnapletLens b SessionManager -> Handler b v a -> Handler b v a
    withSession SnapletLens b SessionManager
    s (Handler b (AuthManager b) (Either AuthFailure ())
     -> Handler b (AuthManager b) (Either AuthFailure ()))
    -> Handler b (AuthManager b) (Either AuthFailure ())
    -> Handler b (AuthManager b) (Either AuthFailure ())
    forall a b. (a -> b) -> a -> b
    $
            case AuthUser -> Maybe UserId
    userId AuthUser
    u of
              Just x :: UserId
    x -> do
                SnapletLens b SessionManager
    -> Handler b SessionManager () -> Handler b (AuthManager b) ()
    forall (m :: * -> * -> * -> *) b v' a v.
    MonadSnaplet m =>
    SnapletLens b v' -> m b v' a -> m b v a
    withTop SnapletLens b SessionManager
    s (UserId -> Handler b SessionManager ()
    forall b. UserId -> Handler b SessionManager ()
    setSessionUserId UserId
    x)
                Either AuthFailure ()
    -> Handler b (AuthManager b) (Either AuthFailure ())
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure ()
     -> Handler b (AuthManager b) (Either AuthFailure ()))
    -> Either AuthFailure ()
    -> Handler b (AuthManager b) (Either AuthFailure ())
    forall a b. (a -> b) -> a -> b
    $ () -> Either AuthFailure ()
    forall a b. b -> Either a b
    Right ()
              Nothing -> Either AuthFailure ()
    -> Handler b (AuthManager b) (Either AuthFailure ())
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure ()
     -> Handler b (AuthManager b) (Either AuthFailure ()))
    -> (AuthFailure -> Either AuthFailure ())
    -> AuthFailure
    -> Handler b (AuthManager b) (Either AuthFailure ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AuthFailure -> Either AuthFailure ()
    forall a b. a -> Either a b
    Left (AuthFailure -> Handler b (AuthManager b) (Either AuthFailure ()))
    -> AuthFailure -> Handler b (AuthManager b) (Either AuthFailure ())
    forall a b. (a -> b) -> a -> b
    $
                         String -> AuthFailure
    AuthError (String -> AuthFailure) -> String -> AuthFailure
    forall a b. (a -> b) -> a -> b
    $ "forceLogin: Can't force the login of a user "
                                       String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "without userId"

                         ------------------------------------
                         -- Internal, non-exported helpers --
                         ------------------------------------

    ------------------------------------------------------------------------------
    getRememberToken :: (Serialize t, MonadSnap m)
                     => Key
                     -> ByteString
                     -> Maybe Int
                     -> m (Maybe t)
    getRememberToken :: Key -> ByteString -> Maybe Int -> m (Maybe t)
    getRememberToken sk :: Key
    sk rc :: ByteString
    rc rp :: Maybe Int
    rp = ByteString -> Key -> Maybe Int -> m (Maybe t)
    forall (m :: * -> *) t.
    (MonadSnap m, Serialize t) =>
    ByteString -> Key -> Maybe Int -> m (Maybe t)
    getSecureCookie ByteString
    rc Key
    sk Maybe Int
    rp

    ------------------------------------------------------------------------------
    setRememberToken :: (Serialize t, MonadSnap m)
                     => Key
                     -> ByteString
                     -> Maybe ByteString
                     -> Maybe Int
                     -> t
                     -> m ()
    setRememberToken :: Key -> ByteString -> Maybe ByteString -> Maybe Int -> t -> m ()
    setRememberToken sk :: Key
    sk rc :: ByteString
    rc rd :: Maybe ByteString
    rd rp :: Maybe Int
    rp token :: t
    token = ByteString -> Maybe ByteString -> Key -> Maybe Int -> t -> m ()
    forall (m :: * -> *) t.
    (MonadSnap m, Serialize t) =>
    ByteString -> Maybe ByteString -> Key -> Maybe Int -> t -> m ()
    setSecureCookie ByteString
    rc Maybe ByteString
    rd Key
    sk Maybe Int
    rp t
    token

    ------------------------------------------------------------------------------
    -- | Set the current user's 'UserId' in the active session
    --
    setSessionUserId :: UserId -> Handler b SessionManager ()
    setSessionUserId :: UserId -> Handler b SessionManager ()
    setSessionUserId (UserId t :: Text
    t) = Text -> Text -> Handler b SessionManager ()
    forall b. Text -> Text -> Handler b SessionManager ()
    setInSession "__user_id" Text
    t

    ------------------------------------------------------------------------------
    -- | Remove 'UserId' from active session, effectively logging the user out.
    removeSessionUserId :: Handler b SessionManager ()
    removeSessionUserId :: Handler b SessionManager ()
    removeSessionUserId = Text -> Handler b SessionManager ()
    forall b. Text -> Handler b SessionManager ()
    deleteFromSession "__user_id"

    ------------------------------------------------------------------------------
    -- | Get the current user's 'UserId' from the active session
    --
    getSessionUserId :: Handler b SessionManager (Maybe UserId)
    getSessionUserId :: Handler b SessionManager (Maybe UserId)
    getSessionUserId = do
      Maybe Text
    uid <- Text -> Handler b SessionManager (Maybe Text)
    forall b. Text -> Handler b SessionManager (Maybe Text)
    getFromSession "__user_id"
      Maybe UserId -> Handler b SessionManager (Maybe UserId)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe UserId -> Handler b SessionManager (Maybe UserId))
    -> Maybe UserId -> Handler b SessionManager (Maybe UserId)
    forall a b. (a -> b) -> a -> b
    $ (Text -> UserId) -> Maybe Text -> Maybe UserId
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Text -> UserId
    UserId Maybe Text
    uid

    ------------------------------------------------------------------------------
    -- | Check password for a given user.
    --
    -- Returns "Nothing" if check is successful and an "IncorrectPassword" error
    -- otherwise
    --
    authenticatePassword :: AuthUser        -- ^ Looked up from the back-end
                         -> Password        -- ^ Check against this password
                         -> Maybe AuthFailure
    authenticatePassword :: AuthUser -> Password -> Maybe AuthFailure
    authenticatePassword u :: AuthUser
    u pw :: Password
    pw = Maybe AuthFailure
    auth
      where
        auth :: Maybe AuthFailure
    auth    = case AuthUser -> Maybe Password
    userPassword AuthUser
    u of
                    Nothing -> AuthFailure -> Maybe AuthFailure
    forall a. a -> Maybe a
    Just AuthFailure
    PasswordMissing
                    Just upw :: Password
    upw -> Bool -> Maybe AuthFailure
    check (Bool -> Maybe AuthFailure) -> Bool -> Maybe AuthFailure
    forall a b. (a -> b) -> a -> b
    $ Password -> Password -> Bool
    checkPassword Password
    pw Password
    upw

        check :: Bool -> Maybe AuthFailure
    check b :: Bool
    b = if Bool
    b then Maybe AuthFailure
    forall a. Maybe a
    Nothing else AuthFailure -> Maybe AuthFailure
    forall a. a -> Maybe a
    Just AuthFailure
    IncorrectPassword

    ------------------------------------------------------------------------------
    -- | Wrap lookups around request-local cache
    --
    cacheOrLookup
      :: Handler b (AuthManager b) (Maybe AuthUser)
          -- ^ Lookup action to perform if request local cache is empty
      -> Handler b (AuthManager b) (Maybe AuthUser)
    cacheOrLookup :: Handler b (AuthManager b) (Maybe AuthUser)
    -> Handler b (AuthManager b) (Maybe AuthUser)
    cacheOrLookup f :: Handler b (AuthManager b) (Maybe AuthUser)
    f = do
        Maybe AuthUser
    au <- (AuthManager b -> Maybe AuthUser)
    -> Handler b (AuthManager b) (Maybe AuthUser)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> Maybe AuthUser
    forall b. AuthManager b -> Maybe AuthUser
    activeUser
        if Maybe AuthUser -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe AuthUser
    au
          then Maybe AuthUser -> Handler b (AuthManager b) (Maybe AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe AuthUser
    au
          else do
            Maybe AuthUser
    au' <- Handler b (AuthManager b) (Maybe AuthUser)
    f
            (AuthManager b -> AuthManager b) -> Handler b (AuthManager b) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\mgr :: AuthManager b
    mgr -> AuthManager b
    mgr { activeUser :: Maybe AuthUser
    activeUser = Maybe AuthUser
    au' })
            Maybe AuthUser -> Handler b (AuthManager b) (Maybe AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe AuthUser
    au'

    ------------------------------------------------------------------------------
    -- | Register a new user by specifying login and password 'Param' fields
    --
    registerUser
      :: ByteString            -- ^ Login field
      -> ByteString            -- ^ Password field
      -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    registerUser :: ByteString
    -> ByteString
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    registerUser lf :: ByteString
    lf pf :: ByteString
    pf = do
        Maybe Text
    l <- (ByteString -> Text) -> Maybe ByteString -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ByteString -> Text
    decodeUtf8 (Maybe ByteString -> Maybe Text)
    -> Handler b (AuthManager b) (Maybe ByteString)
    -> Handler b (AuthManager b) (Maybe Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ByteString -> Handler b (AuthManager b) (Maybe ByteString)
    forall (m :: * -> *).
    MonadSnap m =>
    ByteString -> m (Maybe ByteString)
    getParam ByteString
    lf
        Maybe ByteString
    p <- ByteString -> Handler b (AuthManager b) (Maybe ByteString)
    forall (m :: * -> *).
    MonadSnap m =>
    ByteString -> m (Maybe ByteString)
    getParam ByteString
    pf

        let l' :: Either AuthFailure Text
    l' = Either AuthFailure Text
    -> (Text -> Either AuthFailure Text)
    -> Maybe Text
    -> Either AuthFailure Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (AuthFailure -> Either AuthFailure Text
    forall a b. a -> Either a b
    Left AuthFailure
    UsernameMissing) Text -> Either AuthFailure Text
    forall a b. b -> Either a b
    Right Maybe Text
    l
        let p' :: Either AuthFailure ByteString
    p' = Either AuthFailure ByteString
    -> (ByteString -> Either AuthFailure ByteString)
    -> Maybe ByteString
    -> Either AuthFailure ByteString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (AuthFailure -> Either AuthFailure ByteString
    forall a b. a -> Either a b
    Left AuthFailure
    PasswordMissing) ByteString -> Either AuthFailure ByteString
    forall a b. b -> Either a b
    Right Maybe ByteString
    p

        -- In case of multiple AuthFailure, the first available one
        -- will be propagated.
        case (Text -> ByteString -> (Text, ByteString))
    -> Either AuthFailure Text
    -> Either AuthFailure ByteString
    -> Either AuthFailure (Text, ByteString)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (,) Either AuthFailure Text
    l' Either AuthFailure ByteString
    p' of
          Left e :: AuthFailure
    e           -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ AuthFailure -> Either AuthFailure AuthUser
    forall a b. a -> Either a b
    Left AuthFailure
    e
          Right (lgn :: Text
    lgn, pwd :: ByteString
    pwd) -> Text
    -> ByteString
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b.
    Text
    -> ByteString
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    createUser Text
    lgn ByteString
    pwd

    ------------------------------------------------------------------------------
    -- | A 'MonadSnap' handler that processes a login form.
    --
    -- The request paremeters are passed to 'performLogin'
    --
    -- To make your users stay logged in for longer than the session replay
    -- prevention timeout, you must pass a field name as the third parameter and
    -- that field must be set to a value of \"1\" by the submitting form.  This
    -- lets you use a user selectable check box.  Or if you want user remembering
    -- always turned on, you can use a hidden form field.
    loginUser
      :: ByteString
          -- ^ Username field
      -> ByteString
          -- ^ Password field
      -> Maybe ByteString
          -- ^ Remember field; Nothing if you want no remember function.
      -> (AuthFailure -> Handler b (AuthManager b) ())
          -- ^ Upon failure
      -> Handler b (AuthManager b) ()
          -- ^ Upon success
      -> Handler b (AuthManager b) ()
    loginUser :: ByteString
    -> ByteString
    -> Maybe ByteString
    -> (AuthFailure -> Handler b (AuthManager b) ())
    -> Handler b (AuthManager b) ()
    -> Handler b (AuthManager b) ()
    loginUser unf :: ByteString
    unf pwdf :: ByteString
    pwdf remf :: Maybe ByteString
    remf loginFail :: AuthFailure -> Handler b (AuthManager b) ()
    loginFail loginSucc :: Handler b (AuthManager b) ()
    loginSucc =
        ByteString
    -> ByteString
    -> Maybe ByteString
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b.
    ByteString
    -> ByteString
    -> Maybe ByteString
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    loginUser' ByteString
    unf ByteString
    pwdf Maybe ByteString
    remf Handler b (AuthManager b) (Either AuthFailure AuthUser)
    -> (Either AuthFailure AuthUser -> Handler b (AuthManager b) ())
    -> Handler b (AuthManager b) ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (AuthFailure -> Handler b (AuthManager b) ())
    -> (AuthUser -> Handler b (AuthManager b) ())
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) ()
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either AuthFailure -> Handler b (AuthManager b) ()
    loginFail (Handler b (AuthManager b) ()
    -> AuthUser -> Handler b (AuthManager b) ()
    forall a b. a -> b -> a
    const Handler b (AuthManager b) ()
    loginSucc)

    ------------------------------------------------------------------------------
    loginUser' :: ByteString
               -> ByteString
               -> Maybe ByteString
               -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    loginUser' :: ByteString
    -> ByteString
    -> Maybe ByteString
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    loginUser' unf :: ByteString
    unf pwdf :: ByteString
    pwdf remf :: Maybe ByteString
    remf = do
        Maybe ByteString
    mbUsername <- ByteString -> Handler b (AuthManager b) (Maybe ByteString)
    forall (m :: * -> *).
    MonadSnap m =>
    ByteString -> m (Maybe ByteString)
    getParam ByteString
    unf
        Maybe ByteString
    mbPassword <- ByteString -> Handler b (AuthManager b) (Maybe ByteString)
    forall (m :: * -> *).
    MonadSnap m =>
    ByteString -> m (Maybe ByteString)
    getParam ByteString
    pwdf
        Bool
    remember   <- (Maybe Bool -> Bool)
    -> Handler b (AuthManager b) (Maybe Bool)
    -> Handler b (AuthManager b) Bool
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    False)
                        (MaybeT (Handler b (AuthManager b)) Bool
    -> Handler b (AuthManager b) (Maybe Bool)
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT (Handler b (AuthManager b)) Bool
     -> Handler b (AuthManager b) (Maybe Bool))
    -> MaybeT (Handler b (AuthManager b)) Bool
    -> Handler b (AuthManager b) (Maybe Bool)
    forall a b. (a -> b) -> a -> b
    $
                        do ByteString
    field <- Handler b (AuthManager b) (Maybe ByteString)
    -> MaybeT (Handler b (AuthManager b)) ByteString
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (Handler b (AuthManager b) (Maybe ByteString)
     -> MaybeT (Handler b (AuthManager b)) ByteString)
    -> Handler b (AuthManager b) (Maybe ByteString)
    -> MaybeT (Handler b (AuthManager b)) ByteString
    forall a b. (a -> b) -> a -> b
    $ Maybe ByteString -> Handler b (AuthManager b) (Maybe ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ByteString
    remf
                           ByteString
    value <- Handler b (AuthManager b) (Maybe ByteString)
    -> MaybeT (Handler b (AuthManager b)) ByteString
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (Handler b (AuthManager b) (Maybe ByteString)
     -> MaybeT (Handler b (AuthManager b)) ByteString)
    -> Handler b (AuthManager b) (Maybe ByteString)
    -> MaybeT (Handler b (AuthManager b)) ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Handler b (AuthManager b) (Maybe ByteString)
    forall (m :: * -> *).
    MonadSnap m =>
    ByteString -> m (Maybe ByteString)
    getParam ByteString
    field
                           Bool -> MaybeT (Handler b (AuthManager b)) Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> MaybeT (Handler b (AuthManager b)) Bool)
    -> Bool -> MaybeT (Handler b (AuthManager b)) Bool
    forall a b. (a -> b) -> a -> b
    $ ByteString
    value ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "1" Bool -> Bool -> Bool
    || ByteString
    value ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "on")

        case Maybe ByteString
    mbUsername of
          Nothing -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ AuthFailure -> Either AuthFailure AuthUser
    forall a b. a -> Either a b
    Left AuthFailure
    UsernameMissing
          Just u :: ByteString
    u -> case Maybe ByteString
    mbPassword of
            Nothing -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either AuthFailure AuthUser
     -> Handler b (AuthManager b) (Either AuthFailure AuthUser))
    -> Either AuthFailure AuthUser
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ AuthFailure -> Either AuthFailure AuthUser
    forall a b. a -> Either a b
    Left AuthFailure
    PasswordMissing
            Just p :: ByteString
    p -> Text
    -> Password
    -> Bool
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    forall b.
    Text
    -> Password
    -> Bool
    -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    loginByUsername (ByteString -> Text
    decodeUtf8 ByteString
    u) (ByteString -> Password
    ClearText ByteString
    p) Bool
    remember

    ------------------------------------------------------------------------------
    -- | Simple handler to log the user out. Deletes user from session.
    --
    logoutUser :: Handler b (AuthManager b) ()   -- ^ What to do after logging out
               -> Handler b (AuthManager b) ()
    logoutUser :: Handler b (AuthManager b) () -> Handler b (AuthManager b) ()
    logoutUser target :: Handler b (AuthManager b) ()
    target = Handler b (AuthManager b) ()
    forall b. Handler b (AuthManager b) ()
    logout Handler b (AuthManager b) ()
    -> Handler b (AuthManager b) () -> Handler b (AuthManager b) ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handler b (AuthManager b) ()
    target

    ------------------------------------------------------------------------------
    -- | Require that an authenticated 'AuthUser' is present in the current
    -- session.
    --
    -- This function has no DB cost - only checks to see if a user_id is present
    -- in the current session.
    --
    requireUser :: SnapletLens b (AuthManager b)
                    -- ^ Lens reference to an "AuthManager"
                -> Handler b v a
                    -- ^ Do this if no authenticated user is present.
                -> Handler b v a
                    -- ^ Do this if an authenticated user is present.
                -> Handler b v a
    requireUser :: SnapletLens b (AuthManager b)
    -> Handler b v a -> Handler b v a -> Handler b v a
    requireUser auth :: SnapletLens b (AuthManager b)
    auth bad :: Handler b v a
    bad good :: Handler b v a
    good = do
        Bool
    loggedIn <- SnapletLens b (AuthManager b)
    -> Handler b (AuthManager b) Bool -> Handler b v Bool
    forall (m :: * -> * -> * -> *) b v' a v.
    MonadSnaplet m =>
    SnapletLens b v' -> m b v' a -> m b v a
    withTop SnapletLens b (AuthManager b)
    auth Handler b (AuthManager b) Bool
    forall b. Handler b (AuthManager b) Bool
    isLoggedIn
        if Bool
    loggedIn then Handler b v a
    good else Handler b v a
    bad

    ------------------------------------------------------------------------------
    -- | Run a function on the backend, and return the result.
    --
    -- This uses an existential type so that the backend type doesn't
    -- 'escape' AuthManager.  The reason that the type is Handler b
    -- (AuthManager v) a and not a is because anything that uses the
    -- backend will return an IO something, which you can liftIO, or a
    -- Handler b (AuthManager v) a if it uses other handler things.
    --
    withBackend ::
        (forall r. (IAuthBackend r) => r -> Handler b (AuthManager v) a)
          -- ^ The function to run with the handler.
      -> Handler b (AuthManager v) a
    withBackend :: (forall r. IAuthBackend r => r -> Handler b (AuthManager v) a)
    -> Handler b (AuthManager v) a
    withBackend f :: forall r. IAuthBackend r => r -> Handler b (AuthManager v) a
    f = Handler b (AuthManager v) (Handler b (AuthManager v) a)
    -> Handler b (AuthManager v) a
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (Handler b (AuthManager v) (Handler b (AuthManager v) a)
     -> Handler b (AuthManager v) a)
    -> Handler b (AuthManager v) (Handler b (AuthManager v) a)
    -> Handler b (AuthManager v) a
    forall a b. (a -> b) -> a -> b
    $ do
      (AuthManager backend_ :: r
    backend_ _ _ _ _ _ _ _ _ _) <- Handler b (AuthManager v) (AuthManager v)
    forall s (m :: * -> *). MonadState s m => m s
    get
      Handler b (AuthManager v) a
    -> Handler b (AuthManager v) (Handler b (AuthManager v) a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Handler b (AuthManager v) a
     -> Handler b (AuthManager v) (Handler b (AuthManager v) a))
    -> Handler b (AuthManager v) a
    -> Handler b (AuthManager v) (Handler b (AuthManager v) a)
    forall a b. (a -> b) -> a -> b
    $ r -> Handler b (AuthManager v) a
    forall r. IAuthBackend r => r -> Handler b (AuthManager v) a
    f r
    backend_

    ------------------------------------------------------------------------------
    -- | This function generates a random password reset token and stores it in
    -- the database for the user.  Call this function when a user forgets their
    -- password.  Then use the token to autogenerate a link that the user can
    -- visit to reset their password.  This function also sets a timestamp so the
    -- reset token can be expired.
    setPasswordResetToken :: Text -> Handler b (AuthManager b) (Maybe Text)
    setPasswordResetToken :: Text -> Handler b (AuthManager b) (Maybe Text)
    setPasswordResetToken login :: Text
    login = do
      ByteString
    tokBS <- IO ByteString -> Handler b (AuthManager b) ByteString
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> Handler b (AuthManager b) ByteString)
    -> (RNG -> IO ByteString)
    -> RNG
    -> Handler b (AuthManager b) ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> RNG -> IO ByteString
    randomToken 40 (RNG -> Handler b (AuthManager b) ByteString)
    -> Handler b (AuthManager b) RNG
    -> Handler b (AuthManager b) ByteString
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (AuthManager b -> RNG) -> Handler b (AuthManager b) RNG
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets AuthManager b -> RNG
    forall b. AuthManager b -> RNG
    randomNumberGenerator
      let token :: Text
    token = ByteString -> Text
    decodeUtf8 ByteString
    tokBS
      UTCTime
    now <- IO UTCTime -> Handler b (AuthManager b) UTCTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
      Bool
    success <- Text
    -> Maybe Text -> Maybe UTCTime -> Handler b (AuthManager b) Bool
    forall v.
    Text
    -> Maybe Text -> Maybe UTCTime -> Handler v (AuthManager v) Bool
    modPasswordResetToken Text
    login (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    token) (UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just UTCTime
    now)
      Maybe Text -> Handler b (AuthManager b) (Maybe Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Text -> Handler b (AuthManager b) (Maybe Text))
    -> Maybe Text -> Handler b (AuthManager b) (Maybe Text)
    forall a b. (a -> b) -> a -> b
    $ if Bool
    success then Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    token else Maybe Text
    forall a. Maybe a
    Nothing

    ------------------------------------------------------------------------------
    -- | Clears a user's password reset token.  Call this when the user
    -- successfully changes their password to ensure that the password reset link
    -- cannot be used again.
    clearPasswordResetToken :: Text -> Handler b (AuthManager b) Bool
    clearPasswordResetToken :: Text -> Handler b (AuthManager b) Bool
    clearPasswordResetToken login :: Text
    login = Text
    -> Maybe Text -> Maybe UTCTime -> Handler b (AuthManager b) Bool
    forall v.
    Text
    -> Maybe Text -> Maybe UTCTime -> Handler v (AuthManager v) Bool
    modPasswordResetToken Text
    login Maybe Text
    forall a. Maybe a
    Nothing Maybe UTCTime
    forall a. Maybe a
    Nothing

    ------------------------------------------------------------------------------
    -- | Helper function used for setting and clearing the password reset token
    -- and associated timestamp.
    modPasswordResetToken :: Text
                          -> Maybe Text
                          -> Maybe UTCTime
                          -> Handler v (AuthManager v) Bool
    modPasswordResetToken :: Text
    -> Maybe Text -> Maybe UTCTime -> Handler v (AuthManager v) Bool
    modPasswordResetToken login :: Text
    login token :: Maybe Text
    token timestamp :: Maybe UTCTime
    timestamp = do
      Maybe ()
    res <- MaybeT (Handler v (AuthManager v)) ()
    -> Handler v (AuthManager v) (Maybe ())
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT (Handler v (AuthManager v)) ()
     -> Handler v (AuthManager v) (Maybe ()))
    -> MaybeT (Handler v (AuthManager v)) ()
    -> Handler v (AuthManager v) (Maybe ())
    forall a b. (a -> b) -> a -> b
    $ do
          AuthUser
    u <- Handler v (AuthManager v) (Maybe AuthUser)
    -> MaybeT (Handler v (AuthManager v)) AuthUser
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (Handler v (AuthManager v) (Maybe AuthUser)
     -> MaybeT (Handler v (AuthManager v)) AuthUser)
    -> Handler v (AuthManager v) (Maybe AuthUser)
    -> MaybeT (Handler v (AuthManager v)) AuthUser
    forall a b. (a -> b) -> a -> b
    $ (forall r.
     IAuthBackend r =>
     r -> Handler v (AuthManager v) (Maybe AuthUser))
    -> Handler v (AuthManager v) (Maybe AuthUser)
    forall b v a.
    (forall r. IAuthBackend r => r -> Handler b (AuthManager v) a)
    -> Handler b (AuthManager v) a
    withBackend ((forall r.
      IAuthBackend r =>
      r -> Handler v (AuthManager v) (Maybe AuthUser))
     -> Handler v (AuthManager v) (Maybe AuthUser))
    -> (forall r.
        IAuthBackend r =>
        r -> Handler v (AuthManager v) (Maybe AuthUser))
    -> Handler v (AuthManager v) (Maybe AuthUser)
    forall a b. (a -> b) -> a -> b
    $ \b :: r
    b -> IO (Maybe AuthUser) -> Handler v (AuthManager v) (Maybe AuthUser)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe AuthUser) -> Handler v (AuthManager v) (Maybe AuthUser))
    -> IO (Maybe AuthUser)
    -> Handler v (AuthManager v) (Maybe AuthUser)
    forall a b. (a -> b) -> a -> b
    $ r -> Text -> IO (Maybe AuthUser)
    forall r. IAuthBackend r => r -> Text -> IO (Maybe AuthUser)
    lookupByLogin r
    b Text
    login
          Handler v (AuthManager v) (Either AuthFailure AuthUser)
    -> MaybeT (Handler v (AuthManager v)) (Either AuthFailure AuthUser)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Handler v (AuthManager v) (Either AuthFailure AuthUser)
     -> MaybeT
          (Handler v (AuthManager v)) (Either AuthFailure AuthUser))
    -> Handler v (AuthManager v) (Either AuthFailure AuthUser)
    -> MaybeT (Handler v (AuthManager v)) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ AuthUser -> Handler v (AuthManager v) (Either AuthFailure AuthUser)
    forall b.
    AuthUser -> Handler b (AuthManager b) (Either AuthFailure AuthUser)
    saveUser (AuthUser
     -> Handler v (AuthManager v) (Either AuthFailure AuthUser))
    -> AuthUser
    -> Handler v (AuthManager v) (Either AuthFailure AuthUser)
    forall a b. (a -> b) -> a -> b
    $ AuthUser
    u
            { userResetToken :: Maybe Text
    userResetToken = Maybe Text
    token
            , userResetRequestedAt :: Maybe UTCTime
    userResetRequestedAt = Maybe UTCTime
    timestamp
            }
          () -> MaybeT (Handler v (AuthManager v)) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      Bool -> Handler v (AuthManager v) Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Handler v (AuthManager v) Bool)
    -> Bool -> Handler v (AuthManager v) Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> (() -> Bool) -> Maybe () -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (\_ -> Bool
    True) Maybe ()
    res