Merge remote-tracking branch 'upstream/main'

src/Vervis/API.hs

@@ -27,7 +27,6 @@ module Vervis.API
     , createRepositoryC
     , followC
     --, offerDepC
-    , undoC
     )
 where
 
@@ -1973,176 +1972,3 @@ insertAcceptOnTicketStatus shrUser wi (WorkItemDetail _ ctx author) obiidResolve
     update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc]
     return (doc, recipientSet, remoteActors, fwdHosts)
 -}
-
-undoC
-    :: Entity Person
-    -> Actor
-    -> Maybe
-        (Either
-            (LocalActorBy Key, LocalActorBy KeyHashid, OutboxItemId)
-            FedURI
-        )
-    -> RecipientRoutes
-    -> [(Host, NonEmpty LocalURI)]
-    -> [Host]
-    -> AP.Action URIMode
-    -> AP.Undo URIMode
-    -> ExceptT Text Handler OutboxItemId
-undoC (Entity senderPersonID senderPerson) senderActor maybeCap localRecips remoteRecips fwdHosts action (AP.Undo uObject) = do
-
-    -- Check input
-    undone <-
-        first (\ (actor, _, item) -> (actor, item)) <$>
-            parseActivityURI uObject
-
-    now <- liftIO getCurrentTime
-    senderHash <- encodeKeyHashid senderPersonID
-
-    (undoID, deliverHttpUndo, maybeDeliverHttpAccept) <- runDBExcept $ do
-
-        -- Find the undone activity in our DB
-        undoneDB <- do
-            a <- getActivity undone
-            fromMaybeE a "Can't find undone in DB"
-
-        -- See if the undone activity is a Follow/Resolve on a local target
-        -- If it is, verify the relevant actor is addressed, verify
-        -- permissions, and perform the actual undoing in the DB
-        maybeUndoLocal <- do
-            maybeUndo <-
-                lift $ runMaybeT $
-                    Left <$> MaybeT (tryUnfollow undoneDB) <|>
-                    Right <$> MaybeT (tryUnresolve undoneDB)
-            case maybeUndo of
-                Nothing -> pure Nothing
-                Just (Left (updateDB, actorID, Left followerSetID)) -> do
-                    actorByKey <- lift $ getLocalActor actorID
-                    unless (actorByKey == LocalActorPerson senderPersonID) $
-                        throwE "Tryin to undo a Follow of someone else"
-                    (fByKey, fActorID, _) <- do
-                        followee <- lift $ getFollowee' followerSetID
-                        getFollowee followee
-                    fByHash <- hashLocalActor fByKey
-                    unless (actorIsAddressed localRecips fByHash) $
-                        throwE "Followee's actor not addressed by the Undo"
-                    lift updateDB
-                    fActor <- lift $ getJust fActorID
-                    return $ Just
-                        ( fByKey
-                        , Entity fActorID fActor
-                        , makeRecipientSet
-                            [fByHash]
-                            [LocalStagePersonFollowers senderHash]
-                        , [LocalActorPerson senderHash]
-                        , []
-                        )
-                Just (Left (updateDB, actorID, Right uTarget)) -> do
-                    actorByKey <- lift $ getLocalActor actorID
-                    unless (actorByKey == LocalActorPerson senderPersonID) $
-                        throwE "Trying to undo a Follow of someone else"
-                    verifyRemoteAddressed remoteRecips uTarget
-                    lift updateDB
-                    return Nothing
-                Just (Right (updateDB, ticketID)) -> do
-                    wiByKey <- lift $ getWorkItem ticketID
-                    wiByHash <- lift $ lift $ VA2.runAct $ hashWorkItem wiByKey
-                    let resource = workItemResource wiByKey
-                        actorByKey = workItemActor wiByKey
-                        actorByHash = workItemActor wiByHash
-                    unless (actorIsAddressed localRecips actorByHash) $
-                        throwE "Work item's actor not addressed by the Undo"
-                    capID <- fromMaybeE maybeCap "No capability provided"
-                    capability <-
-                        case capID of
-                            Left (capActor, _, capItem) -> return (capActor, capItem)
-                            Right _ -> throwE "Capability is a remote URI, i.e. not authored by the local tracker"
-                    verifyCapability capability (Left senderPersonID) resource RoleTriage
-                    lift updateDB
-                    actorID <- do
-                        maybeActor <- lift $ getLocalActorEntity actorByKey
-                        case localActorID <$> maybeActor of
-                            Nothing -> error "Actor entity not in DB"
-                            Just aid -> pure aid
-                    actor <- lift $ getJust actorID
-                    return $ Just
-                        ( actorByKey
-                        , Entity actorID actor
-                        , makeRecipientSet
-                            [actorByHash]
-                            [ localActorFollowers actorByHash
-                            , workItemFollowers wiByHash
-                            , LocalStagePersonFollowers senderHash
-                            ]
-                        , [LocalActorPerson senderHash]
-                        , [ localActorFollowers actorByHash
-                          , workItemFollowers wiByHash
-                          , LocalStagePersonFollowers senderHash
-                          ]
-                        )
-
-        -- Insert the Undo activity to author's outbox
-        undoID <- lift $ insertEmptyOutboxItem (actorOutbox senderActor) now
-        luUndo <- lift $ updateOutboxItem (LocalActorPerson senderPersonID) undoID action
-
-        -- Deliver the Undo activity to local recipients, and schedule delivery
-        -- for unavailable remote recipients
-        deliverHttpUndo <- do
-            let sieve =
-                    case maybeUndoLocal of
-                        Nothing ->
-                            makeRecipientSet
-                                [] [LocalStagePersonFollowers senderHash]
-                        Just (_, _, s, _, _) -> s
-                localRecipsFinal = localRecipSieve sieve False localRecips
-            deliverActivityDB
-                (LocalActorPerson senderHash) (personActor senderPerson)
-                localRecipsFinal remoteRecips fwdHosts undoID action
-
-        maybeDeliverHttpAccept <- for maybeUndoLocal $ \ (actorByKey, Entity actorID actor, _, acceptActors, acceptStages) -> do
-
-            -- Verify the relevant actor has received the Undp
-            verifyActorHasItem actorID undoID "Actor didn't receive the Undo"
-
-            -- Insert an Accept activity to actor's outbox
-            acceptID <- lift $ insertEmptyOutboxItem (actorOutbox actor) now
-            actionAccept <- prepareAccept luUndo acceptActors acceptStages
-            _luAccept <- lift $ updateOutboxItem actorByKey acceptID actionAccept
-
-            -- Deliver the Accept activity to local recipients, and schedule
-            -- delivery for unavailable remote recipients
-            let localRecipsAccept = makeRecipientSet acceptActors acceptStages
-            actorByHash <- hashLocalActor actorByKey
-            deliverActivityDB
-                actorByHash actorID localRecipsAccept [] []
-                acceptID actionAccept
-
-        -- Return instructions for HTTP delivery to remote recipients
-        return (undoID, deliverHttpUndo, maybeDeliverHttpAccept)
-
-    -- Launch asynchronous HTTP delivery of Undo and Accept
-    lift $ do
-        forkWorker "undoC: async HTTP Undo delivery" deliverHttpUndo
-        for_ maybeDeliverHttpAccept $
-            forkWorker "undoC: async HTTP Accept delivery"
-
-    return undoID
-
-    where
-
-    prepareAccept luUndo actors stages = do
-        encodeRouteHome <- getEncodeRouteHome
-        hLocal <- asksSite siteInstanceHost
-        let recips =
-                map encodeRouteHome $
-                        map renderLocalActor actors ++
-                        map renderLocalStage stages
-        return AP.Action
-            { AP.actionCapability = Nothing
-            , AP.actionSummary    = Nothing
-            , AP.actionAudience   = Audience recips [] [] [] [] []
-            , AP.actionFulfills   = []
-            , AP.actionSpecific   = AP.AcceptActivity AP.Accept
-                { AP.acceptObject   = ObjURI hLocal luUndo
-                , AP.acceptResult   = Nothing
-                }
-            }

