UI: Add 'Accept' button to invites you haven't yet accepted
This commit is contained in:
Pere Lev
parent
ce1e542401
commit
ee91a6403e
5 changed files with 108 additions and 7 deletions
|
|
@ -295,7 +295,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
|
|||
case (collab, acceptDB) of
|
||||
(Left (fulfillsID, Left recipID), Left (_, _, acceptID)) -> do
|
||||
maybeAccept <- lift $ insertUnique $ CollabRecipLocalAccept recipID fulfillsID acceptID
|
||||
unless (isNothing maybeAccept) $
|
||||
unless (isJust maybeAccept) $
|
||||
throwE "This Invite already has an Accept by recip"
|
||||
(Left (fulfillsID, Right recipID), Right (_, _, acceptID)) -> do
|
||||
maybeAccept <- lift $ insertUnique $ CollabRecipRemoteAccept recipID fulfillsID acceptID
|
||||
|
|
|
|||
|
|
@ -43,6 +43,7 @@ module Vervis.Client
|
|||
, remove
|
||||
, inviteComponent
|
||||
, acceptProjectInvite
|
||||
, acceptPersonalInvite
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -1410,3 +1411,44 @@ acceptProjectInvite personID component project uInvite = do
|
|||
audience = [audComp, audProject, audAuthor]
|
||||
|
||||
return (Nothing, audience, activity)
|
||||
|
||||
acceptPersonalInvite
|
||||
:: PersonId
|
||||
-> Either (LocalActorBy Key) RemoteActorId
|
||||
-> FedURI
|
||||
-> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Accept URIMode)
|
||||
acceptPersonalInvite personID resource uInvite = do
|
||||
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
resource' <- bitraverse VR.hashLocalActor pure resource
|
||||
|
||||
let activity = AP.Accept uInvite Nothing
|
||||
|
||||
-- If resource is remote, get it from DB to determine its followers
|
||||
-- collection
|
||||
resourceDB <-
|
||||
bitraverse
|
||||
pure
|
||||
(\ remoteActorID -> lift $ runDB $ do
|
||||
ra <- getJust remoteActorID
|
||||
u <- getRemoteActorURI ra
|
||||
return (ra, u)
|
||||
)
|
||||
resource'
|
||||
|
||||
senderHash <- encodeKeyHashid personID
|
||||
|
||||
let audResource =
|
||||
case resourceDB of
|
||||
Left la ->
|
||||
AudLocal [la] [localActorFollowers la]
|
||||
Right (remoteActor, ObjURI h lu) ->
|
||||
AudRemote h
|
||||
[lu]
|
||||
(maybeToList $ remoteActorFollowers remoteActor)
|
||||
audAuthor =
|
||||
AudLocal [] [LocalStagePersonFollowers senderHash]
|
||||
|
||||
audience = [audResource, audAuthor]
|
||||
|
||||
return (Nothing, audience, activity)
|
||||
|
|
|
|||
|
|
@ -160,6 +160,7 @@ type SigKeyKeyHashid = KeyHashid SigKey
|
|||
type ProjectKeyHashid = KeyHashid Project
|
||||
type CollabEnableKeyHashid = KeyHashid CollabEnable
|
||||
type StemKeyHashid = KeyHashid Stem
|
||||
type PermitFulfillsInviteKeyHashid = KeyHashid PermitFulfillsInvite
|
||||
|
||||
-- This is where we define all of the routes in our application. For a full
|
||||
-- explanation of the syntax, please see:
|
||||
|
|
@ -856,6 +857,8 @@ instance YesodBreadcrumbs App where
|
|||
PublishRemoveR -> ("Remove someone from a resource", Just HomeR)
|
||||
PublishResolveR -> ("Close a ticket", Just HomeR)
|
||||
|
||||
AcceptInviteR _ -> ("", Nothing)
|
||||
|
||||
PersonR p -> ("Person ~" <> keyHashidText p, Just HomeR)
|
||||
PersonInboxR p -> ("Inbox", Just $ PersonR p)
|
||||
PersonOutboxR p -> ("Outbox", Just $ PersonR p)
|
||||
|
|
|
|||
|
|
@ -44,6 +44,8 @@ module Vervis.Handler.Client
|
|||
|
||||
, getPublishResolveR
|
||||
, postPublishResolveR
|
||||
|
||||
, postAcceptInviteR
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -59,6 +61,7 @@ import Data.Text (Text)
|
|||
import Data.Time.Clock
|
||||
import Data.Traversable
|
||||
import Database.Persist
|
||||
import Network.HTTP.Types.Method
|
||||
import Text.Blaze.Html (preEscapedToHtml)
|
||||
import Optics.Core
|
||||
import Yesod.Auth
|
||||
|
|
@ -107,8 +110,10 @@ import Vervis.Persist.Collab
|
|||
import Vervis.Recipient
|
||||
import Vervis.Settings
|
||||
import Vervis.Web.Actor
|
||||
import Vervis.Widget
|
||||
import Vervis.Widget.Tracker
|
||||
|
||||
import qualified Vervis.Client as C
|
||||
import qualified Vervis.Recipient as VR
|
||||
|
||||
-- | Account verification email resend form
|
||||
|
|
@ -236,11 +241,13 @@ getHomeR = do
|
|||
Nothing -> error "Impossible, we should have found the local actor in DB"
|
||||
Just a -> pure $ localActorID a
|
||||
actor <- getJust actorID
|
||||
fulfillsHash <- encodeKeyHashid fulfillsID
|
||||
return
|
||||
( fulfillsID
|
||||
, role
|
||||
, () <$ valid
|
||||
, accept
|
||||
, fulfillsHash
|
||||
, Left (topic, actor)
|
||||
)
|
||||
remotes <- do
|
||||
|
|
@ -265,11 +272,13 @@ getHomeR = do
|
|||
remoteActor <- getJust remoteActorID
|
||||
remoteObject <- getJust $ remoteActorIdent remoteActor
|
||||
inztance <- getJust $ remoteObjectInstance remoteObject
|
||||
fulfillsHash <- encodeKeyHashid fulfillsID
|
||||
return
|
||||
( fulfillsID
|
||||
, role
|
||||
, () <$ valid
|
||||
, accept
|
||||
, fulfillsHash
|
||||
, Right (inztance, remoteObject, remoteActor)
|
||||
)
|
||||
return $ sortOn (view _1) $ locals ++ remotes
|
||||
|
|
@ -299,7 +308,7 @@ getHomeR = do
|
|||
x = deleteFirstsBy ((==) `on` key) xs (p ++ r ++ d ++ l ++ j ++ g)
|
||||
in (p, r, d, l, j, g, x)
|
||||
|
||||
item (_permitID, role, deleg, _typ, actor, exts) =
|
||||
item (_gestureID, role, deleg, _typ, actor, exts) =
|
||||
[whamlet|
|
||||
<span>
|
||||
[
|
||||
|
|
@ -317,7 +326,7 @@ getHomeR = do
|
|||
#{renderObjURI u}
|
||||
|]
|
||||
|
||||
invite (_fulfillsID, role, valid, accept, actor) =
|
||||
invite (_fulfillsID, role, valid, accept, fulfillsHash, actor) =
|
||||
[whamlet|
|
||||
<span>
|
||||
[
|
||||
|
|
@ -330,7 +339,8 @@ getHomeR = do
|
|||
$maybe _ <- accept
|
||||
\ [You've accepted] #
|
||||
$nothing
|
||||
\ [Accept Button] [Reject Button] #
|
||||
^{buttonW POST "Accept" (AcceptInviteR fulfillsHash)}
|
||||
$#\ [Reject Button] #
|
||||
^{actorLinkFedW actor}
|
||||
|]
|
||||
|
||||
|
|
@ -1397,9 +1407,6 @@ getPublishInviteR = do
|
|||
|
||||
postPublishInviteR :: Handler ()
|
||||
postPublishInviteR = do
|
||||
federation <- getsYesod $ appFederation . appSettings
|
||||
unless federation badMethod
|
||||
|
||||
(uRecipient, uResourceCollabs, role, (uCap, cap)) <-
|
||||
runFormPostRedirect PublishInviteR inviteForm
|
||||
|
||||
|
|
@ -1499,3 +1506,50 @@ postPublishResolveR = do
|
|||
Right _ -> do
|
||||
setMessage "Resolve activity sent"
|
||||
redirect HomeR
|
||||
|
||||
postAcceptInviteR :: KeyHashid PermitFulfillsInvite -> Handler ()
|
||||
postAcceptInviteR fulfillsHash = do
|
||||
fulfillsID <- decodeKeyHashid404 fulfillsHash
|
||||
|
||||
personEntity@(Entity personID person) <- requireAuth
|
||||
personHash <- encodeKeyHashid personID
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
|
||||
result <- runExceptT $ do
|
||||
(uInvite, topic) <- lift $ runDB $ do
|
||||
PermitFulfillsInvite permitID <- get404 fulfillsID
|
||||
Permit p _ <- getJust permitID
|
||||
unless (p == personID) notFound
|
||||
uInvite <- do
|
||||
i <-
|
||||
requireEitherAlt
|
||||
(getValBy $ UniquePermitTopicGestureLocal fulfillsID)
|
||||
(getValBy $ UniquePermitTopicGestureRemote fulfillsID)
|
||||
"Invite not found"
|
||||
"Multiple invites"
|
||||
case i of
|
||||
Left (PermitTopicGestureLocal _ inviteID) -> do
|
||||
outboxID <- outboxItemOutbox <$> getJust inviteID
|
||||
actorID <- getKeyByJust $ UniqueActorOutbox outboxID
|
||||
actor <- getLocalActor actorID
|
||||
actorHash <- VR.hashLocalActor actor
|
||||
inviteHash <- encodeKeyHashid inviteID
|
||||
return $ encodeRouteHome $
|
||||
activityRoute actorHash inviteHash
|
||||
Right (PermitTopicGestureRemote _ _ inviteID) -> do
|
||||
invite <- getJust inviteID
|
||||
getRemoteActivityURI invite
|
||||
topic <- bimap snd snd <$> getPermitTopic permitID
|
||||
return (uInvite, topic)
|
||||
(maybeSummary, audience, accept) <-
|
||||
C.acceptPersonalInvite personID topic uInvite
|
||||
(localRecips, remoteRecips, fwdHosts, action) <-
|
||||
C.makeServerInput Nothing maybeSummary audience $
|
||||
AP.AcceptActivity accept
|
||||
handleViaActor
|
||||
personID Nothing localRecips remoteRecips fwdHosts action
|
||||
|
||||
case result of
|
||||
Left e -> setMessage $ toHtml e
|
||||
Right _acceptID -> setMessage "Accept sent"
|
||||
redirect HomeR
|
||||
|
|
|
|||
|
|
@ -136,6 +136,8 @@
|
|||
/publish/remove PublishRemoveR GET POST
|
||||
/publish/resolve PublishResolveR GET POST
|
||||
|
||||
/accept-invite/#PermitFulfillsInviteKeyHashid AcceptInviteR POST
|
||||
|
||||
---- Person ------------------------------------------------------------------
|
||||
|
||||
/people/#PersonKeyHashid PersonR GET
|
||||
|
|
|
|||
Loading…
Reference in a new issue