Implement C2S unfollowing, using Undo{Follow}

2024-12-27 16:34:52 +09:00 · 2019-10-05 14:10:29 +00:00 · 2019-10-05 14:10:29 +00:00 · bbe6f159d0
commit bbe6f159d0
parent 6a4975a52c
17 changed files with 384 additions and 53 deletions
--- a/config/routes
+++ b/config/routes
@ -64,6 +64,7 @@
 /s/#ShrIdent/outbox/#OutboxItemKeyHashid     SharerOutboxItemR    GET
 /s/#ShrIdent/followers                       SharerFollowersR     GET
 /s/#ShrIdent/follow                          SharerFollowR        POST
+/s/#ShrIdent/unfollow                        SharerUnfollowR      POST

 /p                                           PeopleR              GET

@ -93,6 +94,7 @@
 /s/#ShrIdent/r/#RpIdent/followers            RepoFollowersR        GET
 /s/#ShrIdent/r/#RpIdent/edit                 RepoEditR             GET
 /s/#ShrIdent/r/#RpIdent/follow               RepoFollowR           POST
+/s/#ShrIdent/r/#RpIdent/unfollow             RepoUnfollowR         POST
 /s/#ShrIdent/r/#RpIdent/s/+Texts             RepoSourceR           GET
 /s/#ShrIdent/r/#RpIdent/c                    RepoHeadChangesR      GET
 /s/#ShrIdent/r/#RpIdent/b/#Text              RepoBranchR           GET
@ -117,6 +119,7 @@
 /s/#ShrIdent/p/#PrjIdent/followers           ProjectFollowersR     GET
 /s/#ShrIdent/p/#PrjIdent/edit                ProjectEditR          GET
 /s/#ShrIdent/p/#PrjIdent/follow              ProjectFollowR        POST
+/s/#ShrIdent/p/#PrjIdent/unfollow            ProjectUnfollowR      POST
 /s/#ShrIdent/p/#PrjIdent/d                   ProjectDevsR          GET POST
 /s/#ShrIdent/p/#PrjIdent/d/!new              ProjectDevNewR        GET
 /s/#ShrIdent/p/#PrjIdent/d/#ShrIdent         ProjectDevR           GET DELETE POST
@ -153,6 +156,7 @@
 /s/#ShrIdent/p/#PrjIdent/t/#Int/assign       TicketAssignR         GET POST
 /s/#ShrIdent/p/#PrjIdent/t/#Int/unassign     TicketUnassignR       POST
 /s/#ShrIdent/p/#PrjIdent/t/#Int/follow       TicketFollowR         POST
+/s/#ShrIdent/p/#PrjIdent/t/#Int/unfollow     TicketUnfollowR       POST
 /s/#ShrIdent/p/#PrjIdent/tcr                 ClaimRequestsProjectR GET
 /s/#ShrIdent/p/#PrjIdent/t/#Int/cr           ClaimRequestsTicketR  GET POST
 /s/#ShrIdent/p/#PrjIdent/t/#Int/cr/new       ClaimRequestNewR      GET
--- a/src/Vervis/API.hs
+++ b/src/Vervis/API.hs
@ -17,6 +17,7 @@ module Vervis.API
    ( createNoteC
    , followC
    , offerTicketC
+    , undoC
    , pushCommitsC
    , getFollowersCollection
    )
@ -99,8 +100,8 @@ import Database.Persist.Local
 import Yesod.Persist.Local

 import Vervis.ActivityPub
+import Vervis.ActivityPub.Recipient
 import Vervis.ActorKey
-import Vervis.API.Recipient
 import Vervis.FedURI
 import Vervis.Foundation
 import Vervis.Model
@ -883,6 +884,85 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
                        insert_ $ InboxItemLocal ibid obiid ibiid
                    return remotes

