{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}

{-|

This module allows you to use the auth snaplet with your user database
stored in a Redis instance.

In your initializer you'll need something like:

@
 a <- nestSnaplet "auth" auth $
          initRedisAuthManager defAuthSettings sess defaultConnectInfo
@


Redis Key Space

The following keys are used to store the user information in Redis.
Be sure to avoid key collisions within your applications.

* next.userId - Int representing the next spare userId.

* user:[username] (eg. user:bob) - Hash of the user fields for user bob.

* userid:[userId] (eg. userid:2 - bob) - Stores username for userId based lookup.

* useremail:[email] (eg. useremail:bob@example.com - bob) - Stores email for lookup

* usertoken:[usertoken] (eg. usertoken:XXXXXXXX - bob) - Remember Token based user lookup.

-}


module Snap.Snaplet.Auth.Backends.Redis
  ( initRedisAuthManager
  ) where

import           Control.Monad.State hiding (get)
import qualified Data.ByteString as B
import           Data.HashMap.Strict   (HashMap)
import qualified Data.HashMap.Strict   as HM
import           Data.Maybe (fromMaybe)
import qualified Data.Text as T
import           Data.Text (Text)
import           Data.Text.Encoding as E
import           Data.Time
import           Database.Redis
import           Snap.Snaplet
import           Text.Read (readMaybe)
import           Web.ClientSession

import           Snap.Snaplet.Auth
import           Snap.Snaplet.RedisDB
import           Snap.Snaplet.Session


------------------------------------------------------------------------------
-- | Initialize a Redis backed 'AuthManager'
initRedisAuthManager :: SnapletLens b SessionManager
                        -- ^ Lens into a 'SessionManager' auth snaplet will use
                        -> RedisDB
                        -- ^ Redis ConnectInfo
                        -> SnapletInit b (AuthManager b)
initRedisAuthManager :: SnapletLens b SessionManager
-> RedisDB -> SnapletInit b (AuthManager b)
initRedisAuthManager SnapletLens b SessionManager
l RedisDB
d =
    Text
-> Text
-> Maybe (IO FilePath)
-> Initializer b (AuthManager b) (AuthManager b)
-> SnapletInit b (AuthManager b)
forall b v.
Text
-> Text
-> Maybe (IO FilePath)
-> Initializer b v v
-> SnapletInit b v
makeSnaplet
        Text
"RedisAuthManager"
        Text
"A snaplet providing user authentication using a Redis backend"
        Maybe (IO FilePath)
forall a. Maybe a
Nothing (Initializer b (AuthManager b) (AuthManager b)
 -> SnapletInit b (AuthManager b))
-> Initializer b (AuthManager b) (AuthManager b)
-> SnapletInit b (AuthManager b)
forall a b. (a -> b) -> a -> b
$ do
            RNG
rng <- IO RNG -> Initializer b (AuthManager b) RNG
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO RNG
mkRNG
            AuthSettings
s <- Initializer b (AuthManager b) AuthSettings
forall b v. Initializer b v AuthSettings
authSettingsFromConfig
            Key
key <- IO Key -> Initializer b (AuthManager b) Key
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Key -> Initializer b (AuthManager b) Key)
-> IO Key -> Initializer b (AuthManager b) Key
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Key
getKey (AuthSettings -> FilePath
asSiteKey AuthSettings
s)
            let redisMgr :: RedisAuthManager
redisMgr = RedisAuthManager :: Connection -> RedisAuthManager
RedisAuthManager { conn :: Connection
conn = RedisDB -> Connection
_connection RedisDB
d }
            AuthManager b -> Initializer b (AuthManager b) (AuthManager b)
forall (m :: * -> *) a. Monad m => a -> m a
return AuthManager :: forall b r.
IAuthBackend r =>
r
-> SnapletLens b SessionManager
-> Maybe AuthUser
-> Int
-> ByteString
-> Maybe ByteString
-> Maybe Int
-> Key
-> Maybe (Int, NominalDiffTime)
-> RNG
-> AuthManager b
AuthManager {
                         backend :: RedisAuthManager
backend               = RedisAuthManager
redisMgr
                       , session :: SnapletLens b SessionManager
session               = SnapletLens b SessionManager
l
                       , activeUser :: Maybe AuthUser
activeUser            = Maybe AuthUser
forall a. Maybe a
Nothing
                       , minPasswdLen :: Int
minPasswdLen          = AuthSettings -> Int
asMinPasswdLen AuthSettings
s
                       , rememberCookieName :: ByteString
rememberCookieName    = AuthSettings -> ByteString
asRememberCookieName AuthSettings
s
#if MIN_VERSION_snap(1,0,0)
                       , rememberCookieDomain :: Maybe ByteString
rememberCookieDomain  = Maybe ByteString
forall a. Maybe a
Nothing
#endif
                       , rememberPeriod :: Maybe Int
rememberPeriod        = AuthSettings -> Maybe Int
asRememberPeriod AuthSettings
s
                       , siteKey :: Key
siteKey               = Key
key
                       , lockout :: Maybe (Int, NominalDiffTime)
lockout               = AuthSettings -> Maybe (Int, NominalDiffTime)
asLockout AuthSettings
s
                       , randomNumberGenerator :: RNG
randomNumberGenerator = RNG
rng
                       }

