naskya/vervis
1
0
Fork 0
mirror of https://code.naskya.net/repos/ndqEd synced 2025-01-10 01:26:46 +09:00
Code Activity

Vocabulary for Project

Browse source
This commit is contained in:
Pere Lev 2023-06-26 17:25:56 +03:00
parent cc87b6e17d
commit 050e8d09bc
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
1 changed files with 59 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

59
src/Web/ActivityPub.hs
View file

@ -46,6 +46,7 @@ module Web.ActivityPub
, CollectionPage (..)
, Recipient (..)
, Resource (..)
, Project (..)
-- * Content objects
, Note (..)
@ -374,6 +375,7 @@ data ActorType
| ActorTypeRepo
| ActorTypeTicketTracker
| ActorTypePatchTracker
| ActorTypeProject
| ActorTypeOther Text
deriving Eq
@ -385,6 +387,7 @@ instance FromJSON ActorType where
| t == "Repository" = ActorTypeRepo
| t == "TicketTracker" = ActorTypeTicketTracker
| t == "PatchTracker" = ActorTypePatchTracker
| t == "Project" = ActorTypeProject
| otherwise = ActorTypeOther t
instance ToJSON ActorType where
@ -395,6 +398,7 @@ instance ToJSON ActorType where
ActorTypeRepo -> "Repository"
ActorTypeTicketTracker -> "TicketTracker"
ActorTypePatchTracker -> "PatchTracker"
ActorTypeProject -> "Project"
ActorTypeOther t -> t
data Owner = OwnerInstance | OwnerActor LocalURI
@ -810,6 +814,61 @@ instance ActivityPub Resource where
= "id" .= ObjURI h luId
<> "managedBy" .= ObjURI h luManager
data Project u = Project
{ projectActor :: Actor u
, projectTracker :: Maybe (ObjURI u)
, projectChildren :: [ObjURI u]
, projectParents :: [ObjURI u]
, projectComponents :: [ObjURI u]
}
instance ActivityPub Project where
jsonldContext _ = [as2Context, secContext, forgeContext]
parseObject o = do
(h, a) <- parseObject o
unless (actorType (actorDetail a) == ActorTypeProject) $
fail "Actor type isn't Project"
fmap (h,) $
Project a
<$> o .:? "ticketsTrackedBy"
<*> (do c <- o .: "subprojects"
typ <- c .: "type"
unless (typ == ("Collection" :: Text)) $
fail "subprojects.type isn't Collection"
items <- c .: "items"
mtotal <- c .:? "totalItems"
for_ mtotal $ \ total ->
unless (length items == total) $
fail "Incorrect totalItems"
return items
)
<*> o .:? "context" .!= []
<*> (do c <- o .: "components"
typ <- c .: "type"
unless (typ == ("Collection" :: Text)) $
fail "components.type isn't Collection"
items <- c .: "items"
mtotal <- c .:? "totalItems"
for_ mtotal $ \ total ->
unless (length items == total) $
fail "Incorrect totalItems"
return items
)
toSeries h (Project actor tracker children parents components)
= toSeries h actor
<> "ticketsTrackedBy" .=? tracker
<> "subprojects" `pair` pairs
( "type" .= ("Collection" :: Text)
<> "items" .= children
<> "totalItems" .= length children
)
<> "context" .= parents
<> "components" `pair` pairs
( "type" .= ("Collection" :: Text)
<> "items" .= components
<> "totalItems" .= length components
)
data Audience u = Audience
{ audienceTo :: [ObjURI u]
, audienceBto :: [ObjURI u]