haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

maybeAuth/requireAuth use Entity

Browse Source
This commit is contained in:
Michael Snoyman 2012-01-31 13:02:18 +02:00
parent 6b1ccc0f86
commit 26fe38a9f4
2 changed files with 7 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
yesod-auth/Yesod/Auth.hs
View File

@ -218,26 +218,28 @@ maybeAuthId = do
maybeAuth :: ( YesodAuth m maybeAuth :: ( YesodAuth m
, b ~ YesodPersistBackend m , b ~ YesodPersistBackend m
, b ~ PersistEntityBackend val
, Key b val ~ AuthId m , Key b val ~ AuthId m
, PersistStore b (GHandler s m) , PersistStore b (GHandler s m)
, PersistEntity val , PersistEntity val
, YesodPersist m , YesodPersist m
) => GHandler s m (Maybe (Key b val, val)) ) => GHandler s m (Maybe (Entity val))
maybeAuth = runMaybeT $ do maybeAuth = runMaybeT $ do
aid <- MaybeT $ maybeAuthId aid <- MaybeT $ maybeAuthId
a <- MaybeT $ runDB $ get aid a <- MaybeT $ runDB $ get aid
return (aid, a) return $ Entity aid a
requireAuthId :: YesodAuth m => GHandler s m (AuthId m) requireAuthId :: YesodAuth m => GHandler s m (AuthId m)
requireAuthId = maybeAuthId >>= maybe redirectLogin return requireAuthId = maybeAuthId >>= maybe redirectLogin return
requireAuth :: ( YesodAuth m requireAuth :: ( YesodAuth m
, b ~ YesodPersistBackend m , b ~ YesodPersistBackend m
, b ~ PersistEntityBackend val
, Key b val ~ AuthId m , Key b val ~ AuthId m
, PersistStore b (GHandler s m) , PersistStore b (GHandler s m)
, PersistEntity val , PersistEntity val
, YesodPersist m , YesodPersist m
) => GHandler s m (Key b val, val) ) => GHandler s m (Entity val)
requireAuth = maybeAuth >>= maybe redirectLogin return requireAuth = maybeAuth >>= maybe redirectLogin return
redirectLogin :: Yesod m => GHandler s m a redirectLogin :: Yesod m => GHandler s m a

4
yesod-auth/Yesod/Auth/HashDB.hs
View File

@ -198,10 +198,10 @@ getAuthIdHashDB :: ( YesodAuth master, YesodPersist master
-> Creds master -- ^ the creds argument -> Creds master -- ^ the creds argument
-> GHandler sub master (Maybe (AuthId master)) -> GHandler sub master (Maybe (AuthId master))
getAuthIdHashDB authR uniq creds = do getAuthIdHashDB authR uniq creds = do
muid <- maybeAuth muid <- maybeAuthId
case muid of case muid of
-- user already authenticated -- user already authenticated
Just (uid, _) -> return $ Just uid Just uid -> return $ Just uid
Nothing -> do Nothing -> do
x <- case uniq (credsIdent creds) of x <- case uniq (credsIdent creds) of
Nothing -> return Nothing Nothing -> return Nothing