+undoC
+    :: ShrIdent
+    -> TextHtml
+    -> Audience URIMode
+    -> Undo URIMode
+    -> Handler (Either Text OutboxItemId)
+undoC shrUser summary audience undo@(Undo luObject) = runExceptT $ do
+    (localRecips, remoteRecips) <- do
+        mrecips <- parseAudience audience
+        fromMaybeE mrecips "Follow with no recipients"
+    federation <- asksSite $ appFederation . appSettings
+    unless (federation || null remoteRecips) $
+        throwE "Federation disabled, but remote recipients specified"
+    route <-
+        fromMaybeE
+            (decodeRouteLocal luObject)
+            "Undo object isn't a valid route"
+    obiidOriginal <- case route of
+        SharerOutboxItemR shr obikhid
+            | shr == shrUser ->
+                decodeKeyHashidE obikhid "Undo object invalid obikhid"
+        _ -> throwE "Undo object isn't actor's outbox item route"
+    let dont = Authority "dont-do.any-forwarding" Nothing
+    (obiidUndo, doc, remotesHttp) <- runDBExcept $ do
+        Entity _pidAuthor personAuthor <- lift $ getAuthor shrUser
+        obi <- do
+            mobi <- lift $ get obiidOriginal
+            fromMaybeE mobi "Undo object obiid doesn't exist in DB"
+        unless (outboxItemOutbox obi == personOutbox personAuthor) $
+            throwE "Undo object obiid belongs to different actor"
+        lift $ do
+            deleteFollow obiidOriginal
+            deleteFollowRemote obiidOriginal
+            deleteFollowRemoteRequest obiidOriginal
+            let obidAuthor = personOutbox personAuthor
+            (obiidUndo, doc, luUndo) <- insertUndoToOutbox obidAuthor
+            let ibidAuthor = personInbox personAuthor
+                fsidAuthor = personFollowers personAuthor
+            knownRemotes <- deliverLocal shrUser ibidAuthor fsidAuthor obiidUndo localRecips
+            remotesHttp <- deliverRemoteDB' dont obiidUndo remoteRecips knownRemotes
+            return (obiidUndo, doc, remotesHttp)
+    lift $ forkWorker "undoC: Outbox POST handler: async HTTP delivery" $ deliverRemoteHttp dont obiidUndo doc remotesHttp
+    return obiidUndo
+    where
+    getAuthor shr = do
+        sid <- getKeyBy404 $ UniqueSharer shr
+        getBy404 $ UniquePersonIdent sid
+    deleteFollow obiid = do
+        mfid <- getKeyBy $ UniqueFollowFollow obiid
+        traverse_ delete mfid
+    deleteFollowRemote obiid = do
+        mfrid <- getKeyBy $ UniqueFollowRemoteFollow obiid
+        traverse_ delete mfrid
+    deleteFollowRemoteRequest obiid = do
+        mfrrid <- getKeyBy $ UniqueFollowRemoteRequestActivity obiid
+        traverse_ delete mfrrid
+    insertUndoToOutbox obid = do
+        hLocal <- asksSite siteInstanceHost
+        encodeRouteLocal <- getEncodeRouteLocal
+        let activity mluAct = Doc hLocal Activity
+                { activityId       = mluAct
+                , activityActor    = encodeRouteLocal $ SharerR shrUser
+                , activitySummary  = Just summary
+                , activityAudience = audience
+                , activitySpecific = UndoActivity undo
+                }
+        now <- liftIO getCurrentTime
+        obiid <- insert OutboxItem
+            { outboxItemOutbox    = obid
+            , outboxItemActivity  =
+                persistJSONObjectFromDoc $ activity Nothing
+            , outboxItemPublished = now
+            }
+        obikhid <- encodeKeyHashid obiid
+        let luAct = encodeRouteLocal $ SharerOutboxItemR shrUser obikhid
+            doc = activity $ Just luAct
+        update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc]
+        return (obiid, doc, luAct)
+
 pushCommitsC
    :: (Entity Person, Sharer)
    -> Html
--- a/src/Vervis/ActivityPub.hs
+++ b/src/Vervis/ActivityPub.hs
@ -20,7 +20,6 @@ module Vervis.ActivityPub
    , parseParent
    , runDBExcept
    , getLocalParentMessageId
-    , concatRecipients
    , getPersonOrGroupId
    , getTicketTeam
    , getProjectTeam
@ -41,6 +40,7 @@ module Vervis.ActivityPub
    , deliverRemoteDB'
    , deliverRemoteHttp
    , serveCommit
+    , deliverLocal
    )
 where

@ -80,6 +80,7 @@ import Yesod.Persist.Core
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.CaseInsensitive as CI
 import qualified Data.List.NonEmpty as NE
+import qualified Data.List as L
 import qualified Data.List.Ordered as LO
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
@ -104,6 +105,7 @@ import Data.List.NonEmpty.Local
 import Data.Tuple.Local
 import Database.Persist.Local

