mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-27 18:24:51 +09:00
S2S: Support following sharer-patch and repo-patch
Also fixed a bug in which trying to follow a ticket with nonexistent ltkhid/talkhid would result with 404 as if the actor inbox is nonexistent. Now, there's a friendly message reported.
This commit is contained in:
fr33domlover
parent
06a051d2e5
commit
c7b6ad643b
1 changed files with 81 additions and 54 deletions
|
|
@ -80,6 +80,8 @@ import Vervis.Foundation
|
|||
import Vervis.Model
|
||||
import Vervis.Model.Ident
|
||||
import Vervis.Model.Ticket
|
||||
import Vervis.Patch
|
||||
import Vervis.Ticket
|
||||
|
||||
sharerAcceptF
|
||||
:: ShrIdent
|
||||
|
|
@ -240,7 +242,7 @@ sharerRejectF shr now author body (Reject (ObjURI hOffer luOffer)) = do
|
|||
followF
|
||||
:: (Route App -> Maybe a)
|
||||
-> Route App
|
||||
-> (a -> AppDB b)
|
||||
-> (a -> AppDB (Maybe b))
|
||||
-> (b -> InboxId)
|
||||
-> (b -> OutboxId)
|
||||
-> (b -> FollowerSetId)
|
||||
|
|
@ -267,30 +269,33 @@ followF
|
|||
(activityId $ actbActivity body)
|
||||
"Follow without 'id'"
|
||||
emsg <- lift $ runDB $ do
|
||||
recip <- getRecip obj
|
||||
newItem <- insertToInbox luFollow $ recipInbox recip
|
||||
case newItem of
|
||||
Nothing -> return $ Left "Activity already exists in inbox, not using"
|
||||
Just ractid -> do
|
||||
let raidAuthor = remoteAuthorId author
|
||||
ra <- getJust raidAuthor
|
||||
ro <- getJust $ remoteActorIdent ra
|
||||
(obiid, doc) <-
|
||||
insertAcceptToOutbox
|
||||
ra
|
||||
luFollow
|
||||
(recipOutbox recip)
|
||||
newFollow <- insertFollow ractid obiid $ recipFollowers recip
|
||||
if newFollow
|
||||
then Right <$> do
|
||||
let raInfo = RemoteRecipient raidAuthor (remoteObjectIdent ro) (remoteActorInbox ra) (remoteActorErrorSince ra)
|
||||
iidAuthor = remoteAuthorInstance author
|
||||
hAuthor = objUriAuthority $ remoteAuthorURI author
|
||||
hostSection = ((iidAuthor, hAuthor), raInfo :| [])
|
||||
(obiid, doc,) <$> deliverRemoteDB' dont obiid [] [hostSection]
|
||||
else do
|
||||
delete obiid
|
||||
return $ Left "You're already a follower of me"
|
||||
mrecip <- getRecip obj
|
||||
case mrecip of
|
||||
Nothing -> return $ Left "Follow object not found, ignoring activity"
|
||||
Just recip -> do
|
||||
newItem <- insertToInbox luFollow $ recipInbox recip
|
||||
case newItem of
|
||||
Nothing -> return $ Left "Activity already exists in inbox, not using"
|
||||
Just ractid -> do
|
||||
let raidAuthor = remoteAuthorId author
|
||||
ra <- getJust raidAuthor
|
||||
ro <- getJust $ remoteActorIdent ra
|
||||
(obiid, doc) <-
|
||||
insertAcceptToOutbox
|
||||
ra
|
||||
luFollow
|
||||
(recipOutbox recip)
|
||||
newFollow <- insertFollow ractid obiid $ recipFollowers recip
|
||||
if newFollow
|
||||
then Right <$> do
|
||||
let raInfo = RemoteRecipient raidAuthor (remoteObjectIdent ro) (remoteActorInbox ra) (remoteActorErrorSince ra)
|
||||
iidAuthor = remoteAuthorInstance author
|
||||
hAuthor = objUriAuthority $ remoteAuthorURI author
|
||||
hostSection = ((iidAuthor, hAuthor), raInfo :| [])
|
||||
(obiid, doc,) <$> deliverRemoteDB' dont obiid [] [hostSection]
|
||||
else do
|
||||
delete obiid
|
||||
return $ Left "You're already a follower of me"
|
||||
case emsg of
|
||||
Left msg -> return msg
|
||||
Right (obiid, doc, remotesHttp) -> do
|
||||
|
|
@ -382,23 +387,31 @@ sharerFollowF shr =
|
|||
objRoute (SharerR shr')
|
||||
| shr == shr' = Just Nothing
|
||||
objRoute (SharerTicketR shr' talkhid)
|
||||
| shr == shr' = Just $ Just talkhid
|
||||
| shr == shr' = Just $ Just (talkhid, False)
|
||||
objRoute (SharerPatchR shr' talkhid)
|
||||
| shr == shr' = Just $ Just (talkhid, True)
|
||||
objRoute _ = Nothing
|
||||
|
||||
getRecip mtalkhid = do
|
||||
sid <- getKeyBy404 $ UniqueSharer shr
|
||||
Entity pid p <- getBy404 $ UniquePersonIdent sid
|
||||
mt <- for mtalkhid $ \ talkhid -> do
|
||||
talid <- decodeKeyHashid404 talkhid
|
||||
tal <- get404 talid
|
||||
unless (ticketAuthorLocalAuthor tal == pid) notFound
|
||||
mtup <- getBy $ UniqueTicketUnderProjectAuthor talid
|
||||
unless (isNothing mtup) notFound
|
||||
getJust $ ticketAuthorLocalTicket tal
|
||||
return (p, mt)
|
||||
p <- getValBy404 $ UniquePersonIdent sid
|
||||
mmt <- for mtalkhid $ \ (talkhid, patch) -> runMaybeT $ do
|
||||
talid <- decodeKeyHashidM talkhid
|
||||
if patch
|
||||
then do
|
||||
(_, Entity _ lt, _, _, _) <- MaybeT $ getSharerPatch shr talid
|
||||
return lt
|
||||
else do
|
||||
(_, Entity _ lt, _, _) <- MaybeT $ getSharerTicket shr talid
|
||||
return lt
|
||||
return $
|
||||
case mmt of
|
||||
Nothing -> Just (p, Nothing)
|
||||
Just Nothing -> Nothing
|
||||
Just (Just t) -> Just (p, Just t)
|
||||
|
||||
followers (p, Nothing) = personFollowers p
|
||||
followers (_, Just lt) = localTicketFollowers lt
|
||||
followers (p, Nothing) = personFollowers p
|
||||
followers (_, Just lt) = localTicketFollowers lt
|
||||
|
||||
projectFollowF
|
||||
:: ShrIdent
|
||||
|
|
@ -426,17 +439,16 @@ projectFollowF shr prj =
|
|||
|
||||
getRecip mltkhid = do
|
||||
sid <- getKeyBy404 $ UniqueSharer shr
|
||||
Entity jid j <- getBy404 $ UniqueProject prj sid
|
||||
mt <- for mltkhid $ \ ltkhid -> do
|
||||
ltid <- decodeKeyHashid404 ltkhid
|
||||
lt <- get404 ltid
|
||||
tclid <-
|
||||
getKeyBy404 $ UniqueTicketContextLocal $ localTicketTicket lt
|
||||
tpl <-
|
||||
getValBy404 $ UniqueTicketProjectLocal tclid
|
||||
unless (ticketProjectLocalProject tpl == jid) notFound
|
||||
j <- getValBy404 $ UniqueProject prj sid
|
||||
mmt <- for mltkhid $ \ ltkhid -> runMaybeT $ do
|
||||
ltid <- decodeKeyHashidM ltkhid
|
||||
(_, _, _, Entity _ lt, _, _, _) <- MaybeT $ getProjectTicket shr prj ltid
|
||||
return lt
|
||||
return (j, mt)
|
||||
return $
|
||||
case mmt of
|
||||
Nothing -> Just (j, Nothing)
|
||||
Just Nothing -> Nothing
|
||||
Just (Just t) -> Just (j, Just t)
|
||||
|
||||
followers (j, Nothing) = projectFollowers j
|
||||
followers (_, Just lt) = localTicketFollowers lt
|
||||
|
|
@ -454,17 +466,32 @@ repoFollowF shr rp =
|
|||
objRoute
|
||||
(RepoR shr rp)
|
||||
getRecip
|
||||
repoInbox
|
||||
repoOutbox
|
||||
repoFollowers
|
||||
(repoInbox . fst)
|
||||
(repoOutbox . fst)
|
||||
followers
|
||||
(RepoOutboxItemR shr rp)
|
||||
where
|
||||
objRoute (RepoR shr' rp') | shr == shr' && rp == rp' = Just ()
|
||||
objRoute _ = Nothing
|
||||
objRoute (RepoR shr' rp')
|
||||
| shr == shr' && rp == rp' = Just Nothing
|
||||
objRoute (RepoPatchR shr' rp' ltkhid)
|
||||
| shr == shr' && rp == rp' = Just $ Just ltkhid
|
||||
objRoute _ = Nothing
|
||||
|
||||
getRecip () = do
|
||||
getRecip mltkhid = do
|
||||
sid <- getKeyBy404 $ UniqueSharer shr
|
||||
getValBy404 $ UniqueRepo rp sid
|
||||
r <- getValBy404 $ UniqueRepo rp sid
|
||||
mmt <- for mltkhid $ \ ltkhid -> runMaybeT $ do
|
||||
ltid <- decodeKeyHashidM ltkhid
|
||||
(_, _, _, Entity _ lt, _, _, _, _) <- MaybeT $ getRepoPatch shr rp ltid
|
||||
return lt
|
||||
return $
|
||||
case mmt of
|
||||
Nothing -> Just (r, Nothing)
|
||||
Just Nothing -> Nothing
|
||||
Just (Just t) -> Just (r, Just t)
|
||||
|
||||
followers (r, Nothing) = repoFollowers r
|
||||
followers (_, Just lt) = localTicketFollowers lt
|
||||
|
||||
undoF
|
||||
:: Route App
|
||||
|
|
|
|||
Loading…
Reference in a new issue