src/Vervis/Actor/Person/Client.hs

@@ -1009,7 +1009,7 @@ clientResolve
     -> ActE OutboxItemId
 clientResolve now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) (AP.Resolve uObject) = do
 
-    (actorMeID, localRecipsFinal, acceptID) <- withDBExcept $ do
+    (actorMeID, localRecipsFinal, resolveID) <- withDBExcept $ do
 
         -- Grab me from DB
         (personMe, actorMe) <- lift $ do
@@ -1028,8 +1028,42 @@ clientResolve now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHos
 
     lift $ sendActivity
         (LocalActorPerson personMeID) actorMeID localRecipsFinal remoteRecips
-        fwdHosts acceptID action
+        fwdHosts resolveID action
-    return acceptID
+    return resolveID
+
+-- Meaning: The human wants to unfollow or unresolve
+-- Behavior:
+--      * Insert the Undo to my inbox
+--      * Asynchrnously deliver without filter
+clientUndo
+    :: UTCTime
+    -> PersonId
+    -> ClientMsg
+    -> AP.Undo URIMode
+    -> ActE OutboxItemId
+clientUndo now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) (AP.Undo uObject) = do
+
+    (actorMeID, localRecipsFinal, undoID) <- withDBExcept $ do
+
+        -- Grab me from DB
+        (personMe, actorMe) <- lift $ do
+            p <- getJust personMeID
+            (p,) <$> getJust (personActor p)
+
+        -- Insert the Undo activity to my outbox
+        acceptID <- lift $ insertEmptyOutboxItem' (actorOutbox actorMe) now
+        _luAccept <- lift $ updateOutboxItem' (LocalActorPerson personMeID) acceptID action
+
+        return
+            ( personActor personMe
+            , localRecips
+            , acceptID
+            )
+
+    lift $ sendActivity
+        (LocalActorPerson personMeID) actorMeID localRecipsFinal remoteRecips
+        fwdHosts undoID action
+    return undoID
 
 clientBehavior :: UTCTime -> PersonId -> ClientMsg -> ActE (Text, Act (), Next)
 clientBehavior now personID msg =