+import Vervis.ActivityPub.Recipient
 import Vervis.FedURI
 import Vervis.Foundation
 import Vervis.Model
@ -190,9 +192,6 @@ getLocalParentMessageId did shr lmid = do
        throwE "Local parent belongs to a different discussion"
    return mid

-concatRecipients :: Audience u -> [ObjURI u]
-concatRecipients (Audience to bto cc bcc gen _) = concat [to, bto, cc, bcc, gen]
-
 getPersonOrGroupId :: SharerId -> AppDB (Either PersonId GroupId)
 getPersonOrGroupId sid = do
    mpid <- getKeyBy $ UniquePersonIdent sid
@ -693,3 +692,74 @@ serveCommit shr rp ref patch parents = do
        }
    makeAuthor encodeRouteHome (Just sharer) _ =
        Right $ encodeRouteHome $ SharerR $ sharerIdent sharer
+
+-- | Given a list of local recipients, which may include actors and
+-- collections,
+--
+-- * Insert activity to inboxes of actors
+-- * If the author's follower collection is listed, insert activity to the
+--   local members and return the remote members
+-- * Ignore other collections
+deliverLocal
+    :: ShrIdent
+    -> InboxId
+    -> FollowerSetId
+    -> Key OutboxItem
+    -> [(ShrIdent, LocalSharerRelatedSet)]
+    -> AppDB
+        [ ( (InstanceId, Host)
+          , NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime)
+          )
+        ]
+deliverLocal shrAuthor ibidAuthor fsidAuthor obiid recips = do
+    (pidsFollowers, remotesFollowers) <-
+        if authorFollowers shrAuthor recips
+            then getFollowers fsidAuthor
+            else return ([], [])
+    ibidsFollowers <-
+        map (personInbox . entityVal) <$>
+            selectList [PersonId <-. pidsFollowers] [Asc PersonInbox]
+    ibidsSharer <- L.delete ibidAuthor <$> getSharerInboxes recips
+    ibidsOther <- concat <$> traverse getOtherInboxes recips
+    let ibids = LO.union ibidsFollowers ibidsSharer ++ ibidsOther
+    ibiids <- insertMany $ replicate (length ibids) $ InboxItem True
+    insertMany_ $
+        map (\ (ibid, ibiid) -> InboxItemLocal ibid obiid ibiid)
+            (zip ibids ibiids)
+    return remotesFollowers
+    where
+    getSharerInboxes sharers = do
+        let shrs =
+                [shr | (shr, s) <- sharers
+                        , localRecipSharer $ localRecipSharerDirect s
+                ]
+        sids <- selectKeysList [SharerIdent <-. shrs] []
+        map (personInbox . entityVal) <$> selectList [PersonIdent <-. sids] [Asc PersonInbox]
+    getOtherInboxes (shr, LocalSharerRelatedSet _ projects repos) = do
+        msid <- getKeyBy $ UniqueSharer shr
+        case msid of
+            Nothing -> return []
+            Just sid ->
+                (++)
+                    <$> getProjectInboxes sid projects
+                    <*> getRepoInboxes sid repos
+        where
+        getProjectInboxes sid projects =
+            let prjs =
+                    [prj | (prj, j) <- projects
+                         , localRecipProject $ localRecipProjectDirect j
+                    ]
+            in  map (projectInbox . entityVal) <$>
+                    selectList [ProjectSharer ==. sid, ProjectIdent <-. prjs] []
+        getRepoInboxes sid repos =
+            let rps =
+                    [rp | (rp, r) <- repos
+                         , localRecipRepo $ localRecipRepoDirect r
+                    ]
+            in  map (repoInbox . entityVal) <$>
+                    selectList [RepoSharer ==. sid, RepoIdent <-. rps] []
+    authorFollowers shr lrset =
+        case lookup shr lrset of
+            Just s
+                | localRecipSharerFollowers $ localRecipSharerDirect s -> True
+            _ -> False
--- a/src/Vervis/ActivityPub/Recipient.hs
+++ b/src/Vervis/ActivityPub/Recipient.hs
@ -13,14 +13,17 @@
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

-module Vervis.API.Recipient
+module Vervis.ActivityPub.Recipient
    ( LocalActor (..)
    , LocalTicketDirectSet (..)
    , LocalProjectDirectSet (..)
    , LocalProjectRelatedSet (..)
+    , LocalRepoDirectSet (..)
+    , LocalRepoRelatedSet (..)
    , LocalSharerDirectSet (..)
    , LocalSharerRelatedSet (..)
    , LocalRecipientSet
+    , concatRecipients
    , parseAudience
    , actorRecips
    )
