sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-29 03:04:53 +09:00
Code Issues Activity

Switch activityId from LocalURI to Maybe LocalURI, for C2S posting without ID

Browse source
This commit is contained in:
fr33domlover 2019-06-19 08:53:31 +00:00
parent 1ae924558f
commit 7c30ee2d52
6 changed files with 47 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/Vervis/API.hs
View file

@ -440,7 +440,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
, messageRoot = did , messageRoot = did
} }
let activity luAct luNote = Doc host Activity let activity luAct luNote = Doc host Activity
{ activityId = luAct { activityId = Just luAct
, activityActor = luAttrib , activityActor = luAttrib
, activitySummary = , activitySummary =
Just $ TextHtml $ TL.toStrict $ renderHtml summary Just $ TextHtml $ TL.toStrict $ renderHtml summary

20
src/Vervis/Federation.hs
View file

@ -129,10 +129,14 @@ handleSharerInbox
-> ExceptT Text Handler Text -> ExceptT Text Handler Text
handleSharerInbox _now shrRecip (ActivityAuthLocalPerson pidAuthor) body = do handleSharerInbox _now shrRecip (ActivityAuthLocalPerson pidAuthor) body = do
(shrActivity, obiid) <- do (shrActivity, obiid) <- do
luAct <-
fromMaybeE
(activityId $ actbActivity body)
"Local activity: No 'id'"
route <- route <-
case decodeRouteLocal $ activityId $ actbActivity body of fromMaybeE
Nothing -> throwE "Local activity: Not a valid route" (decodeRouteLocal luAct)
Just r -> return r "Local activity: Not a valid route"
case route of case route of
SharerOutboxItemR shr obikhid -> SharerOutboxItemR shr obikhid ->
(shr,) <$> decodeKeyHashidE obikhid "Local activity: ID is invalid hashid" (shr,) <$> decodeKeyHashidE obikhid "Local activity: ID is invalid hashid"
@ -169,10 +173,14 @@ handleSharerInbox _now shrRecip (ActivityAuthLocalPerson pidAuthor) body = do
return $ "Activity inserted to inbox of /s/" <> recip return $ "Activity inserted to inbox of /s/" <> recip
handleSharerInbox _now shrRecip (ActivityAuthLocalProject jidAuthor) body = do handleSharerInbox _now shrRecip (ActivityAuthLocalProject jidAuthor) body = do
(shrActivity, prjActivity, obiid) <- do (shrActivity, prjActivity, obiid) <- do
luAct <-
fromMaybeE
(activityId $ actbActivity body)
"Local activity: No 'id'"
route <- route <-
case decodeRouteLocal $ activityId $ actbActivity body of fromMaybeE
Nothing -> throwE "Local activity: Not a valid route" (decodeRouteLocal luAct)
Just r -> return r "Local activity: Not a valid route"
case route of case route of
ProjectOutboxItemR shr prj obikhid -> ProjectOutboxItemR shr prj obikhid ->
(shr,prj,) <$> decodeKeyHashidE obikhid "Local activity: ID is invalid hashid" (shr,prj,) <$> decodeKeyHashidE obikhid "Local activity: ID is invalid hashid"

18
src/Vervis/Federation/Discussion.hs
View file

@ -107,6 +107,8 @@ sharerCreateNoteF
-> Note -> Note
-> ExceptT Text Handler Text -> ExceptT Text Handler Text
sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext mpublished _ _) = do sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext mpublished _ _) = do
luCreate <-
fromMaybeE (activityId $ actbActivity body) "Create without 'id'"
_luNote <- fromMaybeE mluNote "Note without note id" _luNote <- fromMaybeE mluNote "Note without note id"
_published <- fromMaybeE mpublished "Note without 'published' field" _published <- fromMaybeE mpublished "Note without 'published' field"
uContext <- fromMaybeE muContext "Note without context" uContext <- fromMaybeE muContext "Note without context"
@ -125,7 +127,8 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext
valid <- checkContextParent context mparent valid <- checkContextParent context mparent
case valid of case valid of
Left e -> return $ Left e Left e -> return $ Left e
Right _ -> Right <$> insertToInbox (personInbox personRecip) Right _ ->
Right <$> insertToInbox luCreate (personInbox personRecip)
where where
checkContextParent context mparent = runExceptT $ do checkContextParent context mparent = runExceptT $ do
case context of case context of
@ -169,11 +172,10 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext
did <- fromMaybeE mdid "Remote parent known, but no context RemoteDiscussion" did <- fromMaybeE mdid "Remote parent known, but no context RemoteDiscussion"
unless (messageRoot m == did) $ unless (messageRoot m == did) $
throwE "Remote parent belongs to a different discussion" throwE "Remote parent belongs to a different discussion"
insertToInbox ibidRecip = do insertToInbox luCreate ibidRecip = do
let iidAuthor = remoteAuthorInstance author let iidAuthor = remoteAuthorInstance author
luActivity = activityId $ actbActivity body
jsonObj = PersistJSON $ actbObject body jsonObj = PersistJSON $ actbObject body
ract = RemoteActivity iidAuthor luActivity jsonObj now ract = RemoteActivity iidAuthor luCreate jsonObj now
ractid <- either entityKey id <$> insertBy' ract ractid <- either entityKey id <$> insertBy' ract
ibiid <- insert $ InboxItem True ibiid <- insert $ InboxItem True
mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid
@ -199,6 +201,8 @@ projectCreateNoteF
-> Note -> Note
-> ExceptT Text Handler Text -> ExceptT Text Handler Text
projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent muCtx mpub src content) = do projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent muCtx mpub src content) = do
luCreate <-
fromMaybeE (activityId $ actbActivity body) "Create without 'id'"
luNote <- fromMaybeE mluNote "Note without note id" luNote <- fromMaybeE mluNote "Note without note id"
published <- fromMaybeE mpub "Note without 'published' field" published <- fromMaybeE mpub "Note without 'published' field"
uContext <- fromMaybeE muCtx "Note without context" uContext <- fromMaybeE muCtx "Note without context"
@ -224,7 +228,7 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
mremotesHttp <- runDBExcept $ do mremotesHttp <- runDBExcept $ do
(sid, fsidProject, fsidTicket, jid, ibid, did, meparent) <- getContextAndParent num mparent (sid, fsidProject, fsidTicket, jid, ibid, did, meparent) <- getContextAndParent num mparent
lift $ join <$> do lift $ join <$> do
mmid <- insertToDiscussion luNote published ibid did meparent fsidTicket mmid <- insertToDiscussion luCreate luNote published ibid did meparent fsidTicket
for mmid $ \ (ractid, mid) -> do for mmid $ \ (ractid, mid) -> do
updateOrphans luNote did mid updateOrphans luNote did mid
for msig $ \ sig -> do for msig $ \ sig -> do
@ -278,12 +282,12 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
return mid return mid
Nothing -> return $ Right $ l2f hParent luParent Nothing -> return $ Right $ l2f hParent luParent
return (sid, fsidProject, ticketFollowers t, jid, ibid, did, meparent) return (sid, fsidProject, ticketFollowers t, jid, ibid, did, meparent)
insertToDiscussion luNote published ibid did meparent fsid = do insertToDiscussion luCreate luNote published ibid did meparent fsid = do
let iidAuthor = remoteAuthorInstance author let iidAuthor = remoteAuthorInstance author
raidAuthor = remoteAuthorId author raidAuthor = remoteAuthorId author
ractid <- either entityKey id <$> insertBy' RemoteActivity ractid <- either entityKey id <$> insertBy' RemoteActivity
{ remoteActivityInstance = iidAuthor { remoteActivityInstance = iidAuthor
, remoteActivityIdent = activityId $ actbActivity body , remoteActivityIdent = luCreate
, remoteActivityContent = PersistJSON $ actbObject body , remoteActivityContent = PersistJSON $ actbObject body
, remoteActivityReceived = now , remoteActivityReceived = now
} }

