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

S2S: sharerCreateTicketF: Tweak to use the new utils

Browse source
This commit is contained in:
fr33domlover 2020-07-15 10:14:41 +00:00
parent 1a8ecb5995
commit e46bcac559
1 changed files with 7 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -454,13 +454,16 @@ sharerCreateTicketF
-> ExceptT Text Handler Text -> ExceptT Text Handler Text
sharerCreateTicketF now shrRecip author body mfwd luCreate ticket muTarget = do sharerCreateTicketF now shrRecip author body mfwd luCreate ticket muTarget = do
(targetAndContext, _, _) <- checkCreateTicket author ticket muTarget (targetAndContext, _, _) <- checkCreateTicket author ticket muTarget
runDBExcept $ do mractid <- runDBExcept $ do
ibidRecip <- lift $ do ibidRecip <- lift $ do
sid <- getKeyBy404 $ UniqueSharer shrRecip sid <- getKeyBy404 $ UniqueSharer shrRecip
p <- getValBy404 $ UniquePersonIdent sid personInbox <$> getValBy404 (UniquePersonIdent sid)
return $ personInbox p
checkTargetAndContextDB targetAndContext checkTargetAndContextDB targetAndContext
lift $ insertToInbox luCreate ibidRecip lift $ insertToInbox now author body ibidRecip luCreate True
return $
case mractid of
Nothing -> "Activity already exists in my inbox"
Just _ -> "Activity inserted to my inbox"
where where
checkTargetAndContextDB (Left (_, shr, prj)) = do checkTargetAndContextDB (Left (_, shr, prj)) = do
mj <- lift $ runMaybeT $ do mj <- lift $ runMaybeT $ do
@ -469,22 +472,6 @@ sharerCreateTicketF now shrRecip author body mfwd luCreate ticket muTarget = do
unless (isJust mj) $ throwE "Local context: No such project" unless (isJust mj) $ throwE "Local context: No such project"
checkTargetAndContextDB (Right _) = return () checkTargetAndContextDB (Right _) = return ()
insertToInbox luAct ibidRecip = do
let iidAuthor = remoteAuthorInstance author
roid <-
either entityKey id <$> insertBy' (RemoteObject iidAuthor luAct)
let jsonObj = persistJSONFromBL $ actbBL body
ract = RemoteActivity roid jsonObj now
ractid <- either entityKey id <$> insertBy' ract
ibiid <- insert $ InboxItem True
mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid
let recip = shr2text shrRecip
case mibrid of
Nothing -> do
delete ibiid
return $ "Activity already exists in inbox of /s/" <> recip
Just _ -> return $ "Activity inserted to inbox of /s/" <> recip
projectCreateTicketF projectCreateTicketF
:: UTCTime :: UTCTime
-> ShrIdent -> ShrIdent