@ -49,11 +52,14 @@ import Yesod.MonadSite

 import Data.List.NonEmpty.Local

-import Vervis.ActivityPub
 import Vervis.FedURI
 import Vervis.Foundation
 import Vervis.Model.Ident

+concatRecipients :: Audience u -> [ObjURI u]
+concatRecipients (Audience to bto cc bcc gen _) =
+    concat [to, bto, cc, bcc, gen]
+
 -------------------------------------------------------------------------------
 -- Actor and collection-of-persons types
 --
--- a/src/Vervis/Client.hs
+++ b/src/Vervis/Client.hs
@ -22,11 +22,17 @@ module Vervis.Client
    , followTicket
    , followRepo
    , offerTicket
+    , undoFollowSharer
+    , undoFollowProject
+    , undoFollowTicket
+    , undoFollowRepo
    )
 where

 import Control.Monad.Trans.Except
+import Control.Monad.Trans.Reader
 import Database.Persist
+import Database.Persist.Sql
 import Data.Text (Text)
 import Text.Blaze.Html (preEscapedToHtml)
 import Text.Blaze.Html.Renderer.Text
@ -40,6 +46,7 @@ import qualified Data.Text.Lazy as TL

 import Network.FedURI
 import Web.ActivityPub hiding (Follow)
+import Yesod.ActivityPub
 import Yesod.FedURI
 import Yesod.Hashids
 import Yesod.MonadSite
@ -47,8 +54,10 @@ import Yesod.RenderSource

 import qualified Web.ActivityPub as AP

+import Control.Monad.Trans.Except.Local
 import Database.Persist.Local

+import Vervis.ActivityPub
 import Vervis.FedURI
 import Vervis.Foundation
 import Vervis.Model
@ -242,3 +251,120 @@ offerTicket shrAuthor (TextHtml title) (TextPandocMarkdown desc) shr prj = runEx
            , audienceNonActors = map encodeRouteHome recipsC
            }
    return (summary, audience, offer)
