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 2020-05-27 11:39:19 +00:00
parent 06a051d2e5
commit c7b6ad643b

View file

@ -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,7 +269,10 @@ followF
(activityId $ actbActivity body)
"Follow without 'id'"
emsg <- lift $ runDB $ do
recip <- getRecip obj
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"
@ -382,20 +387,28 @@ 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
@ -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 (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