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
|
resetPassKey Text
|
||||||
resetPassKeyCreated UTCTime
|
resetPassKeyCreated UTCTime
|
||||||
about Text
|
about Text
|
||||||
|
inbox InboxId
|
||||||
|
|
||||||
UniquePersonIdent ident
|
UniquePersonIdent ident
|
||||||
UniquePersonLogin login
|
UniquePersonLogin login
|
||||||
|
@ -44,15 +45,17 @@ OutboxItem
|
||||||
activity PersistActivity
|
activity PersistActivity
|
||||||
published UTCTime
|
published UTCTime
|
||||||
|
|
||||||
|
Inbox
|
||||||
|
|
||||||
InboxItem
|
InboxItem
|
||||||
unread Bool
|
unread Bool
|
||||||
|
|
||||||
InboxItemLocal
|
InboxItemLocal
|
||||||
person PersonId
|
inbox InboxId
|
||||||
activity OutboxItemId
|
activity OutboxItemId
|
||||||
item InboxItemId
|
item InboxItemId
|
||||||
|
|
||||||
UniqueInboxItemLocal person activity
|
UniqueInboxItemLocal inbox activity
|
||||||
UniqueInboxItemLocalItem item
|
UniqueInboxItemLocalItem item
|
||||||
|
|
||||||
RemoteActivity
|
RemoteActivity
|
||||||
|
@ -64,11 +67,11 @@ RemoteActivity
|
||||||
UniqueRemoteActivity instance ident
|
UniqueRemoteActivity instance ident
|
||||||
|
|
||||||
InboxItemRemote
|
InboxItemRemote
|
||||||
person PersonId
|
inbox InboxId
|
||||||
activity RemoteActivityId
|
activity RemoteActivityId
|
||||||
item InboxItemId
|
item InboxItemId
|
||||||
|
|
||||||
UniqueInboxItemRemote person activity
|
UniqueInboxItemRemote inbox activity
|
||||||
UniqueInboxItemRemoteItem item
|
UniqueInboxItemRemoteItem item
|
||||||
|
|
||||||
UnlinkedDelivery
|
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"
|
(shr,) <$> decodeKeyHashidE obkhid "Local activity: ID is invalid hashid"
|
||||||
_ -> throwE "Local activity: Not an activity route"
|
_ -> throwE "Local activity: Not an activity route"
|
||||||
runDBExcept $ do
|
runDBExcept $ do
|
||||||
pidRecip <- lift $ do
|
Entity pidRecip personRecip <- lift $ do
|
||||||
sid <- getKeyBy404 $ UniqueSharer shrRecip
|
sid <- getKeyBy404 $ UniqueSharer shrRecip
|
||||||
getKeyBy404 $ UniquePersonIdent sid
|
getBy404 $ UniquePersonIdent sid
|
||||||
mob <- lift $ get obid
|
mob <- lift $ get obid
|
||||||
ob <- fromMaybeE mob "Local activity: No such ID in DB"
|
ob <- fromMaybeE mob "Local activity: No such ID in DB"
|
||||||
let pidOutbox = outboxItemPerson ob
|
let pidOutbox = outboxItemPerson ob
|
||||||
|
@ -593,12 +593,13 @@ handleSharerInbox _now shrRecip (Left pidAuthor) _raw activity = do
|
||||||
if pidRecip == pidAuthor
|
if pidRecip == pidAuthor
|
||||||
then return "Received activity authored by self, ignoring"
|
then return "Received activity authored by self, ignoring"
|
||||||
else lift $ do
|
else lift $ do
|
||||||
ibid <- insert $ InboxItem True
|
ibiid <- insert $ InboxItem True
|
||||||
miblid <- insertUnique $ InboxItemLocal pidRecip obid ibid
|
let ibid = personInbox personRecip
|
||||||
|
miblid <- insertUnique $ InboxItemLocal ibid obid ibiid
|
||||||
let recip = shr2text shrRecip
|
let recip = shr2text shrRecip
|
||||||
case miblid of
|
case miblid of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
delete ibid
|
delete ibiid
|
||||||
return $
|
return $
|
||||||
"Activity already exists in inbox of /s/" <> recip
|
"Activity already exists in inbox of /s/" <> recip
|
||||||
Just _ ->
|
Just _ ->
|
||||||
|
@ -621,13 +622,13 @@ handleSharerInbox now shrRecip (Right iidSender) raw activity =
|
||||||
then return Nothing
|
then return Nothing
|
||||||
else Just <$> parseParent uParent
|
else Just <$> parseParent uParent
|
||||||
ExceptT $ runDB $ do
|
ExceptT $ runDB $ do
|
||||||
pidRecip <- do
|
personRecip <- do
|
||||||
sid <- getKeyBy404 $ UniqueSharer shrRecip
|
sid <- getKeyBy404 $ UniqueSharer shrRecip
|
||||||
getKeyBy404 $ UniquePersonIdent sid
|
getValBy404 $ UniquePersonIdent sid
|
||||||
valid <- checkContextParent context mparent
|
valid <- checkContextParent context mparent
|
||||||
case valid of
|
case valid of
|
||||||
Left e -> return $ Left e
|
Left e -> return $ Left e
|
||||||
Right _ -> Right <$> insertToInbox pidRecip
|
Right _ -> Right <$> insertToInbox (personInbox personRecip)
|
||||||
where
|
where
|
||||||
checkContextParent context mparent = runExceptT $ do
|
checkContextParent context mparent = runExceptT $ do
|
||||||
case context of
|
case context of
|
||||||
|
@ -671,17 +672,17 @@ handleSharerInbox now shrRecip (Right iidSender) raw activity =
|
||||||
did <- fromMaybeE mdid "Remote parent known, but no context RemoteDiscussion"
|
did <- fromMaybeE mdid "Remote parent known, but no context RemoteDiscussion"
|
||||||
unless (messageRoot m == did) $
|
unless (messageRoot m == did) $
|
||||||
throwE "Remote parent belongs to a different discussion"
|
throwE "Remote parent belongs to a different discussion"
|
||||||
insertToInbox pidRecip = do
|
insertToInbox ibidRecip = do
|
||||||
let luActivity = activityId activity
|
let luActivity = activityId activity
|
||||||
jsonObj = PersistJSON raw
|
jsonObj = PersistJSON raw
|
||||||
ract = RemoteActivity iidSender luActivity jsonObj now
|
ract = RemoteActivity iidSender luActivity jsonObj now
|
||||||
ractid <- either entityKey id <$> insertBy' ract
|
ractid <- either entityKey id <$> insertBy' ract
|
||||||
ibid <- insert $ InboxItem True
|
ibiid <- insert $ InboxItem True
|
||||||
mibrid <- insertUnique $ InboxItemRemote pidRecip ractid ibid
|
mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid
|
||||||
let recip = shr2text shrRecip
|
let recip = shr2text shrRecip
|
||||||
case mibrid of
|
case mibrid of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
delete ibid
|
delete ibiid
|
||||||
return $ "Activity already exists in inbox of /s/" <> recip
|
return $ "Activity already exists in inbox of /s/" <> recip
|
||||||
Just _ -> return $ "Activity inserted to 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
|
-- TODO inefficient, see the other TODOs about mergeConcat
|
||||||
remotes = map (second $ NE.nubBy ((==) `on` fst4)) $ mergeConcat teamRemotes fsRemotes
|
remotes = map (second $ NE.nubBy ((==) `on` fst4)) $ mergeConcat teamRemotes fsRemotes
|
||||||
for_ pids $ \ pid -> do
|
for_ pids $ \ pid -> do
|
||||||
ibid <- insert $ InboxItem True
|
ibid <- personInbox <$> getJust pid
|
||||||
mibrid <- insertUnique $ InboxItemRemote pid ractid ibid
|
ibiid <- insert $ InboxItem True
|
||||||
|
mibrid <- insertUnique $ InboxItemRemote ibid ractid ibiid
|
||||||
when (isNothing mibrid) $
|
when (isNothing mibrid) $
|
||||||
delete ibid
|
delete ibiid
|
||||||
return remotes
|
return remotes
|
||||||
|
|
||||||
deliverRemoteDB
|
deliverRemoteDB
|
||||||
|
@ -1439,8 +1441,9 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished s
|
||||||
, map (second $ NE.nubBy ((==) `on` fst4)) $ mergeConcat teamRemotes fsRemotes
|
, map (second $ NE.nubBy ((==) `on` fst4)) $ mergeConcat teamRemotes fsRemotes
|
||||||
)
|
)
|
||||||
lift $ for_ (union recipPids morePids) $ \ pid -> do
|
lift $ for_ (union recipPids morePids) $ \ pid -> do
|
||||||
ibid <- insert $ InboxItem True
|
ibid <- personInbox <$> getJust pid
|
||||||
insert_ $ InboxItemLocal pid obid ibid
|
ibiid <- insert $ InboxItem True
|
||||||
|
insert_ $ InboxItemLocal ibid obid ibiid
|
||||||
return remotes
|
return remotes
|
||||||
where
|
where
|
||||||
getPersonId :: ShrIdent -> ExceptT Text AppDB PersonId
|
getPersonId :: ShrIdent -> ExceptT Text AppDB PersonId
|
||||||
|
|
|
@ -217,7 +217,7 @@ instance Yesod App where
|
||||||
for mperson' $ \ (p@(Entity pid person), verified) -> runDB $ do
|
for mperson' $ \ (p@(Entity pid person), verified) -> runDB $ do
|
||||||
sharer <- getJust $ personIdent person
|
sharer <- getJust $ personIdent person
|
||||||
unread <- do
|
unread <- do
|
||||||
vs <- countUnread pid
|
vs <- countUnread $ personInbox person
|
||||||
case vs :: [E.Value Int] of
|
case vs :: [E.Value Int] of
|
||||||
[E.Value i] -> return i
|
[E.Value i] -> return i
|
||||||
_ -> error $ "countUnread returned " ++ show vs
|
_ -> error $ "countUnread returned " ++ show vs
|
||||||
|
@ -244,17 +244,17 @@ instance Yesod App where
|
||||||
$(widgetFile "default-layout")
|
$(widgetFile "default-layout")
|
||||||
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
||||||
where
|
where
|
||||||
countUnread pid =
|
countUnread ibid =
|
||||||
E.select $ E.from $ \ (ib `E.LeftOuterJoin` ibl `E.LeftOuterJoin` ibr) -> do
|
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.==. ibr E.?. InboxItemRemoteItem
|
||||||
E.on $ E.just (ib E.^. InboxItemId) E.==. ibl E.?. InboxItemLocalItem
|
E.on $ E.just (ib E.^. InboxItemId) E.==. ibl E.?. InboxItemLocalItem
|
||||||
E.where_ $
|
E.where_ $
|
||||||
( E.isNothing (ibr E.?. InboxItemRemotePerson) E.||.
|
( E.isNothing (ibr E.?. InboxItemRemoteInbox) E.||.
|
||||||
ibr E.?. InboxItemRemotePerson E.==. E.just (E.val pid)
|
ibr E.?. InboxItemRemoteInbox E.==. E.just (E.val ibid)
|
||||||
)
|
)
|
||||||
E.&&.
|
E.&&.
|
||||||
( E.isNothing (ibl E.?. InboxItemLocalPerson) E.||.
|
( E.isNothing (ibl E.?. InboxItemLocalInbox) E.||.
|
||||||
ibl E.?. InboxItemLocalPerson E.==. E.just (E.val pid)
|
ibl E.?. InboxItemLocalInbox E.==. E.just (E.val ibid)
|
||||||
)
|
)
|
||||||
E.&&.
|
E.&&.
|
||||||
ib E.^. InboxItemUnread E.==. E.val True
|
ib E.^. InboxItemUnread E.==. E.val True
|
||||||
|
@ -576,6 +576,7 @@ instance AccountDB AccountPersistDB' where
|
||||||
mr <- getMessageRender
|
mr <- getMessageRender
|
||||||
return $ Left $ mr $ MsgUsernameExists name
|
return $ Left $ mr $ MsgUsernameExists name
|
||||||
Right sid -> do
|
Right sid -> do
|
||||||
|
ibid <- insert Inbox
|
||||||
let defTime = UTCTime (ModifiedJulianDay 0) 0
|
let defTime = UTCTime (ModifiedJulianDay 0) 0
|
||||||
person = Person
|
person = Person
|
||||||
{ personIdent = sid
|
{ personIdent = sid
|
||||||
|
@ -588,6 +589,7 @@ instance AccountDB AccountPersistDB' where
|
||||||
, personResetPassKey = ""
|
, personResetPassKey = ""
|
||||||
, personResetPassKeyCreated = defTime
|
, personResetPassKeyCreated = defTime
|
||||||
, personAbout = ""
|
, personAbout = ""
|
||||||
|
, personInbox = ibid
|
||||||
}
|
}
|
||||||
pid <- insert person
|
pid <- insert person
|
||||||
return $ Right $ Entity pid person
|
return $ Right $ Entity pid person
|
||||||
|
|
|
@ -147,10 +147,11 @@ getSharerInboxR :: ShrIdent -> Handler TypedContent
|
||||||
getSharerInboxR shr = do
|
getSharerInboxR shr = do
|
||||||
(total, pages, mpage) <- runDB $ do
|
(total, pages, mpage) <- runDB $ do
|
||||||
sid <- getKeyBy404 $ UniqueSharer shr
|
sid <- getKeyBy404 $ UniqueSharer shr
|
||||||
pid <- getKeyBy404 $ UniquePersonIdent sid
|
p <- getValBy404 $ UniquePersonIdent sid
|
||||||
|
let ibid = personInbox p
|
||||||
getPageAndNavCount
|
getPageAndNavCount
|
||||||
(countItems pid)
|
(countItems ibid)
|
||||||
(\ off lim -> map adaptItem <$> getItems pid off lim)
|
(\ off lim -> map adaptItem <$> getItems ibid off lim)
|
||||||
let here = SharerInboxR shr
|
let here = SharerInboxR shr
|
||||||
encodeRouteLocal <- getEncodeRouteLocal
|
encodeRouteLocal <- getEncodeRouteLocal
|
||||||
encodeRoutePageLocal <- getEncodeRoutePageLocal
|
encodeRoutePageLocal <- getEncodeRoutePageLocal
|
||||||
|
@ -194,10 +195,10 @@ getSharerInboxR shr = do
|
||||||
let pageNav = navWidget navModel
|
let pageNav = navWidget navModel
|
||||||
in defaultLayout $(widgetFile "person/inbox")
|
in defaultLayout $(widgetFile "person/inbox")
|
||||||
where
|
where
|
||||||
countItems pid =
|
countItems ibid =
|
||||||
(+) <$> count [InboxItemLocalPerson ==. pid]
|
(+) <$> count [InboxItemLocalInbox ==. ibid]
|
||||||
<*> count [InboxItemRemotePerson ==. pid]
|
<*> count [InboxItemRemoteInbox ==. ibid]
|
||||||
getItems pid off lim =
|
getItems ibid off lim =
|
||||||
E.select $ E.from $
|
E.select $ E.from $
|
||||||
\ (ib `E.LeftOuterJoin` (ibl `E.InnerJoin` ob) `E.LeftOuterJoin` (ibr `E.InnerJoin` ract)) -> do
|
\ (ib `E.LeftOuterJoin` (ibl `E.InnerJoin` ob) `E.LeftOuterJoin` (ibr `E.InnerJoin` ract)) -> do
|
||||||
E.on $ ibr E.?. InboxItemRemoteActivity E.==. ract E.?. RemoteActivityId
|
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 $ ibl E.?. InboxItemLocalActivity E.==. ob E.?. OutboxItemId
|
||||||
E.on $ E.just (ib E.^. InboxItemId) E.==. ibl E.?. InboxItemLocalItem
|
E.on $ E.just (ib E.^. InboxItemId) E.==. ibl E.?. InboxItemLocalItem
|
||||||
E.where_
|
E.where_
|
||||||
$ ( E.isNothing (ibr E.?. InboxItemRemotePerson) E.||.
|
$ ( E.isNothing (ibr E.?. InboxItemRemoteInbox) E.||.
|
||||||
ibr E.?. InboxItemRemotePerson E.==. E.just (E.val pid)
|
ibr E.?. InboxItemRemoteInbox E.==. E.just (E.val ibid)
|
||||||
)
|
)
|
||||||
E.&&.
|
E.&&.
|
||||||
( E.isNothing (ibl E.?. InboxItemLocalPerson) E.||.
|
( E.isNothing (ibl E.?. InboxItemLocalInbox) E.||.
|
||||||
ibl E.?. InboxItemLocalPerson E.==. E.just (E.val pid)
|
ibl E.?. InboxItemLocalInbox E.==. E.just (E.val ibid)
|
||||||
)
|
)
|
||||||
E.orderBy [E.desc $ ib E.^. InboxItemId]
|
E.orderBy [E.desc $ ib E.^. InboxItemId]
|
||||||
E.offset $ fromIntegral off
|
E.offset $ fromIntegral off
|
||||||
|
@ -511,8 +512,9 @@ getNotificationsR :: ShrIdent -> Handler Html
|
||||||
getNotificationsR shr = do
|
getNotificationsR shr = do
|
||||||
items <- runDB $ do
|
items <- runDB $ do
|
||||||
sid <- getKeyBy404 $ UniqueSharer shr
|
sid <- getKeyBy404 $ UniqueSharer shr
|
||||||
pid <- getKeyBy404 $ UniquePersonIdent sid
|
p <- getValBy404 $ UniquePersonIdent sid
|
||||||
map adaptItem <$> getItems pid
|
let ibid = personInbox p
|
||||||
|
map adaptItem <$> getItems ibid
|
||||||
notifications <- for items $ \ (ibid, activity) -> do
|
notifications <- for items $ \ (ibid, activity) -> do
|
||||||
((_result, widget), enctype) <-
|
((_result, widget), enctype) <-
|
||||||
runFormPost $ notificationForm $ Just $ Just (ibid, False)
|
runFormPost $ notificationForm $ Just $ Just (ibid, False)
|
||||||
|
@ -521,7 +523,7 @@ getNotificationsR shr = do
|
||||||
runFormPost $ notificationForm $ Just Nothing
|
runFormPost $ notificationForm $ Just Nothing
|
||||||
defaultLayout $(widgetFile "person/notifications")
|
defaultLayout $(widgetFile "person/notifications")
|
||||||
where
|
where
|
||||||
getItems pid =
|
getItems ibid =
|
||||||
E.select $ E.from $
|
E.select $ E.from $
|
||||||
\ (ib `E.LeftOuterJoin` (ibl `E.InnerJoin` ob) `E.LeftOuterJoin` (ibr `E.InnerJoin` ract)) -> do
|
\ (ib `E.LeftOuterJoin` (ibl `E.InnerJoin` ob) `E.LeftOuterJoin` (ibr `E.InnerJoin` ract)) -> do
|
||||||
E.on $ ibr E.?. InboxItemRemoteActivity E.==. ract E.?. RemoteActivityId
|
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 $ ibl E.?. InboxItemLocalActivity E.==. ob E.?. OutboxItemId
|
||||||
E.on $ E.just (ib E.^. InboxItemId) E.==. ibl E.?. InboxItemLocalItem
|
E.on $ E.just (ib E.^. InboxItemId) E.==. ibl E.?. InboxItemLocalItem
|
||||||
E.where_
|
E.where_
|
||||||
$ ( E.isNothing (ibr E.?. InboxItemRemotePerson) E.||.
|
$ ( E.isNothing (ibr E.?. InboxItemRemoteInbox) E.||.
|
||||||
ibr E.?. InboxItemRemotePerson E.==. E.just (E.val pid)
|
ibr E.?. InboxItemRemoteInbox E.==. E.just (E.val ibid)
|
||||||
)
|
)
|
||||||
E.&&.
|
E.&&.
|
||||||
( E.isNothing (ibl E.?. InboxItemLocalPerson) E.||.
|
( E.isNothing (ibl E.?. InboxItemLocalInbox) E.||.
|
||||||
ibl E.?. InboxItemLocalPerson E.==. E.just (E.val pid)
|
ibl E.?. InboxItemLocalInbox E.==. E.just (E.val ibid)
|
||||||
)
|
)
|
||||||
E.&&.
|
E.&&.
|
||||||
ib E.^. InboxItemUnread E.==. E.val True
|
ib E.^. InboxItemUnread E.==. E.val True
|
||||||
|
@ -561,17 +563,18 @@ postNotificationsR shr = do
|
||||||
FormSuccess mitem -> do
|
FormSuccess mitem -> do
|
||||||
(multi, markedUnread) <- runDB $ do
|
(multi, markedUnread) <- runDB $ do
|
||||||
sid <- getKeyBy404 $ UniqueSharer shr
|
sid <- getKeyBy404 $ UniqueSharer shr
|
||||||
pid <- getKeyBy404 $ UniquePersonIdent sid
|
p <- getValBy404 $ UniquePersonIdent sid
|
||||||
|
let ibid = personInbox p
|
||||||
case mitem of
|
case mitem of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
ibids <- map E.unValue <$> getItems pid
|
ibiids <- map E.unValue <$> getItems ibid
|
||||||
updateWhere
|
updateWhere
|
||||||
[InboxItemId <-. ibids]
|
[InboxItemId <-. ibiids]
|
||||||
[InboxItemUnread =. False]
|
[InboxItemUnread =. False]
|
||||||
return (True, False)
|
return (True, False)
|
||||||
Just (ibid, unread) -> do
|
Just (ibiid, unread) -> do
|
||||||
mibl <- getValBy $ UniqueInboxItemLocalItem ibid
|
mibl <- getValBy $ UniqueInboxItemLocalItem ibiid
|
||||||
mibr <- getValBy $ UniqueInboxItemRemoteItem ibid
|
mibr <- getValBy $ UniqueInboxItemRemoteItem ibiid
|
||||||
mib <-
|
mib <-
|
||||||
requireEitherM
|
requireEitherM
|
||||||
mibl
|
mibl
|
||||||
|
@ -581,12 +584,12 @@ postNotificationsR shr = do
|
||||||
let samePid =
|
let samePid =
|
||||||
case mib of
|
case mib of
|
||||||
Left ibl ->
|
Left ibl ->
|
||||||
inboxItemLocalPerson ibl == pid
|
inboxItemLocalInbox ibl == ibid
|
||||||
Right ibr ->
|
Right ibr ->
|
||||||
inboxItemRemotePerson ibr == pid
|
inboxItemRemoteInbox ibr == ibid
|
||||||
if samePid
|
if samePid
|
||||||
then do
|
then do
|
||||||
update ibid [InboxItemUnread =. unread]
|
update ibiid [InboxItemUnread =. unread]
|
||||||
return (False, unread)
|
return (False, unread)
|
||||||
else
|
else
|
||||||
permissionDenied
|
permissionDenied
|
||||||
|
@ -603,18 +606,18 @@ postNotificationsR shr = do
|
||||||
setMessage $ toHtml $ "Marking as read failed:" <> T.pack (show l)
|
setMessage $ toHtml $ "Marking as read failed:" <> T.pack (show l)
|
||||||
redirect $ NotificationsR shr
|
redirect $ NotificationsR shr
|
||||||
where
|
where
|
||||||
getItems pid =
|
getItems ibid =
|
||||||
E.select $ E.from $
|
E.select $ E.from $
|
||||||
\ (ib `E.LeftOuterJoin` ibl `E.LeftOuterJoin` ibr) -> do
|
\ (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.==. ibr E.?. InboxItemRemoteItem
|
||||||
E.on $ E.just (ib E.^. InboxItemId) E.==. ibl E.?. InboxItemLocalItem
|
E.on $ E.just (ib E.^. InboxItemId) E.==. ibl E.?. InboxItemLocalItem
|
||||||
E.where_
|
E.where_
|
||||||
$ ( E.isNothing (ibr E.?. InboxItemRemotePerson) E.||.
|
$ ( E.isNothing (ibr E.?. InboxItemRemoteInbox) E.||.
|
||||||
ibr E.?. InboxItemRemotePerson E.==. E.just (E.val pid)
|
ibr E.?. InboxItemRemoteInbox E.==. E.just (E.val ibid)
|
||||||
)
|
)
|
||||||
E.&&.
|
E.&&.
|
||||||
( E.isNothing (ibl E.?. InboxItemLocalPerson) E.||.
|
( E.isNothing (ibl E.?. InboxItemLocalInbox) E.||.
|
||||||
ibl E.?. InboxItemLocalPerson E.==. E.just (E.val pid)
|
ibl E.?. InboxItemLocalInbox E.==. E.just (E.val ibid)
|
||||||
)
|
)
|
||||||
E.&&.
|
E.&&.
|
||||||
ib E.^. InboxItemUnread E.==. E.val True
|
ib E.^. InboxItemUnread E.==. E.val True
|
||||||
|
|
|
@ -539,6 +539,60 @@ changes hLocal ctx =
|
||||||
, setFieldMaybe "Ticket" "closer"
|
, setFieldMaybe "Ticket" "closer"
|
||||||
-- 94
|
-- 94
|
||||||
, removeField "Ticket" "creator"
|
, 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))
|
migrateDB :: MonadIO m => Text -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int))
|
||||||
|
|
|
@ -61,6 +61,13 @@ module Vervis.Migration.Model
|
||||||
, Ticket20190606Generic (..)
|
, Ticket20190606Generic (..)
|
||||||
, Ticket20190606
|
, Ticket20190606
|
||||||
, TicketAuthorLocal20190606Generic (..)
|
, TicketAuthorLocal20190606Generic (..)
|
||||||
|
, Person20190607Generic (..)
|
||||||
|
, Person20190607
|
||||||
|
, Inbox20190607Generic (..)
|
||||||
|
, InboxItemLocal20190607Generic (..)
|
||||||
|
, InboxItemLocal20190607
|
||||||
|
, InboxItemRemote20190607Generic (..)
|
||||||
|
, InboxItemRemote20190607
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -156,3 +163,6 @@ model_2019_06_06 = $(schema "2019_06_06")
|
||||||
|
|
||||||
makeEntitiesMigration "20190606"
|
makeEntitiesMigration "20190606"
|
||||||
$(modelFile "migrations/2019_06_06_mig.model")
|
$(modelFile "migrations/2019_06_06_mig.model")
|
||||||
|
|
||||||
|
makeEntitiesMigration "20190607"
|
||||||
|
$(modelFile "migrations/2019_06_07.model")
|
||||||
|
|
Loading…
Reference in a new issue