Question

我遇到过yesod和授权问题。

我在未登录时尝试查看博客帖子时进入登录页面。

这不是我想要的。

即使未登录，我也希望能够查看博文。

我试图修复它但没有任何效果。

以下是代码的相关部分：

mkMessage "Blog" "messages" "en"

mkYesod "Blog" [parseRoutes|
/ RootR GET
/blog BlogR GET POST
/blog/#EntryId EntryR GET POST
/auth AuthR Auth getAuth
|]

instance Yesod Blog where
    approot = ApprootStatic "http://localhost:3000"
    defaultLayout = defLayout
    authRoute _ = Just $ AuthR LoginR

    isAuthorized BlogR True = do
      mauth <- maybeAuth
      case mauth of
        Nothing -> return AuthenticationRequired
        Just (Entity _ user)
             | isAdmin user -> return Authorized
             | otherwise    -> unauthorizedI MsgNotAnAdmin

    isAuthorized (EntryR _) True = do
      mauth <- maybeAuth
      case mauth of 
         Nothing -> return AuthenticationRequired
         Just _  -> return Authorized

    isAuthorized _ _ = return Authorized

isAdmin :: User -> Bool
isAdmin user = userEmail user == "email@something.com"

instance YesodPersist Blog where
    type YesodPersistBackend Blog = SqlPersist
    runDB f = do
      master <- getYesod
      let pool = connPool master
      runSqlPool f pool

type Form x = Html -> MForm Blog Blog (FormResult x, Widget)

instance RenderMessage Blog FormMessage where
    renderMessage _ _ = defaultFormMessage

instance YesodNic Blog

instance YesodAuth Blog where
    type AuthId Blog = UserId
    loginDest _ = RootR
    logoutDest _ = RootR
    authHttpManager = httpManager
    authPlugins _ = [authBrowserId]
    getAuthId creds = do
      let email = credsIdent creds
          user = User email
      res <- runDB $ insertBy user
      return $ Just $ either entityKey id res

getRootR :: Handler RepHtml
getRootR = defaultLayout $ do
             setTitleI MsgHomepageTitle
             [whamlet|
<p>_{MsgWelcomeHomepage}
<p>
    <a href=@{BlogR}>_{MsgSeeArchive}
|]

entryForm :: Form Entry
entryForm = renderDivs $ Entry
            <$> areq textField (fieldSettingsLabel MsgNewEntryTitle) Nothing
            <*> aformM (liftIO getCurrentTime)
            <*> areq nicHtmlField (fieldSettingsLabel MsgNewEntryContent)
            Nothing

getBlogR :: Handler RepHtml
getBlogR = do
  muser <- maybeAuth
  entries <- runDB $ selectList [] [Desc EntryPosted]
  (entryWidget, enctype) <- generateFormPost entryForm
  defaultLayout $ do
             setTitleI MsgBlogArchiveTitle
             [whamlet|
$if null entries
    <p>_{MsgNoEntries}
$else
    <ul>
        $forall Entity entryId entry <- entries
            <li>
                <a href=@{EntryR entryId}>#{entryTitle entry}
$maybe Entity _ user <- muser
    $if isAdmin user
        <form method=post enctype=#{enctype}>
              ^{entryWidget}
              <div>
                  <input type=submit value=_{MsgNewEntry}>
$nothing
    <p>
        <a href=@{AuthR LoginR}>_{MsgLoginToPost}
|]

postBlogR :: Handler RepHtml
postBlogR = do
  ((res, entryWidget), enctype) <- runFormPost entryForm
  case res of
    FormSuccess entry -> do
              entryId <- runDB $ insert entry
              setMessageI $ MsgEntryCreated $ entryTitle entry
              redirect $ EntryR entryId
    _ -> defaultLayout $ do
              setTitleI MsgPleaseCorrectEntry
              [whamlet|
<form method=post enctype=#{enctype}>
    ^{entryWidget}
    <div>
        <input type=submit value=_{MsgNewEntry}>
|]

-- comment form
commentForm         :: EntryId -> Form Comment
commentForm entryId = renderDivs $ Comment
                      <$> pure entryId
                      <*> aformM (liftIO getCurrentTime)
                      <*> aformM requireAuthId
                      <*> areq textField (fieldSettingsLabel MsgCommentName) Nothing
                      <*> areq textareaField (fieldSettingsLabel MsgCommentText) Nothing

getEntryR :: EntryId -> Handler RepHtml
getEntryR entryId = do
  (entry, comments) <- runDB $ do
          entry <- get404 entryId
          comments <- selectList [] [Asc CommentPosted]
          return (entry, map entityVal comments)
  muser <- maybeAuth
  (commentWidget, enctype) <- generateFormPost (commentForm entryId)
  defaultLayout $ do
    setTitleI $ MsgEntryTitle $ entryTitle entry
    [whamlet|
<h1>#{entryTitle entry}
<article>#{entryContent entry}
    <section .comments>
        <h1>_{MsgCommentsHeading}
        $if null comments
            <p>_{MsgNoComments}
        $else
             $forall Comment _entry posted _user name text <- comments
                 <div .comment>
                      <span .by>#{name}
                      <span .at>#{show posted}
                      <div .content>#{text}
        <section>
            <h1>_{MsgAddCommentHeading}
            $maybe Entity _ user <- muser
                <form method=post enctype=#{enctype}>
                    ^{commentWidget}
                    <div>
                        <input type=submit value=_{MsgAddCommentButton}>
            $nothing
                <p>
                    <a href=@{AuthR LoginR}>_{MsgLoginToComment}
|]

我该如何解决？

Answer 1

好的，我自己发现了这个问题。

这条线给了我一些问题：

<*> aformM requireAuthId

我还必须删除对应用程序中使用它的用户ID字段的引用。

我不知道为什么这个问题首先存在，因为只有在用户登录时才会显示小部件。

但是我希望发布评论的用户的用户ID是否有另一种方法可以在不重新引入问题的情况下进行评论？

或者您认为这是yesod中的错误吗？

Answer 2

（如果我被允许，这将是评论）我现在正在学习Yesod，所以这可能不是最好的方法，但你可以在表单中避免使用requireAuthId，并且如果你制作不同类型的表单，仍然会在注释实体下的持久字段中记录用户ID 。而不是

commentForm :: EntryId -> Form Comment

这是

的简写

commentForm  :: EntryId -> Html -> MForm Blog Blog (FormResult Comment, Widget)

您可以重新排列字段并

commentForm  :: EntryId -> Html -> MForm Blog Blog (FormResult (UserId -> Comment), Widget)

并在POST处理程序中提供用户标识。您甚至可以将表单删除到

commentForm  :: Html -> MForm Blog Blog (FormResult (Text, Textarea), Widget)
commentForm = renderDivs $ (,)
           <$> areq textField (fieldSettingsLabel MsgCommentName) Nothing
           <*> areq textareaField (fieldSettingsLabel MsgCommentText) Nothing

并提供POST处理程序中的所有其他内容。

或者你可以将generateFormPost放在一个案例分支下，这样当你没有登录时就不会生成表单，而不是显然只是没有显示。

为什么yesod需要授权？

2 个答案: