UI for publishing an Invite

src/Vervis/Foundation.hs

@@ -848,6 +848,7 @@ instance YesodBreadcrumbs App where
 
         PublishOfferMergeR -> ("Open MR", Just HomeR)
         PublishMergeR      -> ("Apply MR", Just HomeR)
+        PublishInviteR     -> ("Invite someone to a resource", Just HomeR)
 
         PersonR p             -> ("Person ~" <> keyHashidText p, Just HomeR)
         PersonInboxR p        -> ("Inbox", Just $ PersonR p)

src/Vervis/Handler/Client.hs

@@ -35,6 +35,9 @@ module Vervis.Handler.Client
 
     , getPublishMergeR
     , postPublishMergeR
+
+    , getPublishInviteR
+    , postPublishInviteR
     )
 where
 
@@ -1156,3 +1159,44 @@ postPublishMergeR = do
         Right _ -> do
             setMessage "Apply activity sent"
             redirect HomeR
+
+inviteForm = renderDivs $ (,,)
+    <$> areq fedUriField "(URI) Whom to invite"                          Nothing
+    <*> areq fedUriField "(URI) Resource"                                Nothing
+    <*> areq capField    "(URI) Grant activity to use for authorization" Nothing
+
+getPublishInviteR :: Handler Html
+getPublishInviteR = do
+    ((_, widget), enctype) <- runFormPost inviteForm
+    defaultLayout
+        [whamlet|
+            <h1>Invite someone to a resource
+            <form method=POST action=@{PublishInviteR} enctype=#{enctype}>
+              ^{widget}
+              <input type=submit>
+        |]
+
+postPublishInviteR :: Handler ()
+postPublishInviteR = do
+    federation <- getsYesod $ appFederation . appSettings
+    unless federation badMethod
+
+    (uRecipient, uResource, (uCap, cap)) <-
+        runFormPostRedirect PublishInviteR inviteForm
+
+    (ep@(Entity pid _), a) <- getSender
+    senderHash <- encodeKeyHashid pid
+
+    result <- runExceptT $ do
+        (maybeSummary, audience, inv) <- invite pid uRecipient uResource
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            makeServerInput (Just uCap) maybeSummary audience (AP.InviteActivity inv)
+        handleViaActor pid (Just cap) localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left err -> do
+            setMessage $ toHtml err
+            redirect PublishInviteR
+        Right _ -> do
+            setMessage "Invite activity sent"
+            redirect HomeR

templates/personal-overview.hamlet

@@ -1,6 +1,7 @@
 $# This file is part of Vervis.
 $#
-$# Written in 2016, 2018, 2019, 2022 by fr33domlover <fr33domlover@riseup.net>.
+$# Written in 2016, 2018, 2019, 2022, 2023
+$# by fr33domlover <fr33domlover@riseup.net>.
 $#
 $# ♡ Copying is an act of love. Please copy, reuse and share.
 $#
@@ -41,6 +42,9 @@ $#       Comment on a ticket or merge request
   <li>
     <a href=@{PublishMergeR}>
       Merge a merge request
+  <li>
+    <a href=@{PublishInviteR}>
+      Invite someone to a resource
 
 <h2>Your teams
 

th/routes

@@ -1,6 +1,6 @@
 -- This file is part of Vervis.
 --
--- Written in 2016, 2018, 2019, 2020, 2022
+-- Written in 2016, 2018, 2019, 2020, 2022, 2023
 -- by fr33domlover <fr33domlover@riseup.net>.
 --
 -- ♡ Copying is an act of love. Please copy, reuse and share.
@@ -132,6 +132,7 @@
 --/publish/comment     PublishCommentR    GET POST
 /publish/offer-merge PublishOfferMergeR GET POST
 /publish/merge       PublishMergeR      GET POST
+/publish/invite      PublishInviteR     GET POST
 
 ---- Person ------------------------------------------------------------------