Implement C2S unfollowing, using Undo{Follow}

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

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

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

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
 --

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"

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

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

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

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
+getUser :: Handler (ShrIdent, PersonId)
-getUserShrIdent = do
+getUser = do
-    Entity _ p <- requireVerifiedAuth
+    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)

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)

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")
 

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

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 =

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")
 

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 :: Route App -> Route App -> AppDB FollowerSetId -> Widget
-followW followRoute getFsid = do
+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 _ ->
+            Just _ -> buttonW POST "Unfollow" unfollowRoute
-                [whamlet|
-                  <div>[Following]
-                |]

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

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