forge/Vervis
1
0
Fork 0
Code Pull requests Activity

DB: Remove ComponentLocal* tables, use Komponent instead

Browse source
This commit is contained in:
Pere Lev 2024-04-29 23:23:59 +03:00
parent aeb1a83c93
commit 5d594ca738
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
9 changed files with 225 additions and 108 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

94
migrations/630_2024-04-29_component_komponent.model Normal file
View file

@ -0,0 +1,94 @@
Component
Workflow
OutboxItem
Outbox
Inbox
FollowerSet
Actor
name Text
desc Text
createdAt UTCTime
inbox InboxId
outbox OutboxId
followers FollowerSetId
justCreatedBy ActorId Maybe
errbox InboxId
UniqueActorInbox inbox
UniqueActorOutbox outbox
UniqueActorFollowers followers
Resource
actor ActorId
UniqueResource actor
Komponent
resource ResourceId
UniqueKomponent resource
ComponentLocal
component ComponentId
actor KomponentId
UniqueComponentLocal component
ComponentLocalRepo
component ComponentLocalId
repo RepoId
UniqueComponentLocalRepo component
ComponentLocalDeck
component ComponentLocalId
deck DeckId
UniqueComponentLocalDeck component
ComponentLocalLoom
component ComponentLocalId
loom LoomId
UniqueComponentLocalLoom component
Deck
actor ActorId
resource ResourceId
komponent KomponentId
workflow WorkflowId
nextTicket Int
wiki RepoId Maybe
create OutboxItemId
UniqueDeckActor actor
UniqueDeckCreate create
Loom
nextTicket Int
actor ActorId
resource ResourceId
komponent KomponentId
repo RepoId
create OutboxItemId
UniqueLoomActor actor
UniqueLoomRepo repo
UniqueLoomCreate create
Repo
vcs VersionControlSystem
project DeckId Maybe
mainBranch Text
actor ActorId
resource ResourceId
komponent KomponentId
create OutboxItemId
loom LoomId Maybe
UniqueRepoActor actor
UniqueRepoCreate create

49
src/Vervis/Actor/Project.hs
View file

