UI: Add page for publishing a Resolve with custom ticket and OCAP URIs

src/Vervis/Client.hs

@@ -368,11 +368,12 @@ offerIssue senderHash title desc uTracker = do
     return (Nothing, audience, ticket)
 
 resolve
-    :: KeyHashid Person
+    :: PersonId
     -> FedURI
     -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Resolve URIMode)
-resolve senderHash uObject = do
+resolve senderID uObject = do
 
+    senderHash <- encodeKeyHashid senderID
     encodeRouteHome <- getEncodeRouteHome
     (uTracker, audFollowers) <- do
         routeOrRemote <- parseFedURIOld uObject

src/Vervis/Foundation.hs

@@ -854,6 +854,7 @@ instance YesodBreadcrumbs App where
         PublishMergeR      -> ("Apply MR", Just HomeR)
         PublishInviteR     -> ("Invite someone to a resource", Just HomeR)
         PublishRemoveR     -> ("Remove someone from a resource", Just HomeR)
+        PublishResolveR     -> ("Close a ticket", Just HomeR)
 
         PersonR p             -> ("Person ~" <> keyHashidText p, Just HomeR)
         PersonInboxR p        -> ("Inbox", Just $ PersonR p)

src/Vervis/Handler/Client.hs

@@ -41,6 +41,9 @@ module Vervis.Handler.Client
 
     , getPublishRemoveR
     , postPublishRemoveR
+
+    , getPublishResolveR
+    , postPublishResolveR
     )
 where
 
@@ -1268,3 +1271,42 @@ postPublishRemoveR = do
         Right _ -> do
             setMessage "Remove activity sent"
             redirect HomeR
+
+resolveForm = renderDivs $ (,)
+    <$> areq fedUriField "(URI) Ticket to close"                         Nothing
+    <*> areq capField    "(URI) Grant activity to use for authorization" Nothing
+
+getPublishResolveR :: Handler Html
+getPublishResolveR = do
+    ((_, widget), enctype) <- runFormPost resolveForm
+    defaultLayout
+        [whamlet|
+            <h1>Close a ticket
+            <form method=POST action=@{PublishResolveR} enctype=#{enctype}>
+              ^{widget}
+              <input type=submit>
+        |]
+
+postPublishResolveR :: Handler ()
+postPublishResolveR = do
+    federation <- getsYesod $ appFederation . appSettings
+    unless federation badMethod
+
+    (uTicket, (uCap, cap)) <- runFormPostRedirect PublishResolveR resolveForm
+
+    (ep@(Entity pid _), a) <- getSender
+    senderHash <- encodeKeyHashid pid
+
+    result <- runExceptT $ do
+        (maybeSummary, audience, r) <- resolve pid uTicket
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            makeServerInput (Just uCap) maybeSummary audience (AP.ResolveActivity r)
+        handleViaActor pid (Just cap) localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left err -> do
+            setMessage $ toHtml err
+            redirect PublishResolveR
+        Right _ -> do
+            setMessage "Resolve activity sent"
+            redirect HomeR

src/Vervis/Handler/Ticket.hs

@@ -497,11 +497,10 @@ postTicketCloseR deckHash taskHash = do
     taskID <- decodeKeyHashid404 taskHash
 
     personEntity@(Entity personID person) <- requireAuth
-    personHash <- encodeKeyHashid personID
     encodeRouteHome <- getEncodeRouteHome
     let uTicket = encodeRouteHome $ TicketR deckHash taskHash
     result <- runExceptT $ do
-        (maybeSummary, audience, detail) <- C.resolve personHash uTicket
+        (maybeSummary, audience, detail) <- C.resolve personID uTicket
         grantID <- do
             maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID personID
             fromMaybeE maybeItem "You need to be a collaborator in the Deck to close tickets"

templates/personal-overview.hamlet

@@ -42,6 +42,9 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 $#   <li>
 $#     <a href=@{PublishCommentR}>
 $#       Comment on a ticket or merge request
+  <li>
+    <a href=@{PublishResolveR}>
+      Close a ticket or MR
   <li>
     <a href=@{PublishMergeR}>
       Merge a merge request

th/routes

@@ -134,6 +134,7 @@
 /publish/merge       PublishMergeR      GET POST
 /publish/invite      PublishInviteR     GET POST
 /publish/remove      PublishRemoveR     GET POST
+/publish/resolve     PublishResolveR    GET POST
 
 ---- Person ------------------------------------------------------------------