userHashKey :: Text -> B.ByteString
{-userHashKey user = B.append (B.fromString "user:") (E.encodeUtf8 user)-}
userHashKey :: Text -> ByteString
userHashKey Text
user = ByteString -> ByteString -> ByteString
B.append ByteString
"user:" (Text -> ByteString
E.encodeUtf8 Text
user)

userIdKey :: Text -> B.ByteString
userIdKey :: Text -> ByteString
userIdKey Text
userid = Text -> ByteString
enc (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append (FilePath -> Text
T.pack FilePath
"userid:") Text
userid

userEmailKey :: Text -> B.ByteString
userEmailKey :: Text -> ByteString
userEmailKey Text
em = Text -> ByteString
enc (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append Text
"useremail:" Text
em

userTokenKey :: Text -> B.ByteString
userTokenKey :: Text -> ByteString
userTokenKey Text
usertoken = Text -> ByteString
enc (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append (FilePath -> Text
T.pack FilePath
"usertoken:") Text
usertoken

enc :: Text -> B.ByteString
enc :: Text -> ByteString
enc = Text -> ByteString
E.encodeUtf8

dec :: B.ByteString -> Text
dec :: ByteString -> Text
dec = ByteString -> Text
E.decodeUtf8

encodeInt :: Int -> B.ByteString
encodeInt :: Int -> ByteString
encodeInt = Text -> ByteString
enc (Text -> ByteString) -> (Int -> Text) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show

-- AA TODO: return a Maybe Int here instead.
-- Might be able to use ByteString.Char8.readInt depending on if it's ok
-- with unicode input bytes.
decodeInt :: B.ByteString -> Int
decodeInt :: ByteString -> Int
decodeInt = FilePath -> Int
forall a. Read a => FilePath -> a
read (FilePath -> Int) -> (ByteString -> FilePath) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
dec

encMaybeUTCTime :: Maybe UTCTime -> B.ByteString
encMaybeUTCTime :: Maybe UTCTime -> ByteString
encMaybeUTCTime (Just UTCTime
u) = Text -> ByteString
enc (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> (UTCTime -> FilePath) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> FilePath
forall a. Show a => a -> FilePath
show (UTCTime -> Text) -> UTCTime -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime
u
encMaybeUTCTime Maybe UTCTime
_ = ByteString
""

decMaybeUTCTime :: B.ByteString -> Maybe UTCTime
decMaybeUTCTime :: ByteString -> Maybe UTCTime
decMaybeUTCTime ByteString
s = case ByteString
s of
                            ByteString
"" -> Maybe UTCTime
forall a. Maybe a
Nothing
                            ByteString
_ -> FilePath -> Maybe UTCTime
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath -> Maybe UTCTime)
-> (ByteString -> FilePath) -> ByteString -> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
dec (ByteString -> Maybe UTCTime) -> ByteString -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ ByteString
s

encRoles :: [Role] -> B.ByteString
encRoles :: [Role] -> ByteString
encRoles [] = ByteString
""
encRoles [Role]
roles = Text -> ByteString
enc (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Role -> Text) -> [Role] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Text
T.pack (FilePath -> Text) -> (Role -> FilePath) -> Role -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Role -> FilePath
forall a. Show a => a -> FilePath
show) [Role]
roles

decodeRoles :: B.ByteString -> [Role]
decodeRoles :: ByteString -> [Role]
decodeRoles ByteString
"" = []
decodeRoles ByteString
s = (Text -> Role) -> [Text] -> [Role]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Role
forall a. Read a => FilePath -> a
read (FilePath -> Role) -> (Text -> FilePath) -> Text -> Role
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) ([Text] -> [Role]) -> [Text] -> [Role]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"," (ByteString -> Text
dec ByteString
s)

encPassword :: Maybe Password -> B.ByteString
encPassword :: Maybe Password -> ByteString
encPassword (Just (Encrypted ByteString
p)) = ByteString
p
encPassword (Just (ClearText ByteString
_)) = FilePath -> ByteString
forall a. HasCallStack => FilePath -> a
error FilePath
"encPassword should never encode ClearText password"
encPassword Maybe Password
Nothing = ByteString
""

decPassword :: B.ByteString -> Maybe Password
decPassword :: ByteString -> Maybe Password
decPassword ByteString
"" = Maybe Password
forall a. Maybe a
Nothing
decPassword ByteString
p = Password -> Maybe Password
forall a. a -> Maybe a
Just (ByteString -> Password
Encrypted ByteString
p)

{- Check if user exists and incr next:userid if not -}
nextUserID :: AuthUser -> Redis (Either Reply T.Text)
nextUserID :: AuthUser -> Redis (Either Reply Text)
nextUserID AuthUser
u = case AuthUser -> Maybe UserId
userId AuthUser
u of
                 Just UserId
uid -> Either Reply Text -> Redis (Either Reply Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Reply Text -> Redis (Either Reply Text))
-> Either Reply Text -> Redis (Either Reply Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either Reply Text
forall a b. b -> Either a b
Right (Text -> Either Reply Text) -> Text -> Either Reply Text
forall a b. (a -> b) -> a -> b
$ UserId -> Text
unUid UserId
uid
                 Maybe UserId
Nothing -> do
                   Either Reply Integer
i <- ByteString -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
incr ByteString
"next.userId"
                   case Either Reply Integer
i of
                     Right Integer
newUserId -> Either Reply Text -> Redis (Either Reply Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Reply Text -> Redis (Either Reply Text))
-> Either Reply Text -> Redis (Either Reply Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either Reply Text
forall a b. b -> Either a b
Right (Text -> Either Reply Text) -> Text -> Either Reply Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
newUserId
                     Left Reply
e -> Either Reply Text -> Redis (Either Reply Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Reply Text -> Redis (Either Reply Text))
-> Either Reply Text -> Redis (Either Reply Text)
forall a b. (a -> b) -> a -> b
$ Reply -> Either Reply Text
forall a b. a -> Either a b
Left Reply
e

redisSave :: RedisAuthManager -> AuthUser -> IO (Either AuthFailure AuthUser)
redisSave :: RedisAuthManager -> AuthUser -> IO (Either AuthFailure AuthUser)
redisSave RedisAuthManager
r AuthUser
u =
    Connection
-> Redis (Either AuthFailure AuthUser)
-> IO (Either AuthFailure AuthUser)
forall a. Connection -> Redis a -> IO a
runRedis (RedisAuthManager -> Connection
conn RedisAuthManager
r) (Redis (Either AuthFailure AuthUser)
 -> IO (Either AuthFailure AuthUser))
-> Redis (Either AuthFailure AuthUser)
-> IO (Either AuthFailure AuthUser)
forall a b. (a -> b) -> a -> b
$ do
         Either Reply Text
nexti <- AuthUser -> Redis (Either Reply Text)
nextUserID AuthUser
u
         case Either Reply Text
nexti of
           Right Text
checkedUserId -> do
             TxResult (Status, Status)
res <- RedisTx (Queued (Status, Status))
-> Redis (TxResult (Status, Status))
forall a. RedisTx (Queued a) -> Redis (TxResult a)
multiExec (RedisTx (Queued (Status, Status))
 -> Redis (TxResult (Status, Status)))
-> RedisTx (Queued (Status, Status))
-> Redis (TxResult (Status, Status))
forall a b. (a -> b) -> a -> b
$ do
               Queued Status
res1 <- ByteString -> [(ByteString, ByteString)] -> RedisTx (Queued Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(ByteString, ByteString)] -> m (f Status)
hmset (Text -> ByteString
userHashKey (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Text
userLogin AuthUser
u)
                  [(ByteString
"userId",                 Text -> ByteString
enc Text
checkedUserId),
                   (ByteString
"userLogin",              Text -> ByteString
enc (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Text
userLogin AuthUser
u),
                   (ByteString
"userEmail",              Text -> ByteString
enc (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe Text
userEmail AuthUser
u),
                   (ByteString
"userPassword",           Maybe Password -> ByteString
encPassword (AuthUser -> Maybe Password
userPassword AuthUser
u)),
                   (ByteString
"userActivatedAt",        Maybe UTCTime -> ByteString
encMaybeUTCTime (Maybe UTCTime -> ByteString) -> Maybe UTCTime -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe UTCTime
userActivatedAt AuthUser
u),
                   (ByteString
"userSuspendedAt",        Maybe UTCTime -> ByteString
encMaybeUTCTime (Maybe UTCTime -> ByteString) -> Maybe UTCTime -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe UTCTime
userSuspendedAt AuthUser
u),
                   (ByteString
"userRememberToken",      Text -> ByteString
enc (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe Text
userRememberToken AuthUser
u),
                   (ByteString
"userLoginCount",         Int -> ByteString
encodeInt (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Int
userLoginCount AuthUser
u),
                   (ByteString
"userFailedLoginCount",   Int -> ByteString
encodeInt (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Int
userFailedLoginCount AuthUser
u),
                   (ByteString
"userLockedOutUntil",     Maybe UTCTime -> ByteString
encMaybeUTCTime (Maybe UTCTime -> ByteString) -> Maybe UTCTime -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe UTCTime
userLockedOutUntil AuthUser
u),
                   (ByteString
"userCurrentLoginAt",     Maybe UTCTime -> ByteString
encMaybeUTCTime (Maybe UTCTime -> ByteString) -> Maybe UTCTime -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe UTCTime
userCurrentLoginAt AuthUser
u),
                   (ByteString
"userLastLoginAt",        Maybe UTCTime -> ByteString
encMaybeUTCTime (Maybe UTCTime -> ByteString) -> Maybe UTCTime -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe UTCTime
userLastLoginAt AuthUser
u),
                   (ByteString
"userCurrentLoginIp",     ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe ByteString
userCurrentLoginIp AuthUser
u),
                   (ByteString
"userLastLoginIp",        ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe ByteString
userLastLoginIp AuthUser
u),
                   (ByteString
"userCreatedAt",          Maybe UTCTime -> ByteString
encMaybeUTCTime (Maybe UTCTime -> ByteString) -> Maybe UTCTime -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe UTCTime
userCreatedAt AuthUser
u),
                   (ByteString
"userUpdatedAt",          Maybe UTCTime -> ByteString
encMaybeUTCTime (Maybe UTCTime -> ByteString) -> Maybe UTCTime -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe UTCTime
userUpdatedAt AuthUser
u),
                   (ByteString
"userResetToken",         Text -> ByteString
enc (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe Text
userResetToken AuthUser
u),
                   (ByteString
"userResetRequestedAt",   Maybe UTCTime -> ByteString
encMaybeUTCTime (Maybe UTCTime -> ByteString) -> Maybe UTCTime -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe UTCTime
userResetRequestedAt AuthUser
u),
                   (ByteString
"userRoles",              [Role] -> ByteString
encRoles ([Role] -> ByteString) -> [Role] -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> [Role]
userRoles AuthUser
u),
                   (ByteString
"userMeta",               Text -> ByteString
enc (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text)
-> ([(Text, Value)] -> FilePath) -> [(Text, Value)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> FilePath
forall a. Show a => a -> FilePath
show ([(Text, Value)] -> Text) -> [(Text, Value)] -> Text
forall a b. (a -> b) -> a -> b
$ HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap Text Value -> [(Text, Value)])
-> HashMap Text Value -> [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ AuthUser -> HashMap Text Value
userMeta AuthUser
u)
                  ]
               {- set "userid:1000" = "bob" -}
               Queued Status
res2 <- ByteString -> ByteString -> RedisTx (Queued Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
set (Text -> ByteString
userIdKey Text
checkedUserId) (Text -> ByteString
enc (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Text
userLogin AuthUser
u)
               {- set "useremail:bob@example.com" = "bob" -}
               (Text -> RedisTx (Queued Status)) -> Maybe Text -> RedisTx ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Text
em -> ByteString -> ByteString -> RedisTx (Queued Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
set (Text -> ByteString
userEmailKey Text
em) (Text -> ByteString
enc (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Text
userLogin AuthUser
u)) (AuthUser -> Maybe Text
userEmail AuthUser
u)
               {- set "usertoken:XXXX" = "bob" -}
               (Text -> RedisTx (Queued Status)) -> Maybe Text -> RedisTx ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Text
t -> ByteString -> ByteString -> RedisTx (Queued Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
set (Text -> ByteString
userTokenKey Text
t) (Text -> ByteString
enc (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Text
userLogin AuthUser
u)) (Maybe Text -> RedisTx ()) -> Maybe Text -> RedisTx ()
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe Text
userRememberToken AuthUser
u
               Queued (Status, Status) -> RedisTx (Queued (Status, Status))
forall (m :: * -> *) a. Monad m => a -> m a
return (Queued (Status, Status) -> RedisTx (Queued (Status, Status)))
-> Queued (Status, Status) -> RedisTx (Queued (Status, Status))
forall a b. (a -> b) -> a -> b
$ (,) (Status -> Status -> (Status, Status))
-> Queued Status -> Queued (Status -> (Status, Status))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Queued Status
res1 Queued (Status -> (Status, Status))
-> Queued Status -> Queued (Status, Status)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Queued Status
res2
             case TxResult (Status, Status)
res of
               TxSuccess (Status, Status)
_ -> Either AuthFailure AuthUser -> Redis (Either AuthFailure AuthUser)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AuthFailure AuthUser
 -> Redis (Either AuthFailure AuthUser))
-> Either AuthFailure AuthUser
-> Redis (Either AuthFailure AuthUser)
forall a b. (a -> b) -> a -> b
$ AuthUser -> Either AuthFailure AuthUser
forall a b. b -> Either a b
Right AuthUser
u
               TxResult (Status, Status)
TxAborted -> Either AuthFailure AuthUser -> Redis (Either AuthFailure AuthUser)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AuthFailure AuthUser
 -> Redis (Either AuthFailure AuthUser))
-> Either AuthFailure AuthUser
-> Redis (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
$ FilePath -> AuthFailure
AuthError FilePath
"redis transaction aborted"
               TxError FilePath
e -> Either AuthFailure AuthUser -> Redis (Either AuthFailure AuthUser)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AuthFailure AuthUser
 -> Redis (Either AuthFailure AuthUser))
-> Either AuthFailure AuthUser
-> Redis (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
$ FilePath -> AuthFailure
AuthError FilePath
e
           Left (Error ByteString
e) -> Either AuthFailure AuthUser -> Redis (Either AuthFailure AuthUser)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AuthFailure AuthUser
 -> Redis (Either AuthFailure AuthUser))
-> Either AuthFailure AuthUser
-> Redis (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
$ FilePath -> AuthFailure
AuthError (ByteString -> FilePath
forall a. Show a => a -> FilePath
show ByteString
e)
           Left Reply
_ -> Either AuthFailure AuthUser -> Redis (Either AuthFailure AuthUser)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AuthFailure AuthUser
 -> Redis (Either AuthFailure AuthUser))
-> Either AuthFailure AuthUser
-> Redis (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
$ FilePath -> AuthFailure
AuthError FilePath
"redisSave unknown error"

redisDestroy :: RedisAuthManager -> AuthUser -> IO ()
redisDestroy :: RedisAuthManager -> AuthUser -> IO ()
redisDestroy RedisAuthManager
r AuthUser
u =
    case AuthUser -> Maybe UserId
userId AuthUser
u of
      Maybe UserId
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just UserId
uid ->
        Connection -> Redis () -> IO ()
forall a. Connection -> Redis a -> IO a
runRedis (RedisAuthManager -> Connection
conn RedisAuthManager
r) (Redis () -> IO ()) -> Redis () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Either Reply Integer
_ <- [ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
del [Text -> ByteString
userHashKey (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthUser -> Text
userLogin AuthUser
u,
                      Text -> ByteString
userIdKey (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ UserId -> Text
unUid UserId
uid]
            () -> Redis ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

redisLookupByUserId :: RedisAuthManager -> UserId -> IO (Maybe AuthUser)
redisLookupByUserId :: RedisAuthManager -> UserId -> IO (Maybe AuthUser)
redisLookupByUserId RedisAuthManager
r UserId
uid =
  Connection -> Redis (Maybe AuthUser) -> IO (Maybe AuthUser)
forall a. Connection -> Redis a -> IO a
runRedis (RedisAuthManager -> Connection
conn RedisAuthManager
r) (Redis (Maybe AuthUser) -> IO (Maybe AuthUser))
-> Redis (Maybe AuthUser) -> IO (Maybe AuthUser)
forall a b. (a -> b) -> a -> b
$ do
      Either Reply (Maybe ByteString)
ul <- ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
get (Text -> ByteString
userIdKey (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ UserId -> Text
unUid UserId
uid)
      case Either Reply (Maybe ByteString)
ul of
        Right (Just ByteString
userlogin) -> IO (Maybe AuthUser) -> Redis (Maybe AuthUser)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe AuthUser) -> Redis (Maybe AuthUser))
-> IO (Maybe AuthUser) -> Redis (Maybe AuthUser)
forall a b. (a -> b) -> a -> b
$ RedisAuthManager -> Text -> IO (Maybe AuthUser)
redisLookupByLogin RedisAuthManager
r (ByteString -> Text
dec ByteString
userlogin)
        Either Reply (Maybe ByteString)
_ -> Maybe AuthUser -> Redis (Maybe AuthUser)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AuthUser
forall a. Maybe a
Nothing

redisLookupByLogin :: RedisAuthManager -> Text -> IO (Maybe AuthUser)
redisLookupByLogin :: RedisAuthManager -> Text -> IO (Maybe AuthUser)
redisLookupByLogin RedisAuthManager
r Text
ul =
  Connection -> Redis (Maybe AuthUser) -> IO (Maybe AuthUser)
forall a. Connection -> Redis a -> IO a
runRedis (RedisAuthManager -> Connection
conn RedisAuthManager
r) (Redis (Maybe AuthUser) -> IO (Maybe AuthUser))
-> Redis (Maybe AuthUser) -> IO (Maybe AuthUser)
forall a b. (a -> b) -> a -> b
$ do
      Either Reply [(ByteString, ByteString)]
uhash <- ByteString -> Redis (Either Reply [(ByteString, ByteString)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [(ByteString, ByteString)])
hgetall (Text -> ByteString
userHashKey Text
ul)
      case Either Reply [(ByteString, ByteString)]
uhash of
        Right [] -> Maybe AuthUser -> Redis (Maybe AuthUser)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AuthUser
forall a. Maybe a
Nothing
        Left Reply
_ -> Maybe AuthUser -> Redis (Maybe AuthUser)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AuthUser
forall a. Maybe a
Nothing
        Right [(ByteString, ByteString)]
h -> Maybe AuthUser -> Redis (Maybe AuthUser)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AuthUser -> Redis (Maybe AuthUser))
-> Maybe AuthUser -> Redis (Maybe AuthUser)
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe AuthUser
forall a. a -> Maybe a
Just (AuthUser -> Maybe AuthUser) -> AuthUser -> Maybe AuthUser
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> AuthUser
authUserFromHash [(ByteString, ByteString)]
h

#if MIN_VERSION_snap(1,1,0)
redisLookupByEmail :: RedisAuthManager -> Text -> IO (Maybe AuthUser)
redisLookupByEmail :: RedisAuthManager -> Text -> IO (Maybe AuthUser)
redisLookupByEmail RedisAuthManager
r Text
em =
    Connection -> Redis (Maybe AuthUser) -> IO (Maybe AuthUser)
forall a. Connection -> Redis a -> IO a
runRedis (RedisAuthManager -> Connection
conn RedisAuthManager
r) (Redis (Maybe AuthUser) -> IO (Maybe AuthUser))
-> Redis (Maybe AuthUser) -> IO (Maybe AuthUser)
forall a b. (a -> b) -> a -> b
$ do
        Either Reply (Maybe ByteString)
ulogin <- ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
get (Text -> ByteString
userEmailKey Text
em)
        case Either Reply (Maybe ByteString)
ulogin of
            Right (Just ByteString
u) -> do
                Either Reply [(ByteString, ByteString)]
uhash <- ByteString -> Redis (Either Reply [(ByteString, ByteString)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [(ByteString, ByteString)])
hgetall (Text -> ByteString
userHashKey (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
dec ByteString
u)
                case Either Reply [(ByteString, ByteString)]
uhash of
                    Right [] -> Maybe AuthUser -> Redis (Maybe AuthUser)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AuthUser
forall a. Maybe a
Nothing
                    Left  Reply
_  -> Maybe AuthUser -> Redis (Maybe AuthUser)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AuthUser
forall a. Maybe a
Nothing
                    Right [(ByteString, ByteString)]
h  -> Maybe AuthUser -> Redis (Maybe AuthUser)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AuthUser -> Redis (Maybe AuthUser))
-> Maybe AuthUser -> Redis (Maybe AuthUser)
forall a b. (a -> b) -> a -> b
$ AuthUser -> Maybe AuthUser
forall a. a -> Maybe a
Just (AuthUser -> Maybe AuthUser) -> AuthUser -> Maybe AuthUser
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> AuthUser
authUserFromHash [(ByteString, ByteString)]
h
            Either Reply (Maybe ByteString)
_ -> Maybe AuthUser -> Redis (Maybe AuthUser)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AuthUser
forall a. Maybe a
Nothing
#endif

hmlookup :: B.ByteString -> HashMap B.ByteString B.ByteString -> B.ByteString
hmlookup :: ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
k HashMap ByteString ByteString
hm = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> HashMap ByteString ByteString -> Maybe ByteString
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ByteString
k HashMap ByteString ByteString
hm

authUserFromHash :: [(B.ByteString, B.ByteString)] -> AuthUser
authUserFromHash :: [(ByteString, ByteString)] -> AuthUser
authUserFromHash [] = FilePath -> AuthUser
forall a. HasCallStack => FilePath -> a
error FilePath
"authUserFromHash error: Empty hashmap"
authUserFromHash [(ByteString, ByteString)]
l =
    let hm :: HashMap ByteString ByteString
hm = [(ByteString, ByteString)] -> HashMap ByteString ByteString
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(ByteString, ByteString)]
l
         in AuthUser :: Maybe UserId
-> Text
-> Maybe Text
-> Maybe Password
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Int
-> Int
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe ByteString
-> Maybe ByteString
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe UTCTime
-> [Role]
-> HashMap Text Value
-> AuthUser
AuthUser { userId :: Maybe UserId
userId               = UserId -> Maybe UserId
forall a. a -> Maybe a
Just (UserId -> Maybe UserId) -> UserId -> Maybe UserId
forall a b. (a -> b) -> a -> b
$ Text -> UserId
UserId (ByteString -> Text
dec (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userId" HashMap ByteString ByteString
hm)
                     , userLogin :: Text
userLogin            = ByteString -> Text
dec (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userLogin" HashMap ByteString ByteString
hm
                     , userEmail :: Maybe Text
userEmail            = case ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userEmail " HashMap ByteString ByteString
hm of
                                                ByteString
"" -> Maybe Text
forall a. Maybe a
Nothing
                                                ByteString
email -> Text -> Maybe Text
forall a. a -> Maybe a
Just (FilePath -> Text
T.pack (FilePath -> Text)
-> (ByteString -> FilePath) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
forall a. Show a => a -> FilePath
show (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
email)
                     , userPassword :: Maybe Password
userPassword         = ByteString -> Maybe Password
decPassword (ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userPassword" HashMap ByteString ByteString
hm)
                     , userActivatedAt :: Maybe UTCTime
userActivatedAt      = ByteString -> Maybe UTCTime
decMaybeUTCTime (ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userActivatedAt" HashMap ByteString ByteString
hm)
                     , userSuspendedAt :: Maybe UTCTime
userSuspendedAt      = ByteString -> Maybe UTCTime
decMaybeUTCTime (ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userSuspendedAt" HashMap ByteString ByteString
hm)
                     , userRememberToken :: Maybe Text
userRememberToken    = case ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userRememberToken" HashMap ByteString ByteString
hm of
                                                ByteString
"" -> Maybe Text
forall a. Maybe a
Nothing
                                                ByteString
token -> Text -> Maybe Text
forall a. a -> Maybe a
Just (ByteString -> Text
dec ByteString
token)
                     , userLoginCount :: Int
userLoginCount       = ByteString -> Int
decodeInt (ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userLoginCount" HashMap ByteString ByteString
hm)
                     , userFailedLoginCount :: Int
userFailedLoginCount = ByteString -> Int
decodeInt (ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userFailedLoginCount" HashMap ByteString ByteString
hm)
                     , userLockedOutUntil :: Maybe UTCTime
userLockedOutUntil   = ByteString -> Maybe UTCTime
decMaybeUTCTime (ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userLockedOutUntil" HashMap ByteString ByteString
hm)
                     , userCurrentLoginAt :: Maybe UTCTime
userCurrentLoginAt   = ByteString -> Maybe UTCTime
decMaybeUTCTime (ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userCurrentLoginAt" HashMap ByteString ByteString
hm)
                     , userLastLoginAt :: Maybe UTCTime
userLastLoginAt      = ByteString -> Maybe UTCTime
decMaybeUTCTime (ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userLastLoginAt" HashMap ByteString ByteString
hm)
                     , userCurrentLoginIp :: Maybe ByteString
userCurrentLoginIp   = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userCurrentLoginIp" HashMap ByteString ByteString
hm)
                     , userLastLoginIp :: Maybe ByteString
userLastLoginIp      = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userLastLoginIp" HashMap ByteString ByteString
hm)
                     , userCreatedAt :: Maybe UTCTime
userCreatedAt        = ByteString -> Maybe UTCTime
decMaybeUTCTime (ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userCreatedAt" HashMap ByteString ByteString
hm)
                     , userUpdatedAt :: Maybe UTCTime
userUpdatedAt        = ByteString -> Maybe UTCTime
decMaybeUTCTime (ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userUpdatedAt" HashMap ByteString ByteString
hm)
                     , userResetToken :: Maybe Text
userResetToken       = Text -> Maybe Text
forall a. a -> Maybe a
Just (ByteString -> Text
dec (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userResetToken" HashMap ByteString ByteString
hm)
                     , userResetRequestedAt :: Maybe UTCTime
userResetRequestedAt = ByteString -> Maybe UTCTime
decMaybeUTCTime (ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userResetRequestedAt" HashMap ByteString ByteString
hm)
                     , userRoles :: [Role]
userRoles            = ByteString -> [Role]
decodeRoles (ByteString -> HashMap ByteString ByteString -> ByteString
hmlookup ByteString
"userRoles" HashMap ByteString ByteString
hm)
                     {-AA TODO: use toList and fromList for the HashMap serializing.
                     - the snaplet-postgresql-simple project doesnt handle userMeta either.-}
                     , userMeta :: HashMap Text Value
userMeta             = HashMap Text Value
forall k v. HashMap k v
HM.empty
                   }

redisLookupByRememberToken :: RedisAuthManager -> Text -> IO (Maybe AuthUser)
redisLookupByRememberToken :: RedisAuthManager -> Text -> IO (Maybe AuthUser)
redisLookupByRememberToken RedisAuthManager
r Text
utkn =
  Connection -> Redis (Maybe AuthUser) -> IO (Maybe AuthUser)
forall a. Connection -> Redis a -> IO a
runRedis (RedisAuthManager -> Connection
conn RedisAuthManager
r) (Redis (Maybe AuthUser) -> IO (Maybe AuthUser))
-> Redis (Maybe AuthUser) -> IO (Maybe AuthUser)
forall a b. (a -> b) -> a -> b
$ do
      Either Reply (Maybe ByteString)
ul <- ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
get (Text -> ByteString
userTokenKey Text
utkn)
      case Either Reply (Maybe ByteString)
ul of
        Right (Just ByteString
userlogin) -> IO (Maybe AuthUser) -> Redis (Maybe AuthUser)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe AuthUser) -> Redis (Maybe AuthUser))
-> IO (Maybe AuthUser) -> Redis (Maybe AuthUser)
forall a b. (a -> b) -> a -> b
$ RedisAuthManager -> Text -> IO (Maybe AuthUser)
redisLookupByLogin RedisAuthManager
r (ByteString -> Text
dec ByteString
userlogin)
        Either Reply (Maybe ByteString)
_ -> Maybe AuthUser -> Redis (Maybe AuthUser)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AuthUser
forall a. Maybe a
Nothing

newtype RedisAuthManager = RedisAuthManager {
    RedisAuthManager -> Connection
conn :: Connection
    }

instance IAuthBackend RedisAuthManager where
  save :: RedisAuthManager -> AuthUser -> IO (Either AuthFailure AuthUser)
save = RedisAuthManager -> AuthUser -> IO (Either AuthFailure AuthUser)
redisSave
  destroy :: RedisAuthManager -> AuthUser -> IO ()
destroy = RedisAuthManager -> AuthUser -> IO ()
redisDestroy
  lookupByUserId :: RedisAuthManager -> UserId -> IO (Maybe AuthUser)
lookupByUserId = RedisAuthManager -> UserId -> IO (Maybe AuthUser)
redisLookupByUserId
  lookupByLogin :: RedisAuthManager -> Text -> IO (Maybe AuthUser)
lookupByLogin = RedisAuthManager -> Text -> IO (Maybe AuthUser)
redisLookupByLogin
#if MIN_VERSION_snap(1,1,0)
  lookupByEmail :: RedisAuthManager -> Text -> IO (Maybe AuthUser)
lookupByEmail = RedisAuthManager -> Text -> IO (Maybe AuthUser)
redisLookupByEmail
#endif
  lookupByRememberToken :: RedisAuthManager -> Text -> IO (Maybe AuthUser)
lookupByRememberToken = RedisAuthManager -> Text -> IO (Maybe AuthUser)
redisLookupByRememberToken