When successfully submitting a ticket comment, submit Follow activity too

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

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)