diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs index f54bbc9..b09c609 100644 --- a/src/Vervis/Handler/Discussion.hs +++ b/src/Vervis/Handler/Discussion.hs @@ -68,6 +68,8 @@ import Yesod.RenderSource import Vervis.Settings import Vervis.Widget.Discussion +import qualified Vervis.Client as C + getDiscussion :: (MessageId -> Route App) -> Route App @@ -192,19 +194,20 @@ postTopReply -> [Route App] -> Route App -> Route App + -> Route App -> (LocalMessageId -> Route App) -> Handler Html -postTopReply hDest recipsA recipsC context replyP after = do +postTopReply hDest recipsA recipsC context recipF replyP after = do ((result, widget), enctype) <- runFormPost newMessageForm + shrAuthor <- do + Entity _ p <- requireVerifiedAuth + runDB $ sharerIdent <$> get404 (personIdent p) elmid <- runExceptT $ do msg <- case result of FormMissing -> throwE "Field(s) missing." FormFailure _l -> throwE "Message submission failed, see errors below." FormSuccess nm -> return $ TextPandocMarkdown $ T.filter (/= '\r') $ nmContent nm - shrAuthor <- do - Entity _ p <- requireVerifiedAuth - lift $ runDB $ sharerIdent <$> get404 (personIdent p) hLocal <- asksSite siteInstanceHost note <- ExceptT $ createThread shrAuthor msg hDest recipsA recipsC context ExceptT $ createNoteC hLocal note @@ -214,6 +217,15 @@ postTopReply hDest recipsA recipsC context replyP after = do defaultLayout $(widgetFile "discussion/top-reply") Right lmid -> do setMessage "Message submitted." + + encodeRouteFed <- getEncodeRouteFed + let encodeRecipRoute = encodeRouteFed hDest + (summary, audience, follow) <- C.follow shrAuthor (encodeRecipRoute context) (encodeRecipRoute recipF) False + eobiidFollow <- followC shrAuthor summary audience follow + case eobiidFollow of + Left e -> setMessage $ toHtml $ "Following failed: " <> e + Right _ -> return () + redirect $ after lmid getReply @@ -233,23 +245,24 @@ postReply -> [Route App] -> [Route App] -> Route App + -> Route App -> (MessageId -> Route App) -> (MessageId -> Route App) -> (LocalMessageId -> Route App) -> AppDB DiscussionId -> MessageId -> Handler Html -postReply hDest recipsA recipsC context replyG replyP after getdid midParent = do +postReply hDest recipsA recipsC context recipF replyG replyP after getdid midParent = do ((result, widget), enctype) <- runFormPost newMessageForm + shrAuthor <- do + Entity _ p <- requireVerifiedAuth + runDB $ sharerIdent <$> get404 (personIdent p) elmid <- runExceptT $ do msg <- case result of FormMissing -> throwE "Field(s) missing." FormFailure _l -> throwE "Message submission failed, see errors below." FormSuccess nm -> return $ TextPandocMarkdown $ T.filter (/= '\r') $ nmContent nm - shrAuthor <- do - Entity _ p <- requireVerifiedAuth - lift $ runDB $ sharerIdent <$> get404 (personIdent p) hLocal <- asksSite siteInstanceHost note <- ExceptT $ createReply shrAuthor msg hDest recipsA recipsC context midParent ExceptT $ createNoteC hLocal note @@ -261,4 +274,13 @@ postReply hDest recipsA recipsC context replyG replyP after getdid midParent = d defaultLayout $(widgetFile "discussion/reply") Right lmid -> do setMessage "Message submitted." + + encodeRouteFed <- getEncodeRouteFed + let encodeRecipRoute = encodeRouteFed hDest + (summary, audience, follow) <- C.follow shrAuthor (encodeRecipRoute context) (encodeRecipRoute recipF) False + eobiidFollow <- followC shrAuthor summary audience follow + case eobiidFollow of + Left e -> setMessage $ toHtml $ "Following failed: " <> e + Right _ -> return () + redirect $ after lmid diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index 7bc4364..74d0b60 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -692,6 +692,7 @@ postTicketDiscussionR shr prj num = do , TicketTeamR shr prj num ] (TicketR shr prj num) + (ProjectR shr prj) (TicketDiscussionR shr prj num) (const $ TicketR shr prj num) @@ -713,6 +714,7 @@ postTicketMessageR shr prj num mkhid = do , TicketTeamR shr prj num ] (TicketR shr prj num) + (ProjectR shr prj) (TicketReplyR shr prj num . encodeHid) (TicketMessageR shr prj num . encodeHid) (const $ TicketR shr prj num)