+
+undoFollow
+    :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
+    => ShrIdent
+    -> PersonId
+    -> ExceptT Text (ReaderT SqlBackend m) FollowerSetId
+    -> Text
+    -> Route App
+    -> Route App
+    -> m (Either Text (TextHtml, Audience URIMode, Undo URIMode))
+undoFollow shrAuthor pidAuthor getFsid typ objRoute recipRoute = runExceptT $ do
+    encodeRouteLocal <- getEncodeRouteLocal
+    encodeRouteHome <- getEncodeRouteHome
+    obiidFollow <- runDBExcept $ do
+        fsid <- getFsid
+        mf <- lift $ getValBy $ UniqueFollow pidAuthor fsid
+        followFollow <$> fromMaybeE mf ("Not following this " <> typ)
+    obikhidFollow <- encodeKeyHashid obiidFollow
+    summary <- do
+        hLocal <- asksSite siteInstanceHost
+        TextHtml . TL.toStrict . renderHtml <$>
+            withUrlRenderer
+                [hamlet|
+                    <p>
+                      <a href=@{SharerR shrAuthor}>
+                        #{shr2text shrAuthor}
+                      \ unfollowed #
+                        <a href=@{objRoute}>
+                          #{renderAuthority hLocal}#{localUriPath $ encodeRouteLocal objRoute}
+                      \.
+                |]
+    let undo = Undo
+            { undoObject =
+                encodeRouteLocal $ SharerOutboxItemR shrAuthor obikhidFollow
+            }
+        audience = Audience [encodeRouteHome recipRoute] [] [] [] [] []
+    return (summary, audience, undo)
+
+undoFollowSharer
+    :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
+    => ShrIdent
+    -> PersonId
+    -> ShrIdent
+    -> m (Either Text (TextHtml, Audience URIMode, Undo URIMode))
+undoFollowSharer shrAuthor pidAuthor shrFollowee =
+    undoFollow shrAuthor pidAuthor getFsid "sharer" objRoute objRoute
+    where
+    objRoute = SharerR shrFollowee
+    getFsid = do
+        sidFollowee <- do
+            msid <- lift $ getKeyBy $ UniqueSharer shrFollowee
+            fromMaybeE msid "No such local sharer"
+        mp <- lift $ getValBy $ UniquePersonIdent sidFollowee
+        personFollowers <$>
+            fromMaybeE mp "Unfollow target local sharer isn't a person"
+
+undoFollowProject
+    :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
+    => ShrIdent
+    -> PersonId
+    -> ShrIdent
+    -> PrjIdent
+    -> m (Either Text (TextHtml, Audience URIMode, Undo URIMode))
+undoFollowProject shrAuthor pidAuthor shrFollowee prjFollowee =
+    undoFollow shrAuthor pidAuthor getFsid "project" objRoute objRoute
+    where
+    objRoute = ProjectR shrFollowee prjFollowee
+    getFsid = do
+        sidFollowee <- do
+            msid <- lift $ getKeyBy $ UniqueSharer shrFollowee
+            fromMaybeE msid "No such local sharer"
+        mj <- lift $ getValBy $ UniqueProject prjFollowee sidFollowee
+        projectFollowers <$>
+            fromMaybeE mj "Unfollow target no such local project"
+
+undoFollowTicket
+    :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
+    => ShrIdent
+    -> PersonId
+    -> ShrIdent
+    -> PrjIdent
+    -> Int
+    -> m (Either Text (TextHtml, Audience URIMode, Undo URIMode))
+undoFollowTicket shrAuthor pidAuthor shrFollowee prjFollowee numFollowee =
+    undoFollow shrAuthor pidAuthor getFsid "project" objRoute recipRoute
+    where
+    objRoute = TicketR shrFollowee prjFollowee numFollowee
+    recipRoute = ProjectR shrFollowee prjFollowee
+    getFsid = do
+        sid <- do
+            msid <- lift $ getKeyBy $ UniqueSharer shrFollowee
+            fromMaybeE msid "No such local sharer"
+        jid <- do
+            mjid <- lift $ getKeyBy $ UniqueProject prjFollowee sid
+            fromMaybeE mjid "No such local project"
+        mt <- lift $ getValBy $ UniqueTicket jid numFollowee
+        ticketFollowers <$>
+            fromMaybeE mt "Unfollow target no such local ticket"
+
+undoFollowRepo
+    :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
+    => ShrIdent
+    -> PersonId
+    -> ShrIdent
+    -> RpIdent
+    -> m (Either Text (TextHtml, Audience URIMode, Undo URIMode))
+undoFollowRepo shrAuthor pidAuthor shrFollowee rpFollowee =
+    undoFollow shrAuthor pidAuthor getFsid "repo" objRoute objRoute
+    where
+    objRoute = RepoR shrFollowee rpFollowee
+    getFsid = do
+        sidFollowee <- do
+            msid <- lift $ getKeyBy $ UniqueSharer shrFollowee
+            fromMaybeE msid "No such local sharer"
+        mr <- lift $ getValBy $ UniqueRepo rpFollowee sidFollowee
+        repoFollowers <$>
+            fromMaybeE mr "Unfollow target no such local repo"
--- a/src/Vervis/Federation/Discussion.hs
+++ b/src/Vervis/Federation/Discussion.hs
@ -19,85 +19,54 @@ module Vervis.Federation.Discussion
    )
 where

--import Control.Applicative
--import Control.Concurrent.MVar
--import Control.Concurrent.STM.TVar
 import Control.Exception hiding (Handler, try)
 import Control.Monad
 import Control.Monad.Logger.CallStack
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Except
 import Control.Monad.Trans.Maybe
--import Control.Monad.Trans.Reader
--import Crypto.Hash
--import Data.Aeson
 import Data.Bifunctor
 import Data.ByteString (ByteString)
--import Data.Either
 import Data.Foldable
 import Data.Function
 import Data.List (sort, deleteBy, nub, union, unionBy, partition)
 import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
 import Data.Maybe
--import Data.Semigroup
 import Data.Text (Text)
 import Data.Text.Encoding
 import Data.Time.Clock
--import Data.Time.Units
 import Data.Traversable
--import Data.Tuple
 import Database.Persist
--import Database.Persist.Sql hiding (deleteBy)
--import Network.HTTP.Client
--import Network.HTTP.Types.Header
--import Network.HTTP.Types.URI
--import Network.TLS hiding (SHA256)
--import UnliftIO.Exception (try)
 import Yesod.Core hiding (logError, logWarn, logInfo, logDebug)
 import Yesod.Persist.Core

 import qualified Data.ByteString.Lazy as BL
 import qualified Data.CaseInsensitive as CI
