Add force delete KM

vknaisl · vknaisl · commit d15532241a2d · 2026-02-20T12:36:37.000+01:00
diff --git a/wizard-server/src/Wizard/Api/Handler/KnowledgeModelPackage/Api.hs b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelPackage/Api.hs
@@ -3,6 +3,7 @@ module Wizard.Api.Handler.KnowledgeModelPackage.Api where
 import Servant
 import Servant.Swagger.Tags
 
+import Wizard.Api.Handler.KnowledgeModelPackage.Dependent.Api
 import Wizard.Api.Handler.KnowledgeModelPackage.Detail_Bundle_GET
 import Wizard.Api.Handler.KnowledgeModelPackage.Detail_DELETE
 import Wizard.Api.Handler.KnowledgeModelPackage.Detail_GET
@@ -17,7 +18,7 @@ import Wizard.Api.Handler.KnowledgeModelPackage.List_Suggestions_GET
 import Wizard.Model.Context.BaseContext
 
 type KnowledgeModelPackageAPI =
-  Tags "Package"
+  Tags "Knowledge Model Package"
     :> ( List_GET
           :<|> List_Suggestions_GET
           :<|> List_POST
@@ -29,6 +30,7 @@ type KnowledgeModelPackageAPI =
           :<|> List_From_Migration_POST
           :<|> Detail_Bundle_GET
           :<|> Detail_Pull_POST
+          :<|> DependentAPI
        )
 
 knowledgeModelPackageApi :: Proxy KnowledgeModelPackageAPI
@@ -47,3 +49,4 @@ knowledgeModelPackageServer =
     :<|> list_from_migration_POST
     :<|> detail_bundle_GET
     :<|> detail_pull_POST
+    :<|> dependentServer
diff --git a/wizard-server/src/Wizard/Api/Handler/KnowledgeModelPackage/Dependent/Api.hs b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelPackage/Dependent/Api.hs
@@ -0,0 +1,18 @@
+module Wizard.Api.Handler.KnowledgeModelPackage.Dependent.Api where
+
+import Servant
+import Servant.Swagger.Tags
+
+import Wizard.Api.Handler.KnowledgeModelPackage.Dependent.List_GET
+import Wizard.Model.Context.BaseContext
+
+type DependentAPI =
+  Tags "Knowledge Model Package Dependent"
+    :> List_GET
+
+dependentApi :: Proxy DependentAPI
+dependentApi = Proxy
+
+dependentServer :: ServerT DependentAPI BaseContextM
+dependentServer =
+  list_GET
diff --git a/wizard-server/src/Wizard/Api/Handler/KnowledgeModelPackage/Dependent/List_GET.hs b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelPackage/Dependent/List_GET.hs
@@ -0,0 +1,33 @@
+module Wizard.Api.Handler.KnowledgeModelPackage.Dependent.List_GET where
+
+import qualified Data.UUID as U
+import Servant
+
+import Shared.Common.Api.Handler.Common
+import Shared.Common.Model.Context.TransactionState
+import Wizard.Api.Handler.Common
+import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpactJM ()
+import Wizard.Model.Context.BaseContext
+import Wizard.Model.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpact
+import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageService
+
+type List_GET =
+  Header "Authorization" String
+    :> Header "Host" String
+    :> "knowledge-model-packages"
+    :> Capture "uuid" U.UUID
+    :> "dependents"
+    :> QueryParam "allVersions" Bool
+    :> Get '[SafeJSON] (Headers '[Header "x-trace-uuid" String] [KnowledgeModelPackageDeletionImpact])
+
+list_GET
+  :: Maybe String
+  -> Maybe String
+  -> U.UUID
+  -> Maybe Bool
+  -> BaseContextM (Headers '[Header "x-trace-uuid" String] [KnowledgeModelPackageDeletionImpact])
+list_GET mTokenHeader mServerUrl uuid mAllVersions =
+  getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService ->
+    runInAuthService NoTransaction $
+      addTraceUuidHeader
+        =<< getDependentPackageResources uuid mAllVersions
diff --git a/wizard-server/src/Wizard/Api/Handler/KnowledgeModelPackage/Detail_DELETE.hs b/wizard-server/src/Wizard/Api/Handler/KnowledgeModelPackage/Detail_DELETE.hs
@@ -14,12 +14,13 @@ type Detail_DELETE =
     :> Header "Host" String
     :> "knowledge-model-packages"
     :> Capture "uuid" U.UUID
+    :> QueryParam "allVersions" Bool
     :> Verb DELETE 204 '[SafeJSON] (Headers '[Header "x-trace-uuid" String] NoContent)
 
