From 00e0f7c14f28c411ab67588c89e0b0539d93be05 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Mon, 10 Feb 2020 14:07:00 +0000 Subject: [PATCH] DB: Switch RemoteMessage to use RemoteObject --- config/models | 9 +++--- migrations/2020_02_10_rm_point_to_ro.model | 23 +++++++++++++++ src/Vervis/API.hs | 6 ++-- src/Vervis/Client.hs | 5 ++-- src/Vervis/Discussion.hs | 5 ++-- src/Vervis/Federation/Discussion.hs | 14 +++++---- src/Vervis/Handler/Discussion.hs | 13 +++++---- src/Vervis/Migration.hs | 34 ++++++++++++++++++++++ src/Vervis/Migration/Model.hs | 7 +++++ 9 files changed, 94 insertions(+), 22 deletions(-) create mode 100644 migrations/2020_02_10_rm_point_to_ro.model diff --git a/config/models b/config/models index 29be4c5..248b517 100644 --- a/config/models +++ b/config/models @@ -1,6 +1,6 @@ -- This file is part of Vervis. -- --- Written in 2016, 2018, 2019 by fr33domlover . +-- Written in 2016, 2018, 2019, 2020 by fr33domlover . -- -- ♡ Copying is an act of love. Please copy, reuse and share. -- @@ -439,14 +439,13 @@ LocalMessage RemoteMessage author RemoteActorId - instance InstanceId - ident LocalURI + ident RemoteObjectId rest MessageId create RemoteActivityId lostParent FedURI Maybe - UniqueRemoteMessageIdent instance ident - UniqueRemoteMessage rest + UniqueRemoteMessageIdent ident + UniqueRemoteMessage rest UniqueRemoteMessageCreate create RepoCollab diff --git a/migrations/2020_02_10_rm_point_to_ro.model b/migrations/2020_02_10_rm_point_to_ro.model new file mode 100644 index 0000000..4e30476 --- /dev/null +++ b/migrations/2020_02_10_rm_point_to_ro.model @@ -0,0 +1,23 @@ +Instance + host Host + + UniqueInstance host + +RemoteObject + instance InstanceId + ident LocalURI + + UniqueRemoteObject instance ident + +RemoteMessage + author Int64 + instance InstanceId + ident LocalURI + identNew RemoteObjectId + rest Int64 + create Int64 + lostParent FedURI Maybe + + UniqueRemoteMessageIdent instance ident + UniqueRemoteMessage rest + UniqueRemoteMessageCreate create diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index 3b51b2e..64374be 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -181,7 +181,8 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source Right (ObjURI hParent luParent) -> do mrm <- lift $ runMaybeT $ do iid <- MaybeT $ getKeyBy $ UniqueInstance hParent - MaybeT $ getValBy $ UniqueRemoteMessageIdent iid luParent + roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent + MaybeT $ getValBy $ UniqueRemoteMessageIdent roid rm <- fromMaybeE mrm "Remote parent unknown locally" let mid = remoteMessageRest rm m <- lift $ getJust mid @@ -216,7 +217,8 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source Right p@(ObjURI hParent luParent) -> do mrm <- lift $ runMaybeT $ do iid <- MaybeT $ getKeyBy $ UniqueInstance hParent - MaybeT $ getValBy $ UniqueRemoteMessageIdent iid luParent + roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent + MaybeT $ getValBy $ UniqueRemoteMessageIdent roid case mrm of Nothing -> return $ Right p Just rm -> Left <$> do diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs index e8d2b69..80b770b 100644 --- a/src/Vervis/Client.hs +++ b/src/Vervis/Client.hs @@ -123,8 +123,9 @@ createReply shrAuthor (TextPandocMarkdown msg) hDest recipsA recipsC context mid lmkhid <- encodeKeyHashid lmidParent return $ encodeRouteHome $ MessageR (sharerIdent s) lmkhid (Nothing, Just rm) -> do - i <- getJust $ remoteMessageInstance rm - return $ ObjURI (instanceHost i) (remoteMessageIdent rm) + ro <- getJust $ remoteMessageIdent rm + i <- getJust $ remoteObjectInstance ro + return $ ObjURI (instanceHost i) (remoteObjectIdent ro) contentHtml <- ExceptT . pure $ renderPandocMarkdown msg let uContext = encodeRecipRoute context recips = recipsA ++ recipsC diff --git a/src/Vervis/Discussion.hs b/src/Vervis/Discussion.hs index 302156a..0d5151d 100644 --- a/src/Vervis/Discussion.hs +++ b/src/Vervis/Discussion.hs @@ -58,7 +58,8 @@ getMessages getdid = runDB $ do on $ lm ^. LocalMessageRest ==. m ^. MessageId where_ $ m ^. MessageRoot ==. val did return (m, lm ^. LocalMessageId, s) - r <- select $ from $ \ (rm `InnerJoin` m `InnerJoin` ra `InnerJoin` ro `InnerJoin` i) -> do + r <- select $ from $ \ (rm `InnerJoin` m `InnerJoin` ra `InnerJoin` ro `InnerJoin` i `InnerJoin` ro2) -> do + on $ rm ^. RemoteMessageIdent ==. ro2 ^. RemoteObjectId on $ ro ^. RemoteObjectInstance ==. i ^. InstanceId on $ ra ^. RemoteActorIdent ==. ro ^. RemoteObjectId on $ rm ^. RemoteMessageAuthor ==. ra ^. RemoteActorId @@ -67,7 +68,7 @@ getMessages getdid = runDB $ do return ( m , i ^. InstanceHost - , rm ^. RemoteMessageIdent + , ro2 ^. RemoteObjectIdent , ro ^. RemoteObjectIdent , ra ^. RemoteActorName ) diff --git a/src/Vervis/Federation/Discussion.hs b/src/Vervis/Federation/Discussion.hs index 7757342..8db25c9 100644 --- a/src/Vervis/Federation/Discussion.hs +++ b/src/Vervis/Federation/Discussion.hs @@ -122,7 +122,8 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext Right (ObjURI hParent luParent) -> do mrm <- lift $ runMaybeT $ do iid <- MaybeT $ getKeyBy $ UniqueInstance hParent - MaybeT $ getValBy $ UniqueRemoteMessageIdent iid luParent + roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent + MaybeT $ getValBy $ UniqueRemoteMessageIdent roid for_ mrm $ \ rm -> do let mid = remoteMessageRest rm m <- lift $ getJust mid @@ -142,7 +143,8 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext Right (ObjURI hParent luParent) -> do mrm <- lift $ runMaybeT $ do iid <- MaybeT $ getKeyBy $ UniqueInstance hParent - MaybeT $ getValBy $ UniqueRemoteMessageIdent iid luParent + roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent + MaybeT $ getValBy $ UniqueRemoteMessageIdent roid for_ mrm $ \ rm -> do let mid = remoteMessageRest rm m <- lift $ getJust mid @@ -257,7 +259,8 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent Right p@(ObjURI hParent luParent) -> do mrm <- lift $ runMaybeT $ do iid <- MaybeT $ getKeyBy $ UniqueInstance hParent - MaybeT $ getValBy $ UniqueRemoteMessageIdent iid luParent + roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid luParent + MaybeT $ getValBy $ UniqueRemoteMessageIdent roid case mrm of Just rm -> Left <$> do let mid = remoteMessageRest rm @@ -287,10 +290,11 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent _ -> Nothing , messageRoot = did } + roid2 <- + either entityKey id <$> insertBy' (RemoteObject iidAuthor luNote) mrmid <- insertUnique RemoteMessage { remoteMessageAuthor = raidAuthor - , remoteMessageInstance = iidAuthor - , remoteMessageIdent = luNote + , remoteMessageIdent = roid2 , remoteMessageRest = mid , remoteMessageCreate = ractid , remoteMessageLostParent = diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs index 39b0c6e..ca4e8a0 100644 --- a/src/Vervis/Handler/Discussion.hs +++ b/src/Vervis/Handler/Discussion.hs @@ -93,15 +93,16 @@ getNode getdid mid = do s <- getJust $ personIdent p return $ MessageTreeNodeLocal lmid s (Nothing, Just (Entity _rmid rm)) -> do - rs <- getJust $ remoteMessageAuthor rm - ro <- getJust $ remoteActorIdent rs - i <- getJust $ remoteObjectInstance ro + ra <- getJust $ remoteMessageAuthor rm + roA <- getJust $ remoteActorIdent ra + roM <- getJust $ remoteMessageIdent rm + i <- getJust $ remoteObjectInstance roA return $ MessageTreeNodeRemote (instanceHost i) - (remoteMessageIdent rm) - (remoteObjectIdent ro) - (remoteActorName rs) + (remoteObjectIdent roM) + (remoteObjectIdent roA) + (remoteActorName ra) return $ MessageTreeNode mid m author {- diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 53b1b6a..ea7be65 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -1472,6 +1472,40 @@ changes hLocal ctx = Unique "UniqueTicketUnderProjectAuthor" ["author"] -- 226 , removeUnique "TicketUnderProject" "UniqueTicketUnderProject" + -- 227 + , addFieldRefRequired'' + "RemoteMessage" + (do iid <- insert $ Instance227 $ Authority "227.fake.fake" Nothing + insertEntity $ RemoteObject227 iid $ LocalURI "/fake/227" + ) + (Just $ \ (Entity roidTemp roTemp) -> do + rmids <- selectList ([] :: [Filter RemoteMessage227]) [] + for_ rmids $ \ (Entity rmid rm) -> do + let iid = remoteMessage227Instance rm + lu = remoteMessage227Ident rm + roid <- insert $ RemoteObject227 iid lu + update rmid [RemoteMessage227IdentNew =. roid] + delete roidTemp + delete $ remoteObject227Instance roTemp + ) + "identNew" + "RemoteObject" + -- 228 + , addUnique "RemoteMessage" $ + Unique "UniqueRemoteMessageIdentNew" ["identNew"] + -- 229 + , removeUnique "RemoteMessage" "UniqueRemoteMessageIdent" + -- 230 + , renameUnique + "RemoteMessage" + "UniqueRemoteMessageIdentNew" + "UniqueRemoteMessageIdent" + -- 231 + , removeField "RemoteMessage" "instance" + -- 232 + , removeField "RemoteMessage" "ident" + -- 233 + , renameField "RemoteMessage" "identNew" "ident" ] migrateDB diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs index c3d4c94..751e4a3 100644 --- a/src/Vervis/Migration/Model.hs +++ b/src/Vervis/Migration/Model.hs @@ -176,6 +176,10 @@ module Vervis.Migration.Model , RemoteDiscussion215Generic (..) , model_2020_02_09 , TicketUnderProject223Generic (..) + , Instance227Generic (..) + , RemoteObject227Generic (..) + , RemoteMessage227 + , RemoteMessage227Generic (..) ) where @@ -343,3 +347,6 @@ model_2020_02_09 = $(schema "2020_02_09_tup") makeEntitiesMigration "223" $(modelFile "migrations/2020_02_09_tup_mig.model") + +makeEntitiesMigration "227" + $(modelFile "migrations/2020_02_10_rm_point_to_ro.model")