    ------------------------------------------------------------------------------
    -- | Internal module exporting AuthManager implementation.
    --
    {-# LANGUAGE DeriveDataTypeable         #-}
    {-# LANGUAGE ExistentialQuantification  #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE OverloadedStrings          #-}
    {-# LANGUAGE RecordWildCards            #-}

    module Snap.Snaplet.Auth.AuthManager
      ( -- * AuthManager Datatype
        AuthManager(..)

        -- * Backend Typeclass
        , IAuthBackend(..)

        -- * Context-free Operations
        , buildAuthUser
      ) where

    ------------------------------------------------------------------------------
    import           Data.ByteString (ByteString)
    import           Data.Text (Text)
    import           Data.Time
    import           Web.ClientSession

    import           Snap.Snaplet
    import           Snap.Snaplet.Session
    import           Snap.Snaplet.Auth.Types

    ------------------------------------------------------------------------------
    -- | Creates a new user from a username and password.
    --
    buildAuthUser :: IAuthBackend r =>
                     r            -- ^ An auth backend
                  -> Text         -- ^ Username
                  -> ByteString   -- ^ Password
                  -> IO (Either AuthFailure AuthUser)
    buildAuthUser :: forall r.
    IAuthBackend r =>
    r -> Text -> ByteString -> IO (Either AuthFailure AuthUser)
    buildAuthUser r
    r Text
    unm ByteString
    pass = do
      UTCTime
    now <- IO UTCTime
    getCurrentTime
      let au :: AuthUser
    au = AuthUser
    defAuthUser {
                  userLogin :: Text
    userLogin     = Text
    unm
                , userPassword :: Maybe Password
    userPassword  = Maybe Password
    forall a. Maybe a
    Nothing
                , userCreatedAt :: Maybe UTCTime
    userCreatedAt = UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just UTCTime
    now
                , userUpdatedAt :: Maybe UTCTime
    userUpdatedAt = UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just UTCTime
    now
                }
      AuthUser
    au' <- AuthUser -> ByteString -> IO AuthUser
    setPassword AuthUser
    au ByteString
    pass
      r -> AuthUser -> IO (Either AuthFailure AuthUser)
    forall r.
    IAuthBackend r =>
    r -> AuthUser -> IO (Either AuthFailure AuthUser)
    save r
    r AuthUser
    au'

    ------------------------------------------------------------------------------
    -- | All storage backends need to implement this typeclass
    --
    class IAuthBackend r where
      -- | Create or update the given 'AuthUser' record.  A 'userId' of Nothing
      -- indicates that a new user should be created, otherwise the user
      -- information for that userId should be updated.
      save                  :: r -> AuthUser -> IO (Either AuthFailure AuthUser)
      lookupByUserId        :: r -> UserId   -> IO (Maybe AuthUser)
      lookupByLogin         :: r -> Text     -> IO (Maybe AuthUser)
      lookupByEmail         :: r -> Text     -> IO (Maybe AuthUser)
      lookupByRememberToken :: r -> Text     -> IO (Maybe AuthUser)
      destroy               :: r -> AuthUser -> IO ()

    ------------------------------------------------------------------------------
    -- | Abstract data type holding all necessary information for auth operation
    data AuthManager b = forall r. IAuthBackend r => AuthManager {
          ()
    backend               :: r
            -- ^ Storage back-end

        , forall b. AuthManager b -> SnapletLens b SessionManager
    session               :: SnapletLens b SessionManager
            -- ^ A lens pointer to a SessionManager

        , forall b. AuthManager b -> Maybe AuthUser
    activeUser            :: Maybe AuthUser
            -- ^ A per-request logged-in user cache

        , forall b. AuthManager b -> Int
    minPasswdLen          :: Int
            -- ^ Password length range

        , forall b. AuthManager b -> ByteString
    rememberCookieName    :: ByteString
            -- ^ Cookie name for the remember token

        , forall b. AuthManager b -> Maybe ByteString
    rememberCookieDomain  :: Maybe ByteString
            -- ^ Domain for which remember cookie will be created.

        , forall b. AuthManager b -> Maybe Int
    rememberPeriod        :: Maybe Int
            -- ^ Remember period in seconds. Defaults to 2 weeks.

        , forall b. AuthManager b -> Key
    siteKey               :: Key
            -- ^ A unique encryption key used to encrypt remember cookie

        , forall b. AuthManager b -> Maybe (Int, NominalDiffTime)
    lockout               :: Maybe (Int, NominalDiffTime)
            -- ^ Lockout after x tries, re-allow entry after y seconds

        , forall b. AuthManager b -> RNG
    randomNumberGenerator :: RNG
            -- ^ Random number generator
        }

    instance IAuthBackend (AuthManager b) where
        save :: AuthManager b -> AuthUser -> IO (Either AuthFailure AuthUser)
    save AuthManager{r
    Int
    Maybe Int
    Maybe (Int, NominalDiffTime)
    Maybe ByteString
    Maybe AuthUser
    ByteString
    Key
    RNG
    SnapletLens b SessionManager
    backend :: ()
    session :: forall b. AuthManager b -> SnapletLens b SessionManager
    activeUser :: forall b. AuthManager b -> Maybe AuthUser
    minPasswdLen :: forall b. AuthManager b -> Int
    rememberCookieName :: forall b. AuthManager b -> ByteString
    rememberCookieDomain :: forall b. AuthManager b -> Maybe ByteString
    rememberPeriod :: forall b. AuthManager b -> Maybe Int
    siteKey :: forall b. AuthManager b -> Key
    lockout :: forall b. AuthManager b -> Maybe (Int, NominalDiffTime)
    randomNumberGenerator :: forall b. AuthManager b -> RNG
    backend :: r
    session :: SnapletLens b SessionManager
    activeUser :: Maybe AuthUser
    minPasswdLen :: Int
    rememberCookieName :: ByteString
    rememberCookieDomain :: Maybe ByteString
    rememberPeriod :: Maybe Int
    siteKey :: Key
    lockout :: Maybe (Int, NominalDiffTime)
    randomNumberGenerator :: RNG
    ..} AuthUser
    u = r -> AuthUser -> IO (Either AuthFailure AuthUser)
    forall r.
    IAuthBackend r =>
    r -> AuthUser -> IO (Either AuthFailure AuthUser)
    save r
    backend AuthUser
    u
        lookupByUserId :: AuthManager b -> UserId -> IO (Maybe AuthUser)
    lookupByUserId AuthManager{r
    Int
    Maybe Int
    Maybe (Int, NominalDiffTime)
    Maybe ByteString
    Maybe AuthUser
    ByteString
    Key
    RNG
    SnapletLens b SessionManager
    backend :: ()
    session :: forall b. AuthManager b -> SnapletLens b SessionManager
    activeUser :: forall b. AuthManager b -> Maybe AuthUser
    minPasswdLen :: forall b. AuthManager b -> Int
    rememberCookieName :: forall b. AuthManager b -> ByteString
    rememberCookieDomain :: forall b. AuthManager b -> Maybe ByteString
    rememberPeriod :: forall b. AuthManager b -> Maybe Int
    siteKey :: forall b. AuthManager b -> Key
    lockout :: forall b. AuthManager b -> Maybe (Int, NominalDiffTime)
    randomNumberGenerator :: forall b. AuthManager b -> RNG
    backend :: r
    session :: SnapletLens b SessionManager
    activeUser :: Maybe AuthUser
    minPasswdLen :: Int
    rememberCookieName :: ByteString
    rememberCookieDomain :: Maybe ByteString
    rememberPeriod :: Maybe Int
    siteKey :: Key
    lockout :: Maybe (Int, NominalDiffTime)
    randomNumberGenerator :: RNG
    ..} UserId
    u = r -> UserId -> IO (Maybe AuthUser)
    forall r. IAuthBackend r => r -> UserId -> IO (Maybe AuthUser)
    lookupByUserId r
    backend UserId
    u
        lookupByLogin :: AuthManager b -> Text -> IO (Maybe AuthUser)
    lookupByLogin AuthManager{r
    Int
    Maybe Int
    Maybe (Int, NominalDiffTime)
    Maybe ByteString
    Maybe AuthUser
    ByteString
    Key
    RNG
    SnapletLens b SessionManager
    backend :: ()
    session :: forall b. AuthManager b -> SnapletLens b SessionManager
    activeUser :: forall b. AuthManager b -> Maybe AuthUser
    minPasswdLen :: forall b. AuthManager b -> Int
    rememberCookieName :: forall b. AuthManager b -> ByteString
    rememberCookieDomain :: forall b. AuthManager b -> Maybe ByteString
    rememberPeriod :: forall b. AuthManager b -> Maybe Int
    siteKey :: forall b. AuthManager b -> Key
    lockout :: forall b. AuthManager b -> Maybe (Int, NominalDiffTime)
    randomNumberGenerator :: forall b. AuthManager b -> RNG
    backend :: r
    session :: SnapletLens b SessionManager
    activeUser :: Maybe AuthUser
    minPasswdLen :: Int
    rememberCookieName :: ByteString
    rememberCookieDomain :: Maybe ByteString
    rememberPeriod :: Maybe Int
    siteKey :: Key
    lockout :: Maybe (Int, NominalDiffTime)
    randomNumberGenerator :: RNG
    ..} Text
    u = r -> Text -> IO (Maybe AuthUser)
    forall r. IAuthBackend r => r -> Text -> IO (Maybe AuthUser)
    lookupByLogin r
    backend Text
    u
        lookupByEmail :: AuthManager b -> Text -> IO (Maybe AuthUser)
    lookupByEmail AuthManager{r
    Int
    Maybe Int
    Maybe (Int, NominalDiffTime)
    Maybe ByteString
    Maybe AuthUser
    ByteString
    Key
    RNG
    SnapletLens b SessionManager
    backend :: ()
    session :: forall b. AuthManager b -> SnapletLens b SessionManager
    activeUser :: forall b. AuthManager b -> Maybe AuthUser
    minPasswdLen :: forall b. AuthManager b -> Int
    rememberCookieName :: forall b. AuthManager b -> ByteString
    rememberCookieDomain :: forall b. AuthManager b -> Maybe ByteString
    rememberPeriod :: forall b. AuthManager b -> Maybe Int
    siteKey :: forall b. AuthManager b -> Key
    lockout :: forall b. AuthManager b -> Maybe (Int, NominalDiffTime)
    randomNumberGenerator :: forall b. AuthManager b -> RNG
    backend :: r
    session :: SnapletLens b SessionManager
    activeUser :: Maybe AuthUser
    minPasswdLen :: Int
    rememberCookieName :: ByteString
    rememberCookieDomain :: Maybe ByteString
    rememberPeriod :: Maybe Int
    siteKey :: Key
    lockout :: Maybe (Int, NominalDiffTime)
    randomNumberGenerator :: RNG
    ..}  Text
    u = r -> Text -> IO (Maybe AuthUser)
    forall r. IAuthBackend r => r -> Text -> IO (Maybe AuthUser)
    lookupByEmail r
    backend Text
    u
        lookupByRememberToken :: AuthManager b -> Text -> IO (Maybe AuthUser)
    lookupByRememberToken AuthManager{r
    Int
    Maybe Int
    Maybe (Int, NominalDiffTime)
    Maybe ByteString
    Maybe AuthUser
    ByteString
    Key
    RNG
    SnapletLens b SessionManager
    backend :: ()
    session :: forall b. AuthManager b -> SnapletLens b SessionManager
    activeUser :: forall b. AuthManager b -> Maybe AuthUser
    minPasswdLen :: forall b. AuthManager b -> Int
    rememberCookieName :: forall b. AuthManager b -> ByteString
    rememberCookieDomain :: forall b. AuthManager b -> Maybe ByteString
    rememberPeriod :: forall b. AuthManager b -> Maybe Int
    siteKey :: forall b. AuthManager b -> Key
    lockout :: forall b. AuthManager b -> Maybe (Int, NominalDiffTime)
    randomNumberGenerator :: forall b. AuthManager b -> RNG
    backend :: r
    session :: SnapletLens b SessionManager
    activeUser :: Maybe AuthUser
    minPasswdLen :: Int
    rememberCookieName :: ByteString
    rememberCookieDomain :: Maybe ByteString
    rememberPeriod :: Maybe Int
    siteKey :: Key
    lockout :: Maybe (Int, NominalDiffTime)
    randomNumberGenerator :: RNG
    ..} Text
    u = r -> Text -> IO (Maybe AuthUser)
    forall r. IAuthBackend r => r -> Text -> IO (Maybe AuthUser)
    lookupByRememberToken r
    backend Text
    u
        destroy :: AuthManager b -> AuthUser -> IO ()
    destroy AuthManager{r
    Int
    Maybe Int
    Maybe (Int, NominalDiffTime)
    Maybe ByteString
    Maybe AuthUser
    ByteString
    Key
    RNG
    SnapletLens b SessionManager
    backend :: ()
    session :: forall b. AuthManager b -> SnapletLens b SessionManager
    activeUser :: forall b. AuthManager b -> Maybe AuthUser
    minPasswdLen :: forall b. AuthManager b -> Int
    rememberCookieName :: forall b. AuthManager b -> ByteString
    rememberCookieDomain :: forall b. AuthManager b -> Maybe ByteString
    rememberPeriod :: forall b. AuthManager b -> Maybe Int
    siteKey :: forall b. AuthManager b -> Key
    lockout :: forall b. AuthManager b -> Maybe (Int, NominalDiffTime)
    randomNumberGenerator :: forall b. AuthManager b -> RNG
    backend :: r
    session :: SnapletLens b SessionManager
    activeUser :: Maybe AuthUser
    minPasswdLen :: Int
    rememberCookieName :: ByteString
    rememberCookieDomain :: Maybe ByteString
    rememberPeriod :: Maybe Int
    siteKey :: Key
    lockout :: Maybe (Int, NominalDiffTime)
    randomNumberGenerator :: RNG
    ..} AuthUser
    u = r -> AuthUser -> IO ()
    forall r. IAuthBackend r => r -> AuthUser -> IO ()
    destroy r
    backend AuthUser
    u