Add an Inbox table in DB, make inbox related tables use it instead of Person

This allows the inbox system to be separate from Person, allowing other kinds
of objects to have inboxes too. Much like there's FollowerSet which works
separately from Tickets, and will allow to have follower sets for projects,
users, etc. too.

Inboxes are made independent from Person users because I'm going to give
Projects inboxes too.
This commit is contained in:
fr33domlover 2019-06-09 13:16:32 +00:00
parent b1897a20c0
commit 090c562553
7 changed files with 170 additions and 59 deletions

View file

@ -34,6 +34,7 @@ Person
resetPassKey Text
resetPassKeyCreated UTCTime
about Text
inbox InboxId
UniquePersonIdent ident
UniquePersonLogin login
@ -44,15 +45,17 @@ OutboxItem
activity PersistActivity
published UTCTime
Inbox
InboxItem
unread Bool
InboxItemLocal
person PersonId
inbox InboxId
activity OutboxItemId
item InboxItemId
UniqueInboxItemLocal person activity
UniqueInboxItemLocal inbox activity
UniqueInboxItemLocalItem item
RemoteActivity
@ -64,11 +67,11 @@ RemoteActivity
UniqueRemoteActivity instance ident
InboxItemRemote
person PersonId
inbox InboxId
activity RemoteActivityId
item InboxItemId
UniqueInboxItemRemote person activity
UniqueInboxItemRemote inbox activity
UniqueInboxItemRemoteItem item
UnlinkedDelivery

View file

@ -0,0 +1,36 @@
Person
ident Int64
login Text
passphraseHash ByteString
email Text
verified Bool
verifiedKey Text
verifiedKeyCreated UTCTime
resetPassKey Text
resetPassKeyCreated UTCTime
about Text
inbox InboxId
UniquePersonIdent ident
UniquePersonLogin login
UniquePersonEmail email
Inbox
InboxItemLocal
person PersonId
inbox InboxId
activity Int64
item Int64
UniqueInboxItemLocal person activity
UniqueInboxItemLocalItem item
InboxItemRemote
person PersonId
inbox InboxId
activity Int64
item Int64
UniqueInboxItemRemote person activity
UniqueInboxItemRemoteItem item

View file