@ -1388,7 +1388,7 @@ checkExistingComponents
checkExistingComponents projectID componentDB = do checkExistingComponents projectID componentDB = do
-- Find existing Component records I have for this component -- Find existing Component records I have for this component
componentIDs <- lift $ getExistingComponents componentDB componentIDs <- lift $ getExistingComponents $ first localComponentID $ componentDB
-- Grab all the enabled ones, make sure none are enabled, and even if -- Grab all the enabled ones, make sure none are enabled, and even if
-- any are enabled, make sure there's at most one (otherwise it's a -- any are enabled, make sure there's at most one (otherwise it's a
@ -1417,31 +1417,12 @@ checkExistingComponents projectID componentDB = do
where where
getExistingComponents (Left (ComponentRepo (Entity repoID _))) = getExistingComponents (Left komponentID) =
fmap (map $ bimap E.unValue (Left . E.unValue)) $ fmap (map $ bimap E.unValue (Left . E.unValue)) $
E.select $ E.from $ \ (ident `E.InnerJoin` local `E.InnerJoin` comp) -> do E.select $ E.from $ \ (local `E.InnerJoin` comp) -> do
E.on $ local E.^. ComponentLocalComponent E.==. comp E.^. ComponentId E.on $ local E.^. ComponentLocalComponent E.==. comp E.^. ComponentId
E.on $ ident E.^. ComponentLocalRepoComponent E.==. local E.^. ComponentLocalId
E.where_ $ E.where_ $
ident E.^. ComponentLocalRepoRepo E.==. E.val repoID E.&&. local E.^. ComponentLocalActor E.==. E.val komponentID E.&&.
comp E.^. ComponentProject E.==. E.val projectID
return (comp E.^. ComponentId, local E.^. ComponentLocalId)
getExistingComponents (Left (ComponentDeck (Entity deckID _))) =
fmap (map $ bimap E.unValue (Left . E.unValue)) $
E.select $ E.from $ \ (ident `E.InnerJoin` local `E.InnerJoin` comp) -> do
E.on $ local E.^. ComponentLocalComponent E.==. comp E.^. ComponentId
E.on $ ident E.^. ComponentLocalDeckComponent E.==. local E.^. ComponentLocalId
E.where_ $
ident E.^. ComponentLocalDeckDeck E.==. E.val deckID E.&&.
comp E.^. ComponentProject E.==. E.val projectID
return (comp E.^. ComponentId, local E.^. ComponentLocalId)
getExistingComponents (Left (ComponentLoom (Entity loomID _))) =
fmap (map $ bimap E.unValue (Left . E.unValue)) $
E.select $ E.from $ \ (ident `E.InnerJoin` local `E.InnerJoin` comp) -> do
E.on $ local E.^. ComponentLocalComponent E.==. comp E.^. ComponentId
E.on $ ident E.^. ComponentLocalLoomComponent E.==. local E.^. ComponentLocalId
E.where_ $
ident E.^. ComponentLocalLoomLoom E.==. E.val loomID E.&&.
comp E.^. ComponentProject E.==. E.val projectID comp E.^. ComponentProject E.==. E.val projectID
return (comp E.^. ComponentId, local E.^. ComponentLocalId) return (comp E.^. ComponentId, local E.^. ComponentLocalId)
getExistingComponents (Right remoteActorID) = getExistingComponents (Right remoteActorID) =
@ -1659,15 +1640,8 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
Right (author, _, addID) -> Right (author, _, addID) ->
insert_ $ ComponentGestureRemote originID (remoteAuthorId author) addID insert_ $ ComponentGestureRemote originID (remoteAuthorId author) addID
case componentDB of case componentDB of
Left l -> do Left l ->
identID <- insert $ ComponentLocal componentID insert_ $ ComponentLocal componentID (localComponentID l)
case l of
ComponentRepo (Entity repoID _) ->
insert_ $ ComponentLocalRepo identID repoID
ComponentDeck (Entity deckID _) ->
insert_ $ ComponentLocalDeck identID deckID
ComponentLoom (Entity loomID _) ->
insert_ $ ComponentLocalLoom identID loomID
Right remoteActorID -> Right remoteActorID ->
insert_ $ ComponentRemote componentID remoteActorID insert_ $ ComponentRemote componentID remoteActorID
@ -3806,15 +3780,8 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
Right (author, _, inviteID) -> Right (author, _, inviteID) ->
insert_ $ ComponentProjectGestureRemote componentID (remoteAuthorId author) inviteID insert_ $ ComponentProjectGestureRemote componentID (remoteAuthorId author) inviteID
case componentDB of case componentDB of
Left l -> do Left l ->
identID <- insert $ ComponentLocal componentID insert_ $ ComponentLocal componentID (localComponentID l)
case l of
ComponentRepo (Entity repoID _) ->
insert_ $ ComponentLocalRepo identID repoID
ComponentDeck (Entity deckID _) ->
insert_ $ ComponentLocalDeck identID deckID
ComponentLoom (Entity loomID _) ->
insert_ $ ComponentLocalLoom identID loomID
Right remoteActorID -> Right remoteActorID ->
insert_ $ ComponentRemote componentID remoteActorID insert_ $ ComponentRemote componentID remoteActorID
insert_ $ ComponentProjectAccept originID acceptID insert_ $ ComponentProjectAccept originID acceptID

6
src/Vervis/Data/Collab.hs
View file

@ -39,6 +39,7 @@ module Vervis.Data.Collab
, unhashComponentE , unhashComponentE
, componentResource , componentResource
, resourceToComponent , resourceToComponent
, localComponentID
) )
where where
@ -524,3 +525,8 @@ resourceToComponent = \case
LocalResourceLoom k -> Just $ ComponentLoom k LocalResourceLoom k -> Just $ ComponentLoom k
LocalResourceProject _ -> Nothing LocalResourceProject _ -> Nothing
LocalResourceGroup _ -> Nothing LocalResourceGroup _ -> Nothing
localComponentID :: ComponentBy Entity -> KomponentId
localComponentID (ComponentRepo (Entity _ r)) = repoKomponent r
localComponentID (ComponentDeck (Entity _ d)) = deckKomponent d
localComponentID (ComponentLoom (Entity _ l)) = loomKomponent l

43
src/Vervis/Handler/Project.hs
View file

@ -412,10 +412,18 @@ postProjectRemoveR projectHash collabID = do
getProjectComponentsR :: KeyHashid Project -> Handler TypedContent getProjectComponentsR :: KeyHashid Project -> Handler TypedContent
getProjectComponentsR projectHash = do getProjectComponentsR projectHash = do
projectID <- decodeKeyHashid404 projectHash projectID <- decodeKeyHashid404 projectHash
components <- runDB $ concat <$> sequence components <- runDB $ do
[ map (Left . ComponentRepo) <$> getRepos projectID komponentIDs <-
, map (Left . ComponentDeck) <$> getDecks projectID fmap (map E.unValue) $
, map (Left . ComponentLoom) <$> getLooms projectID E.select $ E.from $ \ (comp `E.InnerJoin` enable `E.InnerJoin` local) -> do
E.on $ comp E.^. ComponentId E.==. local E.^. ComponentLocalComponent
E.on $ comp E.^. ComponentId E.==. enable E.^. ComponentEnableComponent
E.where_ $ comp E.^. ComponentProject E.==. E.val projectID
return $ local E.^. ComponentLocalActor
concat <$> sequence
[ map (Left . ComponentRepo) <$> selectKeysList [RepoKomponent <-. komponentIDs] []
, map (Left . ComponentDeck) <$> selectKeysList [DeckKomponent <-. komponentIDs] []
, map (Left . ComponentLoom) <$> selectKeysList [LoomKomponent <-. komponentIDs] []
, map Right <$> getRemotes projectID , map Right <$> getRemotes projectID
] ]
encodeRouteLocal <- getEncodeRouteLocal encodeRouteLocal <- getEncodeRouteLocal
@ -446,33 +454,6 @@ getProjectComponentsR projectHash = do
where where
getRepos projectID =
fmap (map E.unValue) $
E.select $ E.from $ \ (comp `E.InnerJoin` enable `E.InnerJoin` local `E.InnerJoin` repo) -> do
E.on $ local E.^. ComponentLocalId E.==. repo E.^. ComponentLocalRepoComponent
E.on $ comp E.^. ComponentId E.==. local E.^. ComponentLocalComponent
E.on $ comp E.^. ComponentId E.==. enable E.^. ComponentEnableComponent
E.where_ $ comp E.^. ComponentProject E.==. E.val projectID
return $ repo E.^. ComponentLocalRepoRepo
getDecks projectID =
fmap (map E.unValue) $
E.select $ E.from $ \ (comp `E.InnerJoin` enable `E.InnerJoin` local `E.InnerJoin` deck) -> do
E.on $ local E.^. ComponentLocalId E.==. deck E.^. ComponentLocalDeckComponent
E.on $ comp E.^. ComponentId E.==. local E.^. ComponentLocalComponent
E.on $ comp E.^. ComponentId E.==. enable E.^. ComponentEnableComponent
E.where_ $ comp E.^. ComponentProject E.==. E.val projectID
return $ deck E.^. ComponentLocalDeckDeck
getLooms projectID =
fmap (map E.unValue) $
E.select $ E.from $ \ (comp `E.InnerJoin` enable `E.InnerJoin` local `E.InnerJoin` loom) -> do
E.on $ local E.^. ComponentLocalId E.==. loom E.^. ComponentLocalLoomComponent
E.on $ comp E.^. ComponentId E.==. local E.^. ComponentLocalComponent
E.on $ comp E.^. ComponentId E.==. enable E.^. ComponentEnableComponent
E.where_ $ comp E.^. ComponentProject E.==. E.val projectID
return $ loom E.^. ComponentLocalLoomLoom
getRemotes projectID = getRemotes projectID =
fmap (map $ uncurry ObjURI . bimap E.unValue E.unValue) $ fmap (map $ uncurry ObjURI . bimap E.unValue E.unValue) $
E.select $ E.from $ \ (comp `E.InnerJoin` enable `E.InnerJoin` remote `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i) -> do E.select $ E.from $ \ (comp `E.InnerJoin` enable `E.InnerJoin` remote `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i) -> do

51
src/Vervis/Migration.hs
View file

