[FLORA-63] Membership data model for packages

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`
+}

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

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
+)

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);

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)

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)

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

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)

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)

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)

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