@ -578,9 +578,9 @@ handleSharerInbox _now shrRecip (Left pidAuthor) _raw activity = do
(shr,) <$> decodeKeyHashidE obkhid "Local activity: ID is invalid hashid"
_ -> throwE "Local activity: Not an activity route"
runDBExcept $ do
pidRecip <- lift $ do
Entity pidRecip personRecip <- lift $ do
sid <- getKeyBy404 $ UniqueSharer shrRecip
getKeyBy404 $ UniquePersonIdent sid
getBy404 $ UniquePersonIdent sid
mob <- lift $ get obid
ob <- fromMaybeE mob "Local activity: No such ID in DB"
let pidOutbox = outboxItemPerson ob
@ -593,12 +593,13 @@ handleSharerInbox _now shrRecip (Left pidAuthor) _raw activity = do
if pidRecip == pidAuthor
then return "Received activity authored by self, ignoring"
else lift $ do
ibid <- insert $ InboxItem True
miblid <- insertUnique $ InboxItemLocal pidRecip obid ibid
ibiid <- insert $ InboxItem True
let ibid = personInbox personRecip
miblid <- insertUnique $ InboxItemLocal ibid obid ibiid
let recip = shr2text shrRecip
case miblid of
Nothing -> do
delete ibid
delete ibiid
return $
"Activity already exists in inbox of /s/" <> recip
Just _ ->
@ -621,13 +622,13 @@ handleSharerInbox now shrRecip (Right iidSender) raw activity =
then return Nothing
else Just <$> parseParent uParent
ExceptT $ runDB $ do
pidRecip <- do
personRecip <- do
sid <- getKeyBy404 $ UniqueSharer shrRecip
getKeyBy404 $ UniquePersonIdent sid
getValBy404 $ UniquePersonIdent sid
valid <- checkContextParent context mparent
case valid of
Left e -> return $ Left e
Right _ -> Right <$> insertToInbox pidRecip
Right _ -> Right <$> insertToInbox (personInbox personRecip)
where
checkContextParent context mparent = runExceptT $ do
case context of
@ -671,17 +672,17 @@ handleSharerInbox now shrRecip (Right iidSender) raw activity =
did <- fromMaybeE mdid "Remote parent known, but no context RemoteDiscussion"
unless (messageRoot m == did) $
throwE "Remote parent belongs to a different discussion"
insertToInbox pidRecip = do
insertToInbox ibidRecip = do
let luActivity = activityId activity
jsonObj = PersistJSON raw
ract = RemoteActivity iidSender luActivity jsonObj now
ractid <- either entityKey id <$> insertBy' ract
ibid <- insert $ InboxItem True
mibrid <- insertUnique $ InboxItemRemote pidRecip ractid ibid
ibiid <- insert $ InboxItem True
mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid
let recip = shr2text shrRecip
case mibrid of
Nothing -> do
delete ibid
delete ibiid
return $ "Activity already exists in inbox of /s/" <> recip
Just _ -> return $ "Activity inserted to inbox of /s/" <> recip
@ -886,10 +887,11 @@ handleProjectInbox now shrRecip prjRecip iidSender hSender raidSender body raw a
-- TODO inefficient, see the other TODOs about mergeConcat
remotes = map (second $ NE.nubBy ((==) `on` fst4)) $ mergeConcat teamRemotes fsRemotes
for_ pids $ \ pid -> do
ibid <- insert $ InboxItem True
mibrid <- insertUnique $ InboxItemRemote pid ractid ibid
ibid <- personInbox <$> getJust pid
ibiid <- insert $ InboxItem True
mibrid <- insertUnique $ InboxItemRemote ibid ractid ibiid
when (isNothing mibrid) $
delete ibid
delete ibiid
return remotes
deliverRemoteDB
@ -1439,8 +1441,9 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished s
, map (second $ NE.nubBy ((==) `on` fst4)) $ mergeConcat teamRemotes fsRemotes
)
lift $ for_ (union recipPids morePids) $ \ pid -> do
ibid <- insert $ InboxItem True
insert_ $ InboxItemLocal pid obid ibid
ibid <- personInbox <$> getJust pid
ibiid <- insert $ InboxItem True
insert_ $ InboxItemLocal ibid obid ibiid
return remotes
where
getPersonId :: ShrIdent -> ExceptT Text AppDB PersonId

View file