16
src/Vervis/Federation/Ticket.hs
View file

@ -102,6 +102,7 @@ sharerOfferTicketF
-> ExceptT Text Handler Text -> ExceptT Text Handler Text
sharerOfferTicketF now shrRecip author body (Offer ticket uTarget) = do sharerOfferTicketF now shrRecip author body (Offer ticket uTarget) = do
(hProject, shrProject, prjProject) <- parseTarget uTarget (hProject, shrProject, prjProject) <- parseTarget uTarget
luOffer <- fromMaybeE (activityId $ actbActivity body) "Offer without 'id'"
deps <- checkOffer ticket hProject shrProject prjProject deps <- checkOffer ticket hProject shrProject prjProject
local <- hostIsLocal hProject local <- hostIsLocal hProject
runDBExcept $ do runDBExcept $ do
@ -110,7 +111,7 @@ sharerOfferTicketF now shrRecip author body (Offer ticket uTarget) = do
p <- getValBy404 $ UniquePersonIdent sid p <- getValBy404 $ UniquePersonIdent sid
return $ personInbox p return $ personInbox p
when local $ checkTargetAndDeps shrProject prjProject deps when local $ checkTargetAndDeps shrProject prjProject deps
lift $ insertToInbox ibidRecip lift $ insertToInbox luOffer ibidRecip
where where
parseTarget u = do parseTarget u = do
let (h, lu) = f2l u let (h, lu) = f2l u
@ -133,9 +134,8 @@ sharerOfferTicketF now shrRecip author body (Offer ticket uTarget) = do
mt <- lift $ getBy $ UniqueTicket jid dep mt <- lift $ getBy $ UniqueTicket jid dep
unless (isJust mt) $ unless (isJust mt) $
throwE "Local dep: No such ticket number in DB" throwE "Local dep: No such ticket number in DB"
insertToInbox ibidRecip = do insertToInbox luOffer ibidRecip = do
let iidAuthor = remoteAuthorInstance author let iidAuthor = remoteAuthorInstance author
luOffer = activityId $ actbActivity body
jsonObj = PersistJSON $ actbObject body jsonObj = PersistJSON $ actbObject body
ract = RemoteActivity iidAuthor luOffer jsonObj now ract = RemoteActivity iidAuthor luOffer jsonObj now
ractid <- either entityKey id <$> insertBy' ract ractid <- either entityKey id <$> insertBy' ract
@ -172,6 +172,10 @@ projectOfferTicketF
] ]
return t return t
Right () -> do Right () -> do
luOffer <-
fromMaybeE
(activityId $ actbActivity body)
"Offer without 'id'"
hLocal <- getsYesod siteInstanceHost hLocal <- getsYesod siteInstanceHost
deps <- checkOffer ticket hLocal shrRecip prjRecip deps <- checkOffer ticket hLocal shrRecip prjRecip
msig <- checkForward shrRecip prjRecip msig <- checkForward shrRecip prjRecip
@ -181,7 +185,7 @@ projectOfferTicketF
mremotesHttp <- runDBExcept $ do mremotesHttp <- runDBExcept $ do
(sid, jid, ibid, fsid, tids) <- getProjectAndDeps deps (sid, jid, ibid, fsid, tids) <- getProjectAndDeps deps
lift $ join <$> do lift $ join <$> do
mractid <- insertTicket jid ibid tids mractid <- insertTicket luOffer jid ibid tids
for mractid $ \ ractid -> for msig $ \ sig -> do for mractid $ \ ractid -> for msig $ \ sig -> do
remoteRecips <- deliverLocal ractid colls sid fsid remoteRecips <- deliverLocal ractid colls sid fsid
(sig,) <$> deliverRemoteDB (actbBL body) ractid jid sig remoteRecips (sig,) <$> deliverRemoteDB (actbBL body) ractid jid sig remoteRecips
@ -234,12 +238,12 @@ projectOfferTicketF
mtid <- lift $ getKeyBy $ UniqueTicket jid dep mtid <- lift $ getKeyBy $ UniqueTicket jid dep
fromMaybeE mtid "Local dep: No such ticket number in DB" fromMaybeE mtid "Local dep: No such ticket number in DB"
return (sid, jid, projectInbox j, projectFollowers j, tids) return (sid, jid, projectInbox j, projectFollowers j, tids)
insertTicket jid ibid deps = do insertTicket luOffer jid ibid deps = do
let iidAuthor = remoteAuthorInstance author let iidAuthor = remoteAuthorInstance author
raidAuthor = remoteAuthorId author raidAuthor = remoteAuthorId author
ractid <- either entityKey id <$> insertBy' RemoteActivity ractid <- either entityKey id <$> insertBy' RemoteActivity
{ remoteActivityInstance = iidAuthor { remoteActivityInstance = iidAuthor
, remoteActivityIdent = activityId $ actbActivity body , remoteActivityIdent = luOffer
, remoteActivityContent = PersistJSON $ actbObject body , remoteActivityContent = PersistJSON $ actbObject body
, remoteActivityReceived = now , remoteActivityReceived = now
} }