--import qualified Data.List as L
 import qualified Data.List.NonEmpty as NE
--import qualified Data.List.Ordered as LO
 import qualified Data.Text as T
 import qualified Database.Esqueleto as E
--import qualified Network.Wai as W

--import Data.Time.Interval
--import Network.HTTP.Signature hiding (requestHeaders)
 import Yesod.HttpSignature

--import Crypto.PublicVerifKey
 import Database.Persist.JSON
 import Network.FedURI
 import Network.HTTP.Digest
 import Web.ActivityPub
 import Yesod.ActivityPub
--import Yesod.Auth.Unverified
 import Yesod.FedURI
--import Yesod.Hashids
--import Yesod.MonadSite

 import Control.Monad.Trans.Except.Local
--import Data.Aeson.Local
--import Data.Either.Local
--import Data.List.Local
--import Data.List.NonEmpty.Local
--import Data.Maybe.Local
 import Data.Tuple.Local
 import Database.Persist.Local
 import Yesod.Persist.Local

 import Vervis.ActivityPub
--import Vervis.ActorKey
+import Vervis.ActivityPub.Recipient
 import Vervis.FedURI
 import Vervis.Federation.Auth
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident
--import Vervis.RemoteActorStore
 import Vervis.Settings

 sharerCreateNoteF
--- a/src/Vervis/Federation/Ticket.hs
+++ b/src/Vervis/Federation/Ticket.hs
@ -63,6 +63,7 @@ import Database.Persist.Local
 import Yesod.Persist.Local

 import Vervis.ActivityPub
+import Vervis.ActivityPub.Recipient
 import Vervis.FedURI
 import Vervis.Federation.Auth
 import Vervis.Foundation
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@ -300,6 +300,7 @@ instance Yesod App where
        (NotificationsR shr        , _   ) -> person shr
        (SharerOutboxR shr         , True) -> person shr
        (SharerFollowR shr         , True) -> personAny
+        (SharerUnfollowR shr       , True) -> personAny

        (GroupsR                   , True) -> personAny
        (GroupNewR                 , _   ) -> personAny
@ -324,6 +325,7 @@ instance Yesod App where
        (RepoR shar _              , True) -> person shar
        (RepoEditR shr _rp         , _   ) -> person shr
        (RepoFollowR _shr _rp      , True) -> personAny
+        (RepoUnfollowR _shr _rp    , True) -> personAny
        (RepoDevsR shr _rp         , _   ) -> person shr
        (RepoDevNewR shr _rp       , _   ) -> person shr
        (RepoDevR shr _rp _dev     , _   ) -> person shr
@ -333,6 +335,7 @@ instance Yesod App where
        (ProjectR shr _prj         , True) -> person shr
        (ProjectEditR shr _prj     , _   ) -> person shr
        (ProjectFollowR _shr _prj  , _   ) -> personAny
+        (ProjectUnfollowR _shr _prj  , _ ) -> personAny
        (ProjectDevsR shr _prj     , _   ) -> person shr
        (ProjectDevNewR shr _prj   , _   ) -> person shr
        (ProjectDevR shr _prj _dev , _   ) -> person shr
@ -366,6 +369,7 @@ instance Yesod App where
        (TicketAssignR s j _       , _   ) -> projOp ProjOpAssignTicket s j
        (TicketUnassignR s j _     , _   ) -> projOp ProjOpUnassignTicket s j
        (TicketFollowR _ _ _       , True) -> personAny
+        (TicketUnfollowR _ _ _     , True) -> personAny
        (ClaimRequestsTicketR s j _, True) -> projOp ProjOpRequestTicket s j
        (ClaimRequestNewR s j _    , _   ) -> projOp ProjOpRequestTicket s j
        (TicketDiscussionR _ _ _   , True) -> personAny
--- a/src/Vervis/Handler/Client.hs
+++ b/src/Vervis/Handler/Client.hs
@ -16,12 +16,20 @@
 module Vervis.Handler.Client
    ( getPublishR
    , postSharerOutboxR
+
    , postSharerFollowR
    , postProjectFollowR
    , postTicketFollowR
    , postRepoFollowR
+
+    , postSharerUnfollowR
+    , postProjectUnfollowR
+    , postTicketUnfollowR
+    , postRepoUnfollowR
+
    , getNotificationsR
    , postNotificationsR
+
    , postTicketsR
    )
 where