@@ -1042,4 +1076,5 @@ clientBehavior now personID msg =
         AP.OfferActivity offer   -> clientOffer now personID msg offer
         AP.RemoveActivity remove -> clientRemove now personID msg remove
         AP.ResolveActivity resolve -> clientResolve now personID msg resolve
+        AP.UndoActivity undo     -> clientUndo now personID msg undo
         _ -> throwE "Unsupported activity type for C2S"

src/Vervis/Client.hs

@@ -26,11 +26,11 @@ module Vervis.Client
     --, followRepo
     , offerIssue
     , resolve
+    , unresolve
     --, undoFollowSharer
     --, undoFollowProject
     --, undoFollowTicket
     --, undoFollowRepo
-    --, unresolve
     , offerPatches
     , offerMerge
     , applyPatches
@@ -92,10 +92,13 @@ import Vervis.Data.Ticket
 import Vervis.FedURI
 import Vervis.Foundation
 import Vervis.Model
-import Vervis.Recipient
+import Vervis.Persist.Actor
+import Vervis.Recipient (Aud (..), LocalStageBy (..), collectAudience, renderLocalActor, localActorFollowers)
 import Vervis.RemoteActorStore
 import Vervis.Ticket
 
+import qualified Vervis.Recipient as VR
+
 makeServerInput
     :: (MonadSite m, SiteEnv m ~ App)
     => Maybe FedURI
@@ -365,33 +368,32 @@ 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
+        case routeOrRemote of
+            Left route -> do
+                wih <- fromMaybeE (parseWorkItem route) "Not a work item route"
+                wi <- runActE $ unhashWorkItemE wih "Work item invalid keyhashid"
+                let uTracker =
+                        encodeRouteHome $ renderLocalActor $ workItemActor wih
+                    audFollowers = AudLocal [] [workItemFollowers wih]
+                return (uTracker, audFollowers)
+            Right u -> do
                 manager <- asksSite appHttpManager
-    AP.Doc _ t <- withExceptT T.pack $ fetchAP manager (Left uObject)
+                AP.Doc _ t <- withExceptT T.pack $ fetchAP manager (Left u)
                 uTracker <- fromMaybeE (AP.ticketContext t) "Ticket without context"
                 audFollowers <- do
                     (hFollowers, tl) <- fromMaybeE (AP.ticketLocal t) "Ticket without id"
                     let luFollowers = AP.ticketParticipants tl
-        routeOrRemote <- parseFedURIOld $ ObjURI hFollowers luFollowers
+                    return $ AudRemote hFollowers [] [luFollowers]
-        case routeOrRemote of
+                return (uTracker, audFollowers)
-            Left route ->
-                case route of
-                    TicketFollowersR d t ->
-                        return $
-                            AudLocal
-                                []
-                                [LocalStageTicketFollowers d t]
-                    ClothFollowersR l c ->
-                        return $
-                            AudLocal
-                                []
-                                [LocalStageClothFollowers l c]
-                    _ -> throwE "Not a tickets followers route"
-            Right u@(ObjURI h lu) -> return $ AudRemote h [] [lu]
 
     tracker <- do
         tracker <- runActE $ checkTracker uTracker
