Web.ActivityPub: Add Grant startTime and endTime

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
                 }
             }
 

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)

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 _) =

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
                     }
                 }
 

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)