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
-- 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
-- any are enabled, make sure there's at most one (otherwise it's a
@ -1417,31 +1417,12 @@ checkExistingComponents projectID componentDB = do
where
getExistingComponents (Left (ComponentRepo (Entity repoID _))) =
getExistingComponents (Left komponentID) =
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 $ ident E.^. ComponentLocalRepoComponent E.==. local E.^. ComponentLocalId
E.where_ $
ident E.^. ComponentLocalRepoRepo E.==. E.val repoID 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.&&.
local E.^. ComponentLocalActor E.==. E.val komponentID E.&&.
comp E.^. ComponentProject E.==. E.val projectID
return (comp E.^. ComponentId, local E.^. ComponentLocalId)
getExistingComponents (Right remoteActorID) =
@ -1659,15 +1640,8 @@ projectAdd now projectID (Verse authorIdMsig body) add = do
Right (author, _, addID) ->
insert_ $ ComponentGestureRemote originID (remoteAuthorId author) addID
case componentDB of
Left l -> do
identID <- insert $ ComponentLocal componentID
case l of
ComponentRepo (Entity repoID _) ->
insert_ $ ComponentLocalRepo identID repoID
ComponentDeck (Entity deckID _) ->
insert_ $ ComponentLocalDeck identID deckID
ComponentLoom (Entity loomID _) ->
insert_ $ ComponentLocalLoom identID loomID
Left l ->
insert_ $ ComponentLocal componentID (localComponentID l)
Right remoteActorID ->
insert_ $ ComponentRemote componentID remoteActorID
@ -3806,15 +3780,8 @@ projectInvite now projectID (Verse authorIdMsig body) invite = do
Right (author, _, inviteID) ->
insert_ $ ComponentProjectGestureRemote componentID (remoteAuthorId author) inviteID
case componentDB of
Left l -> do
identID <- insert $ ComponentLocal componentID
case l of
ComponentRepo (Entity repoID _) ->
insert_ $ ComponentLocalRepo identID repoID
ComponentDeck (Entity deckID _) ->
insert_ $ ComponentLocalDeck identID deckID
ComponentLoom (Entity loomID _) ->
insert_ $ ComponentLocalLoom identID loomID
Left l ->
insert_ $ ComponentLocal componentID (localComponentID l)
Right remoteActorID ->
insert_ $ ComponentRemote componentID remoteActorID
insert_ $ ComponentProjectAccept originID acceptID

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

@ -39,6 +39,7 @@ module Vervis.Data.Collab
, unhashComponentE
, componentResource
, resourceToComponent
, localComponentID
)
where
@ -524,3 +525,8 @@ resourceToComponent = \case
LocalResourceLoom k -> Just $ ComponentLoom k
LocalResourceProject _ -> 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

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

@ -412,12 +412,20 @@ postProjectRemoveR projectHash collabID = do
getProjectComponentsR :: KeyHashid Project -> Handler TypedContent
getProjectComponentsR projectHash = do
projectID <- decodeKeyHashid404 projectHash
components <- runDB $ concat <$> sequence
[ map (Left . ComponentRepo) <$> getRepos projectID
, map (Left . ComponentDeck) <$> getDecks projectID
, map (Left . ComponentLoom) <$> getLooms projectID
, map Right <$> getRemotes projectID
]
components <- runDB $ do
komponentIDs <-
fmap (map E.unValue) $
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
]
encodeRouteLocal <- getEncodeRouteLocal
encodeRouteHome <- getEncodeRouteHome
hashActor <- getHashLocalActor
@ -446,33 +454,6 @@ getProjectComponentsR projectHash = do
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 =
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

51
src/Vervis/Migration.hs
View file

@ -3707,6 +3707,57 @@ changes hLocal ctx =
)
"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

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

@ -72,3 +72,6 @@ makeEntitiesMigration "625"
makeEntitiesMigration "627"
$(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
( getLocalActor
, getLocalResource
, getLocalComponent
, getLocalActorEnt
--, getLocalResourceEnt
--, getLocalComponentEnt
, getLocalActorEntity
, getLocalActorEntityE
, getLocalActorEntity404
, getLocalResourceEntity
, getLocalResourceEntityE
, getLocalResourceEntity404
, getLocalComponentEntity
, getLocalComponentEntityE
, getLocalComponentEntity404
, verifyLocalActivityExistsInDB
, getRemoteObjectURI
, getRemoteActorURI
@ -84,6 +89,7 @@ import Data.Maybe.Local
import Database.Persist.Local
import Vervis.Data.Actor
import Vervis.Data.Collab
import Vervis.FedURI
import Vervis.Foundation
import Vervis.Model
@ -100,6 +106,10 @@ getLocalResource
:: MonadIO m => ResourceId -> ReaderT SqlBackend m (LocalResourceBy Key)
getLocalResource = fmap (bmap entityKey) . getLocalResourceEnt
getLocalComponent
:: MonadIO m => KomponentId -> ReaderT SqlBackend m (ComponentBy Key)
getLocalComponent = fmap (bmap entityKey) . getLocalComponentEnt
getLocalActorEnt
:: MonadIO m => ActorId -> ReaderT SqlBackend m (LocalActorBy Entity)
getLocalActorEnt actorID = do
@ -137,6 +147,22 @@ getLocalResourceEnt resourceID = do
"Found Resource without specific actor"
"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
:: MonadIO m
=> LocalActorBy Key
@ -185,6 +211,25 @@ getLocalResourceEntityE a e = do
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
:: MonadIO m
=> LocalActorBy Key

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

@ -446,26 +446,13 @@ getComponentIdent
getComponentIdent componentID = do
ident <-
requireEitherAlt
(getKeyBy $ UniqueComponentLocal componentID)
(getBy $ UniqueComponentLocal componentID)
(getBy $ UniqueComponentRemote componentID)
"Found Component without ident"
"Found Component with both local and remote ident"
bitraverse
(\ localID -> do
maybeRepo <- getValBy $ UniqueComponentLocalRepo localID
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 localID (ComponentLocal _ komponentID)) ->
(localID,) <$> getLocalComponent komponentID
)
(\ (Entity k v) -> pure (k, componentRemoteActor v))
ident

19
th/models
View file

@ -1003,27 +1003,10 @@ ComponentProjectAccept
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
ComponentRemote
component ComponentId
actor RemoteActorId