Remove the packageId primary key and tmp-postgres

cbits/categorise.dl

@@ -32,15 +32,16 @@ flora_category("distributed", "Distributed Systems & Computation", "Tooling and
 flora_category("ffi", "FFI", "Tooling to work with the Foreign Function Interface").
 flora_category("game-dev", "Game development", "Libraries used for game development").
 flora_category("generics", "Generics", "Tooling to work with Haskell's Generics").
-flora_category("prelude", "Prelude", "Libraries that provide default imports").
 flora_category("language", "Language", "Tooling for interfacing with other programming languages from Haskell programs").
+flora_category("maths", "Mathematics", "Numerical and Mathematical packages").
 flora_category("natural-language", "Natural Language", "Tooling to working with natural languages").
 flora_category("network", "Network Development", "Connection pools, DNS, HTTP, API clients and network protocols").
-flora_category("maths", "Mathematics", "Numerical and Mathematical packages").
 flora_category("parser-implementations", "Parser Implementations", "Parsing data formats").
 flora_category("parsers","Parsers", "Libraries to ingest and parse data").
 flora_category("parsing", "Parsing", "Parser generators, combinators and tools to help with parsing").
+flora_category("prelude", "Prelude", "Libraries that provide default imports").
 flora_category("system", "System", "Programming and communicating with the Operating System").
+flora_category("template-haskell", "Template Haskell", "Metaprogramming with Template Haskell").
 flora_category("testing", "Testing", "Test frameworks").
 flora_category("text", "Text", "Working with textual data and algorithms").
 flora_category("web", "Web Development", "Programming for the web").

environment.sh

@@ -25,7 +25,7 @@ export FLORA_LOGGING_DESTINATION="stdout"
 #
 #   * Accept multiple packages with the same name but different case
 #   * Accept multiple users with the same name but different case
-export FLORA_COMPATIBILITY_MODE=true
+export FLORA_COMPATIBILITY_MODE="True"
 
 # Set these variables in `environment.local.sh`, which is not tracked by git.
 #export SENTRY_DSN="" # Set this variable to connecto to your Sentry instance

environment.test.sh

@@ -3,3 +3,7 @@
 export FLORA_HTTP_PORT=8085
 export FLORA_ENVIRONMENT="tests"
 export FLORA_DOMAIN="localhost"
+
+export FLORA_DB_DATABASE="flora_test"
+
+export FLORA_PG_CONNSTRING="host=${FLORA_DB_HOST} dbname=${FLORA_DB_DATABASE} user=${FLORA_DB_USER} password=${FLORA_DB_PASSWORD}"

flora.cabal

@@ -194,7 +194,6 @@ library
     , text                       ^>=1.2
     , text-display               ^>=0.0.2
     , time                       ^>=1.9
-    , tmp-postgres
     , transformers               ^>=0.5
     , transformers-base          ^>=0.4
     , typed-process              ^>=0.2

migrations/20211106003401_create_packages.sql

@@ -1,14 +1,11 @@
 -- A package is comprised of metadata and has many releases.
 create table if not exists packages (
-  package_id uuid primary key,
   namespace text not null,
   name text not null,
   synopsis text not null,
   owner_id uuid references users,
   metadata jsonb not null, -- { homepage, documentation url, repository url, issues url }
   created_at timestamptz not null,
-  updated_at timestamptz not null
+  updated_at timestamptz not null,
+  primary key(namespace, name)
 );
-
-create unique index on packages(lower(name), lower(namespace));
-create unique index on packages(package_id, lower(name), lower(namespace));

migrations/20211106120712_create_package_publishers.sql

@@ -1,5 +1,10 @@
 create table if not exists package_publishers (
   package_publisher_id uuid primary key,
-  package_id uuid references packages not null,
-  user_id uuid references users not null
+  package_name text not null,
+  package_namespace text not null,
+  user_id uuid references users not null,
+
+  constraint fk_package_publishers
+    foreign key (package_name, package_namespace)
+      references packages(name, namespace)
 );

migrations/20211106123053_create_releases.sql

@@ -1,12 +1,16 @@
 -- A release belongs to a package, and contains multiple components.
 create table if not exists releases (
   release_id uuid primary key,
-  package_id uuid references packages,
+  package_name text not null,
+  package_namespace text not null,
   version text not null,
   archive_checksum text not null,
-  created_at timestamptz,
-  updated_at timestamptz
+  created_at timestamptz not null,
+  updated_at timestamptz not null,
+
+  constraint fk_package
+    foreign key (package_name, package_namespace)
+      references packages(name, namespace)
 );
 
-create index on releases(package_id);
-create unique index on releases(package_id, version);
+create unique index on releases(package_name, package_namespace, version);

migrations/20211106123253_create_requirements.sql

@@ -1,9 +1,14 @@
 create table if not exists requirements (
   requirement_id uuid primary key,
   package_component_id uuid references package_components not null, -- Points to the dependent
-  package_id uuid references packages not null, -- Points to the dependency
+  package_name text not null,
+  package_namespace text not null,
   requirement text not null,
-  metadata jsonb not null
+  metadata jsonb not null,
+
+  constraint fk_requirements
+    foreign key (package_name, package_namespace)
+      references packages(name, namespace)
 );
 
 create index on "requirements" (package_component_id);

migrations/20211113195849_create_dependents.sql

@@ -15,14 +15,13 @@
 
 create materialized view dependents (
   name,
-  namespace,
-  dependent_id) as
-  select distinct p4.name as name, p4.namespace as namespace, p0.package_id as package_id
+  namespace) as
+  select distinct p4.name as name, p4.namespace as namespace
   from packages as p0