@@ -428,6 +430,116 @@ resolve senderHash uObject = do
 
     return (Nothing, audience, AP.Resolve uObject)
 
+unresolve
+    :: KeyHashid Person
+    -> FedURI
+    -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Undo URIMode)
+unresolve senderHash uTicket = do
+
+    encodeRouteHome <- getEncodeRouteHome
+    (uTracker, audFollowers, uResolve) <- do
+        routeOrRemote <- parseFedURIOld uTicket
+        case routeOrRemote of
+            Left route -> do
+                wih <- fromMaybeE (parseWorkItem route) "Not a work item route"
+                wi <- runActE $ unhashWorkItemE wih "Work item invalid keyhashid"
+                let uTracker =
+                        encodeRouteHome $ renderLocalActor $ workItemActor wih
+                    audFollowers = AudLocal [] [workItemFollowers wih]
+                resolved <- runDBExcept $ do
+                    mresolved <-
+                        case wi of
+                            WorkItemTicket d t -> do
+                                (_, _, _, _, mresolved) <- do
+                                    mt <- lift $ getTicket d t
+                                    fromMaybeE mt "No such ticket in DB"
+                                return mresolved
+                            WorkItemCloth l c -> do
+                                (_, _, _, _, mresolved, _) <- do
+                                    mc <- lift $ getCloth l c
+                                    fromMaybeE mc "No such MR in DB"
+                                return mresolved
+                    (_, etrx) <- fromMaybeE mresolved "Ticket not resolved"
+                    lift $ bitraverse
+                        (\ (Entity _ trl) -> do
+                            let obiid = ticketResolveLocalActivity trl
+                            obid <- outboxItemOutbox <$> getJust obiid
+                            actorID <- do
+                                maybeActorID <- getKeyBy $ UniqueActorOutbox obid
+                                case maybeActorID of
+                                    Nothing -> error "Found outbox not used by any actor"
+                                    Just a -> return a
+                            actor <- getLocalActor actorID
+                            return (actor, obiid)
+                        )
+                        (\ (Entity _ trr) -> do
+                            roid <-
+                                remoteActivityIdent <$>
+                                    getJust (ticketResolveRemoteActivity trr)
+                            ro <- getJust roid
+                            i <- getJust $ remoteObjectInstance ro
+                            return (i, ro)
+                        )
+                        etrx
+                hashItem <- getEncodeKeyHashid
+                hashActor <- VR.getHashLocalActor
+                let uResolve =
+                        case resolved of
+                            Left (actor, obiid) ->
+                                encodeRouteHome $
+                                    activityRoute (hashActor actor) (hashItem obiid)
+                            Right (i, ro) ->
+                                ObjURI (instanceHost i) (remoteObjectIdent ro)
+                return (uTracker, audFollowers, uResolve)
+            Right u -> do
+                manager <- asksSite appHttpManager
+                AP.Doc _ t <- withExceptT T.pack $ fetchAP manager (Left u)
+                uTracker <- fromMaybeE (AP.ticketContext t) "Ticket without context"
+                audFollowers <- do
+                    (hFollowers, tl) <- fromMaybeE (AP.ticketLocal t) "Ticket without id"
+                    let luFollowers = AP.ticketParticipants tl
+                    return $ AudRemote hFollowers [] [luFollowers]
+                uResolve <-
+                    case AP.ticketResolved t of
+                        Just (Just u, _) -> return u
+                        _ -> throwE "No ticket resolve URI specified"
+                return (uTracker, audFollowers, uResolve)
+
+    tracker <- do
+        tracker <- runActE $ checkTracker uTracker
+        case tracker of
+            TrackerDeck deckID -> Left . Left <$> encodeKeyHashid deckID
+            TrackerLoom loomID -> Left . Right <$> encodeKeyHashid loomID
+            TrackerRemote (ObjURI hTracker luTracker) -> Right <$> do
+                instanceID <- lift $ runDB $ either entityKey id <$> insertBy' (Instance hTracker)
+                result <- ExceptT $ first (T.pack . displayException) <$> fetchRemoteActor instanceID hTracker luTracker
+                case result of
+                    Left Nothing -> throwE "Tracker @id mismatch"
+                    Left (Just err) -> throwE $ T.pack $ displayException err
+                    Right Nothing -> throwE "Tracker isn't an actor"
+                    Right (Just actor) -> return (entityVal actor, uTracker)
+
+    let audAuthor =
+            AudLocal [] [LocalStagePersonFollowers senderHash]
+        audTracker =
+            case tracker of
+                Left (Left deckHash) ->
+                    AudLocal
+                        [LocalActorDeck deckHash]
+                        [LocalStageDeckFollowers deckHash]
+                Left (Right loomHash) ->
+                    AudLocal
+                        [LocalActorLoom loomHash]
+                        [LocalStageLoomFollowers loomHash]
+                Right (remoteActor, ObjURI hTracker luTracker) ->
+                    AudRemote hTracker
+                        [luTracker]
+                        (maybeToList $ remoteActorFollowers remoteActor)
+
+        audience = [audAuthor, audTracker, audFollowers]
+
+    return (Nothing, audience, AP.Undo uResolve)
+
 {-
 undoFollow
     :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
@@ -568,73 +680,6 @@ undoFollowRepo shrAuthor pidAuthor shrFollowee rpFollowee =
         repoFollowers <$>
             fromMaybeE mr "Unfollow target no such local repo"
     -}
