diff --git a/config/models b/config/models index 553ea5c..db79a76 100644 --- a/config/models +++ b/config/models @@ -408,12 +408,11 @@ TicketClaimRequest Discussion RemoteDiscussion - instance InstanceId - ident LocalURI - discuss DiscussionId + ident RemoteObjectId + discuss DiscussionId - UniqueRemoteDiscussionIdent instance ident - UniqueRemoteDiscussion discuss + UniqueRemoteDiscussionIdent ident + UniqueRemoteDiscussion discuss Message created UTCTime diff --git a/migrations/2020_02_09_rd_point_to_ro.model b/migrations/2020_02_09_rd_point_to_ro.model new file mode 100644 index 0000000..401f308 --- /dev/null +++ b/migrations/2020_02_09_rd_point_to_ro.model @@ -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 diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index 625c767..3b51b2e 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -194,12 +194,13 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source (rd, rdnew) <- lift $ do let ObjURI hContext luContext = uContext 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 Just rd -> return (rd, False) Nothing -> do did <- insert Discussion - let rd = RemoteDiscussion iid luContext did + let rd = RemoteDiscussion roid did erd <- insertBy' rd case erd of Left (Entity _ rd') -> do diff --git a/src/Vervis/Federation/Discussion.hs b/src/Vervis/Federation/Discussion.hs index f4d6b41..7757342 100644 --- a/src/Vervis/Federation/Discussion.hs +++ b/src/Vervis/Federation/Discussion.hs @@ -131,7 +131,8 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext Right (ObjURI hContext luContext) -> do mdid <- lift $ runMaybeT $ do 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 for_ mparent $ \ parent -> case parent of diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs index 28f758f..39b0c6e 100644 --- a/src/Vervis/Handler/Discussion.hs +++ b/src/Vervis/Handler/Discussion.hs @@ -146,8 +146,9 @@ getDiscussionMessage shr lmid = do ltkhid <- encodeKeyHashid ltid return $ route2fed $ TicketR shr prj ltkhid (Nothing, Just rd) -> do - i <- getJust $ remoteDiscussionInstance rd - return $ ObjURI (instanceHost i) (remoteDiscussionIdent rd) + ro <- getJust $ remoteDiscussionIdent rd + i <- getJust $ remoteObjectInstance ro + return $ ObjURI (instanceHost i) (remoteObjectIdent ro) muParent <- for (messageParent m) $ \ midParent -> do mlocal <- getBy $ UniqueLocalMessage midParent mremote <- getValBy $ UniqueRemoteMessage midParent diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 6fbf81b..e3fb4cf 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -1421,6 +1421,37 @@ changes hLocal ctx = "TicketAuthorRemote" "UniqueTicketAuthorRemoteOffer" "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 diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs index 83ac424..016f518 100644 --- a/src/Vervis/Migration/Model.hs +++ b/src/Vervis/Migration/Model.hs @@ -170,6 +170,10 @@ module Vervis.Migration.Model , TicketProjectLocal205Generic (..) , TicketAuthorRemote205 , TicketAuthorRemote205Generic (..) + , Instance215Generic (..) + , RemoteObject215Generic (..) + , RemoteDiscussion215 + , RemoteDiscussion215Generic (..) ) where @@ -328,3 +332,6 @@ makeEntitiesMigration "201" makeEntitiesMigration "205" $(modelFile "migrations/2020_02_08_tar_point_to_tpl.model") + +makeEntitiesMigration "215" + $(modelFile "migrations/2020_02_09_rd_point_to_ro.model")