diff --git a/Yesod/Helpers/EmailAuth.hs b/Yesod/Helpers/EmailAuth.hs
new file mode 100644
index 00000000..a32b65a2
--- /dev/null
+++ b/Yesod/Helpers/EmailAuth.hs
@@ -0,0 +1,274 @@
+{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}
+module Yesod.Helpers.EmailAuth
+    ( getEmailAuth
+    , EmailAuth
+    , siteEmailAuth
+    , EmailAuthRoutes (..)
+    , YesodEmailAuth (..)
+    ) where
+
+import Yesod
+import Yesod.Helpers.Auth
+import System.Random
+import Data.Maybe
+import Control.Applicative
+import Control.Monad
+import Data.Digest.Pure.MD5
+
+class Yesod y => YesodEmailAuth y where
+    addUnverified :: y
+                  -> String -- ^ email
+                  -> String -- ^ verification key
+                  -> IO Integer -- ^ login_id
+    sendVerifyEmail :: y
+                    -> String -- ^ email
+                    -> String -- ^ verification key
+                    -> String -- ^ verify URL
+                    -> IO ()
+    getVerifyKey :: y
+                 -> Integer -- ^ login_id
+                 -> IO (Maybe String)
+    verifyAccount :: y
+                  -> Integer -- ^ login_id
+                  -> IO ()
+    setPassword :: y
+                -> Integer -- ^ login_id
+                -> String -- ^ salted password
+                -> IO ()
+    getCreds :: y
+             -> String -- ^ email address
+             -> IO (Maybe (Integer, Maybe String, Bool, String)) -- ^ id, salted pass, is verified, verify key
+    getEmail :: y -> Integer -> IO (Maybe String)
+
+    randomKey :: y -> IO String
+    randomKey _ = do
+        stdgen <- newStdGen
+        return $ take 10 $ randomRs ('A', 'Z') stdgen
+
+    onSuccessfulLogin :: y -> Routes y
+    onSuccessfulLogout :: y -> Routes y
+
+    onEmailAuthLogin :: y
+                     -> String -- ^ email
+                     -> Integer -- ^ login_id
+                     -> IO ()
+
+data EmailAuth = EmailAuth
+
+getEmailAuth :: a -> EmailAuth
+getEmailAuth _ = EmailAuth
+
+mkYesodSub "EmailAuth" [''YesodEmailAuth] [$parseRoutes|
+/register       RegisterR      GET POST
+/verify/#/$     VerifyR        GET
+/login          LoginR         GET POST
+/set-password   PasswordR      GET POST
+/logout         LogoutR        GET
+|]
+
+getRegisterR :: Yesod master => GHandler EmailAuth master RepHtml
+getRegisterR = do
+    toMaster <- getRouteToMaster
+    applyLayout "Register a new account" $ [$hamlet|
+%p Enter your e-mail address below, and a confirmation e-mail will be sent to you.
+%form!method=post!action=@id@
+    %label!for=email E-mail
+    %input#email!type=email!name=email!width=150
+    %input!type=submit!value=Register
+|] $ toMaster RegisterR
+
+postRegisterR :: YesodEmailAuth master => GHandler EmailAuth master RepHtml
+postRegisterR = do
+    email <- runFormPost $ checkEmail $ required $ input "email"
+    y <- getYesodMaster
+    creds <- liftIO $ getCreds y email
+    (lid, verKey) <-
+        case creds of
+            Nothing -> liftIO $ do
+                key <- randomKey y
+                lid <- addUnverified y email key
+                return (lid, key)
+            Just (lid, _, _, key) -> return (lid, key)
+    render <- getUrlRender
+    let verUrl = render $ VerifyR lid verKey
+    liftIO $ sendVerifyEmail y email verKey verUrl
+    applyLayout "Confirmation e-mail sent" $ [$hamlet|
+%p A confirmation e-mail has been sent to $id$.
+|] $ cs email
+
+checkEmail :: Form ParamValue -> Form ParamValue
+checkEmail = notEmpty -- FIXME
+
+getVerifyR :: YesodEmailAuth master
+           => Integer -> String -> GHandler EmailAuth master RepHtml
+getVerifyR lid key = do
+    y <- getYesodMaster
+    realKey <- liftIO $ getVerifyKey y lid
+    memail <- liftIO $ getEmail y lid
+    case (realKey == Just key, memail) of
+        (True, Just email) -> do
+            liftIO $ verifyAccount y lid
+            setLoginSession email lid
+            toMaster <- getRouteToMaster
+            redirect RedirectTemporary $ toMaster PasswordR
+        _ -> applyLayout "Invalid verification key" $ [$hamlet|
+%p I'm sorry, but that was an invalid verification key.
+        |] ()
+
+messageKey :: String
+messageKey = "MESSAGE"
+
+getMessage :: GHandler sub master (Maybe HtmlContent)
+getMessage = do
+    s <- session
+    clearSession messageKey
+    return $ listToMaybe $ map (Encoded . cs) $ s messageKey
+
+setMessage :: String -> GHandler sub master ()
+setMessage = setSession messageKey . cs
+
+getLoginR :: Yesod master => GHandler EmailAuth master RepHtml
+getLoginR = do
+    toMaster <- getRouteToMaster
+    msg <- getMessage
+    applyLayout "Login" $ [$hamlet|
+$maybe snd msg
+    %p.message $msg$
+%p Please log in to your account.
+%p
+    %a!href=@fst.fst@ I don't have an account
+%form!method=post!action=@fst.snd@
+    %table
+        %tr
+            %th E-mail
+            %td
+                %input!type=email!name=email
+        %tr
+            %th Password
+            %td
+                %input!type=password!name=password
+        %tr
+            %td!colspan=2
+                %input!type=submit!value=Login
+|] ((toMaster RegisterR, toMaster LoginR), msg)
+
+postLoginR :: YesodEmailAuth master => GHandler EmailAuth master ()
+postLoginR = do
+    (email, pass) <- runFormPost $ (,)
+        <$> checkEmail (required $ input "email")
+        <*> required (input "password")
+    y <- getYesodMaster
+    creds <- liftIO $ getCreds y email
+    let mlid =
+            case creds of
+                Just (lid, Just realpass, True, _) ->
+                    if isValidPass pass realpass then Just lid else Nothing
+                _ -> Nothing
+    case mlid of
+        Just lid -> do
+            setLoginSession email lid
+            redirect RedirectTemporary $ onSuccessfulLogin y
+        Nothing -> do
+            setMessage "Invalid email/password combination"
+            toMaster <- getRouteToMaster
+            redirect RedirectTemporary $ toMaster LoginR
+
+getPasswordR :: Yesod master => GHandler EmailAuth master RepHtml
+getPasswordR = do
+    l <- isJust <$> isLoggedIn
+    toMaster <- getRouteToMaster
+    unless l $ do
+        setMessage "You must be logged in to set a password"
+        redirect RedirectTemporary $ toMaster LoginR
+    msg <- getMessage
+    applyLayout "Set password" $ [$hamlet|
+$maybe fst msg
+    %p.message $msg$
+%h3 Set a new password
+%form!method=post!action=@snd@
+    %table
+        %tr
+            %th New password
+            %td
+                %input!type=password!name=new
+        %tr
+            %th Confirm
+            %td
+                %input!type=password!name=confirm
+        %tr
+            %td!colspan=2
+                %input!type=submit!value=Submit
+|] (msg, toMaster PasswordR)
+
+postPasswordR :: YesodEmailAuth master => GHandler EmailAuth master ()
+postPasswordR = do
+    (new, confirm) <- runFormPost $ (,)
+        <$> notEmpty (required $ input "new")
+        <*> notEmpty (required $ input "confirm")
+    toMaster <- getRouteToMaster
+    when (new /= confirm) $ do
+        setMessage "Passwords did not match, please try again"
+        redirect RedirectTemporary $ toMaster PasswordR
+    mlid <- isLoggedIn
+    lid <- case mlid of
+            Just lid -> return lid
+            Nothing -> do
+                setMessage "You must be logged in to set a password"
+                redirect RedirectTemporary $ toMaster LoginR
+    salted <- liftIO $ saltPass new
+    y <- getYesodMaster
+    liftIO $ setPassword y lid salted
+    setMessage "Password updated"
+    redirect RedirectTemporary $ toMaster LoginR
+
+getLogoutR :: YesodEmailAuth master => GHandler EmailAuth master RepHtml
+getLogoutR = do
+    clearSession identKey
+    clearSession displayNameKey
+    clearSession emailAuthIdKey
+    y <- getYesodMaster
+    redirect RedirectTemporary $ onSuccessfulLogout y
+
+saltLength :: Int
+saltLength = 5
+
+isValidPass :: String -- ^ cleartext password
+            -> String -- ^ salted password
+            -> Bool
+isValidPass clear salted =
+    let salt = take saltLength salted
+     in salted == saltPass' salt clear
+
+saltPass :: String -> IO String
+saltPass pass = do
+    stdgen <- newStdGen
+    let salt = take saltLength $ randomRs ('A', 'Z') stdgen
+    return $ saltPass' salt pass
+
+saltPass' :: String -> String -> String -- FIXME better salting scheme?
+saltPass' salt pass = salt ++ show (md5 $ cs $ salt ++ pass)
+
+emailAuthIdKey :: String
+emailAuthIdKey = "EMAIL_AUTH_ID"
+
+setLoginSession :: YesodEmailAuth master
+                => String -> Integer -> GHandler sub master ()
+setLoginSession email lid = do
+    setSession identKey email
+    setSession displayNameKey email
+    setSession emailAuthIdKey $ show lid
+    y <- getYesodMaster
+    liftIO $ onEmailAuthLogin y email lid
+
+isLoggedIn :: GHandler sub master (Maybe Integer)
+isLoggedIn = do
+    s <- session
+    return $
+        if null (s identKey)
+            then Nothing
+            else listToMaybe (s emailAuthIdKey) >>= readMay
+
+readMay :: String -> Maybe Integer
+readMay s = case reads s of
+                [] -> Nothing
+                ((i, _):_) -> Just i
diff --git a/yesod.cabal b/yesod.cabal
index 45f0b980..a7ea9626 100644
--- a/yesod.cabal
+++ b/yesod.cabal
@@ -33,7 +33,9 @@ library
                      hamlet >= 0.0.1 && < 0.1,
                      transformers >= 0.1 && < 0.3,
                      clientsession >= 0.2 && < 0.3,
-                     MonadCatchIO-transformers >= 0.2.2 && < 0.3
+                     MonadCatchIO-transformers >= 0.2.2 && < 0.3,
+                     pureMD5 >= 1.0.0.3 && < 1.1,
+                     random >= 1.0.0.2 && < 1.1
     exposed-modules: Yesod
                      Yesod.Content
                      Yesod.Dispatch
@@ -48,6 +50,7 @@ library
                      Yesod.Helpers.Auth
                      Yesod.Helpers.Sitemap
                      Yesod.Helpers.Static
+                     Yesod.Helpers.EmailAuth
                      Web.Mime
     ghc-options:     -Wall