diff --git a/changelog.d/63 b/changelog.d/63 new file mode 100644 index 00000000..a95a6613 --- /dev/null +++ b/changelog.d/63 @@ -0,0 +1,7 @@ +synopsis: Membership data model for packages +prs: #785 +issues: #556 + +description: { + Migration for `create_package_groups` & `create_package_group_packages` +} diff --git a/flora.cabal b/flora.cabal index db79b121..8a365b31 100644 --- a/flora.cabal +++ b/flora.cabal @@ -27,13 +27,13 @@ flag prod common common-extensions default-extensions: + NoStarIsType DataKinds DeriveAnyClass DerivingStrategies DerivingVia DuplicateRecordFields LambdaCase - NoStarIsType OverloadedLabels OverloadedRecordDot OverloadedStrings @@ -127,6 +127,12 @@ library Flora.Model.Package.Query Flora.Model.Package.Types Flora.Model.Package.Update + Flora.Model.PackageGroup.Query + Flora.Model.PackageGroup.Types + Flora.Model.PackageGroup.Update + Flora.Model.PackageGroupPackage.Query + Flora.Model.PackageGroupPackage.Types + Flora.Model.PackageGroupPackage.Update Flora.Model.PackageIndex.Query Flora.Model.PackageIndex.Types Flora.Model.PackageIndex.Update @@ -578,6 +584,7 @@ test-suite flora-test Flora.CategorySpec Flora.ImportSpec Flora.OddJobSpec + Flora.PackageGroupSpec Flora.PackageSpec Flora.SearchSpec Flora.TemplateSpec diff --git a/migrations/20240927141418_create_package_groups.sql b/migrations/20240927141418_create_package_groups.sql new file mode 100644 index 00000000..f260350c --- /dev/null +++ b/migrations/20240927141418_create_package_groups.sql @@ -0,0 +1,4 @@ +CREATE TABLE IF NOT EXISTS package_groups ( + package_group_id uuid PRIMARY KEY + , group_name varchar(255) NOT NULL +) diff --git a/migrations/20240927142245_create_package_group_packages.sql b/migrations/20240927142245_create_package_group_packages.sql new file mode 100644 index 00000000..add990b5 --- /dev/null +++ b/migrations/20240927142245_create_package_group_packages.sql @@ -0,0 +1,11 @@ +CREATE TABLE IF NOT EXISTS package_group_packages ( + package_group_package_id uuid PRIMARY KEY + , package_group_id uuid NOT NULL REFERENCES package_groups + , package_id uuid NOT NULL REFERENCES packages +); + +CREATE INDEX package_group_packages_package_id_fkey + ON package_group_packages (package_id); + +CREATE INDEX package_group_packages_package_group_id_fkey + ON package_group_packages (package_group_id); diff --git a/src/core/Flora/Model/PackageGroup/Query.hs b/src/core/Flora/Model/PackageGroup/Query.hs new file mode 100644 index 00000000..d9ea6fb0 --- /dev/null +++ b/src/core/Flora/Model/PackageGroup/Query.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Flora.Model.PackageGroup.Query + ( getPackagesByPackageGroupId + , getPackageGroupByPackageGroupName + ) where + +import Data.Text (Text) +import Data.Vector (Vector) +import Database.PostgreSQL.Entity (joinSelectOneByField, selectOneByField) +import Database.PostgreSQL.Entity.Types (field) +import Database.PostgreSQL.Simple (Only (..)) +import Effectful (Eff, type (:>)) +import Effectful.PostgreSQL.Transact.Effect (DB, dbtToEff) +import Flora.Model.Package.Types (Package) +import Flora.Model.PackageGroup.Types (PackageGroup (..), PackageGroupId (..)) +import Flora.Model.PackageGroupPackage.Types (PackageGroupPackage (..)) + +getPackagesByPackageGroupId :: DB :> es => PackageGroupId -> Eff es (Vector Package) +getPackagesByPackageGroupId packageGroupId = + dbtToEff $ + joinSelectOneByField + @Package + @PackageGroupPackage + [field| package_id |] + [field| package_group_id |] + packageGroupId + +getPackageGroupByPackageGroupName :: DB :> es => Text -> Eff es (Maybe PackageGroup) +getPackageGroupByPackageGroupName groupName = dbtToEff $ selectOneByField [field| group_name |] (Only groupName) diff --git a/src/core/Flora/Model/PackageGroup/Types.hs b/src/core/Flora/Model/PackageGroup/Types.hs new file mode 100644 index 00000000..5e9294e2 --- /dev/null +++ b/src/core/Flora/Model/PackageGroup/Types.hs @@ -0,0 +1,34 @@ +module Flora.Model.PackageGroup.Types where + +import Control.DeepSeq (NFData) +import Data.Aeson +import Data.Text (Text) +import Data.Text.Display +import Data.UUID +import Database.PostgreSQL.Entity +import Database.PostgreSQL.Entity.Types (GenericEntity, TableName) +import Database.PostgreSQL.Simple (FromRow) +import Database.PostgreSQL.Simple.FromField (FromField (..)) +import Database.PostgreSQL.Simple.ToField (ToField (..)) +import Database.PostgreSQL.Simple.ToRow (ToRow) +import GHC.Generics + +newtype PackageGroupId = PackageGroupId {getPackageGroupId :: UUID} + deriving + (Eq, Ord, Show, FromField, ToField, FromJSON, ToJSON, NFData) + via UUID + deriving + (Display) + via ShowInstance UUID + +data PackageGroup = PackageGroup + { packageGroupId :: PackageGroupId + , groupName :: Text + } + deriving stock + (Eq, Ord, Show, Generic) + deriving anyclass + (FromRow, ToRow, FromJSON, ToJSON, NFData) + deriving + (Entity) + via (GenericEntity '[TableName "package_groups"] PackageGroup) diff --git a/src/core/Flora/Model/PackageGroup/Update.hs b/src/core/Flora/Model/PackageGroup/Update.hs new file mode 100644 index 00000000..e4438b20 --- /dev/null +++ b/src/core/Flora/Model/PackageGroup/Update.hs @@ -0,0 +1,13 @@ +module Flora.Model.PackageGroup.Update + ( insertPackageGroup + ) where + +import Control.Monad (void) +import Database.PostgreSQL.Entity (insert) +import Effectful +import Effectful.PostgreSQL.Transact.Effect (DB, dbtToEff) +import Flora.Model.PackageGroup.Types + +insertPackageGroup :: DB :> es => PackageGroup -> Eff es () +insertPackageGroup packageGroup = do + void $ dbtToEff $ insert @PackageGroup packageGroup diff --git a/src/core/Flora/Model/PackageGroupPackage/Query.hs b/src/core/Flora/Model/PackageGroupPackage/Query.hs new file mode 100644 index 00000000..4e27e087 --- /dev/null +++ b/src/core/Flora/Model/PackageGroupPackage/Query.hs @@ -0,0 +1,12 @@ +module Flora.Model.PackageGroupPackage.Query + ( getPackageGroupPackage + ) where + +import Database.PostgreSQL.Entity (selectById) +import Database.PostgreSQL.Simple (Only (..)) +import Effectful (Eff, type (:>)) +import Effectful.PostgreSQL.Transact.Effect (DB, dbtToEff) +import Flora.Model.PackageGroupPackage.Types (PackageGroupPackage (..), PackageGroupPackageId (..)) + +getPackageGroupPackage :: DB :> es => PackageGroupPackageId -> Eff es (Maybe PackageGroupPackage) +getPackageGroupPackage packageGroupPackageId = dbtToEff $ selectById @PackageGroupPackage (Only packageGroupPackageId) diff --git a/src/core/Flora/Model/PackageGroupPackage/Types.hs b/src/core/Flora/Model/PackageGroupPackage/Types.hs new file mode 100644 index 00000000..3e80a778 --- /dev/null +++ b/src/core/Flora/Model/PackageGroupPackage/Types.hs @@ -0,0 +1,37 @@ +module Flora.Model.PackageGroupPackage.Types where + +import GHC.Generics + +import Control.DeepSeq (NFData) +import Data.Aeson +import Data.Text.Display +import Data.UUID +import Database.PostgreSQL.Entity +import Database.PostgreSQL.Entity.Types (GenericEntity, TableName) +import Database.PostgreSQL.Simple (FromRow) +import Database.PostgreSQL.Simple.FromField (FromField (..)) +import Database.PostgreSQL.Simple.ToField (ToField (..)) +import Database.PostgreSQL.Simple.ToRow (ToRow) +import Flora.Model.Package.Types (PackageId) +import Flora.Model.PackageGroup.Types (PackageGroupId) + +newtype PackageGroupPackageId = PackageGroupPackageId {getPackageGroupPackageId :: UUID} + deriving + (Eq, Ord, Show, FromField, ToField, FromJSON, ToJSON, NFData) + via UUID + deriving + (Display) + via ShowInstance UUID + +data PackageGroupPackage = PackageGroupPackage + { packageGroupPackageId :: PackageGroupPackageId + , packageId :: PackageId + , packageGroupId :: PackageGroupId + } + deriving stock + (Eq, Ord, Show, Generic) + deriving anyclass + (FromRow, ToRow, FromJSON, ToJSON, NFData) + deriving + (Entity) + via (GenericEntity '[TableName "package_group_packages"] PackageGroupPackage) diff --git a/src/core/Flora/Model/PackageGroupPackage/Update.hs b/src/core/Flora/Model/PackageGroupPackage/Update.hs new file mode 100644 index 00000000..48547808 --- /dev/null +++ b/src/core/Flora/Model/PackageGroupPackage/Update.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE QuasiQuotes #-} + +module Flora.Model.PackageGroupPackage.Update + ( addPackageToPackageGroup + , removePackageFromPackageGroup + ) where + +import Control.Monad (void) +import Database.PostgreSQL.Entity (deleteByField, insert) +import Database.PostgreSQL.Entity.Internal.QQ +import Effectful +import Effectful.PostgreSQL.Transact.Effect (DB, dbtToEff) +import Flora.Model.Package.Types (PackageId (..)) +import Flora.Model.PackageGroup.Types (PackageGroupId (..)) +import Flora.Model.PackageGroupPackage.Types + +addPackageToPackageGroup :: DB :> es => PackageGroupPackage -> Eff es () +addPackageToPackageGroup packageGroupPackage = + void $ dbtToEff $ insert @PackageGroupPackage packageGroupPackage + +removePackageFromPackageGroup :: DB :> es => PackageId -> PackageGroupId -> Eff es () +removePackageFromPackageGroup pId pgId = + void $ dbtToEff $ deleteByField @PackageGroupPackage [[field| package_id |], [field| package_group_id |]] (pId, pgId) diff --git a/test/Flora/PackageGroupSpec.hs b/test/Flora/PackageGroupSpec.hs new file mode 100644 index 00000000..8a859bbf --- /dev/null +++ b/test/Flora/PackageGroupSpec.hs @@ -0,0 +1,133 @@ +module Flora.PackageGroupSpec where + +import Data.Vector qualified as Vector + +import Control.Monad (void) +import Flora.Model.Package.Types +import Flora.Model.PackageGroup.Query qualified as Query +import Flora.Model.PackageGroup.Types +import Flora.Model.PackageGroupPackage.Update as Update +import Flora.Model.User +import Flora.TestUtils +import Optics.Core + +spec :: TestEff TestTree +spec = + testThese + "package group" + [ testThis "Insert package group" testInsertPackageGroup + , testThis "Add package to package group" testAddPackageToPackageGroup + , testThis "Remove package from package group" testRemovePackageFromPackageGroup + , testThis "Get packages by package group id" testGetPackagesByPackageGroupId + , testThis "Get packages by package group name" testGetPackageGroupByPackageGroupName + ] + +testInsertPackageGroup :: TestEff () +testInsertPackageGroup = do + user <- instantiateUser randomUserTemplate + void $ + instantiatePackage $ + randomPackageTemplate + & #ownerId + .~ pure user.userId + packageGroup <- + instantiatePackageGroup randomPackageGroupTemplate + + result <- Query.getPackageGroupByPackageGroupName packageGroup.groupName + + case result of + Nothing -> + assertFailure + "No Package Group Found in `testInsertPackageGroup`" + Just pg -> + assertEqual pg.packageGroupId packageGroup.packageGroupId + +testAddPackageToPackageGroup :: TestEff () +testAddPackageToPackageGroup = do + user <- instantiateUser randomUserTemplate + package <- + instantiatePackage $ + randomPackageTemplate + & #ownerId + .~ pure user.userId + packageGroup <- + instantiatePackageGroup randomPackageGroupTemplate + void $ + instantiatePackageGroupPackage $ + randomPackageGroupPackageTemplate + & #packageGroupId + .~ pure packageGroup.packageGroupId + & #packageId + .~ pure package.packageId + + results <- + Query.getPackagesByPackageGroupId packageGroup.packageGroupId + + assertEqual 1 (Vector.length results) + +testRemovePackageFromPackageGroup :: TestEff () +testRemovePackageFromPackageGroup = do + user <- instantiateUser randomUserTemplate + package <- + instantiatePackage $ + randomPackageTemplate + & #ownerId + .~ pure user.userId + packageGroup <- + instantiatePackageGroup randomPackageGroupTemplate + void $ + instantiatePackageGroupPackage $ + randomPackageGroupPackageTemplate + & #packageGroupId + .~ pure packageGroup.packageGroupId + & #packageId + .~ pure package.packageId + + Update.removePackageFromPackageGroup package.packageId packageGroup.packageGroupId + + results <- Query.getPackagesByPackageGroupId packageGroup.packageGroupId + + assertBool (Vector.notElem package results) + +testGetPackagesByPackageGroupId :: TestEff () +testGetPackagesByPackageGroupId = do + user <- instantiateUser randomUserTemplate + package <- + instantiatePackage $ + randomPackageTemplate + & #ownerId + .~ pure user.userId + packageGroup <- + instantiatePackageGroup randomPackageGroupTemplate + void $ + instantiatePackageGroupPackage $ + randomPackageGroupPackageTemplate + & #packageGroupId + .~ pure packageGroup.packageGroupId + & #packageId + .~ pure package.packageId + + results <- + Query.getPackagesByPackageGroupId packageGroup.packageGroupId + + assertEqual (Vector.length results) 1 + +testGetPackageGroupByPackageGroupName :: TestEff () +testGetPackageGroupByPackageGroupName = do + user <- instantiateUser randomUserTemplate + void $ + instantiatePackage $ + randomPackageTemplate + & #ownerId + .~ pure user.userId + packageGroup <- + instantiatePackageGroup randomPackageGroupTemplate + + result <- Query.getPackageGroupByPackageGroupName packageGroup.groupName + + case result of + Nothing -> + assertFailure + "No Package Group Name found in `testGetPackageGroupByPackageGroupName" + Just pg -> + assertEqual pg.groupName packageGroup.groupName diff --git a/test/Flora/TestUtils.hs b/test/Flora/TestUtils.hs index cc7b9a2e..529d0883 100644 --- a/test/Flora/TestUtils.hs +++ b/test/Flora/TestUtils.hs @@ -41,6 +41,16 @@ module Flora.TestUtils , instantiatePackage , randomPackageTemplate + -- *** Package Group + , PackageGroupTemplate (..) + , instantiatePackageGroup + , randomPackageGroupTemplate + + -- *** Package Group Package + , PackageGroupPackageTemplate (..) + , instantiatePackageGroupPackage + , randomPackageGroupPackageTemplate + -- *** Release , ReleaseTemplate (..) , instantiateRelease @@ -147,6 +157,10 @@ import Flora.Model.Package , PackageStatus ) import Flora.Model.Package.Update qualified as Update +import Flora.Model.PackageGroup.Types (PackageGroup (..), PackageGroupId (..)) +import Flora.Model.PackageGroup.Update qualified as Update +import Flora.Model.PackageGroupPackage.Types (PackageGroupPackage (..), PackageGroupPackageId (..)) +import Flora.Model.PackageGroupPackage.Update qualified as Update import Flora.Model.Release.Types ( ImportStatus (..) , Release (..) @@ -661,3 +675,63 @@ instantiateRequirement let req = Requirement{..} Update.insertRequirement req pure req + +data PackageGroupTemplate m = PackageGroupTemplate + { packageGroupId :: m PackageGroupId + , groupName :: m Text + } + deriving stock (Generic) + +randomPackageGroupTemplate :: MonadIO m => PackageGroupTemplate m +randomPackageGroupTemplate = + PackageGroupTemplate + { packageGroupId = PackageGroupId <$> H.sample genUUID + , groupName = H.sample genDisplayName + } + +instantiatePackageGroup + :: DB :> es + => PackageGroupTemplate (Eff es) + -> Eff es PackageGroup +instantiatePackageGroup + PackageGroupTemplate + { packageGroupId = generatePackageGroupId + , groupName = generateGroupName + } = do + packageGroupId <- generatePackageGroupId + groupName <- generateGroupName + let pg = PackageGroup{..} + Update.insertPackageGroup pg + pure pg + +data PackageGroupPackageTemplate m = PackageGroupPackageTemplate + { packageGroupPackageId :: m PackageGroupPackageId + , packageId :: m PackageId + , packageGroupId :: m PackageGroupId + } + deriving stock (Generic) + +randomPackageGroupPackageTemplate :: MonadIO m => PackageGroupPackageTemplate m +randomPackageGroupPackageTemplate = + PackageGroupPackageTemplate + { packageGroupPackageId = PackageGroupPackageId <$> H.sample genUUID + , packageId = PackageId <$> H.sample genUUID + , packageGroupId = PackageGroupId <$> H.sample genUUID + } + +instantiatePackageGroupPackage + :: DB :> es + => PackageGroupPackageTemplate (Eff es) + -> Eff es PackageGroupPackage +instantiatePackageGroupPackage + PackageGroupPackageTemplate + { packageGroupPackageId = generatePackageGroupPackageId + , packageId = generatePackageId + , packageGroupId = generatePackageGroupId + } = do + packageGroupPackageId <- generatePackageGroupPackageId + packageId <- generatePackageId + packageGroupId <- generatePackageGroupId + let pgp = PackageGroupPackage{..} + Update.addPackageToPackageGroup pgp + pure pgp diff --git a/test/Main.hs b/test/Main.hs index c31ce510..3c4fdfad 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -25,6 +25,7 @@ import Flora.Model.PackageIndex.Update qualified as Update import Flora.Model.User (UserCreationForm (..), mkUser) import Flora.Model.User.Update qualified as Update import Flora.OddJobSpec qualified as OddJobSpec +import Flora.PackageGroupSpec qualified as PackageGroupSpec import Flora.PackageSpec qualified as PackageSpec import Flora.SearchSpec qualified as SearchSpec import Flora.TemplateSpec qualified as TemplateSpec @@ -71,6 +72,7 @@ specs fixtures = , ImportSpec.spec fixtures , BlobSpec.spec , SearchSpec.spec fixtures + , PackageGroupSpec.spec , AdvisorySpec.spec ] @@ -88,6 +90,8 @@ cleanUp = dbtToEff $ do void $ execute Delete "DELETE FROM affected_packages" () void $ execute Delete "DELETE FROM security_advisories" () void $ execute Delete "DELETE FROM releases" () + void $ execute Delete "DELETE FROM package_group_packages" () + void $ execute Delete "DELETE FROM package_groups" () void $ execute Delete "DELETE FROM packages" () void $ execute Delete "DELETE FROM package_indexes" () void $ execute Delete "DELETE FROM user_organisation" ()