DB: Switch RemoteDiscussion to use RemoteObject instead of instance+ident
This commit is contained in:
parent
fb9e2dd4dd
commit
7612b4e01e
7 changed files with 69 additions and 10 deletions
|
@ -408,11 +408,10 @@ TicketClaimRequest
|
||||||
Discussion
|
Discussion
|
||||||
|
|
||||||
RemoteDiscussion
|
RemoteDiscussion
|
||||||
instance InstanceId
|
ident RemoteObjectId
|
||||||
ident LocalURI
|
|
||||||
discuss DiscussionId
|
discuss DiscussionId
|
||||||
|
|
||||||
UniqueRemoteDiscussionIdent instance ident
|
UniqueRemoteDiscussionIdent ident
|
||||||
UniqueRemoteDiscussion discuss
|
UniqueRemoteDiscussion discuss
|
||||||
|
|
||||||
Message
|
Message
|
||||||
|
|
19
migrations/2020_02_09_rd_point_to_ro.model
Normal file
19
migrations/2020_02_09_rd_point_to_ro.model
Normal file
|
@ -0,0 +1,19 @@
|
||||||
|
Instance
|
||||||
|
host Host
|
||||||
|
|
||||||
|
UniqueInstance host
|
||||||
|
|
||||||
|
RemoteObject
|
||||||
|
instance InstanceId
|
||||||
|
ident LocalURI
|
||||||
|
|
||||||
|
UniqueRemoteObject instance ident
|
||||||
|
|
||||||
|
RemoteDiscussion
|
||||||
|
instance InstanceId
|
||||||
|
ident LocalURI
|
||||||
|
identNew RemoteObjectId
|
||||||
|
discuss Int64
|
||||||
|
|
||||||
|
UniqueRemoteDiscussionIdent instance ident
|
||||||
|
UniqueRemoteDiscussion discuss
|
|
@ -194,12 +194,13 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
|
||||||
(rd, rdnew) <- lift $ do
|
(rd, rdnew) <- lift $ do
|
||||||
let ObjURI hContext luContext = uContext
|
let ObjURI hContext luContext = uContext
|
||||||
iid <- either entityKey id <$> insertBy' (Instance hContext)
|
iid <- either entityKey id <$> insertBy' (Instance hContext)
|
||||||
mrd <- getValBy $ UniqueRemoteDiscussionIdent iid luContext
|
roid <- either entityKey id <$> insertBy' (RemoteObject iid luContext)
|
||||||
|
mrd <- getValBy $ UniqueRemoteDiscussionIdent roid
|
||||||
case mrd of
|
case mrd of
|
||||||
Just rd -> return (rd, False)
|
Just rd -> return (rd, False)
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
did <- insert Discussion
|
did <- insert Discussion
|
||||||
let rd = RemoteDiscussion iid luContext did
|
let rd = RemoteDiscussion roid did
|
||||||
erd <- insertBy' rd
|
erd <- insertBy' rd
|
||||||
case erd of
|
case erd of
|
||||||
Left (Entity _ rd') -> do
|
Left (Entity _ rd') -> do
|
||||||
|
|
|
@ -131,7 +131,8 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext
|
||||||
Right (ObjURI hContext luContext) -> do
|
Right (ObjURI hContext luContext) -> do
|
||||||
mdid <- lift $ runMaybeT $ do
|
mdid <- lift $ runMaybeT $ do
|
||||||
iid <- MaybeT $ getKeyBy $ UniqueInstance hContext
|
iid <- MaybeT $ getKeyBy $ UniqueInstance hContext
|
||||||
rd <- MaybeT $ getValBy $ UniqueRemoteDiscussionIdent iid luContext
|
roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luContext
|
||||||
|
rd <- MaybeT $ getValBy $ UniqueRemoteDiscussionIdent roid
|
||||||
return $ remoteDiscussionDiscuss rd
|
return $ remoteDiscussionDiscuss rd
|
||||||
for_ mparent $ \ parent ->
|
for_ mparent $ \ parent ->
|
||||||
case parent of
|
case parent of
|
||||||
|
|
|
@ -146,8 +146,9 @@ getDiscussionMessage shr lmid = do
|
||||||
ltkhid <- encodeKeyHashid ltid
|
ltkhid <- encodeKeyHashid ltid
|
||||||
return $ route2fed $ TicketR shr prj ltkhid
|
return $ route2fed $ TicketR shr prj ltkhid
|
||||||
(Nothing, Just rd) -> do
|
(Nothing, Just rd) -> do
|
||||||
i <- getJust $ remoteDiscussionInstance rd
|
ro <- getJust $ remoteDiscussionIdent rd
|
||||||
return $ ObjURI (instanceHost i) (remoteDiscussionIdent rd)
|
i <- getJust $ remoteObjectInstance ro
|
||||||
|
return $ ObjURI (instanceHost i) (remoteObjectIdent ro)
|
||||||
muParent <- for (messageParent m) $ \ midParent -> do
|
muParent <- for (messageParent m) $ \ midParent -> do
|
||||||
mlocal <- getBy $ UniqueLocalMessage midParent
|
mlocal <- getBy $ UniqueLocalMessage midParent
|
||||||
mremote <- getValBy $ UniqueRemoteMessage midParent
|
mremote <- getValBy $ UniqueRemoteMessage midParent
|
||||||
|
|
|
@ -1421,6 +1421,37 @@ changes hLocal ctx =
|
||||||
"TicketAuthorRemote"
|
"TicketAuthorRemote"
|
||||||
"UniqueTicketAuthorRemoteOffer"
|
"UniqueTicketAuthorRemoteOffer"
|
||||||
"UniqueTicketAuthorRemoteOpen"
|
"UniqueTicketAuthorRemoteOpen"
|
||||||
|
-- 215
|
||||||
|
, addFieldRefRequired''
|
||||||
|
"RemoteDiscussion"
|
||||||
|
(do iid <- insert $ Instance215 $ Authority "215.fake.fake" Nothing
|
||||||
|
insertEntity $ RemoteObject215 iid $ LocalURI "/fake/215"
|
||||||
|
)
|
||||||
|
(Just $ \ (Entity roidTemp roTemp) -> do
|
||||||
|
rdids <- selectList ([] :: [Filter RemoteDiscussion215]) []
|
||||||
|
for_ rdids $ \ (Entity rdid rd) -> do
|
||||||
|
let iid = remoteDiscussion215Instance rd
|
||||||
|
lu = remoteDiscussion215Ident rd
|
||||||
|
roid <- insert $ RemoteObject215 iid lu
|
||||||
|
update rdid [RemoteDiscussion215IdentNew =. roid]
|
||||||
|
delete roidTemp
|
||||||
|
delete $ remoteObject215Instance roTemp
|
||||||
|
)
|
||||||
|
"identNew"
|
||||||
|
"RemoteObject"
|
||||||
|
-- 216
|
||||||
|
, addUnique "RemoteDiscussion" $
|
||||||
|
Unique "UniqueRemoteDiscussionIdentNew" ["identNew"]
|
||||||
|
-- 217
|
||||||
|
, removeUnique "RemoteDiscussion" "UniqueRemoteDiscussionIdent"
|
||||||
|
-- 218
|
||||||
|
, renameUnique "RemoteDiscussion" "UniqueRemoteDiscussionIdentNew" "UniqueRemoteDiscussionIdent"
|
||||||
|
-- 219
|
||||||
|
, removeField "RemoteDiscussion" "instance"
|
||||||
|
-- 220
|
||||||
|
, removeField "RemoteDiscussion" "ident"
|
||||||
|
-- 221
|
||||||
|
, renameField "RemoteDiscussion" "identNew" "ident"
|
||||||
]
|
]
|
||||||
|
|
||||||
migrateDB
|
migrateDB
|
||||||
|
|
|
@ -170,6 +170,10 @@ module Vervis.Migration.Model
|
||||||
, TicketProjectLocal205Generic (..)
|
, TicketProjectLocal205Generic (..)
|
||||||
, TicketAuthorRemote205
|
, TicketAuthorRemote205
|
||||||
, TicketAuthorRemote205Generic (..)
|
, TicketAuthorRemote205Generic (..)
|
||||||
|
, Instance215Generic (..)
|
||||||
|
, RemoteObject215Generic (..)
|
||||||
|
, RemoteDiscussion215
|
||||||
|
, RemoteDiscussion215Generic (..)
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -328,3 +332,6 @@ makeEntitiesMigration "201"
|
||||||
|
|
||||||
makeEntitiesMigration "205"
|
makeEntitiesMigration "205"
|
||||||
$(modelFile "migrations/2020_02_08_tar_point_to_tpl.model")
|
$(modelFile "migrations/2020_02_08_tar_point_to_tpl.model")
|
||||||
|
|
||||||
|
makeEntitiesMigration "215"
|
||||||
|
$(modelFile "migrations/2020_02_09_rd_point_to_ro.model")
|
||||||
|
|
Loading…
Reference in a new issue