S2S: Re-implement and re-enable deckFollowF

src/Vervis/Federation/Offer.hs

@@ -21,7 +21,7 @@ module Vervis.Federation.Offer
     --, sharerRejectF
 
       personFollowF
-    --, projectFollowF
+    , deckFollowF
     --, repoFollowF
 
     --, sharerUndoF
@@ -581,53 +581,39 @@ personFollowF now recipPersonHash =
         now
         recipPersonHash
 
-{-
+deckFollowF
-projectFollowF
+    :: UTCTime
-    :: KeyHashid Project
+    -> KeyHashid Deck
-    -> UTCTime
     -> RemoteAuthor
     -> ActivityBody
-    -> Maybe (LocalRecipientSet, ByteString)
+    -> Maybe (RecipientRoutes, ByteString)
     -> LocalURI
     -> AP.Follow URIMode
-    -> ExceptT Text Handler Text
+    -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
-projectFollowF deckHash =
+deckFollowF now recipDeckHash =
-    error "projectFollowF temporarily disabled"
-
-
-
     followF
-        objRoute
+        (\case
-        (ProjectR shr prj)
+            DeckR d | d == recipDeckHash -> pure Nothing
-        getRecip
+            TicketR d t | d == recipDeckHash ->
-        (actorInbox . fst)
+                Just <$> decodeKeyHashidE t "Invalid task keyhashid"
-        (actorOutbox . fst)
+            _ -> throwE "Asking to follow someone else"
-        followers
+        )
-        (ProjectOutboxItemR shr prj)
+        deckActor
-    where
+        False
-    objRoute (ProjectR shr' prj')
+        (\ recipDeckID recipDeckActor maybeTaskID ->
-        | shr == shr' && prj == prj' = Just Nothing
+            case maybeTaskID of
-    objRoute (ProjectTicketR shr' prj' num)
+                Nothing -> pure $ actorFollowers recipDeckActor
-        | shr == shr' && prj == prj' = Just $ Just num
+                Just taskID -> do
-    objRoute _ = Nothing
+                    maybeTicket <- lift $ getTicket recipDeckID taskID
-
+                    (_deck, _task, Entity _ ticket, _author, _resolve) <-
-    getRecip mltkhid = do
+                        fromMaybeE maybeTicket "I don't have this ticket in DB"
-        sid <- getKeyBy404 $ UniqueSharer shr
+                    return $ ticketFollowers ticket
-        j <- getValBy404 $ UniqueProject prj sid
+        )
-        a <- getJust $ projectActor j
+        (\ _ -> pure $ makeRecipientSet [] [])
-        mmt <- for mltkhid $ \ ltkhid -> runMaybeT $ do
+        LocalActorDeck
-            ltid <- decodeKeyHashidM ltkhid
+        (\ _ -> pure [])
-            (_, _, _, Entity _ lt, _, _, _, _) <- MaybeT $ getProjectTicket shr prj ltid
+        now
-            return lt
+        recipDeckHash
-        return $
-            case mmt of
-                Nothing -> Just (a, Nothing)
-                Just Nothing -> Nothing
-                Just (Just t) -> Just (a, Just t)
-
-    followers (a, Nothing)  = actorFollowers a
-    followers (_, Just lt)  = localTicketFollowers lt
--}
 
 {-
 repoFollowF

src/Vervis/Handler/Deck.hs

@@ -103,6 +103,7 @@ import Vervis.API
 import Vervis.Federation.Auth
 import Vervis.Federation.Collab
 import Vervis.Federation.Discussion
+import Vervis.Federation.Offer
 import Vervis.Federation.Ticket
 import Vervis.FedURI
 import Vervis.Form.Ticket
@@ -196,10 +197,8 @@ postDeckInboxR recipDeckHash =
                     AP.CreateNote _ note ->
                         (,Nothing) <$> deckCreateNoteF now recipDeckHash author body mfwd luActivity note
                     _ -> return ("Unsupported create object type for decks", Nothing)
-            {-
+            AP.FollowActivity follow ->
-            FollowActivity follow ->
+                deckFollowF now recipDeckHash author body mfwd luActivity follow
-                (,Nothing) <$> projectFollowF shrRecip prjRecip now remoteAuthor body mfwd luActivity follow
-            -}
             AP.InviteActivity invite ->
                 topicInviteF now (GrantResourceDeck recipDeckHash) author body mfwd luActivity invite
             OfferActivity (Offer obj target) ->