module Reflex.Auth.Class(
HasAuth(..)
, AuthedEnv
, getAuthInfoMay
, getLogged
, signout
, signin
) where
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Maybe
import Reflex
import Reflex.ExternalRef
type AuthedEnv t m = Dynamic t (AuthInfo t m)
class (Eq (AuthInfo t m), Reflex t) => HasAuth t m | m -> t where
type AuthInfo t m :: *
getAuthInfoRef :: m (ExternalRef t (Maybe (AuthInfo t m)))
liftAuth :: m a
-> ReaderT (AuthedEnv t m) m a
-> m (Dynamic t a)
getAuthInfoMay :: (HasAuth t m, MonadHold t m, MonadFix m, MonadIO m) => m (Dynamic t (Maybe (AuthInfo t m)))
getAuthInfoMay = holdUniqDyn =<< externalRefDynamic =<< getAuthInfoRef
getLogged :: (HasAuth t m, MonadHold t m, MonadFix m, MonadIO m) => m (Dynamic t Bool)
getLogged = fmap isJust <$> getAuthInfoMay
signout :: (HasAuth t m, PerformEvent t m, MonadIO m, MonadIO (Performable m)) => Event t () -> m (Event t ())
signout e = do
ref <- getAuthInfoRef
performEvent $ ffor e $ const $ writeExternalRef ref Nothing
signin :: (HasAuth t m, PerformEvent t m, MonadIO m, MonadIO (Performable m)) => Event t (AuthInfo t m) -> m (Event t (AuthInfo t m))
signin e = do
ref <- getAuthInfoRef
performEvent $ ffor e $ \ai -> writeExternalRef ref (Just ai) >> pure ai
instance {-# OVERLAPPABLE #-} (HasAuth t m, Monad m) => HasAuth t (ReaderT e m) where
type AuthInfo t (ReaderT e m) = AuthInfo t m
getAuthInfoRef = lift getAuthInfoRef
{-# INLINE getAuthInfoRef #-}
liftAuth unauthed authed = do
e <- ask
let authed' = do
ae <- ask
lift $ runReaderT (runReaderT authed ae) e
lift $ liftAuth (runReaderT unauthed e) authed'
{-# INLINE liftAuth #-}