@ -199,11 +207,14 @@ activityWidget shr widget1 enctype1 widget2 enctype2 widget3 enctype3 =
          <input type=submit>
    |]

-getUserShrIdent :: Handler ShrIdent
-getUserShrIdent = do
-    Entity _ p <- requireVerifiedAuth
+getUser :: Handler (ShrIdent, PersonId)
+getUser = do
+    Entity pid p <- requireVerifiedAuth
    s <- runDB $ getJust $ personIdent p
-    return $ sharerIdent s
+    return (sharerIdent s, pid)
+
+getUserShrIdent :: Handler ShrIdent
+getUserShrIdent = fst <$> getUser

 getPublishR :: Handler Html
 getPublishR = do
@ -389,6 +400,57 @@ postRepoFollowR shrObject rpObject = do
    setFollowMessage shrAuthor eid
    redirect $ RepoR shrObject rpObject

+setUnfollowMessage :: ShrIdent -> Either Text OutboxItemId -> Handler ()
+setUnfollowMessage _   (Left err)    = setMessage $ toHtml err
+setUnfollowMessage shr (Right obiid) = do
+    obikhid <- encodeKeyHashid obiid
+    setMessage =<<
+        withUrlRenderer
+            [hamlet|
+                <a href=@{SharerOutboxItemR shr obikhid}>
+                  Unfollow request published!
+            |]
+
+postSharerUnfollowR :: ShrIdent -> Handler ()
+postSharerUnfollowR shrFollowee = do
+    (shrAuthor, pidAuthor) <- getUser
+    eid <- runExceptT $ do
+        (summary, audience, undo) <-
+            ExceptT $ undoFollowSharer shrAuthor pidAuthor shrFollowee
+        ExceptT $ undoC shrAuthor summary audience undo
+    setUnfollowMessage shrAuthor eid
+    redirect $ SharerR shrFollowee
+
+postProjectUnfollowR :: ShrIdent -> PrjIdent -> Handler ()
+postProjectUnfollowR shrFollowee prjFollowee = do
+    (shrAuthor, pidAuthor) <- getUser
+    eid <- runExceptT $ do
+        (summary, audience, undo) <-
+            ExceptT $ undoFollowProject shrAuthor pidAuthor shrFollowee prjFollowee
+        ExceptT $ undoC shrAuthor summary audience undo
+    setUnfollowMessage shrAuthor eid
+    redirect $ ProjectR shrFollowee prjFollowee
+
+postTicketUnfollowR :: ShrIdent -> PrjIdent -> Int -> Handler ()
+postTicketUnfollowR shrFollowee prjFollowee numFollowee = do
+    (shrAuthor, pidAuthor) <- getUser
+    eid <- runExceptT $ do
+        (summary, audience, undo) <-
+            ExceptT $ undoFollowTicket shrAuthor pidAuthor shrFollowee prjFollowee numFollowee
+        ExceptT $ undoC shrAuthor summary audience undo
+    setUnfollowMessage shrAuthor eid
+    redirect $ TicketR shrFollowee prjFollowee numFollowee
+
+postRepoUnfollowR :: ShrIdent -> RpIdent -> Handler ()
+postRepoUnfollowR shrFollowee rpFollowee = do
+    (shrAuthor, pidAuthor) <- getUser
+    eid <- runExceptT $ do
+        (summary, audience, undo) <-
+            ExceptT $ undoFollowRepo shrAuthor pidAuthor shrFollowee rpFollowee
+        ExceptT $ undoC shrAuthor summary audience undo
+    setUnfollowMessage shrAuthor eid
+    redirect $ RepoR shrFollowee rpFollowee
+
 notificationForm :: Maybe (Maybe (InboxItemId, Bool)) -> Form (Maybe (InboxItemId, Bool))
 notificationForm defs = renderDivs $ mk
    <$> aopt hiddenField (name "Inbox Item ID#") (fmap fst <$> defs)
--- a/src/Vervis/Handler/Person.hs
+++ b/src/Vervis/Handler/Person.hs
@ -148,4 +148,7 @@ getPerson shr sharer person = do
    provideHtmlAndAP personAP $(widgetFile "person")
    where
    followButton =