-    inner join "releases" as r1 on r1."package_id" = p0."package_id"
+    inner join "releases" as r1 on (r1."package_namespace" = p0."namespace" and r1."package_name" = p0."name")
     inner join "package_components" as pc2 on pc2."release_id" = r1."release_id"
     inner join "requirements" as r3 on r3."package_component_id" = pc2."package_component_id"
-    inner join "packages" as p4 on p4."package_id" = r3."package_id";
+    inner join "packages" as p4 on (r3."package_namespace" = p4."namespace" and r3."package_name" = p4."name");
 
-create index on dependents (name, dependent_id);
-create unique index on dependents (name, namespace, dependent_id);
+create index on dependents (name, namespace);
+create unique index on dependents (name, namespace);

migrations/20220211183605_create_package_categories.sql

@@ -1,5 +1,10 @@
 create table if not exists package_categories (
   package_category_id uuid primary key,
-  package_id uuid references packages,
-  category_id uuid references categories
+  package_name text not null,
+  package_namespace text not null,
+  category_id uuid references categories,
+
+  constraint fk_package_categories
+    foreign key (package_name, package_namespace)
+      references packages(name, namespace)
 );

migrations/20220326182257_create_latest_versions.sql

@@ -2,12 +2,12 @@ create materialized view latest_versions (
   namespace,
   name,
   synopsis,
-  package_id,
   version) as
-    select distinct p.namespace, p.name, p.synopsis, p.package_id, max(r.version) as version
+    select distinct p.namespace, p.name, p.synopsis, max(r.version) as version
     from "packages" as p
-      inner join "releases" as r on r."package_id" = p."package_id"
-    group by (p.namespace, p.name, p.synopsis, p.package_id);
+      inner join "releases" as r on r."package_name" = p."name"
+                                and r."package_namespace" = p."namespace"
+    group by (p.namespace, p.name, p.synopsis);
 
 create index on latest_versions (namespace, name);
 create unique index on latest_versions (name, namespace, version);

scripts/run-tests.sh

@@ -6,6 +6,9 @@ source ./environment.test.sh
 
 export DATALOG_DIR="cbits/"
 
+make db-drop
+make db-setup
+
 if [ -z "$1" ] ;
 then
   cabal test

src/Flora/Environment.hs

@@ -12,18 +12,18 @@ module Flora.Environment
 import Colourista.IO (blueMessage)
 import Control.Monad ((>=>))
 import Data.Bifunctor
-import Data.Pool (Pool, createPool)
+import Data.Pool (Pool)
 import Data.Text
 import qualified Data.Text as T
 import Data.Text.Display (Display (..))
 import Data.Time (NominalDiffTime)
 import Data.Word (Word16)
 import Database.PostgreSQL.Entity.DBT
 import qualified Database.PostgreSQL.Simple as PG
-import qualified Database.Postgres.Temp as Postgres.Temp
 import Env (AsUnread (unread), Error (..), Parser, Reader, def, help, nonempty,
             parse, str, switch, var, (<=<))
 import GHC.Generics
+import Optics.Core ((^.))
 import Text.Read (readMaybe)
 
 -- | The datatype that is used in the application
@@ -68,7 +68,7 @@ data FloraConfig = FloraConfig
   , logging     :: LoggingEnv
   , environment :: DeploymentEnv
   }