-detail_DELETE :: Maybe String -> Maybe String -> U.UUID -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent)
-detail_DELETE mTokenHeader mServerUrl pkgUuid =
+detail_DELETE :: Maybe String -> Maybe String -> U.UUID -> Maybe Bool -> BaseContextM (Headers '[Header "x-trace-uuid" String] NoContent)
+detail_DELETE mTokenHeader mServerUrl uuid mAllVersions =
   getAuthServiceExecutor mTokenHeader mServerUrl $ \runInAuthService ->
     runInAuthService Transactional $
       addTraceUuidHeader =<< do
-        deletePackage pkgUuid
+        deletePackage uuid mAllVersions
         return NoContent
diff --git a/wizard-server/src/Wizard/Api/Handler/Swagger/Api.hs b/wizard-server/src/Wizard/Api/Handler/Swagger/Api.hs
@@ -63,6 +63,7 @@ import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationResol
 import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationSM ()
 import Wizard.Api.Resource.KnowledgeModel.Migration.KnowledgeModelMigrationStateSM ()
 import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageChangeSM ()
+import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpactSM ()
 import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageDetailSM ()
 import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageSuggestionSM ()
 import Wizard.Api.Resource.KnowledgeModel.Package.Publish.KnowledgeModelPackagePublishEditorSM ()
diff --git a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Package/KnowledgeModelPackageDeletionImpactJM.hs b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Package/KnowledgeModelPackageDeletionImpactJM.hs
@@ -0,0 +1,20 @@
+module Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpactJM where
+
+import Data.Aeson
+
+import Shared.Common.Util.Aeson
+import Wizard.Api.Resource.KnowledgeModel.Editor.KnowledgeModelEditorSuggestionJM ()
+import Wizard.Api.Resource.Project.ProjectSimpleJM ()
+import Wizard.Model.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpact
+
+instance FromJSON KnowledgeModelPackageDeletionImpact where
+  parseJSON = genericParseJSON jsonOptions
+
+instance ToJSON KnowledgeModelPackageDeletionImpact where
+  toJSON = genericToJSON jsonOptions
+
+instance FromJSON KnowledgeModelPackageReference where
+  parseJSON = genericParseJSON jsonOptions
+
+instance ToJSON KnowledgeModelPackageReference where
+  toJSON = genericToJSON jsonOptions
diff --git a/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Package/KnowledgeModelPackageDeletionImpactSM.hs b/wizard-server/src/Wizard/Api/Resource/KnowledgeModel/Package/KnowledgeModelPackageDeletionImpactSM.hs
@@ -0,0 +1,16 @@
+module Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpactSM where
+
+import Data.Swagger
+
+import Shared.Common.Util.Swagger
+import Wizard.Api.Resource.KnowledgeModel.Editor.KnowledgeModelEditorSuggestionSM ()
+import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpactJM ()
+import Wizard.Api.Resource.Project.ProjectSimpleSM ()
+import Wizard.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackageDependents
+import Wizard.Model.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpact
+
+instance ToSchema KnowledgeModelPackageDeletionImpact where
+  declareNamedSchema = toSwagger netherlandsKmPackageDeletionImpact
+
+instance ToSchema KnowledgeModelPackageReference where
+  declareNamedSchema = toSwagger netherlandsKmPackageReference
diff --git a/wizard-server/src/Wizard/Database/DAO/KnowledgeModel/KnowledgeModelPackageDAO.hs b/wizard-server/src/Wizard/Database/DAO/KnowledgeModel/KnowledgeModelPackageDAO.hs
@@ -13,13 +13,16 @@ import Shared.Common.Model.Common.PageMetadata
 import Shared.Common.Model.Common.Pageable
 import Shared.Common.Model.Common.Sort
 import Shared.Common.Util.Logger
+import Shared.Common.Util.String
 import Shared.Coordinate.Model.Coordinate.Coordinate
 import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage
 import Wizard.Database.DAO.Common
+import Wizard.Database.Mapping.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpact ()
 import Wizard.Database.Mapping.KnowledgeModel.Package.KnowledgeModelPackageList ()
 import Wizard.Database.Mapping.KnowledgeModel.Package.KnowledgeModelPackageSuggestion ()
 import Wizard.Model.Context.AppContext
 import Wizard.Model.Context.ContextLenses ()
+import Wizard.Model.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpact
 import Wizard.Model.KnowledgeModel.Package.KnowledgeModelPackageList
 import Wizard.Model.KnowledgeModel.Package.KnowledgeModelPackageSuggestion
 
@@ -156,6 +159,70 @@ countPackageSuggestions mQuery selectCondition excludeCondition selectParams exc
     [count] -> return . fromOnly $ count
     _ -> return 0
 
+findDependentPackageResources :: [U.UUID] -> AppContextM [KnowledgeModelPackageDeletionImpact]
+findDependentPackageResources pkgUuids = do
+  tenantUuid <- asks currentTenantUuid
+  let sql =
+        f''
+          "WITH RECURSIVE package_tree AS ( \
+          \    SELECT  \
+          \        uuid, \
+          \        name, \
+          \        version, \
+          \        previous_package_uuid, \
+          \        tenant_uuid \
+          \    FROM knowledge_model_package \
+          \    WHERE uuid IN (${pkgUuids}) \
+          \      AND tenant_uuid = '${tenantUuid}' \
+          \ \
+          \    UNION \
+          \ \
+          \    SELECT  \
+          \        p.uuid, \
+          \        p.name, \
+          \        p.version, \
+          \        p.previous_package_uuid, \
+          \        p.tenant_uuid \
+          \    FROM knowledge_model_package p \
+          \    INNER JOIN package_tree pt ON p.previous_package_uuid = pt.uuid \
+          \    WHERE p.tenant_uuid = '${tenantUuid}' \
+          \) \
+          \SELECT  \
+          \    pt.uuid, \
+          \    pt.name, \
+          \    pt.version, \
+          \    (SELECT COALESCE(jsonb_agg(jsonb_build_object( \
+          \        'uuid', child.uuid, \
+          \        'name', child.name, \
+          \        'version', child.version \
+          \    )), '[]'::jsonb) \
+          \    FROM knowledge_model_package child \
+          \    WHERE child.previous_package_uuid = pt.uuid \
+          \      AND child.tenant_uuid = pt.tenant_uuid) AS packages, \
+          \ \
+          \    (SELECT COALESCE(jsonb_agg(jsonb_build_object( \
+          \        'uuid', e.uuid, \
+          \        'name', e.name \
+          \    )), '[]'::jsonb) \
+          \    FROM knowledge_model_editor e \
+          \    WHERE e.previous_package_uuid = pt.uuid \
+          \      AND e.tenant_uuid = pt.tenant_uuid) AS editors, \
+          \ \
+          \    (SELECT COALESCE(jsonb_agg(jsonb_build_object( \
+          \        'uuid', pr.uuid, \
+          \        'name', pr.name \
+          \    )), '[]'::jsonb) \
+          \    FROM project pr \
+          \    WHERE pr.knowledge_model_package_uuid = pt.uuid \
+          \      AND pr.tenant_uuid = pt.tenant_uuid) AS projects \
+          \FROM package_tree pt;"
+          [ ("pkgUuids", L.intercalate "," . fmap (\u -> f' "'%s'" [U.toString u]) $ pkgUuids)
+          , ("tenantUuid", U.toString tenantUuid)
+          ]
+  logInfoI _CMP_DATABASE (trim sql)
+  let action conn = query_ conn (fromString sql)
+  runDB action
+
 updatePackageMetamodelVersion :: U.UUID -> Int -> AppContextM Int64
 updatePackageMetamodelVersion pkgUuid metamodelVersion = do
   tenantUuid <- asks currentTenantUuid
diff --git a/wizard-server/src/Wizard/Database/Mapping/KnowledgeModel/Package/KnowledgeModelPackageDeletionImpact.hs b/wizard-server/src/Wizard/Database/Mapping/KnowledgeModel/Package/KnowledgeModelPackageDeletionImpact.hs
@@ -0,0 +1,22 @@
+module Wizard.Database.Mapping.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpact where
+
+import Database.PostgreSQL.Simple
+import Database.PostgreSQL.Simple.FromField
+import Database.PostgreSQL.Simple.FromRow
+
+import Wizard.Api.Resource.KnowledgeModel.Editor.KnowledgeModelEditorSuggestionJM ()
+import Wizard.Api.Resource.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpactJM ()
+import Wizard.Api.Resource.Project.ProjectSimpleJM ()
+import Wizard.Model.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpact
+
+instance FromRow KnowledgeModelPackageDeletionImpact where
+  fromRow = do
+    uuid <- field
+    name <- field
+    version <- field
+    packages <- fieldWith fromJSONField
+    editors <- fieldWith fromJSONField
+    projects <- fieldWith fromJSONField
+    return $ KnowledgeModelPackageDeletionImpact {..}
+
+instance FromRow KnowledgeModelPackageReference
diff --git a/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Package/KnowledgeModelPackageDependents.hs b/wizard-server/src/Wizard/Database/Migration/Development/KnowledgeModel/Data/Package/KnowledgeModelPackageDependents.hs
@@ -0,0 +1,38 @@
+module Wizard.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackageDependents where
+
+import Shared.KnowledgeModel.Database.Migration.Development.KnowledgeModel.Data.Package.KnowledgeModelPackages
+import Shared.KnowledgeModel.Model.KnowledgeModel.Package.KnowledgeModelPackage
+import Wizard.Database.Migration.Development.KnowledgeModel.Data.Editor.KnowledgeModelEditors
+import Wizard.Database.Migration.Development.Project.Data.Projects
+import Wizard.Model.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpact
+import Wizard.Service.Project.ProjectMapper
+
+netherlandsKmPackageDeletionImpact :: KnowledgeModelPackageDeletionImpact
+netherlandsKmPackageDeletionImpact =
+  KnowledgeModelPackageDeletionImpact
+    { uuid = netherlandsKmPackage.uuid
+    , name = netherlandsKmPackage.name
+    , version = netherlandsKmPackage.version
+    , packages = [netherlandsKmPackageReference]
+    , editors = [amsterdamKnowledgeModelEditorSuggestion]
+    , projects = [toSimple project4]
+    }
+
+netherlandsKmPackageReference :: KnowledgeModelPackageReference
+netherlandsKmPackageReference =
+  KnowledgeModelPackageReference
+    { uuid = netherlandsKmPackageV2.uuid
+    , name = netherlandsKmPackageV2.name
+    , version = netherlandsKmPackageV2.version
+    }
+
+netherlandsKmPackageV2DeletionImpact :: KnowledgeModelPackageDeletionImpact
+netherlandsKmPackageV2DeletionImpact =
+  KnowledgeModelPackageDeletionImpact
+    { uuid = netherlandsKmPackageV2.uuid
+    , name = netherlandsKmPackageV2.name
+    , version = netherlandsKmPackageV2.version
+    , packages = []
+    , editors = []
+    , projects = []
+    }
diff --git a/wizard-server/src/Wizard/Model/KnowledgeModel/Package/KnowledgeModelPackageDeletionImpact.hs b/wizard-server/src/Wizard/Model/KnowledgeModel/Package/KnowledgeModelPackageDeletionImpact.hs
@@ -0,0 +1,24 @@
+module Wizard.Model.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpact where
+
+import qualified Data.UUID as U
+import GHC.Generics
+
+import Wizard.Model.KnowledgeModel.Editor.KnowledgeModelEditorSuggestion
+import Wizard.Model.Project.ProjectSimple
+
+data KnowledgeModelPackageDeletionImpact = KnowledgeModelPackageDeletionImpact
+  { uuid :: U.UUID
+  , name :: String
+  , version :: String
+  , packages :: [KnowledgeModelPackageReference]
+  , editors :: [KnowledgeModelEditorSuggestion]
+  , projects :: [ProjectSimple]
+  }
+  deriving (Show, Eq, Generic)
+
+data KnowledgeModelPackageReference = KnowledgeModelPackageReference
+  { uuid :: U.UUID
+  , name :: String
+  , version :: String
+  }
+  deriving (Show, Eq, Generic)
diff --git a/wizard-server/src/Wizard/Service/KnowledgeModel/Package/KnowledgeModelPackageService.hs b/wizard-server/src/Wizard/Service/KnowledgeModel/Package/KnowledgeModelPackageService.hs
@@ -1,5 +1,6 @@
 module Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageService where
 
+import Control.Monad (void)
 import Control.Monad.Reader (asks)
 import Data.Foldable (traverse_)
 import qualified Data.UUID as U
@@ -23,6 +24,7 @@ import Wizard.Database.DAO.Registry.RegistryOrganizationDAO
 import Wizard.Model.Config.ServerConfig
 import Wizard.Model.Context.AclContext
 import Wizard.Model.Context.AppContext
+import Wizard.Model.KnowledgeModel.Package.KnowledgeModelPackageDeletionImpact
 import Wizard.Model.KnowledgeModel.Package.KnowledgeModelPackageSuggestion
 import Wizard.Model.Tenant.Config.TenantConfig
 import Wizard.Service.KnowledgeModel.Package.KnowledgeModelPackageMapper
@@ -56,6 +58,16 @@ getPackageDetailByUuid pkgUuid excludeDeprecatedVersions = do
   tcRegistry <- getCurrentTenantConfigRegistry
   return $ toDetailDTO pkg tcRegistry.enabled pkgRs orgRs versions (buildPackageUrl serverConfig.registry.clientUrl pkg pkgRs)
 
+getDependentPackageResources :: U.UUID -> Maybe Bool -> AppContextM [KnowledgeModelPackageDeletionImpact]
+getDependentPackageResources uuid mAllVersions = do
+  checkPermission _PM_READ_PERM
+  case mAllVersions of
+    Just True -> do
+      pkg <- findPackageByUuid uuid
+      allPkgs <- findPackagesByOrganizationIdAndKmId pkg.organizationId pkg.kmId
+      findDependentPackageResources (fmap (.uuid) allPkgs)
+    _ -> findDependentPackageResources [uuid]
+
 createPackage :: (KnowledgeModelPackage, [KnowledgeModelPackageEvent]) -> AppContextM KnowledgeModelPackageSimpleDTO
 createPackage (pkg, pkgEvents) =
   runInTransaction $ do
@@ -72,13 +84,17 @@ modifyPackage pkgUuid reqDto =
     updatePackagePhaseAndPublicByUuid pkgUuid reqDto.phase reqDto.public
     return reqDto
 
-deletePackage :: U.UUID -> AppContextM ()
-deletePackage uuid =
+deletePackage :: U.UUID -> Maybe Bool -> AppContextM ()
+deletePackage uuid mAllVersions =
   runInTransaction $ do
     checkPermission _PM_WRITE_PERM
-    _ <- findPackageByUuid uuid
-    deletePackageByUuid uuid
-    return ()
+    case mAllVersions of
+      Just True -> do
+        pkg <- findPackageByUuid uuid
+        void $ deletePackagesFiltered [("organization_id", pkg.organizationId), ("km_id", pkg.kmId)]
+      _ -> do
+        _ <- findPackageByUuid uuid
+        void $ deletePackageByUuid uuid
 
 -- --------------------------------
 -- PRIVATE
diff --git a/wizard-server/test/Wizard/Specs/API/KnowledgeModelPackage/APISpec.hs b/wizard-server/test/Wizard/Specs/API/KnowledgeModelPackage/APISpec.hs
@@ -4,6 +4,7 @@ import Test.Hspec
 import Test.Hspec.Wai hiding (shouldRespondWith)
 
 import Wizard.Specs.API.Common
+import Wizard.Specs.API.KnowledgeModelPackage.Dependent.APISpec
 import Wizard.Specs.API.KnowledgeModelPackage.Detail_DELETE
 import Wizard.Specs.API.KnowledgeModelPackage.Detail_GET
 import Wizard.Specs.API.KnowledgeModelPackage.Detail_PUT
@@ -24,3 +25,4 @@ knowledgeModelPackageAPI baseContext appContext =
       detail_PUT appContext
       detail_DELETE appContext
       detail_pull_POST appContext
+      dependentAPI appContext
diff --git a/wizard-server/test/Wizard/Specs/API/KnowledgeModelPackage/Dependent/APISpec.hs b/wizard-server/test/Wizard/Specs/API/KnowledgeModelPackage/Dependent/APISpec.hs
@@ -0,0 +1,9 @@
+module Wizard.Specs.API.KnowledgeModelPackage.Dependent.APISpec where
+
+import Test.Hspec
+
+import Wizard.Specs.API.KnowledgeModelPackage.Dependent.List_GET
+
+dependentAPI appContext =
+  describe "KNOWLEDGE MODEL PACKAGE DEPENDENT API Spec" $ do
+    list_GET appContext
diff --git a/wizard-server/test/Wizard/Specs/API/KnowledgeModelPackage/Dependent/List_GET.hs b/wizard-server/test/Wizard/Specs/API/KnowledgeModelPackage/Dependent/List_GET.hs
