S2S: Support following sharer-patch and repo-patch

Also fixed a bug in which trying to follow a ticket with nonexistent
ltkhid/talkhid would result with 404 as if the actor inbox is nonexistent. Now,
there's a friendly message reported.

src/Vervis/Federation/Offer.hs

@@ -80,6 +80,8 @@ import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Model.Ticket
+import Vervis.Patch
+import Vervis.Ticket
 
 sharerAcceptF
     :: ShrIdent
@@ -240,7 +242,7 @@ sharerRejectF shr now author body (Reject (ObjURI hOffer luOffer)) = do
 followF
     :: (Route App -> Maybe a)
     -> Route App
-    -> (a -> AppDB b)
+    -> (a -> AppDB (Maybe b))
     -> (b -> InboxId)
     -> (b -> OutboxId)
     -> (b -> FollowerSetId)
@@ -267,7 +269,10 @@ followF
                         (activityId $ actbActivity body)
                         "Follow without 'id'"
                 emsg <- lift $ runDB $ do
-                    recip <- getRecip obj
+                    mrecip <- getRecip obj
+                    case mrecip of
+                        Nothing -> return $ Left "Follow object not found, ignoring activity"
+                        Just recip -> do
                             newItem <- insertToInbox luFollow $ recipInbox recip
                             case newItem of
                                 Nothing -> return $ Left "Activity already exists in inbox, not using"
@@ -382,20 +387,28 @@ sharerFollowF shr =
     objRoute (SharerR shr')
         | shr == shr' = Just Nothing
     objRoute (SharerTicketR shr' talkhid)
-        | shr == shr' = Just $ Just talkhid
+        | shr == shr' = Just $ Just (talkhid, False)
+    objRoute (SharerPatchR shr' talkhid)
+        | shr == shr' = Just $ Just (talkhid, True)
     objRoute _ = Nothing
 
     getRecip mtalkhid = do
         sid <- getKeyBy404 $ UniqueSharer shr
-        Entity pid p <- getBy404 $ UniquePersonIdent sid
+        p <- getValBy404 $ UniquePersonIdent sid
-        mt <- for mtalkhid $ \ talkhid -> do
+        mmt <- for mtalkhid $ \ (talkhid, patch) -> runMaybeT $ do
-            talid <- decodeKeyHashid404 talkhid
+            talid <- decodeKeyHashidM talkhid
-            tal <- get404 talid
+            if patch
-            unless (ticketAuthorLocalAuthor tal == pid) notFound
+                then do
-            mtup <- getBy $ UniqueTicketUnderProjectAuthor talid
+                    (_, Entity _ lt, _, _, _) <- MaybeT $ getSharerPatch shr talid
-            unless (isNothing mtup) notFound
+                    return lt
-            getJust $ ticketAuthorLocalTicket tal
+                else do
-        return (p, mt)
+                    (_, Entity _ lt, _, _) <- MaybeT $ getSharerTicket shr talid
+                    return lt
+        return $
+            case mmt of
+                Nothing -> Just (p, Nothing)
+                Just Nothing -> Nothing
+                Just (Just t) -> Just (p, Just t)
 
     followers (p, Nothing) = personFollowers p
     followers (_, Just lt) = localTicketFollowers lt
@@ -426,17 +439,16 @@ projectFollowF shr prj =
 
     getRecip mltkhid = do
         sid <- getKeyBy404 $ UniqueSharer shr
-        Entity jid j <- getBy404 $ UniqueProject prj sid
+        j <- getValBy404 $ UniqueProject prj sid
-        mt <- for mltkhid $ \ ltkhid -> do
+        mmt <- for mltkhid $ \ ltkhid -> runMaybeT $ do
-            ltid <- decodeKeyHashid404 ltkhid
+            ltid <- decodeKeyHashidM ltkhid
-            lt <- get404 ltid
+            (_, _, _, Entity _ lt, _, _, _) <- MaybeT $ getProjectTicket shr prj ltid
-            tclid <-
-                getKeyBy404 $ UniqueTicketContextLocal $ localTicketTicket lt
-            tpl <-
-                getValBy404 $ UniqueTicketProjectLocal tclid
-            unless (ticketProjectLocalProject tpl == jid) notFound
             return lt
-        return (j, mt)
+        return $
+            case mmt of
+                Nothing -> Just (j, Nothing)
+                Just Nothing -> Nothing
+                Just (Just t) -> Just (j, Just t)
 
     followers (j, Nothing)  = projectFollowers j
     followers (_, Just lt)  = localTicketFollowers lt
@@ -454,17 +466,32 @@ repoFollowF shr rp =
         objRoute
         (RepoR shr rp)
         getRecip
-        repoInbox
+        (repoInbox . fst)
-        repoOutbox
+        (repoOutbox . fst)
-        repoFollowers
+        followers
         (RepoOutboxItemR shr rp)
     where
-    objRoute (RepoR shr' rp') | shr == shr' && rp == rp' = Just ()
+    objRoute (RepoR shr' rp')
+        | shr == shr' && rp == rp' = Just Nothing
+    objRoute (RepoPatchR shr' rp' ltkhid)
+        | shr == shr' && rp == rp' = Just $ Just ltkhid
     objRoute _ = Nothing
 
-    getRecip () = do
+    getRecip mltkhid = do
         sid <- getKeyBy404 $ UniqueSharer shr
-        getValBy404 $ UniqueRepo rp sid
+        r <- getValBy404 $ UniqueRepo rp sid
+        mmt <- for mltkhid $ \ ltkhid -> runMaybeT $ do
+            ltid <- decodeKeyHashidM ltkhid
+            (_, _, _, Entity _ lt, _, _, _, _) <- MaybeT $ getRepoPatch shr rp ltid
+            return lt
+        return $
+            case mmt of
+                Nothing -> Just (r, Nothing)
+                Just Nothing -> Nothing
+                Just (Just t) -> Just (r, Just t)
+
+    followers (r, Nothing) = repoFollowers r
+    followers (_, Just lt) = localTicketFollowers lt
 
 undoF
     :: Route App