naskya/vervis
1
0
Fork 0
mirror of https://code.naskya.net/repos/ndqEd synced 2025-03-20 15:14:54 +09:00
Code Activity

Web.ActivityPub: Add Grant 'allows' & 'delegates' fields

Browse source
This commit is contained in:
Pere Lev 2023-05-30 14:34:37 +03:00
parent 621275e257
commit cc135692c0
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
4 changed files with 43 additions and 2 deletions

27
src/Web/ActivityPub.hs
View file

@ -63,6 +63,7 @@ module Web.ActivityPub
, Branch (..)
, Role (..)
, Duration (..)
, Usage (..)
-- * Activity
, Accept (..)
@ -1548,6 +1549,24 @@ instance ToJSON Duration where
toEncoding (Duration i) =
toEncoding $ T.concat ["PT", T.pack $ show i, "S"]
data Usage = GatherAndConvey | Distribute | Invoke deriving Eq
instance FromJSON Usage where
parseJSON = withText "Usage" parse
where
parse "gatherAndConvey" = pure GatherAndConvey
parse "distribute" = pure Distribute
parse "invoke" = pure Invoke
parse t = fail $ "Unknown usage: " ++ T.unpack t
instance ToJSON Usage where
toJSON = error "toJSON Usage"
toEncoding u =
toEncoding $ case u of
GatherAndConvey -> "gatherAndConvey" :: Text
Distribute -> "distribute"
Invoke -> "invoke"
data Accept u = Accept
{ acceptObject :: ObjURI u
, acceptResult :: Maybe LocalURI
@ -1710,6 +1729,8 @@ data Grant u = Grant
, grantResult :: Maybe (LocalURI, Maybe Duration)
, grantStart :: Maybe UTCTime
, grantEnd :: Maybe UTCTime
, grantAllows :: Usage
, grantDelegates :: Maybe (ObjURI u)
}
parseGrant :: UriMode u => Authority u -> Object -> Parser (Grant u)
@ -1726,9 +1747,11 @@ parseGrant h o =
)
<*> o .:? "startTime"
<*> o .:? "endTime"
<*> o .: "allows"
<*> o .:? "delegates"
encodeGrant :: UriMode u => Authority u -> Grant u -> Series
encodeGrant h (Grant obj context target mresult mstart mend)
encodeGrant h (Grant obj context target mresult mstart mend allows mdelegates)
= "object" .=+ obj
<> "context" .= ObjURI h context
<> "target" .= target
@ -1742,6 +1765,8 @@ encodeGrant h (Grant obj context target mresult mstart mend)
)
<> "startTime" .=? mstart
<> "endTime" .=? mend
<> "allows" .= allows
<> "delegates" .=? mdelegates
data Invite u = Invite
{ inviteInstrument :: Either Role (ObjURI u)