@ -217,7 +217,7 @@ instance Yesod App where
for mperson' $ \ (p@(Entity pid person), verified) -> runDB $ do
sharer <- getJust $ personIdent person
unread <- do
vs <- countUnread pid
vs <- countUnread $ personInbox person
case vs :: [E.Value Int] of
[E.Value i] -> return i
_ -> error $ "countUnread returned " ++ show vs
@ -244,17 +244,17 @@ instance Yesod App where
$(widgetFile "default-layout")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
where
countUnread pid =
countUnread ibid =
E.select $ E.from $ \ (ib `E.LeftOuterJoin` ibl `E.LeftOuterJoin` ibr) -> do
E.on $ E.just (ib E.^. InboxItemId) E.==. ibr E.?. InboxItemRemoteItem
E.on $ E.just (ib E.^. InboxItemId) E.==. ibl E.?. InboxItemLocalItem
E.where_ $
( E.isNothing (ibr E.?. InboxItemRemotePerson) E.||.
ibr E.?. InboxItemRemotePerson E.==. E.just (E.val pid)
( E.isNothing (ibr E.?. InboxItemRemoteInbox) E.||.
ibr E.?. InboxItemRemoteInbox E.==. E.just (E.val ibid)
)
E.&&.
( E.isNothing (ibl E.?. InboxItemLocalPerson) E.||.
ibl E.?. InboxItemLocalPerson E.==. E.just (E.val pid)
( E.isNothing (ibl E.?. InboxItemLocalInbox) E.||.
ibl E.?. InboxItemLocalInbox E.==. E.just (E.val ibid)
)
E.&&.
ib E.^. InboxItemUnread E.==. E.val True
@ -576,6 +576,7 @@ instance AccountDB AccountPersistDB' where
mr <- getMessageRender
return $ Left $ mr $ MsgUsernameExists name
Right sid -> do
ibid <- insert Inbox
let defTime = UTCTime (ModifiedJulianDay 0) 0
person = Person
{ personIdent = sid
@ -588,6 +589,7 @@ instance AccountDB AccountPersistDB' where
, personResetPassKey = ""
, personResetPassKeyCreated = defTime
, personAbout = ""
, personInbox = ibid
}
pid <- insert person
return $ Right $ Entity pid person

View file

@ -147,10 +147,11 @@ getSharerInboxR :: ShrIdent -> Handler TypedContent
getSharerInboxR shr = do
(total, pages, mpage) <- runDB $ do
sid <- getKeyBy404 $ UniqueSharer shr
pid <- getKeyBy404 $ UniquePersonIdent sid
p <- getValBy404 $ UniquePersonIdent sid
let ibid = personInbox p
getPageAndNavCount
(countItems pid)
(\ off lim -> map adaptItem <$> getItems pid off lim)
(countItems ibid)
(\ off lim -> map adaptItem <$> getItems ibid off lim)
let here = SharerInboxR shr
encodeRouteLocal <- getEncodeRouteLocal
encodeRoutePageLocal <- getEncodeRoutePageLocal
@ -194,10 +195,10 @@ getSharerInboxR shr = do
let pageNav = navWidget navModel
in defaultLayout $(widgetFile "person/inbox")
where
countItems pid =
(+) <$> count [InboxItemLocalPerson ==. pid]
<*> count [InboxItemRemotePerson ==. pid]
getItems pid off lim =
countItems ibid =
(+) <$> count [InboxItemLocalInbox ==. ibid]
<*> count [InboxItemRemoteInbox ==. ibid]
getItems ibid off lim =
E.select $ E.from $
\ (ib `E.LeftOuterJoin` (ibl `E.InnerJoin` ob) `E.LeftOuterJoin` (ibr `E.InnerJoin` ract)) -> do
E.on $ ibr E.?. InboxItemRemoteActivity E.==. ract E.?. RemoteActivityId
@ -205,12 +206,12 @@ getSharerInboxR shr = do
E.on $ ibl E.?. InboxItemLocalActivity E.==. ob E.?. OutboxItemId
E.on $ E.just (ib E.^. InboxItemId) E.==. ibl E.?. InboxItemLocalItem
E.where_
$ ( E.isNothing (ibr E.?. InboxItemRemotePerson) E.||.
ibr E.?. InboxItemRemotePerson E.==. E.just (E.val pid)
$ ( E.isNothing (ibr E.?. InboxItemRemoteInbox) E.||.
ibr E.?. InboxItemRemoteInbox E.==. E.just (E.val ibid)
)
E.&&.
( E.isNothing (ibl E.?. InboxItemLocalPerson) E.||.
ibl E.?. InboxItemLocalPerson E.==. E.just (E.val pid)
( E.isNothing (ibl E.?. InboxItemLocalInbox) E.||.
ibl E.?. InboxItemLocalInbox E.==. E.just (E.val ibid)
)
E.orderBy [E.desc $ ib E.^. InboxItemId]
E.offset $ fromIntegral off
@ -511,8 +512,9 @@ getNotificationsR :: ShrIdent -> Handler Html
getNotificationsR shr = do
items <- runDB $ do
sid <- getKeyBy404 $ UniqueSharer shr
pid <- getKeyBy404 $ UniquePersonIdent sid
map adaptItem <$> getItems pid
p <- getValBy404 $ UniquePersonIdent sid
let ibid = personInbox p
map adaptItem <$> getItems ibid
notifications <- for items $ \ (ibid, activity) -> do
((_result, widget), enctype) <-
runFormPost $ notificationForm $ Just $ Just (ibid, False)
@ -521,7 +523,7 @@ getNotificationsR shr = do
runFormPost $ notificationForm $ Just Nothing
defaultLayout $(widgetFile "person/notifications")
where
getItems pid =
getItems ibid =
E.select $ E.from $
\ (ib `E.LeftOuterJoin` (ibl `E.InnerJoin` ob) `E.LeftOuterJoin` (ibr `E.InnerJoin` ract)) -> do
E.on $ ibr E.?. InboxItemRemoteActivity E.==. ract E.?. RemoteActivityId
@ -529,12 +531,12 @@ getNotificationsR shr = do
E.on $ ibl E.?. InboxItemLocalActivity E.==. ob E.?. OutboxItemId
E.on $ E.just (ib E.^. InboxItemId) E.==. ibl E.?. InboxItemLocalItem
E.where_
$ ( E.isNothing (ibr E.?. InboxItemRemotePerson) E.||.
ibr E.?. InboxItemRemotePerson E.==. E.just (E.val pid)
$ ( E.isNothing (ibr E.?. InboxItemRemoteInbox) E.||.
ibr E.?. InboxItemRemoteInbox E.==. E.just (E.val ibid)
)
E.&&.
( E.isNothing (ibl E.?. InboxItemLocalPerson) E.||.
ibl E.?. InboxItemLocalPerson E.==. E.just (E.val pid)
( E.isNothing (ibl E.?. InboxItemLocalInbox) E.||.
ibl E.?. InboxItemLocalInbox E.==. E.just (E.val ibid)
)
E.&&.
ib E.^. InboxItemUnread E.==. E.val True
@ -561,17 +563,18 @@ postNotificationsR shr = do
FormSuccess mitem -> do
(multi, markedUnread) <- runDB $ do
sid <- getKeyBy404 $ UniqueSharer shr
pid <- getKeyBy404 $ UniquePersonIdent sid
p <- getValBy404 $ UniquePersonIdent sid
let ibid = personInbox p
case mitem of
Nothing -> do
ibids <- map E.unValue <$> getItems pid
ibiids <- map E.unValue <$> getItems ibid
updateWhere
[InboxItemId <-. ibids]
[InboxItemId <-. ibiids]
[InboxItemUnread =. False]
return (True, False)
Just (ibid, unread) -> do
mibl <- getValBy $ UniqueInboxItemLocalItem ibid
mibr <- getValBy $ UniqueInboxItemRemoteItem ibid
Just (ibiid, unread) -> do
mibl <- getValBy $ UniqueInboxItemLocalItem ibiid
mibr <- getValBy $ UniqueInboxItemRemoteItem ibiid
mib <-
requireEitherM
mibl
@ -581,12 +584,12 @@ postNotificationsR shr = do
let samePid =
case mib of
Left ibl ->
inboxItemLocalPerson ibl == pid
inboxItemLocalInbox ibl == ibid
Right ibr ->
inboxItemRemotePerson ibr == pid
inboxItemRemoteInbox ibr == ibid
if samePid
then do
update ibid [InboxItemUnread =. unread]
update ibiid [InboxItemUnread =. unread]
return (False, unread)
else
permissionDenied
@ -603,18 +606,18 @@ postNotificationsR shr = do
setMessage $ toHtml $ "Marking as read failed:" <> T.pack (show l)
redirect $ NotificationsR shr
where
getItems pid =
getItems ibid =
E.select $ E.from $
\ (ib `E.LeftOuterJoin` ibl `E.LeftOuterJoin` ibr) -> do
E.on $ E.just (ib E.^. InboxItemId) E.==. ibr E.?. InboxItemRemoteItem
E.on $ E.just (ib E.^. InboxItemId) E.==. ibl E.?. InboxItemLocalItem
E.where_
$ ( E.isNothing (ibr E.?. InboxItemRemotePerson) E.||.
ibr E.?. InboxItemRemotePerson E.==. E.just (E.val pid)
$ ( E.isNothing (ibr E.?. InboxItemRemoteInbox) E.||.
ibr E.?. InboxItemRemoteInbox E.==. E.just (E.val ibid)
)
E.&&.
( E.isNothing (ibl E.?. InboxItemLocalPerson) E.||.
ibl E.?. InboxItemLocalPerson E.==. E.just (E.val pid)
( E.isNothing (ibl E.?. InboxItemLocalInbox) E.||.
ibl E.?. InboxItemLocalInbox E.==. E.just (E.val ibid)
)
E.&&.
ib E.^. InboxItemUnread E.==. E.val True

View file

@ -539,6 +539,60 @@ changes hLocal ctx =
, setFieldMaybe "Ticket" "closer"
-- 94
, removeField "Ticket" "creator"
-- 95
, addEntity $ ST.Entity "Inbox" [] []
-- 96
, addFieldRefRequired'
"Person"
Inbox20190607
(Just $ do
pids <- selectKeysList ([] :: [Filter Person20190607]) []
for_ pids $ \ pid -> do
ibid <- insert Inbox20190607
update pid [Person20190607Inbox =. ibid]
)
"inbox"
"Inbox"
-- 97
, addFieldRefRequired'
"InboxItemLocal"
Inbox20190607
(Just $ do
ibils <- selectList ([] :: [Filter InboxItemLocal20190607]) []
for_ ibils $ \ (Entity ibilid ibil) -> do
person <- getJust $ inboxItemLocal20190607Person ibil
let ibid = person20190607Inbox person
update ibilid [InboxItemLocal20190607Inbox =. ibid]
)
"inbox"
"Inbox"
-- 98
, addFieldRefRequired'
"InboxItemRemote"
Inbox20190607
(Just $ do
ibirs <- selectList ([] :: [Filter InboxItemRemote20190607]) []
for_ ibirs $ \ (Entity ibirid ibir) -> do
person <- getJust $ inboxItemRemote20190607Person ibir
let ibid = person20190607Inbox person
update ibirid [InboxItemRemote20190607Inbox =. ibid]
)
"inbox"
"Inbox"
-- 99
, removeUnique "InboxItemLocal" "UniqueInboxItemLocal"
-- 100
, removeField "InboxItemLocal" "person"
-- 101
, addUnique "InboxItemLocal" $
Unique "UniqueInboxItemLocal" ["inbox", "activity"]
-- 102
, removeUnique "InboxItemRemote" "UniqueInboxItemRemote"
-- 103
, removeField "InboxItemRemote" "person"
-- 104
, addUnique "InboxItemRemote" $
Unique "UniqueInboxItemRemote" ["inbox", "activity"]
]
migrateDB :: MonadIO m => Text -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int))

View file

@ -61,6 +61,13 @@ module Vervis.Migration.Model
, Ticket20190606Generic (..)
, Ticket20190606
, TicketAuthorLocal20190606Generic (..)
, Person20190607Generic (..)
, Person20190607
, Inbox20190607Generic (..)
, InboxItemLocal20190607Generic (..)
, InboxItemLocal20190607
, InboxItemRemote20190607Generic (..)
, InboxItemRemote20190607
)
where
@ -156,3 +163,6 @@ model_2019_06_06 = $(schema "2019_06_06")
makeEntitiesMigration "20190606"
$(modelFile "migrations/2019_06_06_mig.model")
makeEntitiesMigration "20190607"
$(modelFile "migrations/2019_06_07.model")