UI: In deck collaborator list, have a Remove button for each

This commit is contained in:
Pere Lev 2023-06-17 01:27:28 +03:00
parent 58518811e3
commit c8c2106eab
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
5 changed files with 64 additions and 5 deletions

View file

@ -931,6 +931,7 @@ instance YesodBreadcrumbs App where
DeckCollabsR d -> ("Collaborators", Just $ DeckR d) DeckCollabsR d -> ("Collaborators", Just $ DeckR d)
DeckInviteR d -> ("Invite", Just $ DeckR d) DeckInviteR d -> ("Invite", Just $ DeckR d)
DeckRemoveR _ _ -> ("", Nothing)
TicketR d t -> ("#" <> keyHashidText t, Just $ DeckTicketsR d) TicketR d t -> ("#" <> keyHashidText t, Just $ DeckTicketsR d)
TicketDiscussionR d t -> ("Discussion", Just $ TicketR d t) TicketDiscussionR d t -> ("Discussion", Just $ TicketR d t)

View file

@ -39,6 +39,7 @@ module Vervis.Handler.Deck
, getDeckCollabsR , getDeckCollabsR
, getDeckInviteR , getDeckInviteR
, postDeckInviteR , postDeckInviteR
, postDeckRemoveR
@ -59,8 +60,10 @@ module Vervis.Handler.Deck
) )
where where
import Control.Applicative
import Control.Monad import Control.Monad
import Control.Monad.Trans.Except import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Data.Aeson import Data.Aeson
import Data.Bitraversable import Data.Bitraversable
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
@ -71,6 +74,7 @@ import Data.Text (Text)
import Data.Time.Clock import Data.Time.Clock
import Data.Traversable import Data.Traversable
import Database.Persist import Database.Persist
import Network.HTTP.Types.Method
import Text.Blaze.Html (Html) import Text.Blaze.Html (Html)
import Yesod.Auth (requireAuth) import Yesod.Auth (requireAuth)
import Yesod.Core import Yesod.Core
@ -121,6 +125,7 @@ import Vervis.Ticket
import Vervis.TicketFilter import Vervis.TicketFilter
import Vervis.Time import Vervis.Time
import Vervis.Web.Actor import Vervis.Web.Actor
import Vervis.Widget
import Vervis.Widget.Person import Vervis.Widget.Person
import Vervis.Widget.Ticket import Vervis.Widget.Ticket
import Vervis.Widget.Tracker import Vervis.Widget.Tracker
@ -407,7 +412,8 @@ getDeckCollabsR deckHash = do
collabs <- do collabs <- do
grants <- grants <-
getTopicGrants CollabTopicDeckCollab CollabTopicDeckDeck deckID getTopicGrants CollabTopicDeckCollab CollabTopicDeckDeck deckID
traverse (bitraverse getPersonWidgetInfo pure) grants for grants $ \ (actor, ct, time) ->
(,ct,time) <$> getPersonWidgetInfo actor
invites <- do invites <- do
invites' <- invites' <-
getTopicInvites CollabTopicDeckCollab CollabTopicDeckDeck deckID getTopicInvites CollabTopicDeckCollab CollabTopicDeckDeck deckID
@ -452,7 +458,7 @@ postDeckInviteR deckHash = do
uResource = encodeRouteHome $ DeckR deckHash uResource = encodeRouteHome $ DeckR deckHash
C.invite personID uRecipient uResource C.invite personID uRecipient uResource
grantID <- do grantID <- do
maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID recipPersonID maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID personID
fromMaybeE maybeItem "You need to be a collaborator in the Deck to invite people" fromMaybeE maybeItem "You need to be a collaborator in the Deck to invite people"
grantHash <- encodeKeyHashid grantID grantHash <- encodeKeyHashid grantID
let uCap = encodeRouteHome $ DeckOutboxItemR deckHash grantHash let uCap = encodeRouteHome $ DeckOutboxItemR deckHash grantHash
@ -471,6 +477,54 @@ postDeckInviteR deckHash = do
setMessage "Invite sent" setMessage "Invite sent"
redirect $ DeckCollabsR deckHash redirect $ DeckCollabsR deckHash
postDeckRemoveR :: KeyHashid Deck -> CollabTopicDeckId -> Handler Html
postDeckRemoveR deckHash ctID = do
deckID <- decodeKeyHashid404 deckHash
personEntity@(Entity personID person) <- requireAuth
personHash <- encodeKeyHashid personID
encodeRouteHome <- getEncodeRouteHome
result <- runExceptT $ do
mpidOrU <- lift $ runDB $ runMaybeT $ do
CollabTopicDeck collabID deckID' <- MaybeT $ get ctID
guard $ deckID' == deckID
_ <- MaybeT $ getBy $ UniqueCollabEnable collabID
member <-
Left <$> MaybeT (getValBy $ UniqueCollabRecipLocal collabID) <|>
Right <$> MaybeT (getValBy $ UniqueCollabRecipRemote collabID)
lift $
bitraverse
(pure . collabRecipLocalPerson)
(getRemoteActorURI <=< getJust . collabRecipRemoteActor)
member
pidOrU <- maybe notFound pure mpidOrU
(maybeSummary, audience, remove) <- do
uRecipient <-
case pidOrU of
Left pid -> encodeRouteHome . PersonR <$> encodeKeyHashid pid
Right u -> pure u
let uResource = encodeRouteHome $ DeckR deckHash
C.remove personID uRecipient uResource
grantID <- do
maybeItem <- lift $ runDB $ getGrant CollabTopicDeckCollab CollabTopicDeckDeck deckID personID
fromMaybeE maybeItem "You need to be a collaborator in the Deck to remove people"
grantHash <- encodeKeyHashid grantID
let uCap = encodeRouteHome $ DeckOutboxItemR deckHash grantHash
(localRecips, remoteRecips, fwdHosts, action) <-
C.makeServerInput (Just uCap) maybeSummary audience $ AP.RemoveActivity remove
let cap =
Left (LocalActorDeck deckID, LocalActorDeck deckHash, grantID)
handleViaActor
personID (Just cap) localRecips remoteRecips fwdHosts action
case result of
Left e -> do
setMessage $ toHtml e
Right removeID -> do
setMessage "Remove sent"
redirect $ DeckCollabsR deckHash

