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