-
-unresolve
-    :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
-    => ShrIdent
-    -> FedURI
-    -> m (Either Text (Maybe TextHtml, Audience URIMode, Undo URIMode))
-unresolve shrUser uTicket = runExceptT $ do
-    error "Temporarily disabled"
-    {-
-    encodeRouteHome <- getEncodeRouteHome
-    wiFollowers <- askWorkItemFollowers
-    ticket <- parseWorkItem "Ticket" uTicket
-    WorkItemDetail ident context author <- runWorkerExcept $ getWorkItemDetail "Ticket" ticket
-    uResolve <-
-        case ident of
-            Left (_, ltid) -> runSiteDBExcept $ do
-                mtrid <- lift $ getKeyBy $ UniqueTicketResolve ltid
-                trid <- fromMaybeE mtrid "Ticket already isn't resolved"
-                trx <-
-                    lift $
-                    requireEitherAlt
-                        (getValBy $ UniqueTicketResolveLocal trid)
-                        (getValBy $ UniqueTicketResolveRemote trid)
-                        "No TRX"
-                        "Both TRL and TRR"
-                case trx of
-                    Left trl -> lift $ do
-                        let obiid = ticketResolveLocalActivity trl
-                        obid <- outboxItemOutbox <$> getJust obiid
-                        ent <- getOutboxActorEntity obid
-                        obikhid <- encodeKeyHashid obiid
-                        encodeRouteHome . flip outboxItemRoute obikhid <$>
-                            actorEntityPath ent
-                    Right trr -> lift $ do
-                        roid <-
-                            remoteActivityIdent <$>
-                                getJust (ticketResolveRemoteActivity trr)
-                        ro <- getJust roid
-                        i <- getJust $ remoteObjectInstance ro
-                        return $ ObjURI (instanceHost i) (remoteObjectIdent ro)
-            Right (u, _) -> do
-                manager <- asksSite appHttpManager
-                Doc _ t <- withExceptT T.pack $ AP.fetchAP manager $ Left u
-                case ticketResolved t of
-                    Nothing -> throwE "Ticket already isn't resolved"
-                    Just (muBy, _) -> fromMaybeE muBy "Ticket doesn't specify 'resolvedBy'"
-    let audAuthor =
-            AudLocal
-                [LocalActorSharer shrUser]
-                [LocalPersonCollectionSharerFollowers shrUser]
-        audTicketContext = contextAudience context
-        audTicketAuthor = authorAudience author
-        audTicketFollowers =
-            case ident of
-                Left (wi, _ltid) -> AudLocal [] [wiFollowers wi]
-                Right (ObjURI h _, luFollowers) -> AudRemote h [] [luFollowers]
-
-        (_, _, _, audLocal, audRemote) =
-            collectAudience $
-                audAuthor :
-                audTicketAuthor :
-                audTicketFollowers :
-                audTicketContext
-
-        recips = map encodeRouteHome audLocal ++ audRemote
-    return (Nothing, Audience recips [] [] [] [] [], Undo uResolve)
-    -}
 -}
 
 offerPatches
@@ -1315,7 +1360,7 @@ acceptProjectInvite personID component project uInvite = do
     encodeRouteHome <- getEncodeRouteHome
     theater <- asksSite appTheater
     env <- asksSite appEnv
