Client: Use the new Add-based version of adding a component

src/Vervis/Client.hs

@@ -44,7 +44,6 @@ module Vervis.Client
     , invite
     , add
     , remove
-    , inviteComponent
     , acceptProjectInvite
     , acceptPersonalInvite
     , acceptParentChild
@@ -1396,77 +1395,6 @@ remove personID uRecipient uCollection = do
 
     return (Nothing, audience, activity)
 
-inviteComponent
-    :: PersonId
-    -> ProjectId
-    -> FedURI
-    -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Invite URIMode)
-inviteComponent personID projectID uComp = do
-
-    encodeRouteHome <- getEncodeRouteHome
-    theater <- asksSite appTheater
-    env <- asksSite appEnv
-    projectHash <- encodeKeyHashid projectID
-
-    let uComps = encodeRouteHome $ ProjectComponentsR projectHash
-        activity = AP.Invite AP.RoleAdmin uComp uComps
-
-    -- If component is remote, get it via HTTP/DB to determine its followers
-    -- collection
-    comp <- parseComp uComp
-    compDB <-
-        bitraverse
-            (runActE . hashComponent)
-            (\ u@(ObjURI h lu) -> do
-                instanceID <-
-                    lift $ runDB $ either entityKey id <$> insertBy' (Instance h)
-                result <-
-                    ExceptT $ first (T.pack . displayException) <$>
-                        fetchRemoteActor instanceID h lu
-                case result of
-                    Left Nothing -> throwE "Recipient @id mismatch"
-                    Left (Just err) -> throwE $ T.pack $ displayException err
-                    Right Nothing -> throwE "Recipient isn't an actor"
-                    Right (Just actor) -> return (entityVal actor, u)
-            )
-            comp
-
-    senderHash <- encodeKeyHashid personID
-
-    let audComp =
-            case compDB of
-                Left (ComponentRepo r) ->
-                    AudLocal [LocalActorRepo r] [LocalStageRepoFollowers r]
-                Left (ComponentDeck d) ->
-                    AudLocal [LocalActorDeck d] [LocalStageDeckFollowers d]
-                Left (ComponentLoom l) ->
-                    AudLocal [LocalActorLoom l] [LocalStageLoomFollowers l]
-                Right (remoteActor, ObjURI h lu) ->
-                    AudRemote h
-                        [lu]
-                        (maybeToList $ remoteActorFollowers remoteActor)
-        audProject =
-            AudLocal [LocalActorProject projectHash] [LocalStageProjectFollowers projectHash]
-        audAuthor =
-            AudLocal [] [LocalStagePersonFollowers senderHash]
-
-        audience = [audComp, audProject, audAuthor]
-
-    return (Nothing, audience, activity)
-    where
-    parseComp u = do
-        routeOrRemote <- parseFedURIOld u
-        bitraverse
-            (\ route -> do
-                c <-
-                    fromMaybeE
-                        (parseComponent route)
-                        "Not a component route"
-                runActE $ unhashComponentE c "Contains invalid keyhashid"
-            )
-            pure
-            routeOrRemote
-
 acceptProjectInvite
     :: PersonId
     -> LocalActorBy Key

src/Vervis/Handler/Deck.hs

@@ -612,23 +612,10 @@ postDeckAddProjectR deckHash = do
     personHash <- encodeKeyHashid personID
     encodeRouteHome <- getEncodeRouteHome
 
-    let uDeck = encodeRouteHome $ DeckR deckHash
+    let uCollection = encodeRouteHome $ DeckProjectsR deckHash
 
     result <- runExceptT $ do
-        uCollection <- do
+        (maybeSummary, audience, add) <- C.add personID uProject uCollection AP.RoleAdmin
-            project <- do
-                u <- parseFedURIOld uProject
-                bitraverse parseLocalActorE pure u
-            case project of
-                Left la ->
-                    encodeRouteHome . renderLocalActor <$> hashLocalActor la
-                Right (ObjURI h lu) -> do
-                    manager <- asksSite appHttpManager
-                    AP.ResourceWithCollections _ _ mluComponents _ _ _ _ <- ExceptT $ liftIO $ first (T.pack . show) <$> AP.fetchRWC manager h lu
-                    luComponents <- fromMaybeE mluComponents "No components collection"
-                    return $ ObjURI h luComponents
-
-        (maybeSummary, audience, add) <- C.add personID uDeck uCollection AP.RoleAdmin
         cap <- do
             maybeItem <- lift $ runDB $ do
                 resourceID <- deckResource <$> get404 deckID

src/Vervis/Handler/Project.hs

@@ -587,25 +587,26 @@ postProjectInviteCompR projectHash = do
     personEntity@(Entity personID person) <- requireAuth
     personHash <- encodeKeyHashid personID
     encodeRouteHome <- getEncodeRouteHome
+    let uCollection = encodeRouteHome $ ProjectComponentsR projectHash
 
     result <- runExceptT $ do
-        (maybeSummary, audience, invite) <-
+        (maybeSummary, audience, add) <-
-            C.inviteComponent personID projectID uComp
+            C.add personID uComp uCollection AP.RoleAdmin
         cap <- do
             maybeItem <- lift $ runDB $ do
                 resourceID <- projectResource <$> get404 projectID
                 getCapability personID (Left resourceID) AP.RoleAdmin
-            fromMaybeE maybeItem "You need to be have Admin access to the Project to invite components"
+            fromMaybeE maybeItem "You need to be have Admin access to the Project to add components"
         uCap <- lift $ renderActivityURI cap
         (localRecips, remoteRecips, fwdHosts, action) <-
-            C.makeServerInput (Just uCap) maybeSummary audience $ AP.InviteActivity invite
+            C.makeServerInput (Just uCap) maybeSummary audience $ AP.AddActivity add
         let cap' = first (\ (la, i) -> (la, error "lah", i)) cap
         handleViaActor
             personID (Just cap') localRecips remoteRecips fwdHosts action
 
     case result of
         Left e -> setMessage $ toHtml e
-        Right inviteID -> setMessage "Invite sent"
+        Right _addID -> setMessage "Add sent"
     redirect $ ProjectComponentsR projectHash
 
 getProjectChildrenR :: KeyHashid Project -> Handler TypedContent