From 3e110ca53c38a79a24013e6bb7a9bfe7226ff17e Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Sat, 18 May 2024 14:11:39 +0300 Subject: [PATCH] UI: Group: Display resources, invites and action buttons --- src/Vervis/Handler/Group.hs | 11 +++++- src/Vervis/Persist/Collab.hs | 69 +++++++++++++++++++++++++++++++++ templates/group/efforts.hamlet | 70 ++++++++++++++++++++++++++++++++++ 3 files changed, 149 insertions(+), 1 deletion(-) create mode 100644 templates/group/efforts.hamlet diff --git a/src/Vervis/Handler/Group.hs b/src/Vervis/Handler/Group.hs index 08a892b..3df084e 100644 --- a/src/Vervis/Handler/Group.hs +++ b/src/Vervis/Handler/Group.hs @@ -980,7 +980,16 @@ getGroupEffortsR groupHash = do , AP.collectionItems = map (Doc h . makeItem) efforts , AP.collectionContext = Just $ encodeRouteLocal meR } - provideHtmlAndAP effortsAP $ redirectToPrettyJSON (GroupEffortsR groupHash) + provideHtmlAndAP effortsAP $ getHtml groupID group actor efforts + where + getHtml groupID group actor efforts = do + mp <- maybeAuthId + haveAdmin <- fmap isJust $ handlerToWidget $ runDB $ runMaybeT $ do + personID <- MaybeT $ pure mp + MaybeT $ getCapability personID (Left $ groupResource group) AP.RoleAdmin + ((_, widgetAE), enctypeAE) <- handlerToWidget $ runFormPost addEffortForm + drafts <- handlerToWidget $ runDB $ getTeamResourceDrafts groupID + $(widgetFile "group/efforts") addEffortForm = renderDivs $ (,) <$> areq fedUriField "Resource actor URI*" Nothing diff --git a/src/Vervis/Persist/Collab.hs b/src/Vervis/Persist/Collab.hs index 316a637..943a058 100644 --- a/src/Vervis/Persist/Collab.hs +++ b/src/Vervis/Persist/Collab.hs @@ -68,6 +68,7 @@ module Vervis.Persist.Collab , getSquadTeam , getTeamResources + , getTeamResourceDrafts , getEffortAdd , getEffortTopic @@ -1764,6 +1765,74 @@ getTeamResources groupID = , effort E.^. EffortId ) +getTeamResourceDrafts + :: MonadIO m + => GroupId + -> ReaderT SqlBackend m + [ ( Either (LocalActorBy Key, Actor) (Instance, RemoteObject, RemoteActor) + , Bool + , Either (LocalActorBy Key, Actor) (Instance, RemoteObject, RemoteActor) + , Bool + , UTCTime + , AP.Role + , EffortId + ) + ] +getTeamResourceDrafts groupID = do + efforts <- E.select $ E.from $ \ (effort `E.LeftOuterJoin` deleg) -> do + E.on $ E.just (effort E.^. EffortId) E.==. deleg E.?. EffortUsSendDelegatorEffort + E.where_ $ + effort E.^. EffortHolder E.==. E.val groupID E.&&. + E.isNothing (deleg E.?. EffortUsSendDelegatorId) + E.orderBy [E.asc $ effort E.^. EffortId] + return effort + for efforts $ \ (Entity effortID (Effort role _)) -> do + (resource, accept) <- do + topic <- getEffortTopic effortID + accept <- + case bimap fst fst topic of + Left localID -> isJust <$> getBy (UniqueEffortThemAcceptLocal localID) + Right remoteID -> isJust <$> getBy (UniqueEffortThemAcceptRemote remoteID) + (,accept) <$> bitraverse + (\ (_, resourceID) -> do + lr <- getLocalResource resourceID + Resource actorID <- getJust resourceID + actor <- getJust actorID + return (resourceToActor lr, actor) + ) + (\ (_, actorID) -> getRemoteActorData actorID) + topic + ((inviter, time), us) <- do + usOrThem <- + requireEitherAlt + (getKeyBy $ UniqueEffortOriginUs effortID) + (getKeyBy $ UniqueEffortOriginThem effortID) + "Neither us nor them" + "Both us and them" + (addOrActor, us) <- + case usOrThem of + Left usID -> (,True) <$> + requireEitherAlt + (fmap effortUsGestureLocalAdd <$> getValBy (UniqueEffortUsGestureLocal usID)) + (fmap (effortUsGestureRemoteActor &&& effortUsGestureRemoteAdd) <$> getValBy (UniqueEffortUsGestureRemote usID)) + "Neither local not remote" + "Both local and remote" + Right themID -> (,False) <$> + requireEitherAlt + (fmap effortThemGestureLocalAdd <$> getValBy (UniqueEffortThemGestureLocal themID)) + (fmap (effortThemGestureRemoteActor &&& effortThemGestureRemoteAdd) <$> getValBy (UniqueEffortThemGestureRemote themID)) + "Neither local not remote" + "Both local and remote" + (,us) <$> case addOrActor of + Left addID -> do + OutboxItem outboxID _ time <- getJust addID + Entity actorID actor <- getByJust $ UniqueActorOutbox outboxID + (,time) . Left . (,actor) <$> getLocalActor actorID + Right (actorID, addID) -> do + RemoteActivity _ _ time <- getJust addID + (,time) . Right <$> getRemoteActorData actorID + return (inviter, us, resource, accept, time, role, effortID) + getEffortAdd :: MonadIO m => EffortId diff --git a/templates/group/efforts.hamlet b/templates/group/efforts.hamlet new file mode 100644 index 0000000..7255831 --- /dev/null +++ b/templates/group/efforts.hamlet @@ -0,0 +1,70 @@ +$# This file is part of Vervis. +$# +$# Written in 2016, 2019, 2022, 2023, 2024 +$# by fr33domlover . +$# +$# ♡ Copying is an act of love. Please copy, reuse and share. +$# +$# The author(s) have dedicated all copyright and related and neighboring +$# rights to this software to the public domain worldwide. This software is +$# distributed without any warranty. +$# +$# You should have received a copy of the CC0 Public Domain Dedication along +$# with this software. If not, see +$# . + +^{groupNavW (Entity groupID group) actor} + +

Accessible Resources + + + + +
Role + Since + Resource + $if haveAdmin + Remove + $forall (role, since, resource, effortID) <- efforts +
#{show role} + #{showDate since} + ^{actorLinkFedW resource} + $if haveAdmin + ^{buttonW POST "Remove" (GroupRemoveEffortR groupHash effortID)} + +$if haveAdmin +

Request access to a resource: +

+ ^{widgetAE} + + +

Requests In Progress + + + + +
Inviter + Via + Requested resource + Resource accepted? + Role + Time + $if haveAdmin + Approve + $forall (inviter, us, resource, accept, time, role, effortID) <- drafts +
^{actorLinkFedW inviter} + + $if us + Us + $else + Them + ^{actorLinkFedW resource} + + $if accept + [x] + $else + [_] + #{show role} + #{showDate time} + $if haveAdmin && (accept && not us) + ^{buttonW POST "Approve" (GroupApproveEffortR groupHash effortID)}