{-# LANGUAGE ConstraintKinds, ConstrainedClassMethods, AllowAmbiguousTypes #-}
module IHP.LoginSupport.Types
( HasNewSessionUrl (newSessionUrl)
, CurrentUserRecord
, CurrentAdminRecord
, currentUserVaultKey
, currentAdminVaultKey
, currentUserIdVaultKey
, currentAdminIdVaultKey
, lookupAuthVault
) where
import IHP.Prelude
import qualified Data.Vault.Lazy as Vault
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafePerformIO)
class HasNewSessionUrl user where
newSessionUrl :: Proxy user -> Text
type family CurrentUserRecord
type family CurrentAdminRecord
currentUserVaultKey :: Vault.Key (Maybe CurrentUserRecord)
currentUserVaultKey :: Key (Maybe CurrentUserRecord)
currentUserVaultKey = IO (Key (Maybe CurrentUserRecord)) -> Key (Maybe CurrentUserRecord)
forall a. IO a -> a
unsafePerformIO IO (Key (Maybe CurrentUserRecord))
forall a. IO (Key a)
Vault.newKey
{-# NOINLINE currentUserVaultKey #-}
currentAdminVaultKey :: Vault.Key (Maybe CurrentAdminRecord)
currentAdminVaultKey :: Key (Maybe CurrentAdminRecord)
currentAdminVaultKey = IO (Key (Maybe CurrentAdminRecord))
-> Key (Maybe CurrentAdminRecord)
forall a. IO a -> a
unsafePerformIO IO (Key (Maybe CurrentAdminRecord))
forall a. IO (Key a)
Vault.newKey
{-# NOINLINE currentAdminVaultKey #-}
currentUserIdVaultKey :: Vault.Key (Maybe UUID)
currentUserIdVaultKey :: Key (Maybe UUID)
currentUserIdVaultKey = IO (Key (Maybe UUID)) -> Key (Maybe UUID)
forall a. IO a -> a
unsafePerformIO IO (Key (Maybe UUID))
forall a. IO (Key a)
Vault.newKey
{-# NOINLINE currentUserIdVaultKey #-}
currentAdminIdVaultKey :: Vault.Key (Maybe UUID)
currentAdminIdVaultKey :: Key (Maybe UUID)
currentAdminIdVaultKey = IO (Key (Maybe UUID)) -> Key (Maybe UUID)
forall a. IO a -> a
unsafePerformIO IO (Key (Maybe UUID))
forall a. IO (Key a)
Vault.newKey
{-# NOINLINE currentAdminIdVaultKey #-}
lookupAuthVault :: Vault.Key (Maybe user) -> Wai.Request -> Maybe user
lookupAuthVault :: forall user. Key (Maybe user) -> Request -> Maybe user
lookupAuthVault Key (Maybe user)
key Request
req = Maybe (Maybe user) -> Maybe user
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Key (Maybe user) -> Vault -> Maybe (Maybe user)
forall a. Key a -> Vault -> Maybe a
Vault.lookup Key (Maybe user)
key (Request -> Vault
Wai.vault Request
req))
{-# INLINE lookupAuthVault #-}