UI: In deck collaborator list, have a Remove button for each
This commit is contained in:
Pere Lev
parent
58518811e3
commit
c8c2106eab
5 changed files with 64 additions and 5 deletions
|
|
@ -931,6 +931,7 @@ instance YesodBreadcrumbs App where
|
|||
DeckCollabsR d -> ("Collaborators", Just $ DeckR d)
|
||||
|
||||
DeckInviteR d -> ("Invite", Just $ DeckR d)
|
||||
DeckRemoveR _ _ -> ("", Nothing)
|
||||
|
||||
TicketR d t -> ("#" <> keyHashidText t, Just $ DeckTicketsR d)
|
||||
TicketDiscussionR d t -> ("Discussion", Just $ TicketR d t)
|
||||
|
|
|
|||
|
|
@ -39,6 +39,7 @@ module Vervis.Handler.Deck
|
|||
, getDeckCollabsR
|
||||
, getDeckInviteR
|
||||
, postDeckInviteR
|
||||
, postDeckRemoveR
|
||||
|
||||
|
||||
|
||||
|
|
@ -59,8 +60,10 @@ module Vervis.Handler.Deck
|
|||
)
|
||||
where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Control.Monad.Trans.Except
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Data.Aeson
|
||||
import Data.Bitraversable
|
||||
import Data.ByteString (ByteString)
|
||||
|
|
@ -71,6 +74,7 @@ import Data.Text (Text)
|
|||
import Data.Time.Clock
|
||||
import Data.Traversable
|
||||
import Database.Persist
|
||||
import Network.HTTP.Types.Method
|
||||
import Text.Blaze.Html (Html)
|
||||
import Yesod.Auth (requireAuth)
|
||||
import Yesod.Core
|
||||
|
|
@ -121,6 +125,7 @@ import Vervis.Ticket
|
|||
import Vervis.TicketFilter
|
||||
import Vervis.Time
|
||||
import Vervis.Web.Actor
|
||||
import Vervis.Widget
|
||||
import Vervis.Widget.Person
|
||||
import Vervis.Widget.Ticket
|
||||
import Vervis.Widget.Tracker
|
||||
|
|
@ -407,7 +412,8 @@ getDeckCollabsR deckHash = do
|
|||
collabs <- do
|
||||
grants <-
|
||||
getTopicGrants CollabTopicDeckCollab CollabTopicDeckDeck deckID
|
||||
traverse (bitraverse getPersonWidgetInfo pure) grants
|
||||
for grants $ \ (actor, ct, time) ->
|
||||
(,ct,time) <$> getPersonWidgetInfo actor
|
||||
invites <- do
|
||||
invites' <-
|
||||
getTopicInvites CollabTopicDeckCollab CollabTopicDeckDeck deckID
|
||||
|
|
@ -452,7 +458,7 @@ postDeckInviteR deckHash = do
|
|||
uResource = encodeRouteHome $ DeckR deckHash
|
||||
C.invite personID uRecipient uResource
|
||||
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"
|
||||
grantHash <- encodeKeyHashid grantID
|
||||
let uCap = encodeRouteHome $ DeckOutboxItemR deckHash grantHash
|
||||
|
|
@ -471,6 +477,54 @@ postDeckInviteR deckHash = do
|
|||
setMessage "Invite sent"
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -97,7 +97,7 @@ getTopicGrants
|
|||
=> EntityField topic CollabId
|
||||
-> EntityField topic (Key resource)
|
||||
-> Key resource
|
||||
-> ReaderT SqlBackend m [(Either PersonId RemoteActorId, UTCTime)]
|
||||
-> ReaderT SqlBackend m [(Either PersonId RemoteActorId, Key topic, UTCTime)]
|
||||
getTopicGrants topicCollabField topicActorField resourceID =
|
||||
fmap (map adapt) $
|
||||
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
|
||||
( recipL E.?. CollabRecipLocalPerson
|
||||
, recipR E.?. CollabRecipRemoteActor
|
||||
, topic E.^. persistIdField
|
||||
, grant E.^. OutboxItemPublished
|
||||
)
|
||||
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
|
||||
(Nothing, Nothing) -> error "No recip"
|
||||
(Just personID, Nothing) -> Left personID
|
||||
(Nothing, Just remoteActorID) -> Right remoteActorID
|
||||
(Just _, Just _) -> error "Multi recip"
|
||||
, ctID
|
||||
, time
|
||||
)
|
||||
|
||||
|
|
|
|||
|
|
@ -21,11 +21,12 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|||
<th>Collaborator
|
||||
<th>Role
|
||||
<th>Since
|
||||
$forall (person, since) <- collabs
|
||||
$forall (person, ctID, since) <- collabs
|
||||
<tr>
|
||||
<td>^{personLinkFedW person}
|
||||
<td>Admin
|
||||
<td>#{showDate since}
|
||||
<td>^{buttonW POST "Remove" (DeckRemoveR deckHash ctID)}
|
||||
|
||||
<h2>Invites
|
||||
|
||||
|
|
|
|||
|
|
@ -220,6 +220,7 @@
|
|||
|
||||
/decks/#DeckKeyHashid/collabs DeckCollabsR GET
|
||||
/decks/#DeckKeyHashid/invite DeckInviteR GET POST
|
||||
/decks/#DeckKeyHashid/remove/#CollabTopicDeckId DeckRemoveR POST
|
||||
|
||||
---- Ticket ------------------------------------------------------------------
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue