{-# LANGUAGE QuasiQuotes, TypeFamilies #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} module Yesod.Helpers.Auth.Email ( -- * Plugin authEmail , YesodAuthEmail (..) , EmailCreds (..) , saltPass -- * Routes , loginR , registerR , setpassR ) 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 qualified Data.Text as TS import Data.Text.Lazy.Encoding (encodeUtf8) import Data.Text (Text) 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) loginR, registerR, setpassR :: AuthRoute loginR = PluginR "email" ["login"] registerR = PluginR "email" ["register"] setpassR = PluginR "email" ["set-password"] verify :: Text -> Text -> AuthRoute -- FIXME verify eid verkey = PluginR "email" ["verify", eid, verkey] type Email = Text type VerKey = Text type VerUrl = Text type SaltedPass = Text 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, SinglePiece (AuthEmailId m)) => YesodAuthEmail m where type 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 Text randomKey _ = do stdgen <- newStdGen return $ TS.pack $ fst $ randomString 10 stdgen authEmail :: YesodAuthEmail m => AuthPlugin m authEmail = AuthPlugin "email" dispatch $ \tm -> do y <- lift getYesod #if GHC7 [hamlet| #else [$hamlet| #endif