improve handling an anonymous user

Foundation.hs

@@ -115,6 +115,8 @@ instance Yesod App where
     isAuthorized (ChallengeGraphDataR _) _ = return Authorized
     isAuthorized (ChallengeDiscussionR _) _ = return Authorized
 
+    isAuthorized (AvatarR _) _ = return Authorized
+
     -- Default to Authorized for now.
     isAuthorized _ _ = isTrustedAuthorized
 

Handler/Discussion.hs

@@ -49,6 +49,7 @@ instance ToTimelineItem (Entity Submission) where
 getChallengeDiscussionR :: Text -> Handler Html
 getChallengeDiscussionR name = do
     (Entity challengeId challenge) <- runDB $ getBy404 $ UniqueName name
+    maybeUser <- maybeAuth
     (formWidget, formEnctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm (commentForm challengeId)
     comments <- runDB $ selectList [CommentChallenge ==. challengeId] [Desc CommentPosted]
     submissions <-  runDB $ selectList [SubmissionChallenge ==. challengeId] [Desc SubmissionStamp]
@@ -56,9 +57,9 @@ getChallengeDiscussionR name = do
     timelineItems'' <- mapM toTimelineItem submissions
     let sortedTimelineItems = sortBy (\item1 item2 -> (getTime item2 `compare` getTime item1)) (
           timelineItems' ++ timelineItems'')
-    challengeLayout True challenge (discussionWidget formWidget formEnctype name sortedTimelineItems)
+    challengeLayout True challenge (discussionWidget maybeUser formWidget formEnctype name sortedTimelineItems)
 
-discussionWidget formWidget formEnctype name sortedTimelineItems = $(widgetFile "challenge-discussion")
+discussionWidget maybeUser formWidget formEnctype name sortedTimelineItems = $(widgetFile "challenge-discussion")
 
 timelineItemWidget item = $(widgetFile "timeline-item")
 
@@ -66,28 +67,20 @@ postChallengeDiscussionR :: Text -> Handler TypedContent
 postChallengeDiscussionR name = do
     (Entity challengeId _) <- runDB $ getBy404 $ UniqueName name
     ((result, formWidget), formEnctype) <- runFormPost $ renderBootstrap3 BootstrapBasicForm (commentForm challengeId)
-    case result of
+    stamp <- liftIO getCurrentTime
-      FormSuccess comment -> do
+    userId <- requireAuthId
-        userId <- requireAuthId
 
-        if commentAuthor comment == userId
+    case result of
-          then
+      FormSuccess (challengeId, commentContent) -> do
-           do
+        setMessage $ toHtml ("Comment submitted" :: Text)
-            setMessage $ toHtml ("Comment submitted" :: Text)
+        _ <- runDB $ insert $ Comment challengeId userId stamp commentContent
-            _ <- runDB $ insert comment
+        return ()
-            return ()
-          else
-           do
-            setMessage $ toHtml ("Wrong user ID" :: Text)
-            return ()
       _ -> do
         setMessage $ toHtml ("Something went wrong" :: Text)
 
     redirect $ ChallengeDiscussionR name
 
-commentForm :: Key Challenge -> AForm Handler Comment
+commentForm :: Key Challenge -> AForm Handler (ChallengeId, Textarea)
-commentForm challengeId = Comment
+commentForm challengeId = (,)
     <$> pure challengeId
-    <*> lift requireAuthId
-    <*> lift (liftIO getCurrentTime)
     <*> areq textareaField (bfs MsgCommentText) Nothing

Handler/ShowChallenge.hs

@@ -266,6 +266,7 @@ getChallengeSubmissions condition name = do
 challengeAllSubmissionsWidget muserId challenge submissions tests = $(widgetFile "challenge-all-submissions")
 
 challengeLayout withHeader challenge widget = do
+  maybeUser <- maybeAuth
   bc <- widgetToPageContent widget
   defaultLayout $ do
     setTitle "Challenge"

templates/challenge-discussion.hamlet

@@ -1,9 +1,12 @@
 
 <p>
-  <form method=post action=@{ChallengeDiscussionR name}#form enctype=#{formEnctype}>
+  $maybe user <- maybeUser
-    ^{formWidget}
+    <form method=post action=@{ChallengeDiscussionR name}#form enctype=#{formEnctype}>
-    <button .btn .btn-primary type="submit">
+      ^{formWidget}
-       _{MsgSend} <span class="glyphicon glyphicon-upload"></span>
+      <button .btn .btn-primary type="submit">
+         _{MsgSend} <span class="glyphicon glyphicon-upload"></span>
+  $nothing
+    <b>Log in to write a comment
 
 <div .timeline-box>
   $forall item <- sortedTimelineItems

templates/challenge.hamlet

@@ -5,8 +5,9 @@
      <li role="presentation" class="active"><a href="@{ShowChallengeR (challengeName challenge)}">Challenge</a>
      <li role="presentation"><a href="@{ChallengeReadmeR (challengeName challenge)}">Readme</a>
      <li role="presentation"><a href="@{ChallengeHowToR (challengeName challenge)}">How To</a>
-     <li role="presentation"><a href="@{ChallengeSubmissionR (challengeName challenge)}">Submit</a>
+     $if isJust maybeUser
-     <li role="presentation"><a href="@{ChallengeMySubmissionsR (challengeName challenge)}">My Submissions</a>
+       <li role="presentation"><a href="@{ChallengeSubmissionR (challengeName challenge)}">Submit</a>
+       <li role="presentation"><a href="@{ChallengeMySubmissionsR (challengeName challenge)}">My Submissions</a>
      <li role="presentation"><a href="@{ChallengeAllSubmissionsR (challengeName challenge)}">All Submissions</a>
      <li role="presentation"><a href="@{ChallengeDiscussionR (challengeName challenge)}">Discussion</a>
   <div .col-md-10 role="main">