@ -3707,6 +3707,57 @@ changes hLocal ctx =
) )
"komponent" "komponent"
"Komponent" "Komponent"
-- 630
, addFieldRefRequired''
"ComponentLocal"
(do inboxID <- insert Inbox630
errboxID <- insert Inbox630
outboxID <- insert Outbox630
followerSetID <- insert FollowerSet630
actorID <- insert $ Actor630 "" "" defaultTime inboxID outboxID followerSetID Nothing errboxID
resourceID <- insert $ Resource630 actorID
insertEntity $ Komponent630 resourceID
)
(Just $ \ (Entity tempKomponentID (Komponent630 tempResourceID)) -> do
l <- selectKeysList [] []
for_ l $ \ k -> do
komponentID <- do
options <-
sequence
[ do
ma <- fmap componentLocalRepo630Repo <$> getValBy (UniqueComponentLocalRepo630 k)
for ma $ fmap repo630Komponent . getJust
, do
ma <- fmap componentLocalDeck630Deck <$> getValBy (UniqueComponentLocalDeck630 k)
for ma $ fmap deck630Komponent . getJust
, do
ma <- fmap componentLocalLoom630Loom <$> getValBy (UniqueComponentLocalLoom630 k)
for ma $ fmap loom630Komponent . getJust
]
exactlyOneJust
options
"Found ComponentLocal without topic"
"Found ComponentLocal with multiple topics"
update k [ComponentLocal630Actor =. komponentID]
Resource630 tempActorID <- getJust tempResourceID
Actor630 _ _ _ inboxID outboxID followerSetID _ errboxID <- getJust tempActorID
delete tempKomponentID
delete tempResourceID
delete tempActorID
delete inboxID
delete errboxID
delete outboxID
delete followerSetID
)
"actor"
"Komponent"
-- 631
, removeEntity "ComponentLocalDeck"
-- 632
, removeEntity "ComponentLocalLoom"
-- 633
, removeEntity "ComponentLocalRepo"
] ]
migrateDB migrateDB

3
src/Vervis/Migration/Model2024.hs
View file

@ -72,3 +72,6 @@ makeEntitiesMigration "625"
makeEntitiesMigration "627" makeEntitiesMigration "627"
$(modelFile "migrations/627_2024-04-29_komponent_mig.model") $(modelFile "migrations/627_2024-04-29_komponent_mig.model")
makeEntitiesMigration "630"
$(modelFile "migrations/630_2024-04-29_component_komponent.model")

45
src/Vervis/Persist/Actor.hs
View file