-        followW (SharerFollowR shr) (return $ personFollowers person)
+        followW
+            (SharerFollowR shr)
+            (SharerUnfollowR shr)
+            (return $ personFollowers person)
--- a/src/Vervis/Handler/Project.hs
+++ b/src/Vervis/Handler/Project.hs
@ -163,6 +163,7 @@ getProjectR shar proj = do
        followButton =
            followW
                (ProjectFollowR shar proj)
+                (ProjectUnfollowR shar proj)
                (return $ projectFollowers project)
    provideHtmlAndAP projectAP $(widgetFile "project/one")

--- a/src/Vervis/Handler/Repo/Darcs.hs
+++ b/src/Vervis/Handler/Repo/Darcs.hs
@ -98,7 +98,10 @@ getDarcsRepoSource repository user repo dir = do
                $(widgetFile "repo/source-darcs")
    where
    followButton =
-        followW (RepoFollowR user repo) (return $ repoFollowers repository)
+        followW
+            (RepoFollowR user repo)
+            (RepoUnfollowR user repo)
+            (return $ repoFollowers repository)

 getDarcsRepoHeadChanges :: ShrIdent -> RpIdent -> Handler TypedContent
 getDarcsRepoHeadChanges shar repo = do
--- a/src/Vervis/Handler/Repo/Git.hs
+++ b/src/Vervis/Handler/Repo/Git.hs
@ -113,7 +113,10 @@ getGitRepoSource repository user repo ref dir = do
                $(widgetFile "repo/source-git")
    where
    followButton =
-        followW (RepoFollowR user repo) (return $ repoFollowers repository)
+        followW
+            (RepoFollowR user repo)
+            (RepoUnfollowR user repo)
+            (return $ repoFollowers repository)

 getGitRepoHeadChanges :: Repo -> ShrIdent -> RpIdent -> Handler TypedContent
 getGitRepoHeadChanges repository shar repo =
--- a/src/Vervis/Handler/Ticket.hs
+++ b/src/Vervis/Handler/Ticket.hs
@ -295,6 +295,7 @@ getTicketR shar proj num = do
        let followButton =
                followW
                    (TicketFollowR shar proj num)
+                    (TicketUnfollowR shar proj num)
                    (return $ ticketFollowers ticket)
        in  $(widgetFile "ticket/one")

--- a/src/Vervis/Widget/Sharer.hs
+++ b/src/Vervis/Widget/Sharer.hs
@ -59,8 +59,8 @@ sharerLinkFedW (Right (inztance, actor)) =
    where
    uActor = ObjURI (instanceHost inztance) (remoteActorIdent actor)

-followW :: Route App -> AppDB FollowerSetId -> Widget
-followW followRoute getFsid = do
+followW :: Route App -> Route App -> AppDB FollowerSetId -> Widget
+followW followRoute unfollowRoute getFsid = do
    mpid <- maybeVerifiedAuthId
    for_ mpid $ \ pid -> do
        mfollow <- handlerToWidget $ runDB $ do
@ -68,7 +68,4 @@ followW followRoute getFsid = do
            getValBy $ UniqueFollow pid fsid
        case mfollow of
            Nothing -> buttonW POST "Follow" followRoute
-            Just _ ->
-                [whamlet|
-                  <div>[Following]
-                |]
+            Just _ -> buttonW POST "Unfollow" unfollowRoute
--- a/src/Web/ActivityPub.hs
+++ b/src/Web/ActivityPub.hs
@ -1155,6 +1155,7 @@ instance ActivityPub Activity where
        activityType (OfferActivity _)  = "Offer"
        activityType (PushActivity _)   = "Push"
        activityType (RejectActivity _) = "Reject"
+        activityType (UndoActivity _)   = "Undo"
        encodeSpecific h _ (AcceptActivity a) = encodeAccept h a
        encodeSpecific h u (CreateActivity a) = encodeCreate h u a
        encodeSpecific _ _ (FollowActivity a) = encodeFollow a
--- a/vervis.cabal
+++ b/vervis.cabal
@ -115,9 +115,9 @@ library

                       Vervis.Access
                       Vervis.ActivityPub
+                       Vervis.ActivityPub.Recipient
                       Vervis.ActorKey
                       Vervis.API
-                       Vervis.API.Recipient
                       Vervis.Application
                       Vervis.Avatar
                       Vervis.BinaryBody