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

S2S: Re-enable deckCreateNoteF

This commit is contained in:
fr33domlover 2022-10-16 12:14:30 +00:00
parent 71bceec18b
commit 2e7f9ef5e6
2 changed files with 74 additions and 67 deletions

View file

@ -15,7 +15,7 @@
module Vervis.Federation.Discussion module Vervis.Federation.Discussion
( personCreateNoteF ( personCreateNoteF
--, deckCreateNoteF , deckCreateNoteF
--, loomCreateNoteF --, loomCreateNoteF
) )
where where
@ -53,13 +53,14 @@ import Yesod.HttpSignature
import Database.Persist.JSON import Database.Persist.JSON
import Network.FedURI import Network.FedURI
import Network.HTTP.Digest import Network.HTTP.Digest
import Web.ActivityPub hiding (ActorLocal (..))
import Web.Text import Web.Text
import Yesod.ActivityPub import Yesod.ActivityPub
import Yesod.FedURI import Yesod.FedURI
import Yesod.Hashids import Yesod.Hashids
import Yesod.MonadSite import Yesod.MonadSite
import qualified Web.ActivityPub as AP
import Control.Monad.Trans.Except.Local import Control.Monad.Trans.Except.Local
import Data.Tuple.Local import Data.Tuple.Local
import Database.Persist.Local import Database.Persist.Local
@ -78,6 +79,7 @@ import Vervis.Persist.Discussion
import Vervis.Recipient import Vervis.Recipient
import Vervis.Settings import Vervis.Settings
import Vervis.Ticket import Vervis.Ticket
import Vervis.Web.Delivery
-- | Insert the new remote comment into the discussion tree. If we didn't have -- | Insert the new remote comment into the discussion tree. If we didn't have
-- this comment before, return the database ID of the newly created cached -- this comment before, return the database ID of the newly created cached
@ -170,7 +172,7 @@ personCreateNoteF
-> ActivityBody -> ActivityBody
-> Maybe (RecipientRoutes, ByteString) -> Maybe (RecipientRoutes, ByteString)
-> LocalURI -> LocalURI
-> Note URIMode -> AP.Note URIMode
-> ExceptT Text Handler Text -> ExceptT Text Handler Text
personCreateNoteF now recipPersonHash author body mfwd luCreate note = do personCreateNoteF now recipPersonHash author body mfwd luCreate note = do
@ -238,68 +240,74 @@ personCreateNoteF now recipPersonHash author body mfwd luCreate note = do
unless (messageRoot m == did) $ unless (messageRoot m == did) $
throwE "Remote parent belongs to a different discussion" throwE "Remote parent belongs to a different discussion"
{- deckCreateNoteF
projectCreateNoteF
:: UTCTime :: UTCTime
-> KeyHashid Project -> KeyHashid Deck
-> RemoteAuthor -> RemoteAuthor
-> ActivityBody -> ActivityBody
-> Maybe (LocalRecipientSet, ByteString) -> Maybe (RecipientRoutes, ByteString)
-> LocalURI -> LocalURI
-> Note URIMode -> AP.Note URIMode
-> ExceptT Text Handler Text -> ExceptT Text Handler Text
projectCreateNoteF now deckRecip author body mfwd luCreate note = do deckCreateNoteF now recipDeckHash author body mfwd luCreate note = do
(luNote, published, context, mparent, source, content) <- checkNote note
case context of recipDeckID <- decodeKeyHashid404 recipDeckHash
Right _ -> return "Not using; context isn't local" (luNote, published, Comment maybeParent topic source content) <- do
Left (NoteContextProjectTicket shr prj ltid) -> do (luId, luAuthor, published, comment) <- parseRemoteComment note
mremotesHttp <- runDBExcept $ do unless (luAuthor == objUriLocal (remoteAuthorURI author)) $
(jid, ibid) <- lift getProjectRecip404 throwE "Create author != note author"
(_, _, _, Entity _ lt, _, Entity _ tpl, _, _) <- do return (luId, published, comment)
mticket <- lift $ getProjectTicket shr prj ltid
fromMaybeE mticket "Context: No such project-ticket" case topic of
if ticketProjectLocalProject tpl == jid Right _ ->
then do pure "Topic is remote, i.e. not mine, so ignoring activity"
mractid <- lift $ insertToInbox now author body ibid luCreate False Left (CommentTopicCloth _ _) ->
case mractid of pure "Topic is a local cloth, i.e. not mine, so ignoring activity"
Nothing -> return $ Left "Activity already in my inbox" Left (CommentTopicTicket deckID taskID)
Just ractid -> do | deckID /= recipDeckID ->
let did = localTicketDiscuss lt pure "Topic is some other deck's ticket, so ignoring activity"
meparent <- traverse (getParent did) mparent | otherwise -> do
mmid <- lift $ insertToDiscussion author luNote published source content did meparent ractid msgOrForward <- runDBExcept $ do
case mmid of
Nothing -> return $ Left "I already have this comment, just storing in inbox" Entity recipActorID recipActor <- lift $ do
Just mid -> lift $ do deck <- get404 recipDeckID
updateOrphans author luNote did mid let actorID = deckActor deck
case mfwd of Entity actorID <$> getJust actorID
Nothing ->
return $ Left "Storing in inbox, caching comment, no inbox forwarding header" (_d, _td, Entity _ ticket, _a, _r) <- do
Just (localRecips, sig) -> Right <$> do mticket <- lift $ getTicket recipDeckID taskID
ltkhid <- encodeKeyHashid ltid fromMaybeE mticket "Topic: No such ticket in DB"
let sieve =
makeRecipientSet mractid <- lift $ insertToInbox now author body (actorInbox recipActor) luCreate False
[] case mractid of
[ LocalPersonCollectionProjectFollowers shrRecip prjRecip Nothing -> return $ Left "Activity already in my inbox"
, LocalPersonCollectionProjectTeam shrRecip prjRecip Just createID -> do
, LocalPersonCollectionProjectTicketFollowers shrRecip prjRecip ltkhid let did = ticketDiscuss ticket
--, LocalPersonCollectionProjectTicketTeam shrRecip prjRecip ltkhid meparent <- traverse (getMessageParent did) maybeParent
] mmid <- lift $ insertToDiscussion author luNote published source content did meparent createID
remoteRecips <- insertRemoteActivityToLocalInboxes False ractid $ localRecipSieve' sieve False False localRecips case mmid of
(sig,) <$> deliverRemoteDB_J (actbBL body) ractid jid sig remoteRecips Nothing -> return $ Left "I already have this comment, just storing in inbox"
else return $ Left "Context is a project-ticket of another project" Just mid -> lift $ do
case mremotesHttp of updateOrphans author luNote did mid
Left msg -> return msg case mfwd of
Right (sig, remotesHttp) -> do Nothing ->
forkWorker "projectCreateNoteF inbox forwarding by http" $ deliverRemoteHTTP_J now shrRecip prjRecip (actbBL body) sig remotesHttp return $ Left "Storing in inbox, caching comment, no inbox forwarding header"
return "Stored to inbox, cached comment, and did inbox forwarding" Just (localRecips, sig) -> Right <$> do
Left (NoteContextRepoProposal _ _ _) -> return "Context is a repo-patch, ignoring activity" taskHash <- encodeKeyHashid taskID
where let sieve =
getProjectRecip404 = do makeRecipientSet
sid <- getKeyBy404 $ UniqueSharer shrRecip []
Entity jid j <- getBy404 $ UniqueProject prjRecip sid [ LocalStageDeckFollowers recipDeckHash
a <- getJust $ projectActor j , LocalStageTicketFollowers recipDeckHash taskHash
return (jid, actorInbox a) ]
-} forwardActivityDB
(actbBL body) localRecips sig recipActorID
(LocalActorDeck recipDeckHash) sieve createID
case msgOrForward of
Left msg -> return msg
Right forwardHttp -> do
forkWorker "projectCreateNoteF inbox-forwarding" forwardHttp
return "Stored to inbox, cached comment, and did inbox forwarding"
{- {-
repoCreateNoteF repoCreateNoteF

View file

@ -100,6 +100,7 @@ import Vervis.Access
import Vervis.API import Vervis.API
import Vervis.Federation.Auth import Vervis.Federation.Auth
import Vervis.Federation.Collab import Vervis.Federation.Collab
import Vervis.Federation.Discussion
import Vervis.Federation.Ticket import Vervis.Federation.Ticket
import Vervis.FedURI import Vervis.FedURI
import Vervis.Form.Project import Vervis.Form.Project
@ -184,14 +185,12 @@ postDeckInboxR recipDeckHash =
case specific of case specific of
AP.AcceptActivity accept -> AP.AcceptActivity accept ->
deckAcceptF now recipDeckHash author body mfwd luActivity accept deckAcceptF now recipDeckHash author body mfwd luActivity accept
{- AP.CreateActivity (AP.Create obj mtarget) ->
CreateActivity (Create obj mtarget) ->
case obj of case obj of
CreateNote _ note -> AP.CreateNote _ note ->
(,Nothing) <$> projectCreateNoteF now shrRecip prjRecip remoteAuthor body mfwd luActivity note (,Nothing) <$> deckCreateNoteF now recipDeckHash author body mfwd luActivity note
CreateTicket _ ticket -> _ -> error "Unsupported create object type for decks"
(,Nothing) <$> projectCreateTicketF now shrRecip prjRecip remoteAuthor body mfwd luActivity ticket mtarget {-
_ -> error "Unsupported create object type for projects"
FollowActivity follow -> FollowActivity follow ->
(,Nothing) <$> projectFollowF shrRecip prjRecip now remoteAuthor body mfwd luActivity follow (,Nothing) <$> projectFollowF shrRecip prjRecip now remoteAuthor body mfwd luActivity follow
-} -}