When successfully submitting a ticket comment, submit Follow activity too
This commit is contained in:
parent
77678fc8f6
commit
c91599b989
2 changed files with 32 additions and 8 deletions
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue