Yesod.Auth.Email 始终设置密码 returns "Passwords did not match, please try again"

Question

目前正在尝试设置 Yesod.Auth.Email，但是运行在获得验证 url 后遇到了一些问题。

在"Set password"页面（有"New password"和"Confirm"），输入密码后和确认框一样，总是returns"Passwords did not match, please try again".

这是记录的请求，

POST /auth/page/email/set-password
  Params: [("_token","wcpv0LhJfy"),("new","1234"),("confirm","1234")]
  Request Body: _token=wcpv0LhJfy&new=1234&confirm=1234
  Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
  Status: 303 See Other 0.002459s

显示它们确实应该匹配。

查看处理程序 postPasswordR 的源代码，我不完全清楚为什么它会失败，因为这不是您在 instance YesodAuthEmail App?

中覆盖的内容

一个最小的例子

直接取自 the email-auth section in the Yesod book，另存为 Main.hs，

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

import Control.Monad (join)
import Control.Monad.Logger (runNoLoggingT)
import Data.Maybe (isJust)
import Data.Text (Text, unpack)
import qualified Data.Text.Lazy.Encoding
import Data.Typeable (Typeable)
import Database.Persist.Sqlite
import Database.Persist.TH
import Network.Mail.Mime
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.Hamlet (shamlet)
import Text.Shakespeare.Text (stext)
import Yesod
import Yesod.Auth
import Yesod.Auth.Email

share
  [ mkPersist
      sqlSettings
      { mpsGeneric = False
      }
  , mkMigrate "migrateAll"
  ]
  [persistLowerCase|
User
    email Text
    password Text Maybe -- Password may not be set yet
    verkey Text Maybe -- Used for resetting passwords
    verified Bool
    UniqueUser email
    deriving Typeable
|]

data App =
  App SqlBackend

mkYesod
  "App"
  [parseRoutes|
/ HomeR GET
/auth AuthR Auth getAuth
|]

instance Yesod App
         -- Emails will include links, so be sure to include an approot so that
         -- the links are valid!
                                 where
  approot = ApprootStatic "http://localhost:3000"

instance RenderMessage App FormMessage where
  renderMessage _ _ = defaultFormMessage

-- Set up Persistent
instance YesodPersist App where
  type YesodPersistBackend App = SqlBackend
  runDB f = do
    App conn <- getYesod
    runSqlConn f conn

instance YesodAuth App where
  type AuthId App = UserId
  loginDest _ = HomeR
  logoutDest _ = HomeR
  authPlugins _ = [authEmail]
  -- Need to find the UserId for the given email address.
  getAuthId creds =
    runDB $
    do x <- insertBy $ User (credsIdent creds) Nothing Nothing False
       return $
         Just $
         case x of
           Left (Entity userid _) -> userid -- newly added user
           Right userid -> userid -- existing user
  authHttpManager = error "Email doesn't need an HTTP manager"

instance YesodAuthPersist App

-- Here's all of the email-specific code
instance YesodAuthEmail App where
  type AuthEmailId App = UserId
  afterPasswordRoute _ = HomeR
  addUnverified email verkey =
    runDB $ insert $ User email Nothing (Just verkey) False
  sendVerifyEmail email _ verurl
                          -- Print out to the console the verification email, for easier
                          -- debugging.
   = do
    liftIO $ putStrLn $ "Copy/ Paste this URL in your browser:" ++ unpack verurl
    -- Send email.
    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 =
          renderHtml
            [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 userVerkey) . get
  setVerifyKey uid key = runDB $ update uid [UserVerkey =. Just key]
  verifyAccount uid =
    runDB $
    do mu <- get uid
       case mu of
         Nothing -> return Nothing
         Just u -> do
           update uid [UserVerified =. True]
           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 = userVerkey u
             , emailCredsEmail = email
             }
  getEmail = runDB . fmap (fmap userEmail) . get

getHomeR :: Handler Html
getHomeR = do
  maid <- maybeAuthId
  defaultLayout
    [whamlet|
            <p>Your current auth ID: #{show maid}
            $maybe _ <- maid
                <p>
                    <a href=@{AuthR LogoutR}>Logout
            $nothing
                <p>
                    <a href=@{AuthR LoginR}>Go to the login page
        |]

main :: IO ()
main =
  runNoLoggingT $
  withSqliteConn "email.db3" $
  \conn ->
     liftIO $
     do runSqlConn (runMigration migrateAll) conn
        warp 3000 $ App conn

然后运行和stack runghc Main.hs安装了stack install yesod persistent-sqlite之后。

我的 stackage LTS 版本是 lts-7.14，我是运行ning GHC 版本 8.0.1.20161117。

仍然得到相同的结果。

Answer 1

您必须启用 CSRF 中间件才能使其正常工作。我将相应地更新书籍示例。报错信息明显不好，应该改进。为了使您的代码正常工作，请在使用基础类型创建 Yesod 类型类的实例时添加此代码：

yesodMiddleware = defaultCsrfMiddleware . defaultYesodMiddleware

Yesod.Auth.Email 始终设置密码 returns "Passwords did not match, please try again"

Yesod.Auth.Email setting password always returns "Passwords did not match, please try again"

haskell

yesod

一个最小的例子