使用Yesod 1.4的基本电子邮件/密码验证

时间:2015-09-02 13:43:30

标签: haskell yesod

我试图将Yesod.Auth.Email集成到Yesod 1.4的默认支架中(您使用stack exec -- yesod init --bare && stack init得到的内容)。所以我将相关部分从authentication and authorization example from the Yesod book复制到我的Foundation.hs并开始将其调整为新的Yesod版本:

instance YesodAuthEmail App where
    type AuthEmailId App = UserId

    afterPasswordRoute _ = HomeR

    addUnverified email verkey = do
        userId <- runDB $ insert $ User email Nothing
        runDB $ insert $ Email email (Just userId) (Just verkey)
        return userId

    sendVerifyEmail email _ verurl =
        liftIO $ renderSendMail (emptyMail $ Address Nothing "noreply")
            { mailTo = [Address Nothing email]
            , mailHeaders =
                [ ("Subject", "Verify your email address")
                ]
            , mailParts = [[textPart, htmlPart]]
            }
      where
        textPart = Part
            { partType = "text/plain; charset=utf-8"
            , partEncoding = None
            , partFilename = Nothing
            , partContent = Data.Text.Lazy.Encoding.encodeUtf8
                [stext|
                    Please confirm your email address by clicking on the link below.

                    #{verurl}

                    Thank you
                |]
            , partHeaders = []
            }
        htmlPart = Part
            { partType = "text/html; charset=utf-8"
            , partEncoding = None
            , partFilename = Nothing
            , partContent = withUrlRenderer
                [shamlet|
                    <p>Please confirm your email address by clicking on the link below.
                    <p>
                        <a href=#{verurl}>#{verurl}
                    <p>Thank you
                |]
            , partHeaders = []
            }
    getVerifyKey = runDB . fmap (join . fmap emailVerkey) . getBy
    setVerifyKey uid key = runDB $ update uid [EmailVerkey =. Just key]
    verifyAccount uid = runDB $ do
        mu <- get uid
        case mu of
            Nothing -> return Nothing
            Just u -> do
                update uid [EmailVerkey =. Nothing]
                return $ Just uid
    getPassword = runDB . fmap (join . fmap userPassword) . get
    setPassword uid pass = runDB $ update uid [UserPassword =. Just pass]
    getEmailCreds email = runDB $ do
        mu <- getBy $ UniqueUser email
        case mu of
            Nothing -> return Nothing
            Just (Entity uid u) -> return $ Just EmailCreds
                { emailCredsId = uid
                , emailCredsAuthId = Just uid
                , emailCredsStatus = isJust $ userPassword u
                , emailCredsVerkey = emailVerkey u
                , emailCredsEmail = email
                }
    getEmail = runDB . fmap (fmap emailEmail) . get

config/modelsyesod init脚手架相同:

User
    ident Text
    password Text Maybe
    UniqueUser ident
    deriving Typeable
Email
    email Text
    user UserId Maybe
    verkey Text Maybe
    UniqueEmail email

我收到一堆类型错误,主要是因为函数(例如getVerifyKey)应该接受/返回User s,而不是Email s。

为什么他们改为使用单独的Email表而不是保留verkey表中的emailUser列?我相当肯定我的用户永远不需要注册多个电子邮件地址。你建议保持这种方式,以便它与不同的auth插件一起使用吗?

1 个答案:

答案 0 :(得分:2)

您似乎可以在UserId中切换EmailId的{​​{1}},它可能会毫无问题地发挥作用。

我认为脚手架表是出于说明目的(唯一列,连接),并展示了用户和电子邮件之间的良好概念分离,但并非绝对必要。