@ -17,14 +17,19 @@
module Vervis.Persist.Actor module Vervis.Persist.Actor
( getLocalActor ( getLocalActor
, getLocalResource , getLocalResource
, getLocalComponent
, getLocalActorEnt , getLocalActorEnt
--, getLocalResourceEnt --, getLocalResourceEnt
--, getLocalComponentEnt
, getLocalActorEntity , getLocalActorEntity
, getLocalActorEntityE , getLocalActorEntityE
, getLocalActorEntity404 , getLocalActorEntity404
, getLocalResourceEntity , getLocalResourceEntity
, getLocalResourceEntityE , getLocalResourceEntityE
, getLocalResourceEntity404 , getLocalResourceEntity404
, getLocalComponentEntity
, getLocalComponentEntityE
, getLocalComponentEntity404
, verifyLocalActivityExistsInDB , verifyLocalActivityExistsInDB
, getRemoteObjectURI , getRemoteObjectURI
, getRemoteActorURI , getRemoteActorURI
@ -84,6 +89,7 @@ import Data.Maybe.Local
import Database.Persist.Local import Database.Persist.Local
import Vervis.Data.Actor import Vervis.Data.Actor
import Vervis.Data.Collab
import Vervis.FedURI import Vervis.FedURI
import Vervis.Foundation import Vervis.Foundation
import Vervis.Model import Vervis.Model
@ -100,6 +106,10 @@ getLocalResource
:: MonadIO m => ResourceId -> ReaderT SqlBackend m (LocalResourceBy Key) :: MonadIO m => ResourceId -> ReaderT SqlBackend m (LocalResourceBy Key)
getLocalResource = fmap (bmap entityKey) . getLocalResourceEnt getLocalResource = fmap (bmap entityKey) . getLocalResourceEnt
getLocalComponent
:: MonadIO m => KomponentId -> ReaderT SqlBackend m (ComponentBy Key)
getLocalComponent = fmap (bmap entityKey) . getLocalComponentEnt
getLocalActorEnt getLocalActorEnt
:: MonadIO m => ActorId -> ReaderT SqlBackend m (LocalActorBy Entity) :: MonadIO m => ActorId -> ReaderT SqlBackend m (LocalActorBy Entity)
getLocalActorEnt actorID = do getLocalActorEnt actorID = do
@ -137,6 +147,22 @@ getLocalResourceEnt resourceID = do
"Found Resource without specific actor" "Found Resource without specific actor"
"Found Resource with multiple actors" "Found Resource with multiple actors"
getLocalComponentEnt
:: MonadIO m => KomponentId -> ReaderT SqlBackend m (ComponentBy Entity)
getLocalComponentEnt komponentID = do
Komponent resourceID <- getJust komponentID
Resource actorID <- getJust resourceID
options <-
sequence
[ fmap ComponentRepo <$> getBy (UniqueRepoActor actorID)
, fmap ComponentDeck <$> getBy (UniqueDeckActor actorID)
, fmap ComponentLoom <$> getBy (UniqueLoomActor actorID)
]
exactlyOneJust
options
"Found Komponent without specific actor"
"Found Komponent with multiple actors"
getLocalActorEntity getLocalActorEntity
:: MonadIO m :: MonadIO m
=> LocalActorBy Key => LocalActorBy Key
@ -185,6 +211,25 @@ getLocalResourceEntityE a e = do
getLocalResourceEntity404 = maybe notFound return <=< getLocalResourceEntity getLocalResourceEntity404 = maybe notFound return <=< getLocalResourceEntity
getLocalComponentEntity
:: MonadIO m
=> ComponentBy Key
-> ReaderT SqlBackend m (Maybe (ComponentBy Entity))
getLocalComponentEntity (ComponentLoom l) =
fmap (ComponentLoom . Entity l) <$> get l
getLocalComponentEntity (ComponentRepo r) =
fmap (ComponentRepo . Entity r) <$> get r
getLocalComponentEntity (ComponentDeck d) =
fmap (ComponentDeck . Entity d) <$> get d
getLocalComponentEntityE a e = do
m <- lift $ getLocalComponentEntity a
case m of
Nothing -> throwE e
Just a' -> return a'
getLocalComponentEntity404 = maybe notFound return <=< getLocalComponentEntity
verifyLocalActivityExistsInDB verifyLocalActivityExistsInDB
:: MonadIO m :: MonadIO m
=> LocalActorBy Key => LocalActorBy Key

19
src/Vervis/Persist/Collab.hs
View file

@ -446,26 +446,13 @@ getComponentIdent
getComponentIdent componentID = do getComponentIdent componentID = do
ident <- ident <-
requireEitherAlt requireEitherAlt
(getKeyBy $ UniqueComponentLocal componentID) (getBy $ UniqueComponentLocal componentID)
(getBy $ UniqueComponentRemote componentID) (getBy $ UniqueComponentRemote componentID)
"Found Component without ident" "Found Component without ident"
"Found Component with both local and remote ident" "Found Component with both local and remote ident"
bitraverse bitraverse
(\ localID -> do (\ (Entity localID (ComponentLocal _ komponentID)) ->
maybeRepo <- getValBy $ UniqueComponentLocalRepo localID (localID,) <$> getLocalComponent komponentID
maybeDeck <- getValBy $ UniqueComponentLocalDeck localID
maybeLoom <- getValBy $ UniqueComponentLocalLoom localID
fmap (localID,) $ return $
case (maybeRepo, maybeDeck, maybeLoom) of
(Nothing, Nothing, Nothing) ->
error "Found ComponentLocal without ident"
(Just r, Nothing, Nothing) ->
ComponentRepo $ componentLocalRepoRepo r
(Nothing, Just d, Nothing) ->
ComponentDeck $ componentLocalDeckDeck d
(Nothing, Nothing, Just l) ->
ComponentLoom $ componentLocalLoomLoom l
_ -> error "Found ComponentLocal with multiple idents"
) )
(\ (Entity k v) -> pure (k, componentRemoteActor v)) (\ (Entity k v) -> pure (k, componentRemoteActor v))
ident ident

19
th/models
View file

@ -1003,27 +1003,10 @@ ComponentProjectAccept
ComponentLocal ComponentLocal
component ComponentId component ComponentId
actor KomponentId
UniqueComponentLocal component UniqueComponentLocal component
ComponentLocalRepo
component ComponentLocalId
repo RepoId
UniqueComponentLocalRepo component
ComponentLocalDeck
component ComponentLocalId
deck DeckId
UniqueComponentLocalDeck component
ComponentLocalLoom
component ComponentLocalId
loom LoomId
UniqueComponentLocalLoom component
ComponentRemote ComponentRemote
component ComponentId component ComponentId
actor RemoteActorId actor RemoteActorId