From ef036fd08b3ba4ea0a64d999baddc866b14ed9ae Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Sat, 27 Apr 2024 22:02:40 +0300 Subject: [PATCH] UI: Project: Parents: Button for approving a parent --- src/Vervis/Foundation.hs | 1 + src/Vervis/Handler/Project.hs | 65 +++++++++++++++++++++++++++++++- src/Vervis/Persist/Collab.hs | 42 +++++++++++++++++++++ templates/project/parents.hamlet | 6 ++- th/routes | 1 + 5 files changed, 112 insertions(+), 3 deletions(-) diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 0760015..b6a897a 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -1045,3 +1045,4 @@ instance YesodBreadcrumbs App where ProjectAddParentR _ -> ("", Nothing) ProjectApproveChildR _ _ -> ("", Nothing) + ProjectApproveParentR _ _ -> ("", Nothing) diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs index 0a574cb..33144ca 100644 --- a/src/Vervis/Handler/Project.hs +++ b/src/Vervis/Handler/Project.hs @@ -51,6 +51,7 @@ module Vervis.Handler.Project , postProjectAddParentR , postProjectApproveChildR + , postProjectApproveParentR ) where @@ -913,7 +914,7 @@ getProjectParentsR projectHash = do Right (actorID, addID) -> do RemoteActivity _ _ time <- getJust addID (,time) . Right <$> getRemoteActorData actorID - return (inviter, us, parent, accept, time, role) + return (inviter, us, parent, accept, time, role, destID) $(widgetFile "project/parents") where getRemoteActorData actorID = do @@ -1176,5 +1177,65 @@ postProjectApproveChildR projectHash sourceID = do Left e -> do setMessage $ toHtml e Right removeID -> - setMessage "Add sent" + setMessage "Accept sent" redirect $ ProjectChildrenR projectHash + +postProjectApproveParentR :: KeyHashid Project -> DestId -> Handler Html +postProjectApproveParentR projectHash destID = do + projectID <- decodeKeyHashid404 projectHash + + personEntity@(Entity personID person) <- requireAuth + personHash <- encodeKeyHashid personID + encodeRouteHome <- getEncodeRouteHome + + result <- runExceptT $ do + mpidOrU <- lift $ runDB $ runMaybeT $ do + project <- MaybeT $ get projectID + _ <- MaybeT $ get destID + DestHolderProject _ j <- + MaybeT $ getValBy $ UniqueDestHolderProject destID + guard $ projectID == j + + uAdd <- lift $ do + add <- getDestAdd destID + renderActivityURI add + + topic <- lift $ do + t <- bimap snd snd <$> getDestTopic destID + bitraverse + (\case + Left j' -> pure j' + Right _g -> error "I'm a project, I have a Dest with topic being Group" + ) + pure + t + lift $ + (projectResource project,uAdd,) <$> + bitraverse + pure + (getRemoteActorURI <=< getJust) + topic + (resourceID, uAdd, pidOrU) <- maybe notFound pure mpidOrU + (maybeSummary, audience, accept) <- do + uParent <- + case pidOrU of + Left j -> encodeRouteHome . ProjectR <$> encodeKeyHashid j + Right u -> pure u + let uChild = encodeRouteHome $ ProjectR projectHash + C.acceptParentChild personID uAdd uParent uChild + cap <- do + maybeItem <- lift $ runDB $ getCapability personID (Left resourceID) AP.RoleAdmin + fromMaybeE maybeItem "You need to be have Admin access to the Project to approve parents" + uCap <- lift $ renderActivityURI cap + (localRecips, remoteRecips, fwdHosts, action) <- + C.makeServerInput (Just uCap) maybeSummary audience $ AP.AcceptActivity accept + let cap' = first (\ (la, i) -> (la, error "lah", i)) cap + handleViaActor + personID (Just cap') localRecips remoteRecips fwdHosts action + + case result of + Left e -> do + setMessage $ toHtml e + Right removeID -> + setMessage "Accept sent" + redirect $ ProjectParentsR projectHash diff --git a/src/Vervis/Persist/Collab.hs b/src/Vervis/Persist/Collab.hs index 0ba2bb5..ad5ed42 100644 --- a/src/Vervis/Persist/Collab.hs +++ b/src/Vervis/Persist/Collab.hs @@ -36,6 +36,7 @@ module Vervis.Persist.Collab , getSourceAdd , getDestTopic , getDestHolder + , getDestAdd , checkExistingStems , checkExistingPermits @@ -548,6 +549,47 @@ getDestHolder destID = "Found Dest without holder" "Found Dest with both project and team holder" +getDestAdd + :: MonadIO m + => DestId + -> ReaderT SqlBackend m + (Either + (LocalActorBy Key, OutboxItemId) + FedURI + ) +getDestAdd destID = do + usOrThem <- + requireEitherAlt + (getKeyBy $ UniqueDestOriginUs destID) + (getKeyBy $ UniqueDestOriginThem destID) + "Neither us nor them" + "Both us and them" + add <- + case usOrThem of + Left _usID -> + requireEitherAlt + (fmap destUsGestureLocalActivity <$> getValBy (UniqueDestUsGestureLocal destID)) + (fmap destUsGestureRemoteActivity <$> getValBy (UniqueDestUsGestureRemote destID)) + "Neither local not remote" + "Both local and remote" + Right themID -> + requireEitherAlt + (fmap destThemGestureLocalAdd <$> getValBy (UniqueDestThemGestureLocal themID)) + (fmap destThemGestureRemoteAdd <$> getValBy (UniqueDestThemGestureRemote themID)) + "Neither local not remote" + "Both local and remote" + bitraverse + (\ addID -> do + OutboxItem outboxID _ time <- getJust addID + Entity actorID actor <- getByJust $ UniqueActorOutbox outboxID + (,addID) <$> getLocalActor actorID + ) + (\ addID -> do + add <- getJust addID + getRemoteActivityURI add + ) + add + checkExistingStems :: ComponentBy Key -> Either (Entity Project) RemoteActorId -> ActDBE () checkExistingStems componentByID projectDB = do diff --git a/templates/project/parents.hamlet b/templates/project/parents.hamlet index c3c749d..cf6749f 100644 --- a/templates/project/parents.hamlet +++ b/templates/project/parents.hamlet @@ -48,7 +48,9 @@ $if haveAdmin I accepted? Role Time - $forall (inviter, us, parent, accept, time, role) <- invites + $if haveAdmin + Approve + $forall (inviter, us, parent, accept, time, role, destID) <- invites ^{actorLinkFedW inviter} @@ -64,3 +66,5 @@ $if haveAdmin [_] #{show role} #{showDate time} + $if haveAdmin && (not accept && not us) + ^{buttonW POST "Approve" (ProjectApproveParentR projectHash destID)} diff --git a/th/routes b/th/routes index 2a51f0e..de39fe1 100644 --- a/th/routes +++ b/th/routes @@ -361,3 +361,4 @@ /projects/#ProjectKeyHashid/parent/add ProjectAddParentR POST /projects/#ProjectKeyHashid/child/approve/#SourceId ProjectApproveChildR POST +/projects/#ProjectKeyHashid/parent/approve/#DestId ProjectApproveParentR POST