{-# LANGUAGE QuasiQuotes, TypeFamilies #-} {-# LANGUAGE CPP #-} module Yesod.Helpers.Auth.Email ( authEmail , YesodAuthEmail (..) , EmailCreds (..) , saltPass ) where import Network.Mail.Mime (randomString) import Yesod.Helpers.Auth import System.Random import Control.Monad (when) import Control.Applicative ((<$>), (<*>)) import Data.Digest.Pure.MD5 import qualified Data.Text.Lazy as T import Data.Text.Lazy.Encoding (encodeUtf8) import Yesod.Form import Yesod.Handler import Yesod.Content import Yesod.Widget import Yesod.Core import Text.Hamlet (hamlet) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class (lift) login, register, setpass :: AuthRoute login = PluginR "email" ["login"] register = PluginR "email" ["register"] setpass = PluginR "email" ["set-password"] verify :: String -> String -> AuthRoute -- FIXME verify eid verkey = PluginR "email" ["verify", eid, verkey] type Email = String type VerKey = String type VerUrl = String type SaltedPass = String type VerStatus = Bool -- | Data stored in a database for each e-mail address. data EmailCreds m = EmailCreds { emailCredsId :: AuthEmailId m , emailCredsAuthId :: Maybe (AuthId m) , emailCredsStatus :: VerStatus , emailCredsVerkey :: Maybe VerKey } class YesodAuth m => YesodAuthEmail m where type AuthEmailId m showAuthEmailId :: m -> AuthEmailId m -> String readAuthEmailId :: m -> String -> Maybe (AuthEmailId m) addUnverified :: Email -> VerKey -> GHandler Auth m (AuthEmailId m) sendVerifyEmail :: Email -> VerKey -> VerUrl -> GHandler Auth m () getVerifyKey :: AuthEmailId m -> GHandler Auth m (Maybe VerKey) setVerifyKey :: AuthEmailId m -> VerKey -> GHandler Auth m () verifyAccount :: AuthEmailId m -> GHandler Auth m (Maybe (AuthId m)) getPassword :: AuthId m -> GHandler Auth m (Maybe SaltedPass) setPassword :: AuthId m -> SaltedPass -> GHandler Auth m () getEmailCreds :: Email -> GHandler Auth m (Maybe (EmailCreds m)) getEmail :: AuthEmailId m -> GHandler Auth m (Maybe Email) -- | Generate a random alphanumeric string. randomKey :: m -> IO String randomKey _ = do stdgen <- newStdGen return $ fst $ randomString 10 stdgen authEmail :: YesodAuthEmail m => AuthPlugin m authEmail = AuthPlugin "email" dispatch $ \tm -> do y <- lift getYesod #if GHC7 [hamlet| #else [$hamlet| #endif