Switch activityId from LocalURI to Maybe LocalURI, for C2S posting without ID
This commit is contained in:
parent
1ae924558f
commit
7c30ee2d52
6 changed files with 47 additions and 30 deletions
|
@ -440,7 +440,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
|
|||
, messageRoot = did
|
||||
}
|
||||
let activity luAct luNote = Doc host Activity
|
||||
{ activityId = luAct
|
||||
{ activityId = Just luAct
|
||||
, activityActor = luAttrib
|
||||
, activitySummary =
|
||||
Just $ TextHtml $ TL.toStrict $ renderHtml summary
|
||||
|
|
|
@ -129,10 +129,14 @@ handleSharerInbox
|
|||
-> ExceptT Text Handler Text
|
||||
handleSharerInbox _now shrRecip (ActivityAuthLocalPerson pidAuthor) body = do
|
||||
(shrActivity, obiid) <- do
|
||||
luAct <-
|
||||
fromMaybeE
|
||||
(activityId $ actbActivity body)
|
||||
"Local activity: No 'id'"
|
||||
route <-
|
||||
case decodeRouteLocal $ activityId $ actbActivity body of
|
||||
Nothing -> throwE "Local activity: Not a valid route"
|
||||
Just r -> return r
|
||||
fromMaybeE
|
||||
(decodeRouteLocal luAct)
|
||||
"Local activity: Not a valid route"
|
||||
case route of
|
||||
SharerOutboxItemR shr obikhid ->
|
||||
(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
|
||||
handleSharerInbox _now shrRecip (ActivityAuthLocalProject jidAuthor) body = do
|
||||
(shrActivity, prjActivity, obiid) <- do
|
||||
luAct <-
|
||||
fromMaybeE
|
||||
(activityId $ actbActivity body)
|
||||
"Local activity: No 'id'"
|
||||
route <-
|
||||
case decodeRouteLocal $ activityId $ actbActivity body of
|
||||
Nothing -> throwE "Local activity: Not a valid route"
|
||||
Just r -> return r
|
||||
fromMaybeE
|
||||
(decodeRouteLocal luAct)
|
||||
"Local activity: Not a valid route"
|
||||
case route of
|
||||
ProjectOutboxItemR shr prj obikhid ->
|
||||
(shr,prj,) <$> decodeKeyHashidE obikhid "Local activity: ID is invalid hashid"
|
||||
|
|
|
@ -107,6 +107,8 @@ sharerCreateNoteF
|
|||
-> Note
|
||||
-> ExceptT Text Handler Text
|
||||
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"
|
||||
_published <- fromMaybeE mpublished "Note without 'published' field"
|
||||
uContext <- fromMaybeE muContext "Note without context"
|
||||
|
@ -125,7 +127,8 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext
|
|||
valid <- checkContextParent context mparent
|
||||
case valid of
|
||||
Left e -> return $ Left e
|
||||
Right _ -> Right <$> insertToInbox (personInbox personRecip)
|
||||
Right _ ->
|
||||
Right <$> insertToInbox luCreate (personInbox personRecip)
|
||||
where
|
||||
checkContextParent context mparent = runExceptT $ do
|
||||
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"
|
||||
unless (messageRoot m == did) $
|
||||
throwE "Remote parent belongs to a different discussion"
|
||||
insertToInbox ibidRecip = do
|
||||
insertToInbox luCreate ibidRecip = do
|
||||
let iidAuthor = remoteAuthorInstance author
|
||||
luActivity = activityId $ actbActivity body
|
||||
jsonObj = PersistJSON $ actbObject body
|
||||
ract = RemoteActivity iidAuthor luActivity jsonObj now
|
||||
ract = RemoteActivity iidAuthor luCreate jsonObj now
|
||||
ractid <- either entityKey id <$> insertBy' ract
|
||||
ibiid <- insert $ InboxItem True
|
||||
mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid
|
||||
|
@ -199,6 +201,8 @@ projectCreateNoteF
|
|||
-> Note
|
||||
-> ExceptT Text Handler Text
|
||||
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"
|
||||
published <- fromMaybeE mpub "Note without 'published' field"
|
||||
uContext <- fromMaybeE muCtx "Note without context"
|
||||
|
@ -224,7 +228,7 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
|
|||
mremotesHttp <- runDBExcept $ do
|
||||
(sid, fsidProject, fsidTicket, jid, ibid, did, meparent) <- getContextAndParent num mparent
|
||||
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
|
||||
updateOrphans luNote did mid
|
||||
for msig $ \ sig -> do
|
||||
|
@ -278,12 +282,12 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
|
|||
return mid
|
||||
Nothing -> return $ Right $ l2f hParent luParent
|
||||
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
|
||||
raidAuthor = remoteAuthorId author
|
||||
ractid <- either entityKey id <$> insertBy' RemoteActivity
|
||||
{ remoteActivityInstance = iidAuthor
|
||||
, remoteActivityIdent = activityId $ actbActivity body
|
||||
, remoteActivityIdent = luCreate
|
||||
, remoteActivityContent = PersistJSON $ actbObject body
|
||||
, remoteActivityReceived = now
|
||||
}
|
||||
|
|
|
@ -102,6 +102,7 @@ sharerOfferTicketF
|
|||
-> ExceptT Text Handler Text
|
||||
sharerOfferTicketF now shrRecip author body (Offer ticket uTarget) = do
|
||||
(hProject, shrProject, prjProject) <- parseTarget uTarget
|
||||
luOffer <- fromMaybeE (activityId $ actbActivity body) "Offer without 'id'"
|
||||
deps <- checkOffer ticket hProject shrProject prjProject
|
||||
local <- hostIsLocal hProject
|
||||
runDBExcept $ do
|
||||
|
@ -110,7 +111,7 @@ sharerOfferTicketF now shrRecip author body (Offer ticket uTarget) = do
|
|||
p <- getValBy404 $ UniquePersonIdent sid
|
||||
return $ personInbox p
|
||||
when local $ checkTargetAndDeps shrProject prjProject deps
|
||||
lift $ insertToInbox ibidRecip
|
||||
lift $ insertToInbox luOffer ibidRecip
|
||||
where
|
||||
parseTarget u = do
|
||||
let (h, lu) = f2l u
|
||||
|
@ -133,9 +134,8 @@ sharerOfferTicketF now shrRecip author body (Offer ticket uTarget) = do
|
|||
mt <- lift $ getBy $ UniqueTicket jid dep
|
||||
unless (isJust mt) $
|
||||
throwE "Local dep: No such ticket number in DB"
|
||||
insertToInbox ibidRecip = do
|
||||
insertToInbox luOffer ibidRecip = do
|
||||
let iidAuthor = remoteAuthorInstance author
|
||||
luOffer = activityId $ actbActivity body
|
||||
jsonObj = PersistJSON $ actbObject body
|
||||
ract = RemoteActivity iidAuthor luOffer jsonObj now
|
||||
ractid <- either entityKey id <$> insertBy' ract
|
||||
|
@ -172,6 +172,10 @@ projectOfferTicketF
|
|||
]
|
||||
return t
|
||||
Right () -> do
|
||||
luOffer <-
|
||||
fromMaybeE
|
||||
(activityId $ actbActivity body)
|
||||
"Offer without 'id'"
|
||||
hLocal <- getsYesod siteInstanceHost
|
||||
deps <- checkOffer ticket hLocal shrRecip prjRecip
|
||||
msig <- checkForward shrRecip prjRecip
|
||||
|
@ -181,7 +185,7 @@ projectOfferTicketF
|
|||
mremotesHttp <- runDBExcept $ do
|
||||
(sid, jid, ibid, fsid, tids) <- getProjectAndDeps deps
|
||||
lift $ join <$> do
|
||||
mractid <- insertTicket jid ibid tids
|
||||
mractid <- insertTicket luOffer jid ibid tids
|
||||
for mractid $ \ ractid -> for msig $ \ sig -> do
|
||||
remoteRecips <- deliverLocal ractid colls sid fsid
|
||||
(sig,) <$> deliverRemoteDB (actbBL body) ractid jid sig remoteRecips
|
||||
|
@ -234,12 +238,12 @@ projectOfferTicketF
|
|||
mtid <- lift $ getKeyBy $ UniqueTicket jid dep
|
||||
fromMaybeE mtid "Local dep: No such ticket number in DB"
|
||||
return (sid, jid, projectInbox j, projectFollowers j, tids)
|
||||
insertTicket jid ibid deps = do
|
||||
insertTicket luOffer jid ibid deps = do
|
||||
let iidAuthor = remoteAuthorInstance author
|
||||
raidAuthor = remoteAuthorId author
|
||||
ractid <- either entityKey id <$> insertBy' RemoteActivity
|
||||
{ remoteActivityInstance = iidAuthor
|
||||
, remoteActivityIdent = activityId $ actbActivity body
|
||||
, remoteActivityIdent = luOffer
|
||||
, remoteActivityContent = PersistJSON $ actbObject body
|
||||
, remoteActivityReceived = now
|
||||
}
|
||||
|
|
|
@ -317,7 +317,7 @@ changes hLocal ctx =
|
|||
let localUri = LocalURI "/x/y" ""
|
||||
fedUri = l2f "x.y" localUri
|
||||
doc = Doc "x.y" Activity
|
||||
{ activityId = localUri
|
||||
{ activityId = Nothing
|
||||
, activityActor = localUri
|
||||
, activitySummary = Nothing
|
||||
, activityAudience = Audience [] [] [] [] [] []
|
||||
|
@ -439,7 +439,7 @@ changes hLocal ctx =
|
|||
|
||||
luAttrib = LocalURI ("/s/" <> shr2text shr) ""
|
||||
activity luAct luNote = Doc hLocal Activity
|
||||
{ activityId = luAct
|
||||
{ activityId = Just luAct
|
||||
, activityActor = luAttrib
|
||||
, activitySummary = Nothing
|
||||
, activityAudience = aud
|
||||
|
@ -684,7 +684,7 @@ changes hLocal ctx =
|
|||
let localUri = LocalURI "/x/y" ""
|
||||
fedUri = l2f "x.y" localUri
|
||||
doc = Doc "x.y" Activity
|
||||
{ activityId = localUri
|
||||
{ activityId = Nothing
|
||||
, activityActor = localUri
|
||||
, activitySummary = Nothing
|
||||
, activityAudience = Audience [] [] [] [] [] []
|
||||
|
@ -748,7 +748,7 @@ changes hLocal ctx =
|
|||
: #{ticket20190612Title ticket}.
|
||||
|]
|
||||
doc luAct = Doc hLocal Activity
|
||||
{ activityId = luAct
|
||||
{ activityId = Just luAct
|
||||
, activityActor = author
|
||||
, activitySummary =
|
||||
Just $ TextHtml $ TL.toStrict $ renderHtml $
|
||||
|
|
|
@ -759,7 +759,7 @@ data SpecificActivity
|
|||
| RejectActivity Reject
|
||||
|
||||
data Activity = Activity
|
||||
{ activityId :: LocalURI
|
||||
{ activityId :: Maybe LocalURI
|
||||
, activityActor :: LocalURI
|
||||
, activitySummary :: Maybe TextHtml
|
||||
, activityAudience :: Audience
|
||||
|
@ -769,11 +769,12 @@ data Activity = Activity
|
|||
instance ActivityPub Activity where
|
||||
jsonldContext _ = [as2Context, forgeContext, extContext]
|
||||
parseObject o = do
|
||||
(h, id_) <- f2l <$> o .: "id"
|
||||
actor <- withHost h $ f2l <$> o .: "actor"
|
||||
(h, actor) <- f2l <$> o .: "actor"
|
||||
fmap (h,) $
|
||||
Activity id_ actor
|
||||
<$> (fmap (TextHtml . sanitizeBalance) <$> o .:? "summary")
|
||||
Activity
|
||||
<$> withHostMaybe h (fmap f2l <$> o .:? "id")
|
||||
<*> pure actor
|
||||
<*> (fmap (TextHtml . sanitizeBalance) <$> o .:? "summary")
|
||||
<*> parseAudience o
|
||||
<*> do
|
||||
typ <- o .: "type"
|
||||
|
@ -788,7 +789,7 @@ instance ActivityPub Activity where
|
|||
"Unrecognized activity type: " ++ T.unpack typ
|
||||
toSeries host (Activity id_ actor summary audience specific)
|
||||
= "type" .= activityType specific
|
||||
<> "id" .= l2f host id_
|
||||
<> "id" .=? (l2f host <$> id_)
|
||||
<> "actor" .= l2f host actor
|
||||
<> "summary" .=? summary
|
||||
<> encodeAudience audience
|
||||
|
|
Loading…
Reference in a new issue