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")