When successfully submitting a ticket comment, submit Follow activity too

This commit is contained in:
fr33domlover 2019-09-30 09:00:44 +00:00
parent 77678fc8f6
commit c91599b989
2 changed files with 32 additions and 8 deletions

View file

@ -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

View file

@ -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)