View file

@ -97,7 +97,7 @@ getTopicGrants
=> EntityField topic CollabId => EntityField topic CollabId
-> EntityField topic (Key resource) -> EntityField topic (Key resource)
-> Key resource -> Key resource
-> ReaderT SqlBackend m [(Either PersonId RemoteActorId, UTCTime)] -> ReaderT SqlBackend m [(Either PersonId RemoteActorId, Key topic, UTCTime)]
getTopicGrants topicCollabField topicActorField resourceID = getTopicGrants topicCollabField topicActorField resourceID =
fmap (map adapt) $ fmap (map adapt) $
E.select $ E.from $ \ (topic `E.InnerJoin` enable `E.InnerJoin` grant `E.LeftOuterJoin` recipL `E.LeftOuterJoin` recipR) -> do E.select $ E.from $ \ (topic `E.InnerJoin` enable `E.InnerJoin` grant `E.LeftOuterJoin` recipL `E.LeftOuterJoin` recipR) -> do
@ -110,15 +110,17 @@ getTopicGrants topicCollabField topicActorField resourceID =
return return
( recipL E.?. CollabRecipLocalPerson ( recipL E.?. CollabRecipLocalPerson
, recipR E.?. CollabRecipRemoteActor , recipR E.?. CollabRecipRemoteActor
, topic E.^. persistIdField
, grant E.^. OutboxItemPublished , grant E.^. OutboxItemPublished
) )
where where
adapt (E.Value maybePersonID, E.Value maybeRemoteActorID, E.Value time) = adapt (E.Value maybePersonID, E.Value maybeRemoteActorID, E.Value ctID, E.Value time) =
( case (maybePersonID, maybeRemoteActorID) of ( case (maybePersonID, maybeRemoteActorID) of
(Nothing, Nothing) -> error "No recip" (Nothing, Nothing) -> error "No recip"
(Just personID, Nothing) -> Left personID (Just personID, Nothing) -> Left personID
(Nothing, Just remoteActorID) -> Right remoteActorID (Nothing, Just remoteActorID) -> Right remoteActorID
(Just _, Just _) -> error "Multi recip" (Just _, Just _) -> error "Multi recip"
, ctID
, time , time
) )

View file

@ -21,11 +21,12 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<th>Collaborator <th>Collaborator
<th>Role <th>Role
<th>Since <th>Since
$forall (person, since) <- collabs $forall (person, ctID, since) <- collabs
<tr> <tr>
<td>^{personLinkFedW person} <td>^{personLinkFedW person}
<td>Admin <td>Admin
<td>#{showDate since} <td>#{showDate since}
<td>^{buttonW POST "Remove" (DeckRemoveR deckHash ctID)}
<h2>Invites <h2>Invites

View file

@ -220,6 +220,7 @@
/decks/#DeckKeyHashid/collabs DeckCollabsR GET /decks/#DeckKeyHashid/collabs DeckCollabsR GET
/decks/#DeckKeyHashid/invite DeckInviteR GET POST /decks/#DeckKeyHashid/invite DeckInviteR GET POST
/decks/#DeckKeyHashid/remove/#CollabTopicDeckId DeckRemoveR POST
---- Ticket ------------------------------------------------------------------ ---- Ticket ------------------------------------------------------------------