From 090c5625530368a171bfcb5445bd3b3fcb8b588a Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Sun, 9 Jun 2019 13:16:32 +0000 Subject: [PATCH] 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. --- config/models | 11 +++--- migrations/2019_06_07.model | 36 +++++++++++++++++++ src/Vervis/Federation.hs | 37 ++++++++++--------- src/Vervis/Foundation.hs | 14 ++++---- src/Vervis/Handler/Inbox.hs | 67 ++++++++++++++++++----------------- src/Vervis/Migration.hs | 54 ++++++++++++++++++++++++++++ src/Vervis/Migration/Model.hs | 10 ++++++ 7 files changed, 170 insertions(+), 59 deletions(-) create mode 100644 migrations/2019_06_07.model diff --git a/config/models b/config/models index bb8e8c5..65ab350 100644 --- a/config/models +++ b/config/models @@ -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 diff --git a/migrations/2019_06_07.model b/migrations/2019_06_07.model new file mode 100644 index 0000000..708f507 --- /dev/null +++ b/migrations/2019_06_07.model @@ -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 diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs index 1e604b4..1a51dff 100644 --- a/src/Vervis/Federation.hs +++ b/src/Vervis/Federation.hs @@ -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 diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 09c2015..bb656dd 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -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 diff --git a/src/Vervis/Handler/Inbox.hs b/src/Vervis/Handler/Inbox.hs index 365a576..85253ef 100644 --- a/src/Vervis/Handler/Inbox.hs +++ b/src/Vervis/Handler/Inbox.hs @@ -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 diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 955b86a..21f892e 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -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)) diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs index 6dc10a5..1d3e535 100644 --- a/src/Vervis/Migration/Model.hs +++ b/src/Vervis/Migration/Model.hs @@ -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")