S2S: Project Grant handler
This commit is contained in:
Pere Lev
parent
a083b0d866
commit
06e5ab9e90
5 changed files with 366 additions and 11 deletions
|
|
@ -397,7 +397,7 @@ acceptC (Entity senderPersonID senderPerson) senderActor maybeCap localRecips re
|
|||
, actionFulfills = [AP.acceptObject accept]
|
||||
, actionSpecific = GrantActivity Grant
|
||||
{ grantObject = RoleAdmin
|
||||
, grantContext = encodeRouteLocal $ renderLocalActor topicHash
|
||||
, grantContext = encodeRouteHome $ renderLocalActor topicHash
|
||||
, grantTarget = encodeRouteHome $ PersonR recipHash
|
||||
, grantResult = Nothing
|
||||
, grantStart = Nothing
|
||||
|
|
@ -1196,7 +1196,7 @@ createPatchTrackerC (Entity pidUser personUser) senderActor maybeCap localRecips
|
|||
[encodeRouteHome $ PersonOutboxItemR adminHash obikhidCreate]
|
||||
, actionSpecific = GrantActivity Grant
|
||||
{ grantObject = AP.RXRole RoleAdmin
|
||||
, grantContext = encodeRouteLocal $ LoomR loomHash
|
||||
, grantContext = encodeRouteHome $ LoomR loomHash
|
||||
, grantTarget = encodeRouteHome $ PersonR adminHash
|
||||
, grantResult = Nothing
|
||||
, grantStart = Nothing
|
||||
|
|
@ -1432,7 +1432,7 @@ createRepositoryC (Entity pidUser personUser) senderActor maybeCap localRecips r
|
|||
[encodeRouteHome $ PersonOutboxItemR adminHash obikhidCreate]
|
||||
, actionSpecific = GrantActivity Grant
|
||||
{ grantObject = AP.RXRole RoleAdmin
|
||||
, grantContext = encodeRouteLocal $ RepoR repoHash
|
||||
, grantContext = encodeRouteHome $ RepoR repoHash
|
||||
, grantTarget = encodeRouteHome $ PersonR adminHash
|
||||
, grantResult = Nothing
|
||||
, grantStart = Nothing
|
||||
|
|
|
|||
|
|
@ -415,7 +415,7 @@ topicAccept topicActor topicResource now recipKey (Verse authorIdMsig body) acce
|
|||
, AP.actionSpecific = AP.GrantActivity AP.Grant
|
||||
{ AP.grantObject = AP.RXRole role
|
||||
, AP.grantContext =
|
||||
encodeRouteLocal $ renderLocalActor topicByHash
|
||||
encodeRouteHome $ renderLocalActor topicByHash
|
||||
, AP.grantTarget =
|
||||
if isInvite
|
||||
then uAccepter
|
||||
|
|
@ -1296,7 +1296,7 @@ topicCreateMe topicActor topicResource collabTopicFieldTopic collabTopicCtor now
|
|||
, AP.actionSpecific = AP.GrantActivity AP.Grant
|
||||
{ AP.grantObject = AP.RXRole AP.RoleAdmin
|
||||
, AP.grantContext =
|
||||
encodeRouteLocal $ renderLocalActor topicByHash
|
||||
encodeRouteHome $ renderLocalActor topicByHash
|
||||
, AP.grantTarget = uCreator
|
||||
, AP.grantResult = Nothing
|
||||
, AP.grantStart = Just now
|
||||
|
|
|
|||
|
|
@ -537,7 +537,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
|
|||
, AP.actionSpecific = AP.GrantActivity AP.Grant
|
||||
{ AP.grantObject = AP.RXRole role
|
||||
, AP.grantContext =
|
||||
encodeRouteLocal $ renderLocalActor topicByHash
|
||||
encodeRouteHome $ renderLocalActor topicByHash
|
||||
, AP.grantTarget =
|
||||
if isInvite
|
||||
then uAccepter
|
||||
|
|
@ -594,7 +594,7 @@ projectAccept now projectID (Verse authorIdMsig body) accept = do
|
|||
, AP.actionFulfills = [AP.acceptObject accept]
|
||||
, AP.actionSpecific = AP.GrantActivity AP.Grant
|
||||
{ AP.grantObject = AP.RXDelegator
|
||||
, AP.grantContext = encodeRouteLocal $ ProjectR projectHash
|
||||
, AP.grantContext = encodeRouteHome $ ProjectR projectHash
|
||||
, AP.grantTarget = uComponent
|
||||
, AP.grantResult = Nothing
|
||||
, AP.grantStart = Just now
|
||||
|
|
@ -877,6 +877,257 @@ projectFollow now recipProjectID verse follow = do
|
|||
(\ _ -> pure [])
|
||||
now recipProjectID verse follow
|
||||
|
||||
-- Meaning: An actor is granting access-to-some-resource to another actor
|
||||
-- Behavior:
|
||||
-- * Verify that:
|
||||
-- * The sender is a component of mine, C
|
||||
-- * The Grant's context is C
|
||||
-- * The Grant's target is me
|
||||
-- * The Grant's usage is gatherAndConvey
|
||||
-- * The Grant doesn't specify 'delegates'
|
||||
-- * The activity is authorized via a valid delegator-Grant I had sent
|
||||
-- to C
|
||||
-- * Verify the Grant's role is the same one specified in the Invite/Add
|
||||
-- that added the Component
|
||||
-- * Verify I don't yet have a delegation from C
|
||||
-- * Insert the Grant to my inbox
|
||||
-- * Record the delegation in the Component record in DB
|
||||
-- * Forward the Grant to my followers
|
||||
-- * For each person (non-team) collaborator of mine, prepare and send a
|
||||
-- Grant, and store it in the Componet record in DB:
|
||||
-- * Role: The lower among (1) admin (2) the collaborator's role in me
|
||||
-- * Resource: C
|
||||
-- * Target: The collaborator
|
||||
-- * Delegates: The Grant I just got from C
|
||||
-- * Result: ProjectCollabLiveR for this collaborator
|
||||
-- * Usage: invoke
|
||||
projectGrant
|
||||
:: UTCTime
|
||||
-> ProjectId
|
||||
-> Verse
|
||||
-> AP.Grant URIMode
|
||||
-> ActE (Text, Act (), Next)
|
||||
projectGrant now projectID (Verse authorIdMsig body) grant = do
|
||||
|
||||
-- Check capability
|
||||
capability <- do
|
||||
|
||||
-- Verify that a capability is provided
|
||||
uCap <- do
|
||||
let muCap = AP.activityCapability $ actbActivity body
|
||||
fromMaybeE muCap "No capability provided"
|
||||
|
||||
-- Verify the capability URI is one of:
|
||||
-- * Outbox item URI of a local actor, i.e. a local activity
|
||||
-- * A remote URI
|
||||
cap <- nameExceptT "Invite capability" $ parseActivityURI' uCap
|
||||
|
||||
-- Verify the capability is local
|
||||
case cap of
|
||||
Left (actorByKey, _, outboxItemID) ->
|
||||
return (actorByKey, outboxItemID)
|
||||
_ -> throwE "Capability is remote i.e. definitely not by me"
|
||||
|
||||
-- Check grant
|
||||
(role, component) <- checkDelegationStart grant
|
||||
|
||||
maybeNew <- withDBExcept $ do
|
||||
|
||||
-- Grab me from DB
|
||||
(recipActorID, recipActor) <- lift $ do
|
||||
recip <- getJust projectID
|
||||
let actorID = projectActor recip
|
||||
(actorID,) <$> getJust actorID
|
||||
|
||||
-- Find the Component record from the capability
|
||||
Entity enableID (ComponentEnable componentID _) <- do
|
||||
unless (fst capability == LocalActorProject projectID) $
|
||||
throwE "Capability isn't mine"
|
||||
m <- lift $ getBy $ UniqueComponentEnableGrant $ snd capability
|
||||
fromMaybeE m "I don't have a Component with this capability"
|
||||
Component j role' <- lift $ getJust componentID
|
||||
unless (j == projectID) $
|
||||
throwE "Found a Component for this delegator-Grant but it's not mine"
|
||||
unless (role' == role) $
|
||||
throwE "Grant role isn't the same as in the Invite/Add"
|
||||
ident <- lift $ getComponentIdent componentID
|
||||
identForCheck <-
|
||||
lift $
|
||||
bitraverse
|
||||
(pure . snd)
|
||||
(\ (_, raID) -> getRemoteActorURI =<< getJust raID)
|
||||
ident
|
||||
unless (identForCheck == component) $
|
||||
throwE "Capability's component and Grant author aren't the same actor"
|
||||
|
||||
-- Verify I don't yet have a delegation from the component
|
||||
maybeDeleg <-
|
||||
lift $ case bimap fst fst ident of
|
||||
Left localID -> (() <$) <$> getBy (UniqueComponentDelegateLocal localID)
|
||||
Right remoteID -> (() <$) <$> getBy (UniqueComponentDelegateRemote remoteID)
|
||||
verifyNothingE maybeDeleg "I already have a delegation-start Grant from this component"
|
||||
|
||||
maybeGrantDB <- lift $ insertToInbox now authorIdMsig body (actorInbox recipActor) False
|
||||
for maybeGrantDB $ \ grantDB -> do
|
||||
|
||||
-- Record the delegation in DB
|
||||
lift $ case (grantDB, bimap fst fst ident) of
|
||||
(Left (_, _, grantID), Left localID) -> insert_ $ ComponentDelegateLocal localID grantID
|
||||
(Right (_, _, grantID), Right remoteID) -> insert_ $ ComponentDelegateRemote remoteID grantID
|
||||
_ -> error "projectGrant impossible"
|
||||
|
||||
-- Prepare forwarding of Accept to my followers
|
||||
projectHash <- encodeKeyHashid projectID
|
||||
let sieve = makeRecipientSet [] [LocalStageProjectFollowers projectHash]
|
||||
|
||||
-- For each Collab in me, prepare a delegation-extension Grant
|
||||
localCollabs <-
|
||||
lift $
|
||||
E.select $ E.from $ \ (topic `E.InnerJoin` collab `E.InnerJoin` enable `E.InnerJoin` recipL) -> do
|
||||
E.on $ enable E.^. CollabEnableCollab E.==. recipL E.^. CollabRecipLocalCollab
|
||||
E.on $ topic E.^. CollabTopicProjectCollab E.==. enable E.^. CollabEnableCollab
|
||||
E.on $ topic E.^. CollabTopicProjectCollab E.==. collab E.^. CollabId
|
||||
E.where_ $ topic E.^. CollabTopicProjectProject E.==. E.val projectID
|
||||
return
|
||||
( collab E.^. CollabRole
|
||||
, recipL E.^. CollabRecipLocalId
|
||||
, recipL E.^. CollabRecipLocalPerson
|
||||
, enable E.^. CollabEnableId
|
||||
)
|
||||
localExtensions <- lift $ for localCollabs $ \ (E.Value role', E.Value recipID, E.Value personID, E.Value enableID') -> do
|
||||
extID <- insertEmptyOutboxItem' (actorOutbox recipActor) now
|
||||
insert_ $ ComponentFurtherLocal enableID recipID extID
|
||||
ext@(actionExt, _, _, _) <-
|
||||
prepareExtensionGrant identForCheck (Left personID) (min role role') enableID'
|
||||
let recipByKey = LocalActorProject projectID
|
||||
_luExt <- updateOutboxItem' recipByKey extID actionExt
|
||||
return (extID, ext)
|
||||
|
||||
remoteCollabs <-
|
||||
lift $
|
||||
E.select $ E.from $ \ (topic `E.InnerJoin` collab `E.InnerJoin` enable `E.InnerJoin` recipR) -> do
|
||||
E.on $ enable E.^. CollabEnableCollab E.==. recipR E.^. CollabRecipRemoteCollab
|
||||
E.on $ topic E.^. CollabTopicProjectCollab E.==. enable E.^. CollabEnableCollab
|
||||
E.on $ topic E.^. CollabTopicProjectCollab E.==. collab E.^. CollabId
|
||||
E.where_ $ topic E.^. CollabTopicProjectProject E.==. E.val projectID
|
||||
return
|
||||
( collab E.^. CollabRole
|
||||
, recipR E.^. CollabRecipRemoteId
|
||||
, recipR E.^. CollabRecipRemoteActor
|
||||
, enable E.^. CollabEnableId
|
||||
)
|
||||
remoteExtensions <- lift $ for remoteCollabs $ \ (E.Value role', E.Value recipID, E.Value raID, E.Value enableID') -> do
|
||||
extID <- insertEmptyOutboxItem' (actorOutbox recipActor) now
|
||||
insert_ $ ComponentFurtherRemote enableID recipID extID
|
||||
ext@(actionExt, _, _, _) <-
|
||||
prepareExtensionGrant identForCheck (Right raID) (min role role') enableID'
|
||||
let recipByKey = LocalActorProject projectID
|
||||
_luExt <- updateOutboxItem' recipByKey extID actionExt
|
||||
return (extID, ext)
|
||||
|
||||
return (recipActorID, sieve, localExtensions, remoteExtensions)
|
||||
|
||||
case maybeNew of
|
||||
Nothing -> done "I already have this activity in my inbox"
|
||||
Just (recipActorID, sieve, localExts, remoteExts) -> do
|
||||
let recipByID = LocalActorProject projectID
|
||||
forwardActivity authorIdMsig body recipByID recipActorID sieve
|
||||
lift $ for_ (localExts ++ remoteExts) $
|
||||
\ (extID, (actionExt, localRecipsExt, remoteRecipsExt, fwdHostsExt)) ->
|
||||
sendActivity
|
||||
recipByID recipActorID localRecipsExt
|
||||
remoteRecipsExt fwdHostsExt extID actionExt
|
||||
done "Forwarded the Grant and published delegation extensions"
|
||||
|
||||
where
|
||||
|
||||
checkDelegationStart g = do
|
||||
(role, resource, recipient, _mresult, mstart, mend, usage, mdeleg) <-
|
||||
parseGrant' g
|
||||
role' <-
|
||||
case role of
|
||||
AP.RXRole r -> pure r
|
||||
AP.RXDelegator -> throwE "Role is delegator"
|
||||
component <-
|
||||
fromMaybeE
|
||||
(bitraverse resourceToComponent Just resource)
|
||||
"Resource is a local project, therefore not a component of mine"
|
||||
case (component, authorIdMsig) of
|
||||
(Left c, Left (a, _, _)) | componentActor c == a -> pure ()
|
||||
(Right u, Right (ra, _, _)) | remoteAuthorURI ra == u -> pure ()
|
||||
_ -> throwE "Author and context aren't the same actor"
|
||||
case recipient of
|
||||
Left (GrantRecipProject' j) | j == projectID -> pure ()
|
||||
_ -> throwE "Target isn't me"
|
||||
for_ mstart $ \ start ->
|
||||
unless (start < now) $ throwE "Start time is in the future"
|
||||
for_ mend $ \ _ ->
|
||||
throwE "End time is specified"
|
||||
unless (usage == AP.GatherAndConvey) $
|
||||
throwE "Usage isn't GatherAndConvey"
|
||||
for_ mdeleg $ \ _ ->
|
||||
throwE "'delegates' is specified"
|
||||
return (role', component)
|
||||
|
||||
prepareExtensionGrant component collab role enableID = do
|
||||
encodeRouteHome <- getEncodeRouteHome
|
||||
encodeRouteLocal <- getEncodeRouteLocal
|
||||
|
||||
projectHash <- encodeKeyHashid projectID
|
||||
uStart <- lift $ getActivityURI authorIdMsig
|
||||
|
||||
(uCollab, audCollab) <-
|
||||
case collab of
|
||||
Left personID -> do
|
||||
personHash <- encodeKeyHashid personID
|
||||
return
|
||||
( encodeRouteHome $ PersonR personHash
|
||||
, AudLocal [LocalActorPerson personHash] []
|
||||
)
|
||||
Right raID -> do
|
||||
ra <- getJust raID
|
||||
u@(ObjURI h lu) <- getRemoteActorURI ra
|
||||
return (u, AudRemote h [lu] [])
|
||||
|
||||
uComponent <-
|
||||
case component of
|
||||
Left c -> do
|
||||
a <- componentActor <$> hashComponent c
|
||||
return $ encodeRouteHome $ renderLocalActor a
|
||||
Right u -> pure u
|
||||
|
||||
enableHash <- encodeKeyHashid enableID
|
||||
|
||||
let audience = [audCollab]
|
||||
|
||||
(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 = [uStart]
|
||||
, AP.actionSpecific = AP.GrantActivity AP.Grant
|
||||
{ AP.grantObject = AP.RXRole role
|
||||
, AP.grantContext = uComponent
|
||||
, AP.grantTarget = uCollab
|
||||
, AP.grantResult =
|
||||
Just
|
||||
(encodeRouteLocal $
|
||||
ProjectCollabLiveR projectHash enableHash
|
||||
, Nothing
|
||||
)
|
||||
, AP.grantStart = Just now
|
||||
, AP.grantEnd = Nothing
|
||||
, AP.grantAllows = AP.Invoke
|
||||
, AP.grantDelegates = Just uStart
|
||||
}
|
||||
}
|
||||
|
||||
return (action, recipientSet, remoteActors, fwdHosts)
|
||||
|
||||
-- Meaning: An actor A invited actor B to a resource
|
||||
-- Behavior:
|
||||
-- * Verify the resource is my collabs or components list
|
||||
|
|
@ -1341,6 +1592,7 @@ projectBehavior now projectID (Left verse@(Verse _authorIdMsig body)) =
|
|||
AP.AddActivity add -> projectAdd now projectID verse add
|
||||
AP.CreateActivity create -> projectCreate now projectID verse create
|
||||
AP.FollowActivity follow -> projectFollow now projectID verse follow
|
||||
AP.GrantActivity grant -> projectGrant now projectID verse grant
|
||||
AP.InviteActivity invite -> projectInvite now projectID verse invite
|
||||
AP.JoinActivity join -> projectJoin now projectID verse join
|
||||
AP.RejectActivity reject -> projectReject now projectID verse reject
|
||||
|
|
|
|||
|
|
@ -25,6 +25,7 @@ module Vervis.Data.Collab
|
|||
, parseInvite
|
||||
, parseJoin
|
||||
, parseGrant
|
||||
, parseGrant'
|
||||
, parseAccept
|
||||
, parseReject
|
||||
, parseRemove
|
||||
|
|
@ -49,6 +50,10 @@ module Vervis.Data.Collab
|
|||
, ComponentBy (..)
|
||||
, hashComponent
|
||||
, componentActor
|
||||
, resourceToComponent
|
||||
|
||||
, GrantRecipBy' (..)
|
||||
, hashGrantRecip'
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -60,6 +65,7 @@ import Data.Bifunctor
|
|||
import Data.Bitraversable
|
||||
import Data.Functor.Identity
|
||||
import Data.Text (Text)
|
||||
import Data.Traversable
|
||||
import Database.Persist
|
||||
import Database.Persist.Types
|
||||
import GHC.Generics
|
||||
|
|
@ -279,7 +285,8 @@ parseGrant h (AP.Grant object context target mresult mstart mend allows deleg) =
|
|||
<*> pure mstart
|
||||
<*> pure mend
|
||||
where
|
||||
parseContext lu = do
|
||||
parseContext (ObjURI h' lu) = do
|
||||
unless (h == h') $ throwE "Context and author aren't of same host"
|
||||
hl <- hostIsLocal h
|
||||
if hl
|
||||
then Left <$> do
|
||||
|
|
@ -312,6 +319,66 @@ parseGrant h (AP.Grant object context target mresult mstart mend allows deleg) =
|
|||
"Grant target contains invalid hashid"
|
||||
else pure $ Right u
|
||||
|
||||
parseGrant'
|
||||
:: AP.Grant URIMode
|
||||
-> ActE
|
||||
( AP.RoleExt
|
||||
, Either (GrantResourceBy Key) FedURI
|
||||
, Either (GrantRecipBy' Key) FedURI
|
||||
, Maybe (LocalURI, Maybe Int)
|
||||
, Maybe UTCTime
|
||||
, Maybe UTCTime
|
||||
, AP.Usage
|
||||
, Maybe (Either (LocalActorBy Key, OutboxItemId) FedURI)
|
||||
)
|
||||
parseGrant' (AP.Grant object context target mresult mstart mend allows deleg) =
|
||||
(,,,,,,,)
|
||||
<$> verifyRole object
|
||||
<*> parseContext context
|
||||
<*> parseTarget target
|
||||
<*> pure
|
||||
(fmap
|
||||
(\ (lu, md) -> (lu, (\ (AP.Duration i) -> i) <$> md))
|
||||
mresult
|
||||
)
|
||||
<*> pure mstart
|
||||
<*> pure mend
|
||||
<*> pure allows
|
||||
<*> for deleg (fmap (first (\ (actor, _, item) -> (actor, item))) . parseActivityURI')
|
||||
where
|
||||
parseContext u@(ObjURI h lu) = do
|
||||
hl <- hostIsLocal h
|
||||
if hl
|
||||
then Left <$> do
|
||||
route <-
|
||||
fromMaybeE
|
||||
(decodeRouteLocal lu)
|
||||
"Grant context isn't a valid route"
|
||||
resourceHash <-
|
||||
fromMaybeE
|
||||
(parseGrantResource route)
|
||||
"Grant context isn't a shared resource route"
|
||||
unhashGrantResourceE'
|
||||
resourceHash
|
||||
"Grant resource contains invalid hashid"
|
||||
else pure $ Right u
|
||||
parseTarget u@(ObjURI h lu) = do
|
||||
hl <- hostIsLocal h
|
||||
if hl
|
||||
then Left <$> do
|
||||
route <-
|
||||
fromMaybeE
|
||||
(decodeRouteLocal lu)
|
||||
"Grant target isn't a valid route"
|
||||
recipHash <-
|
||||
fromMaybeE
|
||||
(parseGrantRecip' route)
|
||||
"Grant target isn't a grant recipient route"
|
||||
unhashGrantRecipE'
|
||||
recipHash
|
||||
"Grant target contains invalid hashid"
|
||||
else pure $ Right u
|
||||
|
||||
parseAccept (AP.Accept object mresult) = do
|
||||
--verifyNothingE mresult "Accept must not contain 'result'"
|
||||
first (\ (actor, _, item) -> (actor, item)) <$>
|
||||
|
|
@ -503,3 +570,39 @@ unhashComponentE c e = ExceptT $ maybe (Left e) Right <$> unhashComponent c
|
|||
componentActor (ComponentRepo r) = LocalActorRepo r
|
||||
componentActor (ComponentDeck d) = LocalActorDeck d
|
||||
componentActor (ComponentLoom l) = LocalActorLoom l
|
||||
|
||||
resourceToComponent = \case
|
||||
GrantResourceRepo k -> Just $ ComponentRepo k
|
||||
GrantResourceDeck k -> Just $ ComponentDeck k
|
||||
GrantResourceLoom k -> Just $ ComponentLoom k
|
||||
GrantResourceProject _ -> Nothing
|
||||
|
||||
data GrantRecipBy' f
|
||||
= GrantRecipPerson' (f Person)
|
||||
| GrantRecipProject' (f Project)
|
||||
deriving (Generic, FunctorB, TraversableB, ConstraintsB)
|
||||
|
||||
deriving instance AllBF Eq f GrantRecipBy' => Eq (GrantRecipBy' f)
|
||||
|
||||
parseGrantRecip' (PersonR p) = Just $ GrantRecipPerson' p
|
||||
parseGrantRecip' (ProjectR j) = Just $ GrantRecipProject' j
|
||||
parseGrantRecip' _ = Nothing
|
||||
|
||||
hashGrantRecip' (GrantRecipPerson' k) =
|
||||
GrantRecipPerson' <$> WAP.encodeKeyHashid k
|
||||
hashGrantRecip' (GrantRecipProject' k) =
|
||||
GrantRecipProject' <$> WAP.encodeKeyHashid k
|
||||
|
||||
unhashGrantRecipPure' ctx = f
|
||||
where
|
||||
f (GrantRecipPerson' p) =
|
||||
GrantRecipPerson' <$> decodeKeyHashidPure ctx p
|
||||
f (GrantRecipProject' p) =
|
||||
GrantRecipProject' <$> decodeKeyHashidPure ctx p
|
||||
|
||||
unhashGrantRecip' resource = do
|
||||
ctx <- asksEnv WAP.stageHashidsContext
|
||||
return $ unhashGrantRecipPure' ctx resource
|
||||
|
||||
unhashGrantRecipE' resource e =
|
||||
ExceptT $ maybe (Left e) Right <$> unhashGrantRecip' resource
|
||||
|
|
|
|||
|
|
@ -1868,7 +1868,7 @@ encodeFollow (Follow obj mcontext hide)
|
|||
|
||||
data Grant u = Grant
|
||||
{ grantObject :: RoleExt
|
||||
, grantContext :: LocalURI
|
||||
, grantContext :: ObjURI u
|
||||
, grantTarget :: ObjURI u
|
||||
, grantResult :: Maybe (LocalURI, Maybe Duration)
|
||||
, grantStart :: Maybe UTCTime
|
||||
|
|
@ -1881,7 +1881,7 @@ parseGrant :: UriMode u => Authority u -> Object -> Parser (Grant u)
|
|||
parseGrant h o =
|
||||
Grant
|
||||
<$> o .: "object"
|
||||
<*> withAuthorityO h (o .: "context")
|
||||
<*> o .: "context"
|
||||
<*> o .: "target"
|
||||
<*> (do mres <- o .:+? "result"
|
||||
for mres $ \case
|
||||
|
|
@ -1897,7 +1897,7 @@ parseGrant h o =
|
|||
encodeGrant :: UriMode u => Authority u -> Grant u -> Series
|
||||
encodeGrant h (Grant obj context target mresult mstart mend allows mdelegates)
|
||||
= "object" .= obj
|
||||
<> "context" .= ObjURI h context
|
||||
<> "context" .= context
|
||||
<> "target" .= target
|
||||
<> (case mresult of
|
||||
Nothing -> mempty
|
||||
|
|
|
|||
Loading…
Reference in a new issue