From 6499998066402930b02699424752dcb4939e30b1 Mon Sep 17 00:00:00 2001 From: Matt Roberts Date: Fri, 27 Sep 2024 17:17:54 +0100 Subject: [PATCH 01/10] feat: added two new migration files --- migrations/20240927141418_create_package_groups.sql | 4 ++++ migrations/20240927142245_create_package_group_packages.sql | 5 +++++ 2 files changed, 9 insertions(+) create mode 100644 migrations/20240927141418_create_package_groups.sql create mode 100644 migrations/20240927142245_create_package_group_packages.sql diff --git a/migrations/20240927141418_create_package_groups.sql b/migrations/20240927141418_create_package_groups.sql new file mode 100644 index 00000000..a755fd7c --- /dev/null +++ b/migrations/20240927141418_create_package_groups.sql @@ -0,0 +1,4 @@ +CREATE TABLE IF NOT EXISTS package_groups ( + 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..0fa8e516 --- /dev/null +++ b/migrations/20240927142245_create_package_group_packages.sql @@ -0,0 +1,5 @@ +CREATE TABLE IF NOT EXISTS package_group_packages ( + package_group_id uuid NOT NULL REFERENCES package_groups (id) + , package_id uuid NOT NULL REFERENCES packages (id) + , PRIMARY KEY (package_group_id, package_id) +) From a79aba405ed05a25837c22de8a87b71d470dfe39 Mon Sep 17 00:00:00 2001 From: Matt Roberts Date: Fri, 27 Sep 2024 17:25:54 +0100 Subject: [PATCH 02/10] fix: referenced wrong property from packages --- migrations/20240927142245_create_package_group_packages.sql | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/migrations/20240927142245_create_package_group_packages.sql b/migrations/20240927142245_create_package_group_packages.sql index 0fa8e516..370c23f4 100644 --- a/migrations/20240927142245_create_package_group_packages.sql +++ b/migrations/20240927142245_create_package_group_packages.sql @@ -1,5 +1,5 @@ CREATE TABLE IF NOT EXISTS package_group_packages ( package_group_id uuid NOT NULL REFERENCES package_groups (id) - , package_id uuid NOT NULL REFERENCES packages (id) + , package_id uuid NOT NULL REFERENCES packages (package_id) , PRIMARY KEY (package_group_id, package_id) ) From 0d6bed9ed1dac05ea3f2379b525932b40156a5be Mon Sep 17 00:00:00 2001 From: Matt Roberts Date: Sat, 9 Nov 2024 13:09:59 +0000 Subject: [PATCH 03/10] pkg-config libsodium-bindings added to cabal.project.freeze --- cabal.project.freeze | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal.project.freeze b/cabal.project.freeze index fdefbf4e..eff5f4f1 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -218,7 +218,7 @@ constraints: any.Cabal ==3.10.3.0, any.lens ==5.3.2, lens -benchmark-uniplate -dump-splices +inlining -j +test-hunit +test-properties +test-templates +trustworthy, any.libsodium-bindings ==0.0.2.0, - libsodium-bindings -homebrew -pkg-config, + libsodium-bindings -homebrew +pkg-config, any.lifted-async ==0.10.2.6, any.lifted-base ==0.2.3.12, any.lockfree-queue ==0.2.4, From ac19f72aec48ec78ba0f34ffdc9ac649b4b7bb3c Mon Sep 17 00:00:00 2001 From: Matt Roberts Date: Sat, 9 Nov 2024 14:57:49 +0000 Subject: [PATCH 04/10] feat: added db operations for `PackageGroup` and refactored relevant migrations --- flora.cabal | 5 +- .../20240927141418_create_package_groups.sql | 2 +- ...27142245_create_package_group_packages.sql | 14 +++-- src/core/Flora/Model/PackageGroup/Query.hs | 1 + src/core/Flora/Model/PackageGroup/Types.hs | 59 +++++++++++++++++++ src/core/Flora/Model/PackageGroup/Update.hs | 23 ++++++++ 6 files changed, 98 insertions(+), 6 deletions(-) create mode 100644 src/core/Flora/Model/PackageGroup/Query.hs create mode 100644 src/core/Flora/Model/PackageGroup/Types.hs create mode 100644 src/core/Flora/Model/PackageGroup/Update.hs diff --git a/flora.cabal b/flora.cabal index 83bcbdb3..5d17a75f 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 @@ -119,6 +119,9 @@ 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.PackageIndex.Query Flora.Model.PackageIndex.Types Flora.Model.PackageIndex.Update diff --git a/migrations/20240927141418_create_package_groups.sql b/migrations/20240927141418_create_package_groups.sql index a755fd7c..f260350c 100644 --- a/migrations/20240927141418_create_package_groups.sql +++ b/migrations/20240927141418_create_package_groups.sql @@ -1,4 +1,4 @@ CREATE TABLE IF NOT EXISTS package_groups ( - id uuid PRIMARY KEY + 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 index 370c23f4..add990b5 100644 --- a/migrations/20240927142245_create_package_group_packages.sql +++ b/migrations/20240927142245_create_package_group_packages.sql @@ -1,5 +1,11 @@ CREATE TABLE IF NOT EXISTS package_group_packages ( - package_group_id uuid NOT NULL REFERENCES package_groups (id) - , package_id uuid NOT NULL REFERENCES packages (package_id) - , PRIMARY KEY (package_group_id, package_id) -) + 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..9bc9b544 --- /dev/null +++ b/src/core/Flora/Model/PackageGroup/Query.hs @@ -0,0 +1 @@ +module Flora.Model.PackageGroup.Query where diff --git a/src/core/Flora/Model/PackageGroup/Types.hs b/src/core/Flora/Model/PackageGroup/Types.hs new file mode 100644 index 00000000..aad96231 --- /dev/null +++ b/src/core/Flora/Model/PackageGroup/Types.hs @@ -0,0 +1,59 @@ +module Flora.Model.PackageGroup.Types where + +import Flora.Model.Package.Types + +import GHC.Generics + +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) + +newtype PackageGroupId = PackageGroupId {getPackageGroupId :: UUID} + deriving + (Eq, Ord, Show, FromField, ToField, FromJSON, ToJSON, NFData) + via UUID + deriving + (Display) + via ShowInstance UUID + +newtype PackageGroupPackageId = PackageGroupPackageId {getPackageGroupPackageId :: 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) + +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/PackageGroup/Update.hs b/src/core/Flora/Model/PackageGroup/Update.hs new file mode 100644 index 00000000..e582886e --- /dev/null +++ b/src/core/Flora/Model/PackageGroup/Update.hs @@ -0,0 +1,23 @@ +module Flora.Model.PackageGroup.Update + ( insertPackageGroup + , addPackageToPackageGroup + , removePackageFromPackageGroup + ) where + +import Control.Monad (void) +import Database.PostgreSQL.Entity (delete, 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 + +addPackageToPackageGroup :: DB :> es => PackageGroupPackage -> Eff es () +addPackageToPackageGroup packageGroupPackage = + void $ dbtToEff $ insert @PackageGroupPackage packageGroupPackage + +removePackageFromPackageGroup :: DB :> es => PackageGroupPackage -> Eff es () +removePackageFromPackageGroup packageGroupPackage = + void $ dbtToEff $ delete @PackageGroupPackage packageGroupPackage From 09ddc6c9e38dd81b386ada6e5f3c8ab650c2a3ef Mon Sep 17 00:00:00 2001 From: Matt Roberts Date: Sun, 10 Nov 2024 16:39:15 +0000 Subject: [PATCH 05/10] feat: added functions to `Query.hs` --- src/core/Flora/Model/PackageGroup/Query.hs | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/src/core/Flora/Model/PackageGroup/Query.hs b/src/core/Flora/Model/PackageGroup/Query.hs index 9bc9b544..91a2fb58 100644 --- a/src/core/Flora/Model/PackageGroup/Query.hs +++ b/src/core/Flora/Model/PackageGroup/Query.hs @@ -1 +1,20 @@ -module Flora.Model.PackageGroup.Query where +{-# LANGUAGE QuasiQuotes #-} + +module Flora.Model.PackageGroup.Query + ( getPackagesByPackageGroupId + , getPackageGroupByPackageGroupName + ) where + +import Data.Text (Text) +import Database.PostgreSQL.Entity +import Database.PostgreSQL.Entity.Types (field) +import Database.PostgreSQL.Simple (Only (Only)) +import Effectful +import Effectful.PostgreSQL.Transact.Effect +import Flora.Model.PackageGroup.Types (PackageGroup, PackageGroupId) + +getPackagesByPackageGroupId :: DB :> es => PackageGroupId -> Eff es (Maybe PackageGroup) +getPackagesByPackageGroupId packageGroupId = dbtToEff $ selectById (Only packageGroupId) + +getPackageGroupByPackageGroupName :: DB :> es => Text -> Eff es (Maybe PackageGroup) +getPackageGroupByPackageGroupName packageGroupName = dbtToEff $ selectOneByField [field| packageGroupName |] (Only packageGroupName) From 3833d73b7209d41c5f083633a10c2f7786b934a3 Mon Sep 17 00:00:00 2001 From: Matt Roberts Date: Sun, 10 Nov 2024 21:10:08 +0000 Subject: [PATCH 06/10] fix: refactoring in `PackageGroup/Query.hs`, created `PackageGroupSpec.hs` and updated `test/Main.hs` --- src/core/Flora/Model/PackageGroup/Query.hs | 28 ++++++++--- test/Flora/PackageGroupSpec.hs | 54 ++++++++++++++++++++++ test/Main.hs | 2 + 3 files changed, 78 insertions(+), 6 deletions(-) create mode 100644 test/Flora/PackageGroupSpec.hs diff --git a/src/core/Flora/Model/PackageGroup/Query.hs b/src/core/Flora/Model/PackageGroup/Query.hs index 91a2fb58..6279b7b3 100644 --- a/src/core/Flora/Model/PackageGroup/Query.hs +++ b/src/core/Flora/Model/PackageGroup/Query.hs @@ -6,15 +6,31 @@ module Flora.Model.PackageGroup.Query ) where import Data.Text (Text) -import Database.PostgreSQL.Entity +import Data.Vector (Vector) +import Database.PostgreSQL.Entity (selectOneByField) +import Database.PostgreSQL.Entity.DBT + ( QueryNature (Select) + , query + ) import Database.PostgreSQL.Entity.Types (field) -import Database.PostgreSQL.Simple (Only (Only)) -import Effectful -import Effectful.PostgreSQL.Transact.Effect +import Database.PostgreSQL.Simple (Only (..)) +import Database.PostgreSQL.Simple.SqlQQ (sql) +import Effectful (Eff, type (:>)) +import Effectful.PostgreSQL.Transact.Effect (DB, dbtToEff) +import Flora.Model.Package.Types (Package) import Flora.Model.PackageGroup.Types (PackageGroup, PackageGroupId) -getPackagesByPackageGroupId :: DB :> es => PackageGroupId -> Eff es (Maybe PackageGroup) -getPackagesByPackageGroupId packageGroupId = dbtToEff $ selectById (Only packageGroupId) +getPackagesByPackageGroupId :: DB :> es => PackageGroupId -> Eff es (Vector Package) +getPackagesByPackageGroupId packageGroupId = dbtToEff $ query Select q (Only packageGroupId) + where + q = + [sql| + SELECT p.* + FROM packages AS p + JOIN package_group_packages AS pgp + ON p.package_id = pgp.package_id + WHERE pgp.package_group_id = ? + |] getPackageGroupByPackageGroupName :: DB :> es => Text -> Eff es (Maybe PackageGroup) getPackageGroupByPackageGroupName packageGroupName = dbtToEff $ selectOneByField [field| packageGroupName |] (Only packageGroupName) diff --git a/test/Flora/PackageGroupSpec.hs b/test/Flora/PackageGroupSpec.hs new file mode 100644 index 00000000..e6a5b4e1 --- /dev/null +++ b/test/Flora/PackageGroupSpec.hs @@ -0,0 +1,54 @@ +module Flora.PackageGroupSpec where + +import Data.Maybe +import Data.Set qualified as Set +import Data.Vector qualified as Vector +import Flora.Model.PackageGroup.Query qualified as Query +import Flora.Model.PackageGroup.Update qualified as Update +import Flora.TestUtils +import Test.Tasty + +spec :: TestEff TestTree +spec = + [ testThese + "package group update tests" + [ testThis "Insert package group" testInsertPackageGroup + , testThis "Add package to package group" testAddPackageToPackageGroup + , testThis "Remove package to package group" testRemovePackageFromPackageGroup + ] + , testThese + "package group query tests" + [ testThis "Get packages by package group id" testGetPackagesByPackageGroupId + , testThis "Get packages by package group name" testGetPackageGroupByPackageGroupName + ] + ] + +-- Check DB for absence of the specified `PackageGroup` +-- Run the function `Update.insertPackageGroup` +-- Check the DB for the presence of the specified `PackageGroup` +testInsertPackageGroup :: TestEff () +testInsertPackageGroup = _ + +-- Check the DB for the packages within a specified `PackageGroupPackages` +-- Run the function `Update.addPackageToPackageGroup` +-- Check the DB for the specified `PackageGroupPackages`, and check the +-- additional `Package` id is present +testAddPackageToPackageGroup :: TestEff () +testAddPackageToPackageGroup = _ + +-- Check the DB for the packages within a specified `PackageGroupPackages` +-- Run the function `Update.removePackageFromPackageGroup` +-- Check the DB for the specified `PackageGroupPackages`, and check the +-- additional `Package` id is removed +testRemovePackageFromPackageGroup :: TestEff () +testRemovePackageFromPackageGroup = _ + +-- Check the DB for packages using `PackageGroup` id +-- assert that the id for the packages found matches the expected packages provided +testGetPackagesByPackageGroupId :: TestEff () +testGetPackagesByPackageGroupId = _ + +-- Check the DB for package groups using `PackageGroup` name +-- assert that the package group id found matches the expected package group provided +testGetPackageGroupByPackageGroupName :: TestEff () +testGetPackagesByPackageGroupId = _ diff --git a/test/Main.hs b/test/Main.hs index 18f81bac..c7200ed2 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -78,3 +78,5 @@ cleanUp = dbtToEff $ do void $ execute Delete "DELETE FROM user_organisation" () void $ execute Delete "DELETE FROM package_publishers" () void $ execute Delete "DELETE FROM users" () + void $ execute Delete "DELETE FROM package_groups" + void $ execute Delete "DELETE FROM package_group_packages" From 11a3c7617cf4d9c7b6b2ad2da6166442bcc05803 Mon Sep 17 00:00:00 2001 From: Matt Roberts Date: Tue, 12 Nov 2024 00:21:24 +0000 Subject: [PATCH 07/10] fix(conflicts): rebased development --- test/Flora/PackageGroupSpec.hs | 65 +++++++++++++++++++++++----------- test/Main.hs | 4 +-- 2 files changed, 46 insertions(+), 23 deletions(-) diff --git a/test/Flora/PackageGroupSpec.hs b/test/Flora/PackageGroupSpec.hs index e6a5b4e1..884cdef1 100644 --- a/test/Flora/PackageGroupSpec.hs +++ b/test/Flora/PackageGroupSpec.hs @@ -1,54 +1,77 @@ module Flora.PackageGroupSpec where -import Data.Maybe -import Data.Set qualified as Set -import Data.Vector qualified as Vector +import Data.Maybe (fromJust) +import Data.Text (Text) +import Data.UUID (UUID, fromText) import Flora.Model.PackageGroup.Query qualified as Query +import Flora.Model.PackageGroup.Types (PackageGroup (..), PackageGroupId (..)) import Flora.Model.PackageGroup.Update qualified as Update import Flora.TestUtils -import Test.Tasty spec :: TestEff TestTree spec = - [ testThese - "package group update tests" - [ testThis "Insert package group" testInsertPackageGroup - , testThis "Add package to package group" testAddPackageToPackageGroup - , testThis "Remove package to package group" testRemovePackageFromPackageGroup - ] - , testThese - "package group query tests" - [ testThis "Get packages by package group id" testGetPackagesByPackageGroupId - , testThis "Get packages by package group name" testGetPackageGroupByPackageGroupName - ] - ] + testThese + "package group" + [ testThis "Insert package group" testInsertPackageGroup + , testThis "Add package to package group" testAddPackageToPackageGroup + , testThis "Remove package to package group" testRemovePackageFromPackageGroup + , testThis "Get packages by package group id" testGetPackagesByPackageGroupId + , testThis "Get packages by package group name" testGetPackageGroupByPackageGroupName + ] + +defaultPackageGroup :: PackageGroup +defaultPackageGroup = + PackageGroup + { packageGroupId = defaultPackageGroupId + , groupName = defaultGroupName + } + +defaultPackageGroupId :: PackageGroupId +defaultPackageGroupId = PackageGroupId{getPackageGroupId = fromJust defaultUUID} + +defaultGroupName :: Text +defaultGroupName = "test-group-name" + +defaultUUID :: Maybe UUID +defaultUUID = fromText "db1b378d-58b4-4b50-a70c-7ffa5407ed15" + +extractPackageGroupId :: PackageGroup -> PackageGroupId +extractPackageGroupId pg = packageGroupId pg -- Check DB for absence of the specified `PackageGroup` -- Run the function `Update.insertPackageGroup` -- Check the DB for the presence of the specified `PackageGroup` testInsertPackageGroup :: TestEff () -testInsertPackageGroup = _ +testInsertPackageGroup = do + Update.insertPackageGroup defaultPackageGroup + result <- Query.getPackageGroupByPackageGroupName defaultGroupName + case result of + Nothing -> + assertFailure + "No Package Group named: `test-group-name`" + Just pg -> + assertEqual defaultPackageGroupId (extractPackageGroupId pg) -- Check the DB for the packages within a specified `PackageGroupPackages` -- Run the function `Update.addPackageToPackageGroup` -- Check the DB for the specified `PackageGroupPackages`, and check the -- additional `Package` id is present testAddPackageToPackageGroup :: TestEff () -testAddPackageToPackageGroup = _ +testAddPackageToPackageGroup = undefined -- Check the DB for the packages within a specified `PackageGroupPackages` -- Run the function `Update.removePackageFromPackageGroup` -- Check the DB for the specified `PackageGroupPackages`, and check the -- additional `Package` id is removed testRemovePackageFromPackageGroup :: TestEff () -testRemovePackageFromPackageGroup = _ +testRemovePackageFromPackageGroup = undefined -- Check the DB for packages using `PackageGroup` id -- assert that the id for the packages found matches the expected packages provided testGetPackagesByPackageGroupId :: TestEff () -testGetPackagesByPackageGroupId = _ +testGetPackagesByPackageGroupId = undefined -- Check the DB for package groups using `PackageGroup` name -- assert that the package group id found matches the expected package group provided testGetPackageGroupByPackageGroupName :: TestEff () -testGetPackagesByPackageGroupId = _ +testGetPackageGroupByPackageGroupName = undefined diff --git a/test/Main.hs b/test/Main.hs index c7200ed2..0ce702d1 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -78,5 +78,5 @@ cleanUp = dbtToEff $ do void $ execute Delete "DELETE FROM user_organisation" () void $ execute Delete "DELETE FROM package_publishers" () void $ execute Delete "DELETE FROM users" () - void $ execute Delete "DELETE FROM package_groups" - void $ execute Delete "DELETE FROM package_group_packages" + void $ execute Delete "DELETE FROM package_groups" () + void $ execute Delete "DELETE FROM package_group_packages" () From a91bd83f9fc2d1eccce4cce15a626fe7a32516d2 Mon Sep 17 00:00:00 2001 From: Matt Roberts Date: Wed, 13 Nov 2024 00:31:56 +0000 Subject: [PATCH 08/10] test: first passing test --- flora.cabal | 4 + src/core/Flora/Model/PackageGroup/Query.hs | 2 +- src/core/Flora/Model/PackageGroup/Types.hs | 23 --- src/core/Flora/Model/PackageGroup/Update.hs | 12 +- .../Flora/Model/PackageGroupPackage/Types.hs | 37 +++++ .../Flora/Model/PackageGroupPackage/Update.hs | 18 ++ test/Flora/PackageGroupSpec.hs | 155 ++++++++++++------ test/Flora/PackageGroupTestUtils.hs | 127 ++++++++++++++ test/Flora/TestUtils.hs | 76 +++++++++ test/Main.hs | 6 +- 10 files changed, 376 insertions(+), 84 deletions(-) create mode 100644 src/core/Flora/Model/PackageGroupPackage/Types.hs create mode 100644 src/core/Flora/Model/PackageGroupPackage/Update.hs create mode 100644 test/Flora/PackageGroupTestUtils.hs diff --git a/flora.cabal b/flora.cabal index 5d17a75f..272124f0 100644 --- a/flora.cabal +++ b/flora.cabal @@ -122,6 +122,8 @@ library Flora.Model.PackageGroup.Query Flora.Model.PackageGroup.Types Flora.Model.PackageGroup.Update + Flora.Model.PackageGroupPackage.Types + Flora.Model.PackageGroupPackage.Update Flora.Model.PackageIndex.Query Flora.Model.PackageIndex.Types Flora.Model.PackageIndex.Update @@ -520,6 +522,8 @@ test-suite flora-test Flora.CategorySpec Flora.ImportSpec Flora.OddJobSpec + Flora.PackageGroupSpec + Flora.PackageGroupTestUtils Flora.PackageSpec Flora.SearchSpec Flora.TemplateSpec diff --git a/src/core/Flora/Model/PackageGroup/Query.hs b/src/core/Flora/Model/PackageGroup/Query.hs index 6279b7b3..a927b983 100644 --- a/src/core/Flora/Model/PackageGroup/Query.hs +++ b/src/core/Flora/Model/PackageGroup/Query.hs @@ -33,4 +33,4 @@ getPackagesByPackageGroupId packageGroupId = dbtToEff $ query Select q (Only pac |] getPackageGroupByPackageGroupName :: DB :> es => Text -> Eff es (Maybe PackageGroup) -getPackageGroupByPackageGroupName packageGroupName = dbtToEff $ selectOneByField [field| packageGroupName |] (Only packageGroupName) +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 index aad96231..cc8e48fb 100644 --- a/src/core/Flora/Model/PackageGroup/Types.hs +++ b/src/core/Flora/Model/PackageGroup/Types.hs @@ -1,7 +1,5 @@ module Flora.Model.PackageGroup.Types where -import Flora.Model.Package.Types - import GHC.Generics import Control.DeepSeq (NFData) @@ -24,14 +22,6 @@ newtype PackageGroupId = PackageGroupId {getPackageGroupId :: UUID} (Display) via ShowInstance UUID -newtype PackageGroupPackageId = PackageGroupPackageId {getPackageGroupPackageId :: UUID} - deriving - (Eq, Ord, Show, FromField, ToField, FromJSON, ToJSON, NFData) - via UUID - deriving - (Display) - via ShowInstance UUID - data PackageGroup = PackageGroup { packageGroupId :: PackageGroupId @@ -44,16 +34,3 @@ data PackageGroup deriving (Entity) via (GenericEntity '[TableName "package_groups"] PackageGroup) - -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/PackageGroup/Update.hs b/src/core/Flora/Model/PackageGroup/Update.hs index e582886e..e4438b20 100644 --- a/src/core/Flora/Model/PackageGroup/Update.hs +++ b/src/core/Flora/Model/PackageGroup/Update.hs @@ -1,11 +1,9 @@ module Flora.Model.PackageGroup.Update ( insertPackageGroup - , addPackageToPackageGroup - , removePackageFromPackageGroup ) where import Control.Monad (void) -import Database.PostgreSQL.Entity (delete, insert) +import Database.PostgreSQL.Entity (insert) import Effectful import Effectful.PostgreSQL.Transact.Effect (DB, dbtToEff) import Flora.Model.PackageGroup.Types @@ -13,11 +11,3 @@ import Flora.Model.PackageGroup.Types insertPackageGroup :: DB :> es => PackageGroup -> Eff es () insertPackageGroup packageGroup = do void $ dbtToEff $ insert @PackageGroup packageGroup - -addPackageToPackageGroup :: DB :> es => PackageGroupPackage -> Eff es () -addPackageToPackageGroup packageGroupPackage = - void $ dbtToEff $ insert @PackageGroupPackage packageGroupPackage - -removePackageFromPackageGroup :: DB :> es => PackageGroupPackage -> Eff es () -removePackageFromPackageGroup packageGroupPackage = - void $ dbtToEff $ delete @PackageGroupPackage packageGroupPackage 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..aeb7a829 --- /dev/null +++ b/src/core/Flora/Model/PackageGroupPackage/Update.hs @@ -0,0 +1,18 @@ +module Flora.Model.PackageGroupPackage.Update + ( addPackageToPackageGroup + , removePackageFromPackageGroup + ) where + +import Control.Monad (void) +import Database.PostgreSQL.Entity (delete, insert) +import Effectful +import Effectful.PostgreSQL.Transact.Effect (DB, dbtToEff) +import Flora.Model.PackageGroupPackage.Types + +addPackageToPackageGroup :: DB :> es => PackageGroupPackage -> Eff es () +addPackageToPackageGroup packageGroupPackage = + void $ dbtToEff $ insert @PackageGroupPackage packageGroupPackage + +removePackageFromPackageGroup :: DB :> es => PackageGroupPackage -> Eff es () +removePackageFromPackageGroup packageGroupPackage = + void $ dbtToEff $ delete @PackageGroupPackage packageGroupPackage diff --git a/test/Flora/PackageGroupSpec.hs b/test/Flora/PackageGroupSpec.hs index 884cdef1..8e27eeb8 100644 --- a/test/Flora/PackageGroupSpec.hs +++ b/test/Flora/PackageGroupSpec.hs @@ -1,12 +1,15 @@ module Flora.PackageGroupSpec where -import Data.Maybe (fromJust) -import Data.Text (Text) -import Data.UUID (UUID, fromText) +import Data.Vector qualified as Vector + +import Flora.Model.Package.Types import Flora.Model.PackageGroup.Query qualified as Query -import Flora.Model.PackageGroup.Types (PackageGroup (..), PackageGroupId (..)) -import Flora.Model.PackageGroup.Update qualified as Update +import Flora.Model.PackageGroup.Types +import Flora.Model.PackageGroupPackage.Update as Update +import Flora.Model.User +import Flora.PackageGroupTestUtils import Flora.TestUtils +import Optics.Core spec :: TestEff TestTree spec = @@ -14,64 +17,122 @@ spec = "package group" [ testThis "Insert package group" testInsertPackageGroup , testThis "Add package to package group" testAddPackageToPackageGroup - , testThis "Remove package to package group" testRemovePackageFromPackageGroup + , testThis "Remove package from package group" testRemovePackageFromPackageGroup , testThis "Get packages by package group id" testGetPackagesByPackageGroupId , testThis "Get packages by package group name" testGetPackageGroupByPackageGroupName ] -defaultPackageGroup :: PackageGroup -defaultPackageGroup = - PackageGroup - { packageGroupId = defaultPackageGroupId - , groupName = defaultGroupName - } - -defaultPackageGroupId :: PackageGroupId -defaultPackageGroupId = PackageGroupId{getPackageGroupId = fromJust defaultUUID} - -defaultGroupName :: Text -defaultGroupName = "test-group-name" - -defaultUUID :: Maybe UUID -defaultUUID = fromText "db1b378d-58b4-4b50-a70c-7ffa5407ed15" - -extractPackageGroupId :: PackageGroup -> PackageGroupId -extractPackageGroupId pg = packageGroupId pg - --- Check DB for absence of the specified `PackageGroup` --- Run the function `Update.insertPackageGroup` --- Check the DB for the presence of the specified `PackageGroup` testInsertPackageGroup :: TestEff () testInsertPackageGroup = do - Update.insertPackageGroup defaultPackageGroup - result <- Query.getPackageGroupByPackageGroupName defaultGroupName + user <- instantiateUser randomUserTemplate + package <- + instantiatePackage $ + randomPackageTemplate + & #ownerId + .~ pure user.userId + packageGroup <- + instantiatePackageGroup randomPackageGroupTemplate + + result <- Query.getPackageGroupByPackageGroupName packageGroup.groupName case result of Nothing -> assertFailure "No Package Group named: `test-group-name`" Just pg -> - assertEqual defaultPackageGroupId (extractPackageGroupId pg) + assertEqual pg.packageGroupId (extractPackageGroupIdFromPG packageGroup) --- Check the DB for the packages within a specified `PackageGroupPackages` --- Run the function `Update.addPackageToPackageGroup` --- Check the DB for the specified `PackageGroupPackages`, and check the --- additional `Package` id is present testAddPackageToPackageGroup :: TestEff () -testAddPackageToPackageGroup = undefined +testAddPackageToPackageGroup = do + user <- instantiateUser randomUserTemplate + package <- + instantiatePackage $ + randomPackageTemplate + & #ownerId + .~ pure user.userId + packageGroup <- + instantiatePackageGroup randomPackageGroupTemplate + packageGroupPackage <- + instantiatePackageGroupPackage $ + randomPackageGroupPackageTemplate + & #packageGroupId + .~ pure packageGroup.packageGroupId + & #packageId + .~ pure package.packageId + + results <- + Query.getPackagesByPackageGroupId $ + extractPackageGroupIdFromPGP packageGroupPackage + + assertEqual 1 (Vector.length results) --- Check the DB for the packages within a specified `PackageGroupPackages` --- Run the function `Update.removePackageFromPackageGroup` --- Check the DB for the specified `PackageGroupPackages`, and check the --- additional `Package` id is removed testRemovePackageFromPackageGroup :: TestEff () -testRemovePackageFromPackageGroup = undefined +testRemovePackageFromPackageGroup = do + user <- instantiateUser randomUserTemplate + package <- + instantiatePackage $ + randomPackageTemplate + & #ownerId + .~ pure user.userId + packageGroup <- + instantiatePackageGroup randomPackageGroupTemplate + packageGroupPackage <- + instantiatePackageGroupPackage $ + randomPackageGroupPackageTemplate + & #packageGroupId + .~ pure packageGroup.packageGroupId + & #packageId + .~ pure package.packageId + + -- It's failing here because it is expecting one arg to the delete + -- but it's getting 3 (why?). Might need to ask Hecate if this + -- should be turned into a raw SQL query in the + -- `Flora.Model.PackageGroupPackage/Update.hs` module + Update.removePackageFromPackageGroup packageGroupPackage + + results <- + Query.getPackagesByPackageGroupId $ + extractPackageGroupIdFromPGP packageGroupPackage + + assertBool True -- Not sure how to test this case well.. --- Check the DB for packages using `PackageGroup` id --- assert that the id for the packages found matches the expected packages provided testGetPackagesByPackageGroupId :: TestEff () -testGetPackagesByPackageGroupId = undefined +testGetPackagesByPackageGroupId = do + user <- instantiateUser randomUserTemplate + package <- + instantiatePackage $ + randomPackageTemplate + & #ownerId + .~ pure user.userId + packageGroup <- + instantiatePackageGroup randomPackageGroupTemplate + packageGroupPackage <- + instantiatePackageGroupPackage $ + randomPackageGroupPackageTemplate + & #packageGroupId + .~ pure packageGroup.packageGroupId + & #packageId + .~ pure package.packageId + + results <- + Query.getPackagesByPackageGroupId $ + extractPackageGroupIdFromPGP packageGroupPackage + + assertEqual (Vector.length results) 1 --- Check the DB for package groups using `PackageGroup` name --- assert that the package group id found matches the expected package group provided testGetPackageGroupByPackageGroupName :: TestEff () -testGetPackageGroupByPackageGroupName = undefined +testGetPackageGroupByPackageGroupName = do + user <- instantiateUser randomUserTemplate + package <- + instantiatePackage $ + randomPackageTemplate + & #ownerId + .~ pure user.userId + packageGroup <- + instantiatePackageGroup randomPackageGroupTemplate + result <- Query.getPackageGroupByPackageGroupName packageGroup.groupName + case result of + Nothing -> + assertFailure + "No Package Group named: `test-group-name" + Just pg -> + assertEqual pg.groupName (extractGroupNameFromPG packageGroup) diff --git a/test/Flora/PackageGroupTestUtils.hs b/test/Flora/PackageGroupTestUtils.hs new file mode 100644 index 00000000..9c0e0736 --- /dev/null +++ b/test/Flora/PackageGroupTestUtils.hs @@ -0,0 +1,127 @@ +module Flora.PackageGroupTestUtils where + +import Data.Maybe (fromJust) +import Data.Text (Text) +import Data.Time (UTCTime (UTCTime), secondsToDiffTime) +import Data.Time.Calendar (fromGregorian) +import Data.UUID (UUID, fromText) +import Data.Vector (singleton) +import Flora.Model.Package.Types (Namespace (..), Package (..), PackageAlternative (..), PackageAlternatives (..), PackageId (..), PackageName (..), PackageStatus (FullyImportedPackage)) +import Flora.Model.PackageGroup.Types + ( PackageGroup (..) + , PackageGroupId (..) + ) +import Flora.Model.PackageGroup.Types as PackageGroup (PackageGroup (..)) +import Flora.Model.PackageGroupPackage.Types as PackageGroupPackage (PackageGroupPackage (..), PackageGroupPackageId (..)) +import Flora.Model.User (User (..), UserFlags (..), UserId (..)) +import Sel.Hashing.Password + +defaultPackage :: Package +defaultPackage = + Package + { packageId = defaultPackageId + , namespace = defaultNamespace + , name = defaultPackageName + , ownerId = defaultOwnerId + , createdAt = defaultCreatedAt + , updatedAt = defaultUpdatedAt + , status = FullyImportedPackage + , deprecationInfo = defaultDeprecationInfo + } + +defaultUser :: User +defaultUser = + User + { userId = defaultOwnerId + , username = "default-user" + , email = "default-user-email" + , displayName = "default-user-displayname" + , password = defaultUserPassword + , userFlags = defaultUserFlags + , createdAt = defaultCreatedAt + , updatedAt = defaultUpdatedAt + , totpKey = Nothing + , totpEnabled = False + } + +defaultUserPassword :: PasswordHash +defaultUserPassword = asciiTextToPasswordHash "defaultpassword" + +defaultUserFlags :: UserFlags +defaultUserFlags = + UserFlags{isAdmin = False, canLogin = False} + +defaultNamespace :: Namespace +defaultNamespace = Namespace "test-namespace" + +defaultPackageName :: PackageName +defaultPackageName = PackageName "test-packagename" + +defaultOwnerId :: UserId +defaultOwnerId = UserId $ fromJust defaultUserId + +defaultUserId :: Maybe UUID +defaultUserId = fromText "c044d4ba-9e9b-4b06-ab96-3ee6e9a9c719" + +defaultCreatedAt :: UTCTime +defaultCreatedAt = UTCTime (fromGregorian 2024 11 17) (secondsToDiffTime 0) + +defaultUpdatedAt :: UTCTime +defaultUpdatedAt = defaultCreatedAt + +defaultDeprecationInfo :: Maybe PackageAlternatives +defaultDeprecationInfo = Just $ PackageAlternatives (singleton defaultPackageAlternative) + +defaultPackageAlternative :: PackageAlternative +defaultPackageAlternative = + PackageAlternative + { namespace = Namespace "test-namespace-2" + , package = PackageName "test-packagename-2" + } + +defaultPackageGroupPackage :: PackageGroupPackage +defaultPackageGroupPackage = + PackageGroupPackage + { packageGroupPackageId = defaultPackageGroupPackageId + , packageId = defaultPackageId + , packageGroupId = defaultPackageGroupId + } + +defaultPackageGroupPackageId :: PackageGroupPackageId +defaultPackageGroupPackageId = + PackageGroupPackageId{getPackageGroupPackageId = fromJust defaultPackageGroupPackageUUID} + +defaultPackageGroupPackageUUID :: Maybe UUID +defaultPackageGroupPackageUUID = fromText "18b2f939-4257-4b60-a992-e9035a17a3b2" + +defaultPackageId :: PackageId +defaultPackageId = + PackageId{getPackageId = fromJust defaultPackageUUID} + +defaultPackageUUID :: Maybe UUID +defaultPackageUUID = fromText "e31594a9-36ed-4a3c-8ecc-40c1b0619f98" + +defaultPackageGroup :: PackageGroup +defaultPackageGroup = + PackageGroup + { packageGroupId = defaultPackageGroupId + , groupName = defaultGroupName + } + +defaultPackageGroupId :: PackageGroupId +defaultPackageGroupId = PackageGroupId{getPackageGroupId = fromJust defaultPackageGroupUUID} + +defaultPackageGroupUUID :: Maybe UUID +defaultPackageGroupUUID = fromText "db1b378d-58b4-4b50-a70c-7ffa5407ed15" + +defaultGroupName :: Text +defaultGroupName = "test-group-name" + +extractPackageGroupIdFromPG :: PackageGroup -> PackageGroupId +extractPackageGroupIdFromPG pg = PackageGroup.packageGroupId pg + +extractPackageGroupIdFromPGP :: PackageGroupPackage -> PackageGroupId +extractPackageGroupIdFromPGP pgp = PackageGroupPackage.packageGroupId pgp + +extractGroupNameFromPG :: PackageGroup -> Text +extractGroupNameFromPG pg = PackageGroup.groupName pg diff --git a/test/Flora/TestUtils.hs b/test/Flora/TestUtils.hs index a4e9792c..ca59a890 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 @@ -145,6 +155,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 (..) @@ -658,3 +672,65 @@ 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 0ce702d1..93aae440 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -19,6 +19,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 @@ -60,6 +61,7 @@ specs fixtures = , ImportSpec.spec fixtures , BlobSpec.spec , SearchSpec.spec fixtures + , PackageGroupSpec.spec ] cleanUp :: DB :> es => Eff es () @@ -73,10 +75,10 @@ cleanUp = dbtToEff $ do void $ execute Delete "DELETE FROM requirements" () void $ execute Delete "DELETE FROM package_components" () 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" () void $ execute Delete "DELETE FROM package_publishers" () void $ execute Delete "DELETE FROM users" () - void $ execute Delete "DELETE FROM package_groups" () - void $ execute Delete "DELETE FROM package_group_packages" () From 5d3ca82b04b06b0193015f5753e1968a5d409fc9 Mon Sep 17 00:00:00 2001 From: Matt Roberts Date: Wed, 20 Nov 2024 21:36:10 +0000 Subject: [PATCH 09/10] feat: all tests passing, refactoring --- cabal.project.freeze | 2 +- changelog.d/63 | 19 +++ flora.cabal | 2 +- src/core/Flora/Model/PackageGroup/Types.hs | 3 +- .../Flora/Model/PackageGroupPackage/Query.hs | 12 ++ .../Flora/Model/PackageGroupPackage/Update.hs | 14 +- test/Flora/PackageGroupSpec.hs | 35 +++-- test/Flora/PackageGroupTestUtils.hs | 127 ------------------ test/Flora/TestUtils.hs | 6 +- 9 files changed, 61 insertions(+), 159 deletions(-) create mode 100644 changelog.d/63 create mode 100644 src/core/Flora/Model/PackageGroupPackage/Query.hs delete mode 100644 test/Flora/PackageGroupTestUtils.hs diff --git a/cabal.project.freeze b/cabal.project.freeze index eff5f4f1..fdefbf4e 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -218,7 +218,7 @@ constraints: any.Cabal ==3.10.3.0, any.lens ==5.3.2, lens -benchmark-uniplate -dump-splices +inlining -j +test-hunit +test-properties +test-templates +trustworthy, any.libsodium-bindings ==0.0.2.0, - libsodium-bindings -homebrew +pkg-config, + libsodium-bindings -homebrew -pkg-config, any.lifted-async ==0.10.2.6, any.lifted-base ==0.2.3.12, any.lockfree-queue ==0.2.4, diff --git a/changelog.d/63 b/changelog.d/63 new file mode 100644 index 00000000..42fd59a0 --- /dev/null +++ b/changelog.d/63 @@ -0,0 +1,19 @@ +synopsis: Membership data model for packages +prs: #785 +issues: #556 + +description: { + +- Migration for `create_package_groups` & `create_package_group_packages` +- Updates to various files as a result of the work done +- Created: + - `Flora/Model/PackageGroup/Query.hs` + - `Flora/Model/PackageGroup/Types.hs` + - `Flora/Model/PackageGroup/Update.hs` +- Created: + - `Flora/Model/PackageGroupPackage/Query.hs` + - `Flora/Model/PackageGroupPackage/Types.hs` + - `Flora/Model/PackageGroupPackage/Update.hs` +- Created: + - test/Flora/PackageGroupSpec.hs` +} diff --git a/flora.cabal b/flora.cabal index 272124f0..a7c143e5 100644 --- a/flora.cabal +++ b/flora.cabal @@ -122,6 +122,7 @@ library 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 @@ -523,7 +524,6 @@ test-suite flora-test Flora.ImportSpec Flora.OddJobSpec Flora.PackageGroupSpec - Flora.PackageGroupTestUtils Flora.PackageSpec Flora.SearchSpec Flora.TemplateSpec diff --git a/src/core/Flora/Model/PackageGroup/Types.hs b/src/core/Flora/Model/PackageGroup/Types.hs index cc8e48fb..3d77e9c8 100644 --- a/src/core/Flora/Model/PackageGroup/Types.hs +++ b/src/core/Flora/Model/PackageGroup/Types.hs @@ -22,8 +22,7 @@ newtype PackageGroupId = PackageGroupId {getPackageGroupId :: UUID} (Display) via ShowInstance UUID -data PackageGroup - = PackageGroup +data PackageGroup = PackageGroup { packageGroupId :: PackageGroupId , groupName :: Text } 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/Update.hs b/src/core/Flora/Model/PackageGroupPackage/Update.hs index aeb7a829..48547808 100644 --- a/src/core/Flora/Model/PackageGroupPackage/Update.hs +++ b/src/core/Flora/Model/PackageGroupPackage/Update.hs @@ -1,18 +1,24 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE QuasiQuotes #-} + module Flora.Model.PackageGroupPackage.Update ( addPackageToPackageGroup , removePackageFromPackageGroup ) where import Control.Monad (void) -import Database.PostgreSQL.Entity (delete, insert) +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 => PackageGroupPackage -> Eff es () -removePackageFromPackageGroup packageGroupPackage = - void $ dbtToEff $ delete @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 index 8e27eeb8..c62aa4ca 100644 --- a/test/Flora/PackageGroupSpec.hs +++ b/test/Flora/PackageGroupSpec.hs @@ -2,12 +2,12 @@ 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.PackageGroupTestUtils import Flora.TestUtils import Optics.Core @@ -25,7 +25,7 @@ spec = testInsertPackageGroup :: TestEff () testInsertPackageGroup = do user <- instantiateUser randomUserTemplate - package <- + void $ instantiatePackage $ randomPackageTemplate & #ownerId @@ -34,12 +34,13 @@ testInsertPackageGroup = do instantiatePackageGroup randomPackageGroupTemplate result <- Query.getPackageGroupByPackageGroupName packageGroup.groupName + case result of Nothing -> assertFailure - "No Package Group named: `test-group-name`" + "No Package Group Found in `testInsertPackageGroup`" Just pg -> - assertEqual pg.packageGroupId (extractPackageGroupIdFromPG packageGroup) + assertEqual pg.packageGroupId packageGroup.packageGroupId testAddPackageToPackageGroup :: TestEff () testAddPackageToPackageGroup = do @@ -60,8 +61,7 @@ testAddPackageToPackageGroup = do .~ pure package.packageId results <- - Query.getPackagesByPackageGroupId $ - extractPackageGroupIdFromPGP packageGroupPackage + Query.getPackagesByPackageGroupId packageGroup.packageGroupId assertEqual 1 (Vector.length results) @@ -83,17 +83,11 @@ testRemovePackageFromPackageGroup = do & #packageId .~ pure package.packageId - -- It's failing here because it is expecting one arg to the delete - -- but it's getting 3 (why?). Might need to ask Hecate if this - -- should be turned into a raw SQL query in the - -- `Flora.Model.PackageGroupPackage/Update.hs` module - Update.removePackageFromPackageGroup packageGroupPackage + Update.removePackageFromPackageGroup package.packageId packageGroup.packageGroupId - results <- - Query.getPackagesByPackageGroupId $ - extractPackageGroupIdFromPGP packageGroupPackage + results <- Query.getPackagesByPackageGroupId packageGroup.packageGroupId - assertBool True -- Not sure how to test this case well.. + assertBool (Vector.notElem package results) testGetPackagesByPackageGroupId :: TestEff () testGetPackagesByPackageGroupId = do @@ -114,25 +108,26 @@ testGetPackagesByPackageGroupId = do .~ pure package.packageId results <- - Query.getPackagesByPackageGroupId $ - extractPackageGroupIdFromPGP packageGroupPackage + Query.getPackagesByPackageGroupId packageGroup.packageGroupId assertEqual (Vector.length results) 1 testGetPackageGroupByPackageGroupName :: TestEff () testGetPackageGroupByPackageGroupName = do user <- instantiateUser randomUserTemplate - package <- + void $ instantiatePackage $ randomPackageTemplate & #ownerId .~ pure user.userId packageGroup <- instantiatePackageGroup randomPackageGroupTemplate + result <- Query.getPackageGroupByPackageGroupName packageGroup.groupName + case result of Nothing -> assertFailure - "No Package Group named: `test-group-name" + "No Package Group Name found in `testGetPackageGroupByPackageGroupName" Just pg -> - assertEqual pg.groupName (extractGroupNameFromPG packageGroup) + assertEqual pg.groupName packageGroup.groupName diff --git a/test/Flora/PackageGroupTestUtils.hs b/test/Flora/PackageGroupTestUtils.hs deleted file mode 100644 index 9c0e0736..00000000 --- a/test/Flora/PackageGroupTestUtils.hs +++ /dev/null @@ -1,127 +0,0 @@ -module Flora.PackageGroupTestUtils where - -import Data.Maybe (fromJust) -import Data.Text (Text) -import Data.Time (UTCTime (UTCTime), secondsToDiffTime) -import Data.Time.Calendar (fromGregorian) -import Data.UUID (UUID, fromText) -import Data.Vector (singleton) -import Flora.Model.Package.Types (Namespace (..), Package (..), PackageAlternative (..), PackageAlternatives (..), PackageId (..), PackageName (..), PackageStatus (FullyImportedPackage)) -import Flora.Model.PackageGroup.Types - ( PackageGroup (..) - , PackageGroupId (..) - ) -import Flora.Model.PackageGroup.Types as PackageGroup (PackageGroup (..)) -import Flora.Model.PackageGroupPackage.Types as PackageGroupPackage (PackageGroupPackage (..), PackageGroupPackageId (..)) -import Flora.Model.User (User (..), UserFlags (..), UserId (..)) -import Sel.Hashing.Password - -defaultPackage :: Package -defaultPackage = - Package - { packageId = defaultPackageId - , namespace = defaultNamespace - , name = defaultPackageName - , ownerId = defaultOwnerId - , createdAt = defaultCreatedAt - , updatedAt = defaultUpdatedAt - , status = FullyImportedPackage - , deprecationInfo = defaultDeprecationInfo - } - -defaultUser :: User -defaultUser = - User - { userId = defaultOwnerId - , username = "default-user" - , email = "default-user-email" - , displayName = "default-user-displayname" - , password = defaultUserPassword - , userFlags = defaultUserFlags - , createdAt = defaultCreatedAt - , updatedAt = defaultUpdatedAt - , totpKey = Nothing - , totpEnabled = False - } - -defaultUserPassword :: PasswordHash -defaultUserPassword = asciiTextToPasswordHash "defaultpassword" - -defaultUserFlags :: UserFlags -defaultUserFlags = - UserFlags{isAdmin = False, canLogin = False} - -defaultNamespace :: Namespace -defaultNamespace = Namespace "test-namespace" - -defaultPackageName :: PackageName -defaultPackageName = PackageName "test-packagename" - -defaultOwnerId :: UserId -defaultOwnerId = UserId $ fromJust defaultUserId - -defaultUserId :: Maybe UUID -defaultUserId = fromText "c044d4ba-9e9b-4b06-ab96-3ee6e9a9c719" - -defaultCreatedAt :: UTCTime -defaultCreatedAt = UTCTime (fromGregorian 2024 11 17) (secondsToDiffTime 0) - -defaultUpdatedAt :: UTCTime -defaultUpdatedAt = defaultCreatedAt - -defaultDeprecationInfo :: Maybe PackageAlternatives -defaultDeprecationInfo = Just $ PackageAlternatives (singleton defaultPackageAlternative) - -defaultPackageAlternative :: PackageAlternative -defaultPackageAlternative = - PackageAlternative - { namespace = Namespace "test-namespace-2" - , package = PackageName "test-packagename-2" - } - -defaultPackageGroupPackage :: PackageGroupPackage -defaultPackageGroupPackage = - PackageGroupPackage - { packageGroupPackageId = defaultPackageGroupPackageId - , packageId = defaultPackageId - , packageGroupId = defaultPackageGroupId - } - -defaultPackageGroupPackageId :: PackageGroupPackageId -defaultPackageGroupPackageId = - PackageGroupPackageId{getPackageGroupPackageId = fromJust defaultPackageGroupPackageUUID} - -defaultPackageGroupPackageUUID :: Maybe UUID -defaultPackageGroupPackageUUID = fromText "18b2f939-4257-4b60-a992-e9035a17a3b2" - -defaultPackageId :: PackageId -defaultPackageId = - PackageId{getPackageId = fromJust defaultPackageUUID} - -defaultPackageUUID :: Maybe UUID -defaultPackageUUID = fromText "e31594a9-36ed-4a3c-8ecc-40c1b0619f98" - -defaultPackageGroup :: PackageGroup -defaultPackageGroup = - PackageGroup - { packageGroupId = defaultPackageGroupId - , groupName = defaultGroupName - } - -defaultPackageGroupId :: PackageGroupId -defaultPackageGroupId = PackageGroupId{getPackageGroupId = fromJust defaultPackageGroupUUID} - -defaultPackageGroupUUID :: Maybe UUID -defaultPackageGroupUUID = fromText "db1b378d-58b4-4b50-a70c-7ffa5407ed15" - -defaultGroupName :: Text -defaultGroupName = "test-group-name" - -extractPackageGroupIdFromPG :: PackageGroup -> PackageGroupId -extractPackageGroupIdFromPG pg = PackageGroup.packageGroupId pg - -extractPackageGroupIdFromPGP :: PackageGroupPackage -> PackageGroupId -extractPackageGroupIdFromPGP pgp = PackageGroupPackage.packageGroupId pgp - -extractGroupNameFromPG :: PackageGroup -> Text -extractGroupNameFromPG pg = PackageGroup.groupName pg diff --git a/test/Flora/TestUtils.hs b/test/Flora/TestUtils.hs index ca59a890..224dafe5 100644 --- a/test/Flora/TestUtils.hs +++ b/test/Flora/TestUtils.hs @@ -673,8 +673,7 @@ instantiateRequirement Update.insertRequirement req pure req -data PackageGroupTemplate m - = PackageGroupTemplate +data PackageGroupTemplate m = PackageGroupTemplate { packageGroupId :: m PackageGroupId , groupName :: m Text } @@ -702,8 +701,7 @@ instantiatePackageGroup Update.insertPackageGroup pg pure pg -data PackageGroupPackageTemplate m - = PackageGroupPackageTemplate +data PackageGroupPackageTemplate m = PackageGroupPackageTemplate { packageGroupPackageId :: m PackageGroupPackageId , packageId :: m PackageId , packageGroupId :: m PackageGroupId From 9be5ab333a263bc32aa8b91384631a6c81c156de Mon Sep 17 00:00:00 2001 From: Matt Roberts Date: Thu, 21 Nov 2024 22:58:07 +0000 Subject: [PATCH 10/10] fix: pr feedback and small refactoring --- changelog.d/63 | 14 +---------- src/core/Flora/Model/PackageGroup/Query.hs | 28 +++++++++------------- src/core/Flora/Model/PackageGroup/Types.hs | 3 +-- test/Flora/PackageGroupSpec.hs | 6 ++--- 4 files changed, 16 insertions(+), 35 deletions(-) diff --git a/changelog.d/63 b/changelog.d/63 index 42fd59a0..a95a6613 100644 --- a/changelog.d/63 +++ b/changelog.d/63 @@ -3,17 +3,5 @@ prs: #785 issues: #556 description: { - -- Migration for `create_package_groups` & `create_package_group_packages` -- Updates to various files as a result of the work done -- Created: - - `Flora/Model/PackageGroup/Query.hs` - - `Flora/Model/PackageGroup/Types.hs` - - `Flora/Model/PackageGroup/Update.hs` -- Created: - - `Flora/Model/PackageGroupPackage/Query.hs` - - `Flora/Model/PackageGroupPackage/Types.hs` - - `Flora/Model/PackageGroupPackage/Update.hs` -- Created: - - test/Flora/PackageGroupSpec.hs` + Migration for `create_package_groups` & `create_package_group_packages` } diff --git a/src/core/Flora/Model/PackageGroup/Query.hs b/src/core/Flora/Model/PackageGroup/Query.hs index a927b983..d9ea6fb0 100644 --- a/src/core/Flora/Model/PackageGroup/Query.hs +++ b/src/core/Flora/Model/PackageGroup/Query.hs @@ -7,30 +7,24 @@ module Flora.Model.PackageGroup.Query import Data.Text (Text) import Data.Vector (Vector) -import Database.PostgreSQL.Entity (selectOneByField) -import Database.PostgreSQL.Entity.DBT - ( QueryNature (Select) - , query - ) +import Database.PostgreSQL.Entity (joinSelectOneByField, selectOneByField) import Database.PostgreSQL.Entity.Types (field) import Database.PostgreSQL.Simple (Only (..)) -import Database.PostgreSQL.Simple.SqlQQ (sql) 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.PackageGroup.Types (PackageGroup (..), PackageGroupId (..)) +import Flora.Model.PackageGroupPackage.Types (PackageGroupPackage (..)) getPackagesByPackageGroupId :: DB :> es => PackageGroupId -> Eff es (Vector Package) -getPackagesByPackageGroupId packageGroupId = dbtToEff $ query Select q (Only packageGroupId) - where - q = - [sql| - SELECT p.* - FROM packages AS p - JOIN package_group_packages AS pgp - ON p.package_id = pgp.package_id - WHERE pgp.package_group_id = ? - |] +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 index 3d77e9c8..5e9294e2 100644 --- a/src/core/Flora/Model/PackageGroup/Types.hs +++ b/src/core/Flora/Model/PackageGroup/Types.hs @@ -1,7 +1,5 @@ module Flora.Model.PackageGroup.Types where -import GHC.Generics - import Control.DeepSeq (NFData) import Data.Aeson import Data.Text (Text) @@ -13,6 +11,7 @@ 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 diff --git a/test/Flora/PackageGroupSpec.hs b/test/Flora/PackageGroupSpec.hs index c62aa4ca..8a859bbf 100644 --- a/test/Flora/PackageGroupSpec.hs +++ b/test/Flora/PackageGroupSpec.hs @@ -52,7 +52,7 @@ testAddPackageToPackageGroup = do .~ pure user.userId packageGroup <- instantiatePackageGroup randomPackageGroupTemplate - packageGroupPackage <- + void $ instantiatePackageGroupPackage $ randomPackageGroupPackageTemplate & #packageGroupId @@ -75,7 +75,7 @@ testRemovePackageFromPackageGroup = do .~ pure user.userId packageGroup <- instantiatePackageGroup randomPackageGroupTemplate - packageGroupPackage <- + void $ instantiatePackageGroupPackage $ randomPackageGroupPackageTemplate & #packageGroupId @@ -99,7 +99,7 @@ testGetPackagesByPackageGroupId = do .~ pure user.userId packageGroup <- instantiatePackageGroup randomPackageGroupTemplate - packageGroupPackage <- + void $ instantiatePackageGroupPackage $ randomPackageGroupPackageTemplate & #packageGroupId