S2S: Update Project-Accept handler to handle Components

src/Vervis/API.hs

@@ -1195,7 +1195,7 @@ createPatchTrackerC (Entity pidUser personUser) senderActor maybeCap localRecips
             , actionFulfills =
                 [encodeRouteHome $ PersonOutboxItemR adminHash obikhidCreate]
             , actionSpecific = GrantActivity Grant
-                { grantObject   = RoleAdmin
+                { grantObject   = AP.RXRole RoleAdmin
                 , grantContext  = encodeRouteLocal $ LoomR loomHash
                 , grantTarget   = encodeRouteHome $ PersonR adminHash
                 , grantResult  = Nothing
@@ -1431,7 +1431,7 @@ createRepositoryC (Entity pidUser personUser) senderActor maybeCap localRecips r
             , actionFulfills   =
                 [encodeRouteHome $ PersonOutboxItemR adminHash obikhidCreate]
             , actionSpecific   = GrantActivity Grant
-                { grantObject    = RoleAdmin
+                { grantObject    = AP.RXRole RoleAdmin
                 , grantContext   = encodeRouteLocal $ RepoR repoHash
                 , grantTarget    = encodeRouteHome $ PersonR adminHash
                 , grantResult    = Nothing

src/Vervis/Actor/Common.hs

@@ -413,7 +413,7 @@ topicAccept topicActor topicResource now recipKey (Verse authorIdMsig body) acce
                 , AP.actionAudience   = AP.Audience recips [] [] [] [] []
                 , AP.actionFulfills   = [AP.acceptObject accept]
                 , AP.actionSpecific   = AP.GrantActivity AP.Grant
-                    { AP.grantObject    = role
+                    { AP.grantObject    = AP.RXRole role
                     , AP.grantContext   =
                         encodeRouteLocal $ renderLocalActor topicByHash
                     , AP.grantTarget    =
@@ -1294,7 +1294,7 @@ topicCreateMe topicActor topicResource collabTopicFieldTopic collabTopicCtor now
                 , AP.actionAudience   = AP.Audience recips [] [] [] [] []
                 , AP.actionFulfills   = [uCreate]
                 , AP.actionSpecific   = AP.GrantActivity AP.Grant
-                    { AP.grantObject    = AP.RoleAdmin
+                    { AP.grantObject    = AP.RXRole AP.RoleAdmin
                     , AP.grantContext   =
                         encodeRouteLocal $ renderLocalActor topicByHash
                     , AP.grantTarget    = uCreator

src/Vervis/Actor/Project.hs

@@ -28,6 +28,7 @@ import Control.Monad.Trans.Except
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.Reader
 import Data.Barbie
+import Data.Bifoldable
 import Data.Bifunctor
 import Data.Bitraversable
 import Data.ByteString (ByteString)
@@ -91,7 +92,7 @@ import Vervis.Ticket
 --                 * Verify I haven't seen a component-Accept on this Add
 --             * Otherwise, i.e. sender isn't the component:
 --                 * Verify I've seen the component-Accept for this Add
---                 * Verify the Accept is authorized
+--                 * Verify the new Accept is authorized
 --         * If it's none of these, respond with error
 --
 --     * In collab mode, verify the Collab isn't enabled yet
@@ -123,14 +124,14 @@ import Vervis.Ticket
 --             * CC: Accept sender, Join sender's followers, my followers
 --         * For Invite-component mode:
 --             * Only if sender is the component
---             * delegator-Grant with a result URI
+--             * delegator-Grant
 --             * To: Component
 --             * CC:
 --                 - Component's followers
 --                 - My followers
 --         * For Add-component mode:
 --             * Only if sender isn't the component
---             * delegator-Grant with a result URI
+--             * delegator-Grant
 --             * To: Component
 --             * CC:
 --                 - Component's followers
@@ -169,17 +170,24 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
             fromMaybeE a "Can't find acceptee in DB"
 
         -- See if the accepted activity is an Invite or Join where my collabs
-        -- URI is the resource, grabbing the Collab record from our DB
+        -- URI is the resource, grabbing the Collab record from our DB,
-        (collabID, fulfills, inviterOrJoiner) <- do
+        -- Or if the accepted activity is an Invite or Add where my components
+        -- URI is the resource, grabbing the Component record from our DB
+        collabOrComp <- do
             let adapt = maybe (Right Nothing) (either Left (Right . Just))
             maybeCollab <-
                 ExceptT $ fmap adapt $ runMaybeT $
-                    runExceptT (tryInviteCollab accepteeDB) <|>
+                    runExceptT (Left <$> tryInviteCollab accepteeDB) <|>
-                    runExceptT (tryJoinCollab accepteeDB)
+                    runExceptT (Left <$> tryJoinCollab accepteeDB) <|>
-            fromMaybeE maybeCollab "Accepted activity isn't an Invite or Join I'm aware of"
+                    runExceptT (Right <$> tryInviteComp accepteeDB) <|>
+                    runExceptT (Right <$> tryAddComp accepteeDB)
+            fromMaybeE
+                maybeCollab
+                "Accepted activity isn't an Invite/Join/Add I'm aware of"
 
-        idsForAccept <-
+        idsForAccept <- bitraverse
-            bitraverse
+
+            (\ (collabID, fulfills, inviterOrJoiner) -> (collabID,inviterOrJoiner,) <$> bitraverse
 
                 -- If accepting an Invite, find the Collab recipient and verify
                 -- it's the sender of the Accept
@@ -217,16 +225,74 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
                 )
 
                 fulfills
+            )
 
-        -- Verify the Collab isn't already validated
+            (\ (componentID, ident, inviteOrAdd) -> (componentID, ident,) <$> bitraverse
+
+                -- If accepting an Invite-component, there's nothing to check
+                -- at this point
+                pure
+
+                -- If accepting an Add-component:
+                --     * If the sender is the component, verify I haven't seen
+                --       a component-Accept on this Add
+                --     * Otherwise, verify I've seen the component-Accept for
+                --       this Add and that the new Accept is authorized
+                (\ () -> do
+                    maybeComponentAccept <-
+                        lift $
+                        case bimap fst fst ident of
+                            Left localID -> (() <$) <$> getBy (UniqueComponentAcceptLocal localID)
+                            Right remoteID -> (() <$) <$> getBy (UniqueComponentAcceptRemote remoteID)
+                    if componentIsAuthor ident
+                        then
+                            verifyNothingE
+                                maybeComponentAccept
+                                    "I've already seen a ComponentAccept* on \
+                                    \that Add"
+                        else do
+                            fromMaybeE
+                                maybeComponentAccept
+                                "I haven't yet seen the Component's Accept on \
+                                \the Add"
+                            capID <- fromMaybeE maybeCap "No capability provided"
+                            capability <-
+                                case capID of
+                                    Left (capActor, _, capItem) -> return (capActor, capItem)
+                                    Right _ -> throwE "Capability is a remote URI, i.e. not authored by me"
+                            verifyCapability'
+                                capability
+                                authorIdMsig
+                                (GrantResourceProject projectID)
+                                AP.RoleAdmin
+                )
+
+                inviteOrAdd
+            )
+
+            collabOrComp
+
+        -- In collab mode, verify the Collab isn't already validated
+        -- In component mode, verify the Component isn't already validated
+        bitraverse_
+            (\ (collabID, _, _) -> do
                 maybeEnabled <- lift $ getBy $ UniqueCollabEnable collabID
                 verifyNothingE maybeEnabled "I already sent a Grant for this Invite/Join"
+            )
+            (\ (componentID, _, _) -> do
+                maybeEnabled <- lift $ getBy $ UniqueComponentEnable componentID
+                verifyNothingE maybeEnabled "I already sent a delegator-Grant for this Invite/Add"
+            )
+            collabOrComp
 
         maybeAcceptDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
         for maybeAcceptDB $ \ acceptDB -> do
 
-            -- Record the Accept on the Collab
+            idsForGrant <- case idsForAccept of
-            case (idsForAccept, acceptDB) of
+
+                -- In collab mode, record the Accept and enable the Collab
+                Left (collabID, inviterOrJoiner, collab) -> Left <$> do
+                    case (collab, acceptDB) of
                         (Left (fulfillsID, Left recipID), Left (_, _, acceptID)) -> do
                             maybeAccept <- lift $ insertUnique $ CollabRecipLocalAccept recipID fulfillsID acceptID
                             unless (isNothing maybeAccept) $
@@ -243,39 +309,92 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
                             maybeAccept <- lift $ insertUnique $ CollabApproverRemote fulfillsID (remoteAuthorId author) acceptID
                             unless (isJust maybeAccept) $
                                 throwE "This Join already has an Accept"
-                _ -> error "topicAccept impossible"
+                        _ -> error "projectAccept impossible"
+                    grantID <- lift $ insertEmptyOutboxItem' (actorOutbox recipActor) now
+                    lift $ insert_ $ CollabEnable collabID grantID
+                    return (collabID, inviterOrJoiner, collab, grantID)
+
+                -- In Invite-component mode, only if the Accept author is the
+                -- component, record the Accept and enable the Component
+                Right (componentID, ident, Left ()) -> fmap Right $
+                    lift $ if componentIsAuthor ident
+                        then Just <$> do
+                            case (ident, acceptDB) of
+                                (Left (localID, _), Left (_, _, acceptID)) ->
+                                    insert_ $ ComponentAcceptLocal localID acceptID
+                                (Right (remoteID, _), Right (_, _, acceptID)) ->
+                                    insert_ $ ComponentAcceptRemote remoteID acceptID
+                                _ -> error "personAccept impossible ii"
+                            grantID <- insertEmptyOutboxItem' (actorOutbox recipActor) now
+                            enableID <- insert $ ComponentEnable componentID grantID
+                            return (componentID, ident, grantID, enableID, False)
+                        else pure Nothing
+
+                -- In Add-component mode:
+                -- * If the sender is the component, record the Accept
+                -- * Otherwise, record the Accept and enable the Component
+                Right (componentID, ident, Right ()) -> fmap Right $
+                    lift $ if componentIsAuthor ident
+                        then do
+                            case (ident, acceptDB) of
+                                (Left (localID, _), Left (_, _, acceptID)) ->
+                                    insert_ $ ComponentAcceptLocal localID acceptID
+                                (Right (remoteID, _), Right (_, _, acceptID)) ->
+                                    insert_ $ ComponentAcceptRemote remoteID acceptID
+                                _ -> error "personAccept impossible iii"
+                            return Nothing
+                        else Just <$> do
+                            case acceptDB of
+                                Left (_, _, acceptID) ->
+                                    insert_ $ ComponentProjectGestureLocal componentID acceptID
+                                Right (author, _, acceptID) ->
+                                    insert_ $ ComponentProjectGestureRemote componentID (remoteAuthorId author) acceptID
+                            grantID <- insertEmptyOutboxItem' (actorOutbox recipActor) now
+                            enableID <- insert $ ComponentEnable componentID grantID
+                            return (componentID, ident, grantID, enableID, True)
 
             -- Prepare forwarding of Accept to my followers
             let recipByID = grantResourceLocalActor $ GrantResourceProject projectID
             recipByHash <- hashLocalActor recipByID
             let sieve = makeRecipientSet [] [localActorFollowers recipByHash]
 
-            grantInfo <- do
+            maybeGrant <-
+                case idsForGrant of
 
-                -- Enable the Collab in our DB
+                    -- In collab mode, prepare a regular Grant
-                grantID <- lift $ insertEmptyOutboxItem' (actorOutbox recipActor) now
+                    Left (collabID, inviterOrJoiner, collab, grantID) -> lift $ do
-                lift $ insert_ $ CollabEnable collabID grantID
+                        let isInvite = isLeft collab
-
-                -- Prepare a Grant activity and insert to my outbox
-                let isInvite = isLeft fulfills
                         grant@(actionGrant, _, _, _) <- do
-                    Collab role <- lift $ getJust collabID
+                            Collab role <- getJust collabID
-                    lift $ prepareGrant isInvite inviterOrJoiner role
+                            prepareCollabGrant isInvite inviterOrJoiner role
-                let recipByKey = grantResourceLocalActor $ GrantResourceProject projectID
+                        let recipByKey = LocalActorProject projectID
-                _luGrant <- lift $ updateOutboxItem' recipByKey grantID actionGrant
+                        _luGrant <- updateOutboxItem' recipByKey grantID actionGrant
+                        return $ Just (grantID, grant)
+
+                    -- In Invite-component mode, only if the Accept author is
+                    -- the component, prepare a delegator-Grant
+                    --
+                    -- In Add-component mode, only if the Accept author isn't
+                    -- the component, prepare a delegator-Grant
+                    Right comp -> for comp $ \ (_componentID, ident, grantID, enableID, includeAuthor) -> lift $ do
+                        grant@(actionGrant, _, _, _) <-
+                            prepareDelegGrant (bimap snd snd ident) enableID includeAuthor
+                        let recipByKey = LocalActorProject projectID
+                        _luGrant <- updateOutboxItem' recipByKey grantID actionGrant
                         return (grantID, grant)
 
-            return (recipActorID, sieve, grantInfo)
+            return (recipActorID, sieve, maybeGrant)
 
     case maybeNew of
         Nothing -> done "I already have this activity in my inbox"
-        Just (recipActorID, sieve, (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant))) -> do
+        Just (recipActorID, sieve, maybeGrant) -> do
-            let recipByID = grantResourceLocalActor $ GrantResourceProject projectID
+            let recipByID = LocalActorProject projectID
             forwardActivity authorIdMsig body recipByID recipActorID sieve
-            lift $ sendActivity
+            lift $ for_ maybeGrant $ \ (grantID, (actionGrant, localRecipsGrant, remoteRecipsGrant, fwdHostsGrant)) ->
+                sendActivity
                     recipByID recipActorID localRecipsGrant
                     remoteRecipsGrant fwdHostsGrant grantID actionGrant
-            done "Forwarded the Accept and published a Grant"
+            done "Forwarded the Accept and maybe published a Grant"
 
     where
 
@@ -331,16 +450,50 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
             (,remoteActorFollowers actor) <$> getRemoteActorURI actor
         return (collabID, Right fulfillsID, Right joiner)
 
-    {-
+    verifyCompTopic :: ComponentId -> ActDBE ()
-    tryInviteComp (Left (actorByKey, _actorEntity, itemID)) = do
+    verifyCompTopic componentID = do
-        ComponentOriginInvite
+        Component j _ <- lift $ getJust componentID
-        ComponentProjectGestureLocal
+        unless (j == projectID) $
-    tryInviteCollab (Right remoteActivityID) = do
+            throwE "Accept object is an Invite/Add for some other project"
-        ComponentOriginInvite
-        ComponentProjectGestureRemote
-    -}
 
-    prepareGrant isInvite sender role = do
+    tryInviteComp (Left (actorByKey, _actorEntity, itemID)) = do
+        ComponentProjectGestureLocal componentID _ <-
+            lift $ MaybeT $ getValBy $
+                UniqueComponentProjectGestureLocalActivity itemID
+        _ <- lift $ MaybeT $ getBy $ UniqueComponentOriginInvite componentID
+        ExceptT $ lift $ runExceptT $ verifyCompTopic componentID
+        ident <- lift $ lift $ getComponentIdent componentID
+        return (componentID, ident, Left ())
+    tryInviteComp (Right remoteActivityID) = do
+        ComponentProjectGestureRemote componentID _ _ <-
+            lift $ MaybeT $ getValBy $
+                UniqueComponentProjectGestureRemoteActivity remoteActivityID
+        _ <- lift $ MaybeT $ getBy $ UniqueComponentOriginInvite componentID
+        ExceptT $ lift $ runExceptT $ verifyCompTopic componentID
+        ident <- lift $ lift $ getComponentIdent componentID
+        return (componentID, ident, Left ())
+
+    tryAddComp (Left (actorByKey, _actorEntity, itemID)) = do
+        ComponentGestureLocal originID _ <-
+            lift $ MaybeT $ getValBy $ UniqueComponentGestureLocalAdd itemID
+        ComponentOriginAdd componentID <- lift $ lift $ getJust originID
+        ExceptT $ lift $ runExceptT $ verifyCompTopic componentID
+        ident <- lift $ lift $ getComponentIdent componentID
+        return (componentID, ident, Right ())
+    tryAddComp (Right remoteActivityID) = do
+        ComponentGestureRemote originID _ _ <-
+            lift $ MaybeT $ getValBy $
+                UniqueComponentGestureRemoteAdd remoteActivityID
+        ComponentOriginAdd componentID <- lift $ lift $ getJust originID
+        ExceptT $ lift $ runExceptT $ verifyCompTopic componentID
+        ident <- lift $ lift $ getComponentIdent componentID
+        return (componentID, ident, Right ())
+
+    componentIsAuthor ident =
+        let author = bimap (view _1) (remoteAuthorId . view _1) authorIdMsig
+        in  author == bimap (componentActor . snd) snd ident
+
+    prepareCollabGrant isInvite sender role = do
         encodeRouteHome <- getEncodeRouteHome
         encodeRouteLocal <- getEncodeRouteLocal
 
@@ -382,7 +535,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
                 , AP.actionAudience   = AP.Audience recips [] [] [] [] []
                 , AP.actionFulfills   = [AP.acceptObject accept]
                 , AP.actionSpecific   = AP.GrantActivity AP.Grant
-                    { AP.grantObject    = role
+                    { AP.grantObject    = AP.RXRole role
                     , AP.grantContext   =
                         encodeRouteLocal $ renderLocalActor topicByHash
                     , AP.grantTarget    =
@@ -402,6 +555,57 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
 
         return (action, recipientSet, remoteActors, fwdHosts)
 
+    prepareDelegGrant ident _enableID includeAuthor = do
+        encodeRouteHome <- getEncodeRouteHome
+        encodeRouteLocal <- getEncodeRouteLocal
+
+        (uComponent, audComponent) <-
+            case ident of
+                Left c -> do
+                    a <- componentActor <$> hashComponent c
+                    return
+                        ( encodeRouteHome $ renderLocalActor a
+                        , AudLocal [a] [localActorFollowers a]
+                        )
+                Right raID -> do
+                    ra <- getJust raID
+                    u@(ObjURI h lu) <- getRemoteActorURI ra
+                    return
+                        ( u
+                        , AudRemote h [lu] (maybeToList $ remoteActorFollowers ra)
+                        )
+        audAuthor <- lift $ makeAudSenderOnly authorIdMsig
+        projectHash <- encodeKeyHashid projectID
+        let audProject = AudLocal [] [LocalStageProjectFollowers projectHash]
+
+            audience =
+                if includeAuthor
+                    then [audComponent, audProject, audAuthor]
+                    else [audComponent, audProject]
+
+            (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
+                collectAudience audience
+
+            recips = map encodeRouteHome audLocal ++ audRemote
+            action = AP.Action
+                { AP.actionCapability = Nothing
+                , AP.actionSummary    = Nothing
+                , AP.actionAudience   = AP.Audience recips [] [] [] [] []
+                , AP.actionFulfills   = [AP.acceptObject accept]
+                , AP.actionSpecific   = AP.GrantActivity AP.Grant
+                    { AP.grantObject    = AP.RXDelegator
+                    , AP.grantContext   = encodeRouteLocal $ ProjectR projectHash
+                    , AP.grantTarget    = uComponent
+                    , AP.grantResult    = Nothing
+                    , AP.grantStart     = Just now
+                    , AP.grantEnd       = Nothing
+                    , AP.grantAllows    = AP.Invoke
+                    , AP.grantDelegates = Nothing
+                    }
+                }
+
+        return (action, recipientSet, remoteActors, fwdHosts)
+
 checkExistingComponents
     :: ProjectId -> Either (ComponentBy Entity) RemoteActorId -> ActDBE ()
 checkExistingComponents projectID componentDB = do

src/Vervis/Data/Collab.hs

@@ -253,7 +253,7 @@ parseGrant
     :: Host
     -> AP.Grant URIMode
     -> ActE
-        ( AP.Role
+        ( AP.RoleExt
         , Either (GrantResourceBy Key) LocalURI
         , Either (GrantRecipBy Key) FedURI
         , Maybe (LocalURI, Maybe Int)

src/Vervis/Persist/Collab.hs

@@ -26,6 +26,8 @@ module Vervis.Persist.Collab
     , verifyCapability'
 
     , getGrant
+
+    , getComponentIdent
     )
 where
 
@@ -356,3 +358,38 @@ getGrant topicCollabField topicActorField resourceID personID = do
         [] -> return Nothing
         [E.Value i] -> return $ Just i
         _ -> error $ "Multiple grants for a Person in resource#" ++ show resourceID
+
+getComponentIdent
+    :: MonadIO m
+    => ComponentId
+    -> ReaderT SqlBackend m
+        (Either
+            (ComponentLocalId, ComponentBy Key)
+            (ComponentRemoteId, RemoteActorId)
+        )
+getComponentIdent componentID = do
+    ident <-
+        requireEitherAlt
+            (getKeyBy $ UniqueComponentLocal componentID)
+            (getBy $ UniqueComponentRemote componentID)
+            "Found Component without ident"
+            "Found Component with both local and remote ident"
+    bitraverse
+        (\ localID -> do
+            maybeRepo <- getValBy $ UniqueComponentLocalRepo localID
+            maybeDeck <- getValBy $ UniqueComponentLocalDeck localID
+            maybeLoom <- getValBy $ UniqueComponentLocalLoom localID
+            fmap (localID,) $ return $
+                case (maybeRepo, maybeDeck, maybeLoom) of
+                    (Nothing, Nothing, Nothing) ->
+                        error "Found ComponentLocal without ident"
+                    (Just r, Nothing, Nothing) ->
+                        ComponentRepo $ componentLocalRepoRepo r
+                    (Nothing, Just d, Nothing) ->
+                        ComponentDeck $ componentLocalDeckDeck d
+                    (Nothing, Nothing, Just l) ->
+                        ComponentLoom $ componentLocalLoomLoom l
+                    _ -> error "Found ComponentLocal with multiple idents"
+        )
+        (\ (Entity k v) -> pure (k, componentRemoteActor v))
+        ident

src/Web/ActivityPub.hs

@@ -67,6 +67,7 @@ module Web.ActivityPub
     , Commit (..)
     , Branch (..)
     , Role (..)
+    , RoleExt (..)
     , Duration (..)
     , Usage (..)
 
@@ -1623,16 +1624,16 @@ data Role
     = RoleVisit | RoleReport | RoleTriage | RoleWrite | RoleMaintain | RoleAdmin
     deriving (Show, Read, Eq, Ord, Enum, Bounded)
 
+parseRole "visit"    = pure RoleVisit
+parseRole "report"   = pure RoleReport
+parseRole "triage"   = pure RoleTriage
+parseRole "write"    = pure RoleWrite
+parseRole "maintain" = pure RoleMaintain
+parseRole "admin"    = pure RoleAdmin
+parseRole t = fail $ "Unknown role: " ++ T.unpack t
+
 instance FromJSON Role where
-    parseJSON = withText "Role" parse
+    parseJSON = withText "Role" parseRole
-        where
-        parse "visit"    = pure RoleVisit
-        parse "report"   = pure RoleReport
-        parse "triage"   = pure RoleTriage
-        parse "write"    = pure RoleWrite
-        parse "maintain" = pure RoleMaintain
-        parse "admin"    = pure RoleAdmin
-        parse t = fail $ "Unknown role: " ++ T.unpack t
 
 instance ToJSON Role where
     toJSON = error "toJSON Role"
@@ -1645,6 +1646,21 @@ instance ToJSON Role where
             RoleMaintain -> "maintain"
             RoleAdmin    -> "admin"
 
+data RoleExt = RXRole Role | RXDelegator deriving (Show, Read, Eq)
+
+instance FromJSON RoleExt where
+    parseJSON = withText "RoleExt" parse
+        where
+        parse "delegator" = pure RXDelegator
+        parse t           = RXRole <$> parseRole t
+
+instance ToJSON RoleExt where
+    toJSON = error "toJSON RoleExt"
+    toEncoding r =
+        case r of
+            RXRole role -> toEncoding role
+            RXDelegator -> toEncoding ("delegator" :: Text)
+
 data Duration = Duration Int
 
 instance FromJSON Duration where
@@ -1851,7 +1867,7 @@ encodeFollow (Follow obj mcontext hide)
     <> "hide"    .=  hide
 
 data Grant u = Grant
-    { grantObject   :: Role
+    { grantObject   :: RoleExt
     , grantContext  :: LocalURI
     , grantTarget   :: ObjURI u
     , grantResult   :: Maybe (LocalURI, Maybe Duration)