-    component' <- Vervis.Recipient.hashLocalActor component
+    component' <- VR.hashLocalActor component
     project' <- bitraverse encodeKeyHashid pure project
 
     let activity = AP.Accept uInvite Nothing

src/Vervis/Federation/Offer.hs

@@ -26,7 +26,6 @@ module Vervis.Federation.Offer
     --, repoFollowF
 
       --personUndoF
-      --deckUndoF
       loomUndoF
     , repoUndoF
     )

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)
@@ -951,6 +952,7 @@ instance YesodBreadcrumbs App where
 
         TicketNewR d         -> ("New Ticket", Just $ DeckR d)
         TicketCloseR _ _     -> ("", Nothing)
+        TicketOpenR _ _     -> ("", Nothing)
         TicketFollowR _ _    -> ("", Nothing)
         TicketUnfollowR _ _  -> ("", Nothing)
         TicketReplyR d t     -> ("Reply", Just $ TicketR d t)

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/Person.hs

@@ -254,7 +254,6 @@ postPersonOutboxR personHash = do
                         offerDepC eperson sharer summary audience dep target
                     -}
                     _ -> throwE "Unsupported Offer 'object' type"
-            AP.UndoActivity undo -> run undoC undo
             _ ->
                 handleViaActor
                     (entityKey eperson) maybeCap localRecips remoteRecips

src/Vervis/Handler/Ticket.hs

@@ -27,6 +27,7 @@ module Vervis.Handler.Ticket
     , getTicketNewR
     , postTicketNewR
     , postTicketCloseR
+    , postTicketOpenR
 
     , postTicketFollowR
     , postTicketUnfollowR
@@ -496,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"
@@ -520,6 +520,36 @@ postTicketCloseR deckHash taskHash = do
             setMessage "Resolve activity sent"
             redirect $ TicketR deckHash taskHash
 
+postTicketOpenR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler ()
+postTicketOpenR deckHash taskHash = do
+    deckID <- decodeKeyHashid404 deckHash
+    taskID <- decodeKeyHashid404 taskHash
+
+    personEntity@(Entity personID person) <- requireAuth
+    personHash <- encodeKeyHashid personID
+    encodeRouteHome <- getEncodeRouteHome
+    let uTicket = encodeRouteHome $ TicketR deckHash taskHash
+    result <- runExceptT $ do
+        (maybeSummary, audience, undo) <- C.unresolve personHash uTicket
+        grantID <- do
+            maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID personID
+            fromMaybeE maybeItem "You need to be a collaborator in the Deck to reopen tickets"
+        grantHash <- encodeKeyHashid grantID
+        let uCap = encodeRouteHome $ DeckOutboxItemR deckHash grantHash
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.UndoActivity undo
+        let cap =
+                Left (LocalActorDeck deckID, LocalActorDeck deckHash, grantID)
+        handleViaActor personID (Just cap) localRecips remoteRecips fwdHosts action
+
+    case result of
+        Left e -> do
+            setMessage $ toHtml e
+            redirect $ TicketR deckHash taskHash
+        Right resolveID -> do
+            setMessage "Undo activity sent"
+            redirect $ TicketR deckHash taskHash
+
 postTicketFollowR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler ()
 postTicketFollowR _ = error "Temporarily disabled"
 

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

templates/ticket/one.hamlet

@@ -69,7 +69,7 @@ $#       .
   Status: #
   $maybe (closed, closer) <- resolved
     Closed on #{showDate closed} by ^{personLinkFedW closer}
-$#  ^{buttonW POST "Reopen this ticket" (ProjectTicketOpenR deckHash ticketHash)}
+    ^{buttonW POST "Reopen this ticket" (TicketOpenR deckHash ticketHash)}
   $nothing
     Open
     ^{buttonW POST "Close this ticket" (TicketCloseR deckHash ticketHash)}

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 ------------------------------------------------------------------
 
@@ -240,7 +241,7 @@
 -- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/edit       TicketEditR        GET POST
 -- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/delete     TicketDeleteR      POST
 /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/close      TicketCloseR       POST
--- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/open       TicketOpenR        POST
+/decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/open       TicketOpenR        POST
 -- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/claim      TicketClaimR       POST
 -- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/unclaim    TicketUnclaimR     POST
 -- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/assign     TicketAssignR      GET POST