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

Email authentication works in sample

Browse Source
This commit is contained in:
Michael Snoyman 2010-09-28 15:42:50 +02:00
parent 559f9d53d9
commit 53bc6cfd80
1 changed files with 8 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
auth2.hs
View File

@ -15,7 +15,7 @@ import Safe (readMay)
mkPersist [$persist| mkPersist [$persist|
Email Email
email String email String Eq
status Bool update status Bool update
verkey String null update verkey String null update
password String null update password String null update
@ -84,31 +84,20 @@ instance YesodAuthEmail A2 where
setVerifyKey emailid verkey = runDB $ setVerifyKey emailid verkey = runDB $
update (fromIntegral emailid) [EmailVerkey $ Just verkey] update (fromIntegral emailid) [EmailVerkey $ Just verkey]
verifyAccount emailid' = runDB $ do verifyAccount emailid' = runDB $ do
{- FIXME
let emailid = fromIntegral emailid' let emailid = fromIntegral emailid'
x <- get emailid x <- get emailid
uid <- uid <-
case x of case x of
Nothing -> return Nothing Nothing -> return Nothing
Just (Email (Just uid) _ _) -> return $ Just uid Just email -> do
Just (Email Nothing email _) -> do
update emailid [EmailStatus True] update emailid [EmailStatus True]
return $ Just email return $ Just $ emailEmail email
update emailid [EmailVerkey Nothing]
return uid return uid
-} getPassword email = runDB $ do
return Nothing x <- getBy $ UniqueEmail email
getPassword _ = return Nothing -- FIXME runDB . fmap (join . fmap emailPassword) . get return $ x >>= emailPassword . snd
setPassword emailid password = runDB $ do setPassword email password = runDB $
{- FIXME updateWhere [EmailEmailEq email] [EmailPassword $ Just password]
_x <- get emailid
case x of
Just (Email (Just uid) _ _) -> do
update uid [EmailPassword $ Just password]
update emailid [EmailVerkey Nothing]
_ -> return ()
-}
return ()
getEmailCreds email = runDB $ do getEmailCreds email = runDB $ do
x <- getBy $ UniqueEmail email x <- getBy $ UniqueEmail email
case x of case x of