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:
parent
b1897a20c0
commit
090c562553
7 changed files with 170 additions and 59 deletions
|
@ -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
|
||||
|
|
36
migrations/2019_06_07.model
Normal file
36
migrations/2019_06_07.model
Normal 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
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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")
|
||||
|
|
Loading…
Reference in a new issue