Web.ActivityPub: Add a Resolve activity

This commit is contained in:
fr33domlover 2020-07-23 14:27:11 +00:00
parent 1bd7995bb5
commit 58c0719370

View file

@ -66,6 +66,7 @@ module Web.ActivityPub
, Offer (..) , Offer (..)
, Push (..) , Push (..)
, Reject (..) , Reject (..)
, Resolve (..)
, Undo (..) , Undo (..)
, Audience (..) , Audience (..)
, SpecificActivity (..) , SpecificActivity (..)
@ -1332,6 +1333,16 @@ parseReject o = Reject <$> o .: "object"
encodeReject :: UriMode u => Reject u -> Series encodeReject :: UriMode u => Reject u -> Series
encodeReject (Reject obj) = "object" .= obj encodeReject (Reject obj) = "object" .= obj
data Resolve u = Resolve
{ resolveObject :: ObjURI u
}
parseResolve :: UriMode u => Object -> Parser (Resolve u)
parseResolve o = Resolve <$> o .: "object"
encodeResolve :: UriMode u => Resolve u -> Series
encodeResolve (Resolve obj) = "object" .= obj
data Undo u = Undo data Undo u = Undo
{ undoObject :: LocalURI { undoObject :: LocalURI
} }
@ -1349,6 +1360,7 @@ data SpecificActivity u
| OfferActivity (Offer u) | OfferActivity (Offer u)
| PushActivity (Push u) | PushActivity (Push u)
| RejectActivity (Reject u) | RejectActivity (Reject u)
| ResolveActivity (Resolve u)
| UndoActivity (Undo u) | UndoActivity (Undo u)
data Activity u = Activity data Activity u = Activity
@ -1372,13 +1384,14 @@ instance ActivityPub Activity where
<*> do <*> do
typ <- o .: "type" typ <- o .: "type"
case typ of case typ of
"Accept" -> AcceptActivity <$> parseAccept a o "Accept" -> AcceptActivity <$> parseAccept a o
"Create" -> CreateActivity <$> parseCreate o a actor "Create" -> CreateActivity <$> parseCreate o a actor
"Follow" -> FollowActivity <$> parseFollow o "Follow" -> FollowActivity <$> parseFollow o
"Offer" -> OfferActivity <$> parseOffer o a actor "Offer" -> OfferActivity <$> parseOffer o a actor
"Push" -> PushActivity <$> parsePush a o "Push" -> PushActivity <$> parsePush a o
"Reject" -> RejectActivity <$> parseReject o "Reject" -> RejectActivity <$> parseReject o
"Undo" -> UndoActivity <$> parseUndo a o "Resolve" -> ResolveActivity <$> parseResolve o
"Undo" -> UndoActivity <$> parseUndo a o
_ -> _ ->
fail $ fail $
"Unrecognized activity type: " ++ T.unpack typ "Unrecognized activity type: " ++ T.unpack typ
@ -1391,20 +1404,22 @@ instance ActivityPub Activity where
<> encodeSpecific authority actor specific <> encodeSpecific authority actor specific
where where
activityType :: SpecificActivity u -> Text activityType :: SpecificActivity u -> Text
activityType (AcceptActivity _) = "Accept" activityType (AcceptActivity _) = "Accept"
activityType (CreateActivity _) = "Create" activityType (CreateActivity _) = "Create"
activityType (FollowActivity _) = "Follow" activityType (FollowActivity _) = "Follow"
activityType (OfferActivity _) = "Offer" activityType (OfferActivity _) = "Offer"
activityType (PushActivity _) = "Push" activityType (PushActivity _) = "Push"
activityType (RejectActivity _) = "Reject" activityType (RejectActivity _) = "Reject"
activityType (UndoActivity _) = "Undo" activityType (ResolveActivity _) = "Resolve"
encodeSpecific h _ (AcceptActivity a) = encodeAccept h a activityType (UndoActivity _) = "Undo"
encodeSpecific h u (CreateActivity a) = encodeCreate h u a encodeSpecific h _ (AcceptActivity a) = encodeAccept h a
encodeSpecific _ _ (FollowActivity a) = encodeFollow a encodeSpecific h u (CreateActivity a) = encodeCreate h u a
encodeSpecific h u (OfferActivity a) = encodeOffer h u a encodeSpecific _ _ (FollowActivity a) = encodeFollow a
encodeSpecific h _ (PushActivity a) = encodePush h a encodeSpecific h u (OfferActivity a) = encodeOffer h u a
encodeSpecific _ _ (RejectActivity a) = encodeReject a encodeSpecific h _ (PushActivity a) = encodePush h a
encodeSpecific h _ (UndoActivity a) = encodeUndo h a encodeSpecific _ _ (RejectActivity a) = encodeReject a
encodeSpecific _ _ (ResolveActivity a) = encodeResolve a
encodeSpecific h _ (UndoActivity a) = encodeUndo h a
emptyAudience :: Audience u emptyAudience :: Audience u
emptyAudience = Audience [] [] [] [] [] [] emptyAudience = Audience [] [] [] [] [] []