-  deriving stock Show
+  deriving stock (Show, Generic)
 
 data PoolConfig = PoolConfig
   { subPools          :: Int
@@ -78,7 +78,9 @@ data PoolConfig = PoolConfig
   deriving stock Show
 
 data TestConfig = TestConfig
-  { httpPort :: Word16
+  { httpPort    :: Word16
+  , dbConfig    :: PoolConfig
+  , connectInfo :: PG.ConnectInfo
   }
   deriving stock (Show, Generic)
 
@@ -95,14 +97,10 @@ configToEnv FloraConfig {..} = do
   pure FloraEnv {..}
 
 testConfigToTestEnv :: TestConfig -> IO TestEnv
-testConfigToTestEnv TestConfig{httpPort} = do
-  eitherDb <- Postgres.Temp.start
-  case eitherDb of
-      Right db -> do
-        pool <- createPool (PG.connectPostgreSQL $ Postgres.Temp.toConnectionString db)
-                           PG.close 1 100000000 50
-        pure TestEnv{..}
-      Left _ -> error "Fuck right off"
+testConfigToTestEnv config@TestConfig{..} = do
+  let PoolConfig {..} = config ^. #dbConfig
+  pool <- mkPool connectInfo subPools connectionTimeout connections
+  pure TestEnv{..}
 
 displayConnectInfo :: PG.ConnectInfo -> Text
 displayConnectInfo PG.ConnectInfo {..} = T.pack $
@@ -164,12 +162,15 @@ parseConfig =
 
 parseTestConfig :: Parser Error TestConfig
 parseTestConfig =
-  TestConfig <$> parsePort
+  TestConfig
+  <$> parsePort
+  <*> parsePoolConfig
+  <*> parseConnectInfo
 
 getFloraEnv :: IO FloraEnv
 getFloraEnv = do
   config <- Env.parse id parseConfig
-  blueMessage $ "🔌 Connecting to database at " <> displayConnectInfo (connectInfo config)
+  blueMessage $ "🔌 Connecting to database at " <> displayConnectInfo (config ^. #connectInfo)
   configToEnv config
 
 getFloraTestEnv :: IO TestEnv

src/Flora/Import/Package.hs

@@ -110,7 +110,7 @@ importPackage userId packageName directory = do
 -- 6. Extract multiple 'Requirement's
 -- 7. Insert everything
 importCabal :: (MonadIO m)
-            =>  UserId    -- ^ The UserId of the stand-in user for Hackage, for instance.
+            => UserId    -- ^ The UserId of the stand-in user for Hackage, for instance.
             -> PackageName  -- ^ Name of the package and of the .cabal file
             -> FilePath -- ^ Path to the Cabal file
             -> FilePath -- ^ Directory where to find the .cabal files
@@ -127,19 +127,18 @@ importCabal userId packageName cabalFile directory = do
                              cabalToPackage userId (genDesc ^. #packageDescription) namespace packageName
                            Just package -> pure package
       release <- lift $
-        Query.getReleaseByVersion (package ^. #packageId) (genDesc ^. #packageDescription ^. #package ^. #pkgVersion)
+        Query.getReleaseByVersion (package ^. #namespace, package ^. #name)
+                                  ((genDesc ^. #packageDescription) ^. (#package % #pkgVersion))
                   >>= \case
                           Nothing -> do
-                            r <- createRelease (package ^. #packageId)
-                                               (genDesc ^. #packageDescription ^. #package ^. #pkgVersion)
+                            r <- createRelease (package ^. #namespace) (package ^. #name)
+                                               ((genDesc ^. #packageDescription) ^. (#package % #pkgVersion))
                             logImportMessage (namespace, packageName) $ "Creating Release "
                                 <> display (r ^. #releaseId) <> " for package " <> display (package ^. #name)
-                                <> " (package_id: " <> display (package ^. #packageId) <> ")"
                             pure r
                           Just release -> do
                             logImportMessage (namespace, packageName) $
                                   "Release found: releaseId: " <> display (release ^. #releaseId) <> " / packageId: "
-                                  <> display (package ^. #packageId)
                             pure release
       componentsAndRequirements <- extractComponents userId directory
                                       (namespace, packageName)
@@ -152,7 +151,7 @@ importCabal userId packageName cabalFile directory = do
     case result of
       Left err -> error $ "Encountered error during import: " <> show err
       Right (package, release, components, requirements) -> do
-        let rawCategoryField = T.pack $ Cabal.fromShortText $ genDesc ^. #packageDescription ^. #category
+        let rawCategoryField = T.pack $ Cabal.fromShortText $ genDesc ^. (#packageDescription % #category)
         let categoryList = fmap (UserPackageCategory . T.stripStart) (T.splitOn "," rawCategoryField)
         Update.publishPackage requirements components release categoryList package
 
@@ -253,7 +252,7 @@ extractFromLib :: (MonadIO m)
                -> ExceptT ImportError (DBT m) (PackageComponent, [Requirement])
 extractFromLib userId directory dependentName releaseId packageName library = do
   let dependencies = filter (\d -> Cabal.depPkgName d /= "unbuildable")
-                   $ library ^. #libBuildInfo ^. #targetBuildDepends
+                   $ library ^. (#libBuildInfo % #targetBuildDepends)
   let libraryName = getLibName $ library ^. #libName
   let componentType = Component.Library
   let canonicalForm = CanonicalComponent libraryName componentType
@@ -355,26 +354,28 @@ depToRequirement userId directory (dependentNamespace, dependentPackageName) cab
                    <> " on " <> "@" <> display namespace <> "/" <> display name
   result <- lift $ Query.getPackageByNamespaceAndName namespace name
   case result of
-    Just package@Package{packageId=dependencyPackageId} -> do
+    Just package -> do
       logImportMessage (dependentNamespace, dependentPackageName) $
-              "Required package: " <> "name: " <> display (package ^. #name) <>
-              ", packageId: " <> display dependencyPackageId
+              "Required package: " <> "name: " <> display (package ^. #name)
       logImportMessage (dependentNamespace, dependentPackageName) $
                        "Dependency @" <> display namespace <> "/" <> display name <>
-                       " is in the database (" <> (T.pack . show $ dependencyPackageId) <> ")"
+                       " is in the database"
       requirementId <- RequirementId <$> liftIO UUID.nextRandom
       let requirement = display $ prettyShow $ Cabal.depVerRange cabalDependency
       let metadata = RequirementMetadata{ flag = Nothing }
-      let req = Requirement{requirementId, packageComponentId, packageId=dependencyPackageId, requirement, metadata}
+      let reqNamespace = package ^. #namespace
+      let reqName = package ^. #name
+      let req = Requirement{requirementId, packageComponentId, packageNamespace=reqNamespace, packageName=reqName, requirement, metadata}
       pure [req]
     Nothing | (dependentNamespace, dependentPackageName) == (namespace, name) -> do
               -- Checking if the package depends on itself
               -- Unused when loading only main components of packages
-                let packageId = PackageId UUID.nil
                 logImportMessage (dependentNamespace, dependentPackageName) "A sub-component depends on the package itself."
                 requirementId <- RequirementId <$> liftIO UUID.nextRandom
                 let requirement = display $ prettyShow $ Cabal.depVerRange cabalDependency
                 let metadata = RequirementMetadata{ flag = Nothing }
+                let packageNamespace = dependentNamespace
+                let packageName = dependentPackageName
                 let req = Requirement{..}
                 pure [req]
             | otherwise -> do
@@ -383,20 +384,21 @@ depToRequirement userId directory (dependentNamespace, dependentPackageName) cab
                   <> " does not exist in the database, trying to import it from " <> T.pack directory
                 let cabalPath = directory <> T.unpack (display name) <> ".cabal"
                 package <- lift $ importCabal userId name cabalPath directory
-                let packageId = package ^. #packageId
                 requirementId <- RequirementId <$> liftIO UUID.nextRandom
+                let pNs = package ^. #namespace
+                let pN = package ^. #name
                 let requirement = display $ prettyShow $ Cabal.depVerRange cabalDependency
                 let metadata = RequirementMetadata{ flag = Nothing }
-                let req = Requirement{requirementId, packageComponentId, packageId, requirement, metadata}
+                let req = Requirement{requirementId, packageComponentId, packageNamespace=pNs, packageName=pN, requirement, metadata}
                 pure [req]
 
 createComponent :: MonadIO m => ReleaseId -> CanonicalComponent -> ExceptT ImportError (DBT m) PackageComponent
 createComponent releaseId canonicalForm = do
   componentId <- ComponentId <$> liftIO UUID.nextRandom
   pure PackageComponent{..}
 
-createRelease :: (MonadIO m) => PackageId -> Version -> DBT m Release
-createRelease packageId version = do
+createRelease :: (MonadIO m) => Namespace -> PackageName -> Version -> DBT m Release
+createRelease packageNamespace packageName version = do
   releaseId <- ReleaseId <$> liftIO UUID.nextRandom
   timestamp <- liftIO getCurrentTime
   let archiveChecksum = mempty
@@ -412,8 +414,7 @@ cabalToPackage :: (MonadIO m)
                -> ExceptT ImportError (DBT m) Package
 cabalToPackage ownerId packageDesc namespace name = do
   timestamp <- liftIO getCurrentTime
-  packageId <- PackageId <$> liftIO UUID.nextRandom
-  sourceRepos <- getRepoURL (PackageName $ display $ packageDesc ^. #package ^. #pkgName) (packageDesc ^. #sourceRepos)
+  sourceRepos <- getRepoURL (PackageName $ display $ packageDesc ^. (#package % #pkgName)) (packageDesc ^. #sourceRepos)
   let license = Cabal.license packageDesc
   let homepage = Just (display $ packageDesc ^. #homepage)
   let documentation = ""