yesod / yesod-auth / auth2

mkPersist[$persist|

Email

emailStringEq

statusBoolupdate

verkeyStringnullupdate

passwordStringnullupdate

UniqueEmailemail

|]

dataA2=A2{connPool::ConnectionPool}

mkYesod"A2"[$parseRoutes|

/authAuthRAuthgetAuth

|]

instanceYesodA2whereapproot_="http://localhost:3000"

instanceYesodAuthA2where

typeAuthIdA2=String

loginDest_=AuthRCheckR

logoutDest_=AuthRCheckR

getAuthId=return.Just.credsIdent

showAuthId=constid

readAuthId=constJust

authPlugins=

[authDummy

,authOpenId

,authRpxnow"yesod-test""c8043882f14387d7ad8dfc99a1a8dab2e028f690"

,authFacebook

"d790dfc0203e31c0209ed32f90782c31"

"a7685e10c8977f5435e599aaf1d232eb"

[]

,authEmail

]

main::IO()

main=withConnectionPool$\p->do

fliprunConnectionPoolp$runMigration$migrate(undefined::Email)

basicHandler3000$A2p

instanceYesodAuthEmailA2where

typeAuthEmailIdA2=EmailId

showAuthEmailId_=show

readAuthEmailId_=readMay

addUnverifiedemailverkey=runDB$insert$EmailemailFalse(Justverkey)Nothing

sendVerifyEmailemailverkeyverurl=do

render<-getUrlRenderParams

tm<-getRouteToMaster

letlbs=renderHamletrender[$hamlet|

%p

%a!href=$verurl$Verifyyouremailaddress.

|]

liftIO$renderSendMailMail

{mailHeaders=

[("To",email)

,("From","reply@orangeroster.com")

,("Subject","OrangeRoster:Verifyyouremailaddress")

]

,mailPlain=verurl

,mailParts=

[Part

{partType="text/html;charset=utf-8"

,partEncoding=None

,partDisposition=Inline

,partContent=lbs

}

]

}

getVerifyKeyemailid=runDB$do

x<-get$fromIntegralemailid

return$maybeNothingemailVerkeyx

setVerifyKeyemailidverkey=runDB$

update(fromIntegralemailid)[EmailVerkey$Justverkey]

verifyAccountemailid'=runDB$do

letemailid=fromIntegralemailid'

x<-getemailid

uid<-

casexof

Nothing->returnNothing

Justemail->do

updateemailid[EmailStatusTrue]

return$Just$emailEmailemail

returnuid

getPasswordemail=runDB$do

x<-getBy$UniqueEmailemail

return$x>>=emailPassword.snd

setPasswordemailpassword=runDB$

updateWhere[EmailEmailEqemail][EmailPassword$Justpassword]

getEmailCredsemail=runDB$do

x<-getBy$UniqueEmailemail

casexof

Nothing->returnNothing

Just(eid,e)->

return$JustEmailCreds

{emailCredsId=fromIntegraleid

,emailCredsAuthId=Just$emailEmaile

,emailCredsStatus=emailStatuse

,emailCredsVerkey=emailVerkeye

}

getEmailemailid=runDB$do

x<-get$fromIntegralemailid

return$fmapemailEmailx

instanceYesodPersistA2where

typeYesodDBA2=SqlPersist

runDBdb=fmapconnPoolgetYesod>>=runConnectionPooldb

withConnectionPool::MonadCatchIOm=>(ConnectionPool->ma)->ma

withConnectionPool=withSqlitePool"auth2.db3"10

runConnectionPool::MonadCatchIOm=>SqlPersistma->ConnectionPool->ma

runConnectionPool=runSqlPool