diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index 4b00b23..9f07aae 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -366,6 +366,8 @@ acceptC (Entity senderPersonID senderPerson) senderActor maybeCap localRecips re , grantContext = encodeRouteLocal $ renderLocalActor topicHash , grantTarget = encodeRouteHome $ PersonR recipHash , grantResult = Nothing + , grantStart = Nothing + , grantEnd = Nothing } } @@ -1152,6 +1154,8 @@ createPatchTrackerC (Entity pidUser personUser) senderActor maybeCap localRecips , grantContext = encodeRouteLocal $ LoomR loomHash , grantTarget = encodeRouteHome $ PersonR adminHash , grantResult = Nothing + , grantStart = Nothing + , grantEnd = Nothing } } @@ -1376,6 +1380,8 @@ createRepositoryC (Entity pidUser personUser) senderActor maybeCap localRecips r , grantContext = encodeRouteLocal $ RepoR repoHash , grantTarget = encodeRouteHome $ PersonR adminHash , grantResult = Nothing + , grantStart = Nothing + , grantEnd = Nothing } } @@ -1626,6 +1632,8 @@ createTicketTrackerC (Entity pidUser personUser) senderActor maybeCap localRecip , grantContext = encodeRouteLocal $ DeckR deckHash , grantTarget = encodeRouteHome $ PersonR adminHash , grantResult = Nothing + , grantStart = Nothing + , grantEnd = Nothing } } diff --git a/src/Vervis/Actor/Person.hs b/src/Vervis/Actor/Person.hs index 631aa9d..336e29e 100644 --- a/src/Vervis/Actor/Person.hs +++ b/src/Vervis/Actor/Person.hs @@ -165,7 +165,7 @@ personGrant now recipPersonID author body mfwd luGrant grant = do -- Check input (_remoteResource, recipient) <- do let u@(ObjURI h _) = remoteAuthorURI author - (resource, recip, _mresult) <- parseGrant h grant + (resource, recip, _mresult, _mstart, _mend) <- parseGrant h grant resourceURI <- case resource of Right r -> return (u, r) diff --git a/src/Vervis/Data/Collab.hs b/src/Vervis/Data/Collab.hs index 16caf16..963b775 100644 --- a/src/Vervis/Data/Collab.hs +++ b/src/Vervis/Data/Collab.hs @@ -41,6 +41,7 @@ import Database.Persist.Types import GHC.Generics import Control.Concurrent.Actor +import Data.Time.Clock import Network.FedURI import Web.Actor import Web.Actor.Persist @@ -162,10 +163,12 @@ parseGrant ( Either (GrantResourceBy Key) LocalURI , Either (GrantRecipBy Key) FedURI , Maybe (LocalURI, Maybe Int) + , Maybe UTCTime + , Maybe UTCTime ) -parseGrant h (AP.Grant object context target mresult) = do +parseGrant h (AP.Grant object context target mresult mstart mend) = do verifyRole object - (,,) + (,,,,) <$> parseContext context <*> parseTarget target <*> pure @@ -173,6 +176,8 @@ parseGrant h (AP.Grant object context target mresult) = do (\ (lu, md) -> (lu, (\ (AP.Duration i) -> i) <$> md)) mresult ) + <*> pure mstart + <*> pure mend where verifyRole (Left AP.RoleAdmin) = pure () verifyRole (Right _) = diff --git a/src/Vervis/Federation/Collab.hs b/src/Vervis/Federation/Collab.hs index 7ee4ada..a0cb05b 100644 --- a/src/Vervis/Federation/Collab.hs +++ b/src/Vervis/Federation/Collab.hs @@ -552,6 +552,8 @@ topicAcceptF topicActor topicResource now recipHash author body mfwd luAccept ac , AP.grantContext = encodeRouteLocal $ renderLocalActor topicByHash , AP.grantTarget = remoteAuthorURI author , AP.grantResult = Nothing + , AP.grantStart = Nothing + , AP.grantEnd = Nothing } } diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 4a77205..ee5a814 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -1675,6 +1675,8 @@ data Grant u = Grant , grantContext :: LocalURI , grantTarget :: ObjURI u , grantResult :: Maybe (LocalURI, Maybe Duration) + , grantStart :: Maybe UTCTime + , grantEnd :: Maybe UTCTime } parseGrant :: UriMode u => Authority u -> Object -> Parser (Grant u) @@ -1683,24 +1685,30 @@ parseGrant h o = <$> o .:+ "object" <*> withAuthorityO h (o .: "context") <*> o .: "target" - <*> do mres <- o .:+? "result" + <*> (do mres <- o .:+? "result" for mres $ \case Left u -> (,Nothing) <$> withAuthorityO h (pure u) Right r -> (,) <$> withAuthorityO h (r .: "id") <*> r .:? "duration" + ) + <*> o .:? "startTime" + <*> o .:? "endTime" encodeGrant :: UriMode u => Authority u -> Grant u -> Series -encodeGrant h (Grant obj context target mresult) +encodeGrant h (Grant obj context target mresult mstart mend) = "object" .=+ obj <> "context" .= ObjURI h context <> "target" .= target - <> case mresult of + <> (case mresult of Nothing -> mempty Just (result, mduration) -> "result" `pair` pairs ( "id" .= ObjURI h result <> "duration" .=? mduration ) + ) + <> "startTime" .=? mstart + <> "endTime" .=? mend data Invite u = Invite { inviteInstrument :: Either Role (ObjURI u)