8
src/Vervis/Migration.hs
View file

@ -317,7 +317,7 @@ changes hLocal ctx =
let localUri = LocalURI "/x/y" "" let localUri = LocalURI "/x/y" ""
fedUri = l2f "x.y" localUri fedUri = l2f "x.y" localUri
doc = Doc "x.y" Activity doc = Doc "x.y" Activity
{ activityId = localUri { activityId = Nothing
, activityActor = localUri , activityActor = localUri
, activitySummary = Nothing , activitySummary = Nothing
, activityAudience = Audience [] [] [] [] [] [] , activityAudience = Audience [] [] [] [] [] []
@ -439,7 +439,7 @@ changes hLocal ctx =
luAttrib = LocalURI ("/s/" <> shr2text shr) "" luAttrib = LocalURI ("/s/" <> shr2text shr) ""
activity luAct luNote = Doc hLocal Activity activity luAct luNote = Doc hLocal Activity
{ activityId = luAct { activityId = Just luAct
, activityActor = luAttrib , activityActor = luAttrib
, activitySummary = Nothing , activitySummary = Nothing
, activityAudience = aud , activityAudience = aud
@ -684,7 +684,7 @@ changes hLocal ctx =
let localUri = LocalURI "/x/y" "" let localUri = LocalURI "/x/y" ""
fedUri = l2f "x.y" localUri fedUri = l2f "x.y" localUri
doc = Doc "x.y" Activity doc = Doc "x.y" Activity
{ activityId = localUri { activityId = Nothing
, activityActor = localUri , activityActor = localUri
, activitySummary = Nothing , activitySummary = Nothing
, activityAudience = Audience [] [] [] [] [] [] , activityAudience = Audience [] [] [] [] [] []
@ -748,7 +748,7 @@ changes hLocal ctx =
: #{ticket20190612Title ticket}. : #{ticket20190612Title ticket}.
|] |]
doc luAct = Doc hLocal Activity doc luAct = Doc hLocal Activity
{ activityId = luAct { activityId = Just luAct
, activityActor = author , activityActor = author
, activitySummary = , activitySummary =
Just $ TextHtml $ TL.toStrict $ renderHtml $ Just $ TextHtml $ TL.toStrict $ renderHtml $

13
src/Web/ActivityPub.hs
View file

@ -759,7 +759,7 @@ data SpecificActivity
| RejectActivity Reject | RejectActivity Reject
data Activity = Activity data Activity = Activity
{ activityId :: LocalURI { activityId :: Maybe LocalURI
, activityActor :: LocalURI , activityActor :: LocalURI
, activitySummary :: Maybe TextHtml , activitySummary :: Maybe TextHtml
, activityAudience :: Audience , activityAudience :: Audience
@ -769,11 +769,12 @@ data Activity = Activity
instance ActivityPub Activity where instance ActivityPub Activity where
jsonldContext _ = [as2Context, forgeContext, extContext] jsonldContext _ = [as2Context, forgeContext, extContext]
parseObject o = do parseObject o = do
(h, id_) <- f2l <$> o .: "id" (h, actor) <- f2l <$> o .: "actor"
actor <- withHost h $ f2l <$> o .: "actor"
fmap (h,) $ fmap (h,) $
Activity id_ actor Activity
<$> (fmap (TextHtml . sanitizeBalance) <$> o .:? "summary") <$> withHostMaybe h (fmap f2l <$> o .:? "id")
<*> pure actor
<*> (fmap (TextHtml . sanitizeBalance) <$> o .:? "summary")
<*> parseAudience o <*> parseAudience o
<*> do <*> do
typ <- o .: "type" typ <- o .: "type"
@ -788,7 +789,7 @@ instance ActivityPub Activity where
"Unrecognized activity type: " ++ T.unpack typ "Unrecognized activity type: " ++ T.unpack typ
toSeries host (Activity id_ actor summary audience specific) toSeries host (Activity id_ actor summary audience specific)
= "type" .= activityType specific = "type" .= activityType specific
<> "id" .= l2f host id_ <> "id" .=? (l2f host <$> id_)
<> "actor" .= l2f host actor <> "actor" .= l2f host actor
<> "summary" .=? summary <> "summary" .=? summary
<> encodeAudience audience <> encodeAudience audience