diff --git a/migrations/630_2024-04-29_component_komponent.model b/migrations/630_2024-04-29_component_komponent.model new file mode 100644 index 0000000..46cb993 --- /dev/null +++ b/migrations/630_2024-04-29_component_komponent.model @@ -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 diff --git a/src/Vervis/Actor/Project.hs b/src/Vervis/Actor/Project.hs index 7bf7ab4..bea46fd 100644 --- a/src/Vervis/Actor/Project.hs +++ b/src/Vervis/Actor/Project.hs @@ -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 diff --git a/src/Vervis/Data/Collab.hs b/src/Vervis/Data/Collab.hs index 5e018c9..3a17226 100644 --- a/src/Vervis/Data/Collab.hs +++ b/src/Vervis/Data/Collab.hs @@ -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 diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs index c7ad104..ad86640 100644 --- a/src/Vervis/Handler/Project.hs +++ b/src/Vervis/Handler/Project.hs @@ -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 diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 4d60ade..c9090a3 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -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 diff --git a/src/Vervis/Migration/Model2024.hs b/src/Vervis/Migration/Model2024.hs index 0849827..7fb1598 100644 --- a/src/Vervis/Migration/Model2024.hs +++ b/src/Vervis/Migration/Model2024.hs @@ -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") diff --git a/src/Vervis/Persist/Actor.hs b/src/Vervis/Persist/Actor.hs index 8d50a7a..3a306ff 100644 --- a/src/Vervis/Persist/Actor.hs +++ b/src/Vervis/Persist/Actor.hs @@ -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 diff --git a/src/Vervis/Persist/Collab.hs b/src/Vervis/Persist/Collab.hs index 92fb609..0f33ebc 100644 --- a/src/Vervis/Persist/Collab.hs +++ b/src/Vervis/Persist/Collab.hs @@ -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 diff --git a/th/models b/th/models index 17477b9..c0db222 100644 --- a/th/models +++ b/th/models @@ -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