From 66c1818fcde270acdc4ea4304de3fa0114a481b8 Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Sun, 12 May 2024 18:11:17 +0300 Subject: [PATCH] Client: Use the new Add-based version of adding a component --- src/Vervis/Client.hs | 72 ----------------------------------- src/Vervis/Handler/Deck.hs | 17 +-------- src/Vervis/Handler/Project.hs | 11 +++--- 3 files changed, 8 insertions(+), 92 deletions(-) diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs index 6a8ea76..0f2f220 100644 --- a/src/Vervis/Client.hs +++ b/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 diff --git a/src/Vervis/Handler/Deck.hs b/src/Vervis/Handler/Deck.hs index f9fb527..2c6ed5b 100644 --- a/src/Vervis/Handler/Deck.hs +++ b/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 - 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 + (maybeSummary, audience, add) <- C.add personID uProject uCollection AP.RoleAdmin cap <- do maybeItem <- lift $ runDB $ do resourceID <- deckResource <$> get404 deckID diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs index ad86640..0c8d3c1 100644 --- a/src/Vervis/Handler/Project.hs +++ b/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) <- - C.inviteComponent personID projectID uComp + (maybeSummary, audience, add) <- + 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