diff --git a/app/cli/Main.hs b/app/cli/Main.hs index a3fbd172..01f93a51 100644 --- a/app/cli/Main.hs +++ b/app/cli/Main.hs @@ -30,8 +30,8 @@ data Command = Provision ProvisionTarget | CreateUser UserCreationOptions | GenDesignSystemComponents - | ImportPackages FilePath - | ImportIndex FilePath + | ImportPackages FilePath (Maybe Text) + | ImportIndex FilePath (Maybe Text) deriving stock (Show, Eq) data ProvisionTarget @@ -92,14 +92,30 @@ parseGenDesignSystem :: Parser Command parseGenDesignSystem = pure GenDesignSystemComponents parseImportPackages :: Parser Command -parseImportPackages = ImportPackages <$> argument str (metavar "PATH") +parseImportPackages = + ImportPackages + <$> argument str (metavar "PATH") + <*> optional + ( strOption $ + long "repository" + <> metavar "" + <> help "Which repository we're importing from" + ) parseImportIndex :: Parser Command -parseImportIndex = ImportIndex <$> argument str (metavar "PATH") +parseImportIndex = + ImportIndex + <$> argument str (metavar "PATH") + <*> optional + ( strOption $ + long "repository" + <> metavar "" + <> help "Which repository we're importing from" + ) runOptions :: (Reader PoolConfig :> es, DB :> es, Fail :> es, IOE :> es) => Options -> Eff es () runOptions (Options (Provision Categories)) = importCategories -runOptions (Options (Provision TestPackages)) = importFolderOfCabalFiles "./test/fixtures/Cabal/" +runOptions (Options (Provision TestPackages)) = importFolderOfCabalFiles "./test/fixtures/Cabal/" Nothing runOptions (Options (CreateUser opts)) = do let username = opts ^. #username email = opts ^. #email @@ -117,18 +133,18 @@ runOptions (Options (CreateUser opts)) = do let user = if canLogin then templateUser else templateUser & #userFlags % #canLogin .~ False insertUser user runOptions (Options GenDesignSystemComponents) = generateComponents -runOptions (Options (ImportPackages path)) = importFolderOfCabalFiles path -runOptions (Options (ImportIndex path)) = importIndex path +runOptions (Options (ImportPackages path repository)) = importFolderOfCabalFiles path repository +runOptions (Options (ImportIndex path repository)) = importIndex path repository -importFolderOfCabalFiles :: (Reader PoolConfig :> es, DB :> es, IOE :> es) => FilePath -> Eff es () -importFolderOfCabalFiles path = Log.withStdOutLogger $ \appLogger -> do +importFolderOfCabalFiles :: (Reader PoolConfig :> es, DB :> es, IOE :> es) => FilePath -> Maybe Text -> Eff es () +importFolderOfCabalFiles path repository = Log.withStdOutLogger $ \appLogger -> do user <- fromJust <$> Query.getUserByUsername "hackage-user" - importAllFilesInRelativeDirectory appLogger (user ^. #userId) path True + importAllFilesInRelativeDirectory appLogger (user ^. #userId) repository path True -importIndex :: (Reader PoolConfig :> es, DB :> es, IOE :> es) => FilePath -> Eff es () -importIndex path = Log.withStdOutLogger $ \logger -> do +importIndex :: (Reader PoolConfig :> es, DB :> es, IOE :> es) => FilePath -> Maybe Text -> Eff es () +importIndex path repository = Log.withStdOutLogger $ \logger -> do user <- fromJust <$> Query.getUserByUsername "hackage-user" - importFromIndex logger (user ^. #userId) path True + importFromIndex logger (user ^. #userId) repository path True withInfo :: Parser a -> String -> ParserInfo a withInfo opts desc = info (helper <*> opts) $ progDesc desc diff --git a/flora.cabal b/flora.cabal index 821075a9..861ee925 100644 --- a/flora.cabal +++ b/flora.cabal @@ -69,7 +69,11 @@ library import: common-extensions import: common-ghc-options extra-libraries: stdc++ - cxx-options: -std=c++17 -Wall -D__EMBEDDED_SOUFFLE__ + + -- -Wall + cxx-options: + -std=c++17 -D__EMBEDDED_SOUFFLE__ -Wno-deprecated -fno-gnu-unique + cxx-sources: cbits/categorise.cpp hs-source-dirs: ./src/core ./src/orphans @@ -105,6 +109,7 @@ library Flora.Model.Package.Query Flora.Model.Package.Types Flora.Model.Package.Update + Flora.Model.PackageIndex Flora.Model.PersistentSession Flora.Model.Release Flora.Model.Release.Query @@ -167,6 +172,7 @@ library , text-display , time , time-effectful + , unliftio , uuid , vector , vector-algorithms @@ -418,6 +424,7 @@ test-suite flora-test other-modules: Flora.CabalSpec Flora.CategorySpec + Flora.ImportSpec Flora.OddJobSpec Flora.PackageSpec Flora.TemplateSpec diff --git a/migrations/20230611171412_packageindexes.sql b/migrations/20230611171412_packageindexes.sql new file mode 100644 index 00000000..e1d6e928 --- /dev/null +++ b/migrations/20230611171412_packageindexes.sql @@ -0,0 +1,7 @@ +create table if not exists package_indexes ( + package_index_id uuid primary key, + repository text not null, + timestamp timestamptz +); + +create unique index on package_indexes(repository); diff --git a/migrations/20230623168754_add_repo_to_release.sql b/migrations/20230623168754_add_repo_to_release.sql new file mode 100644 index 00000000..c907ee03 --- /dev/null +++ b/migrations/20230623168754_add_repo_to_release.sql @@ -0,0 +1,6 @@ +alter table releases + add repository text default null; +alter table releases + add constraint repository + foreign key(repository) + references package_indexes(repository); diff --git a/src/core/Flora/Import/Package.hs b/src/core/Flora/Import/Package.hs index e266f6a5..7ca4a0ff 100644 --- a/src/core/Flora/Import/Package.hs +++ b/src/core/Flora/Import/Package.hs @@ -59,7 +59,6 @@ import Effectful.PostgreSQL.Transact.Effect (DB, getPool, runDB) import Effectful.Reader.Static (Reader, ask) import Effectful.Time (Time, UTCTime) import Effectful.Time qualified as Time -import GHC.Stack (HasCallStack) import Log qualified import OddJobs.Job (createJob) import Optics.Core @@ -169,7 +168,7 @@ importFile importFile userId path = withWorkerDbPool $ \wq -> loadFile path - >>= uncurry (extractPackageDataFromCabal userId) + >>= uncurry (extractPackageDataFromCabal userId Nothing) >>= persistImportOutput wq enqueueImportJob :: (DB :> es, IOE :> es) => ImportOutput -> Eff es () @@ -208,11 +207,11 @@ loadFile path = do descr <- loadContent path content pure (timestamp, descr) -loadContent :: (IOE :> es, Log :> es) => String -> BS.ByteString -> Eff es GenericPackageDescription +loadContent :: Log :> es => String -> BS.ByteString -> Eff es GenericPackageDescription loadContent = parseString parseGenericPackageDescription parseString - :: (HasCallStack, Log :> es) + :: Log :> es => (BS.ByteString -> ParseResult a) -- ^ File contents to final value parser -> String @@ -227,8 +226,10 @@ parseString parser name bs = do Log.logAttention_ (display $! show err) throw $! CabalFileCouldNotBeParsed name -loadAndExtractCabalFile :: (DB :> es, IOE :> es, Log :> es, Time :> es) => UserId -> FilePath -> Eff es ImportOutput -loadAndExtractCabalFile userId filePath = loadFile filePath >>= uncurry (extractPackageDataFromCabal userId) +loadAndExtractCabalFile :: (IOE :> es, Log :> es, Time :> es) => UserId -> FilePath -> Eff es ImportOutput +loadAndExtractCabalFile userId filePath = + loadFile filePath + >>= uncurry (extractPackageDataFromCabal userId Nothing) -- | Persists an 'ImportOutput' to the database. An 'ImportOutput' can be obtained -- by extracting relevant information from a Cabal file using 'extractPackageDataFromCabal' @@ -273,8 +274,8 @@ withWorkerDbPool f = do -- | Transforms a 'GenericPackageDescription' from Cabal into an 'ImportOutput' -- that can later be inserted into the database. This function produces stable, deterministic ids, -- so it should be possible to extract and insert a single package many times in a row. -extractPackageDataFromCabal :: (IOE :> es, Time :> es) => UserId -> UTCTime -> GenericPackageDescription -> Eff es ImportOutput -extractPackageDataFromCabal userId uploadTime genericDesc = do +extractPackageDataFromCabal :: (IOE :> es, Time :> es) => UserId -> Maybe Text -> UTCTime -> GenericPackageDescription -> Eff es ImportOutput +extractPackageDataFromCabal userId repository uploadTime genericDesc = do let packageDesc = genericDesc.packageDescription let flags = Vector.fromList genericDesc.genPackageFlags let packageName = force $! packageDesc ^. #package % #pkgName % to unPackageName % to pack % to PackageName @@ -328,6 +329,7 @@ extractPackageDataFromCabal userId uploadTime genericDesc = do , readmeStatus = NotImported , changelog = Nothing , changelogStatus = NotImported + , repository } let lib = extractLibrary package release Nothing [] <$> allLibraries packageDesc diff --git a/src/core/Flora/Import/Package/Bulk.hs b/src/core/Flora/Import/Package/Bulk.hs index 31ee5498..8fb66feb 100644 --- a/src/core/Flora/Import/Package/Bulk.hs +++ b/src/core/Flora/Import/Package/Bulk.hs @@ -4,13 +4,14 @@ module Flora.Import.Package.Bulk (importAllFilesInDirectory, importAllFilesInRelativeDirectory, importFromIndex) where import Codec.Archive.Tar qualified as Tar -import Codec.Archive.Tar.Entry qualified as Tar import Codec.Compression.GZip qualified as GZip -import Control.Monad (when, (>=>)) +import Control.Monad (join, when, (>=>)) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BL import Data.Function ((&)) import Data.List (isSuffixOf) +import Data.Maybe (fromMaybe, isNothing) +import Data.Text (Text) import Data.Text qualified as Text import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Effectful @@ -23,69 +24,116 @@ import Streamly.Data.Fold qualified as SFold import Streamly.Prelude qualified as S import System.Directory qualified as System import System.FilePath +import UnliftIO.Exception (finally) +import Codec.Archive.Tar.Entry qualified as Tar import Flora.Environment.Config (PoolConfig (..)) import Flora.Import.Package (enqueueImportJob, extractPackageDataFromCabal, loadContent, persistImportOutput, withWorkerDbPool) import Flora.Model.Package.Update qualified as Update +import Flora.Model.PackageIndex (getPackageIndexTimestamp, updatePackageIndexTimestamp) +import Flora.Model.Release.Query qualified as Query import Flora.Model.Release.Update qualified as Update import Flora.Model.User -- | Same as 'importAllFilesInDirectory' but accepts a relative path to the current working directory -importAllFilesInRelativeDirectory :: (Reader PoolConfig :> es, DB :> es, IOE :> es) => Logger -> UserId -> FilePath -> Bool -> Eff es () -importAllFilesInRelativeDirectory appLogger user dir directImport = do +importAllFilesInRelativeDirectory + :: (Reader PoolConfig :> es, DB :> es, IOE :> es) + => Logger + -> UserId + -> Maybe Text + -> FilePath + -> Bool + -> Eff es () +importAllFilesInRelativeDirectory appLogger user repository dir directImport = do workdir <- ( dir) <$> liftIO System.getCurrentDirectory - importAllFilesInDirectory appLogger user workdir directImport + importAllFilesInDirectory appLogger user repository workdir directImport -importFromIndex :: (Reader PoolConfig :> es, DB :> es, IOE :> es) => Logger -> UserId -> FilePath -> Bool -> Eff es () -importFromIndex appLogger user index directImport = do +importFromIndex + :: (Reader PoolConfig :> es, DB :> es, IOE :> es) + => Logger + -> UserId + -> Maybe Text + -> FilePath + -> Bool + -> Eff es () +importFromIndex appLogger user repository index directImport = do entries <- Tar.read . GZip.decompress <$> liftIO (BL.readFile index) - case Tar.foldlEntries buildContentStream S.nil entries of - Right stream -> importFromStream appLogger user directImport stream + time <- fromMaybe (posixSecondsToUTCTime 0) . join <$> traverse getPackageIndexTimestamp repository + case Tar.foldlEntries (buildContentStream time) S.nil entries of + Right stream -> importFromStream appLogger user repository directImport stream Left (err, _) -> Log.runLog "flora-cli" appLogger defaultLogLevel $ Log.logAttention_ $ "Failed to get files from index: " <> Text.pack (show err) where - buildContentStream acc entry = + buildContentStream time acc entry = let entryPath = Tar.entryPath entry entryTime = posixSecondsToUTCTime . fromIntegral $ Tar.entryTime entry in Tar.entryContent entry & \case Tar.NormalFile bs _ - | ".cabal" `isSuffixOf` entryPath -> + | ".cabal" `isSuffixOf` entryPath && entryTime > time -> (entryPath, entryTime, BL.toStrict bs) `S.cons` acc _ -> acc -- | Finds all cabal files in the specified directory, and inserts them into the database after extracting the relevant data -importAllFilesInDirectory :: (Reader PoolConfig :> es, DB :> es, IOE :> es) => Logger -> UserId -> FilePath -> Bool -> Eff es () -importAllFilesInDirectory appLogger user dir directImport = do +importAllFilesInDirectory + :: (Reader PoolConfig :> es, DB :> es, IOE :> es) + => Logger + -> UserId + -> Maybe Text + -> FilePath + -> Bool + -> Eff es () +importAllFilesInDirectory appLogger user repository dir directImport = do liftIO $! System.createDirectoryIfMissing True dir liftIO . putStrLn $! "🔎 Searching cabal files in " <> dir - importFromStream appLogger user directImport $ findAllCabalFilesInDirectory dir + importFromStream appLogger user repository directImport $ findAllCabalFilesInDirectory dir importFromStream :: (Reader PoolConfig :> es, DB :> es, IOE :> es) => Logger -> UserId + -> Maybe Text -> Bool -> S.AsyncT IO (String, UTCTime, BS.ByteString) -> Eff es () -importFromStream appLogger user directImport stream = do +importFromStream appLogger user repository directImport stream = do pool <- getPool poolConfig <- ask @PoolConfig - let displayCount = - flip SFold.foldlM' (return 0) $ - \previousCount _ -> - let currentCount = previousCount + 1 - in do - when (currentCount `mod` 400 == 0) $ - displayStats currentCount - return currentCount + -- create a packageindex if it doesn't exist + maybe (pure ()) createPkgIdx repository processedPackageCount <- - withWorkerDbPool $ \wq -> - liftIO $! S.fold displayCount $! S.fromAsync $! S.mapM (processFile wq pool poolConfig) $! stream + finally + ( withWorkerDbPool $ \wq -> + liftIO $! + S.fold displayCount $! + S.fromAsync $! + S.mapM (processFile wq pool poolConfig) $! + stream + ) + -- We want to refresh db and update latest timestamp even if we fell + -- over at some point + ( Update.refreshLatestVersions + >> Update.refreshDependents + >> maybe (pure ()) updatePkgIdxTimestamp repository + ) displayStats processedPackageCount - Update.refreshLatestVersions >> Update.refreshDependents where + updatePkgIdxTimestamp repository = + Query.getLatestReleaseTime (Just repository) + >>= updatePackageIndexTimestamp repository + createPkgIdx repo = do + pkgIndexTz <- getPackageIndexTimestamp repo + when (isNothing pkgIndexTz) $ + updatePackageIndexTimestamp repo Nothing + displayCount = + flip SFold.foldlM' (return 0) $ + \previousCount _ -> + let currentCount = previousCount + 1 + in do + when (currentCount `mod` 400 == 0) $ + displayStats currentCount + return currentCount processFile wq pool poolConfig = runEff . runReader poolConfig @@ -94,7 +142,7 @@ importFromStream appLogger user directImport stream = do . Log.runLog "flora-jobs" appLogger defaultLogLevel . ( \(path, timestamp, content) -> loadContent path content - >>= ( extractPackageDataFromCabal user timestamp + >>= ( extractPackageDataFromCabal user repository timestamp >=> \importedPackage -> if directImport then persistImportOutput wq importedPackage diff --git a/src/core/Flora/Model/Package/Query.hs b/src/core/Flora/Model/Package/Query.hs index c1bb656d..fdfb8b14 100644 --- a/src/core/Flora/Model/Package/Query.hs +++ b/src/core/Flora/Model/Package/Query.hs @@ -168,7 +168,7 @@ packageDependentsWithLatestVersionQuery = FROM "packages" AS p INNER JOIN "dependents" AS dep ON p."package_id" = dep."dependent_id" - INNER JOIN "releases" AS r + INNER JOIN "releases" AS r ON r."package_id" = p."package_id" WHERE dep."namespace" = ? AND dep."name" = ? diff --git a/src/core/Flora/Model/PackageIndex.hs b/src/core/Flora/Model/PackageIndex.hs new file mode 100644 index 00000000..077a5ade --- /dev/null +++ b/src/core/Flora/Model/PackageIndex.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE QuasiQuotes #-} + +module Flora.Model.PackageIndex where + +import GHC.Generics + +import Control.DeepSeq (NFData) +import Control.Monad (void) +import Data.Text (Text) +import Data.Text.Display +import Data.Time (UTCTime) +import Data.UUID +import Data.UUID.V4 qualified as UUID +import Database.PostgreSQL.Entity (insert, selectOneByField, update) +import Database.PostgreSQL.Entity.Types +import Database.PostgreSQL.Simple (Only (..)) +import Database.PostgreSQL.Simple.FromField (FromField (..)) +import Database.PostgreSQL.Simple.FromRow (FromRow (..)) +import Database.PostgreSQL.Simple.ToField (ToField (..)) +import Database.PostgreSQL.Simple.ToRow (ToRow (..)) +import Effectful +import Effectful.PostgreSQL.Transact.Effect (DB, dbtToEff) + +newtype PackageIndexId = PackageIndexId {getPackageIndexId :: UUID} + deriving stock (Generic) + deriving newtype (NFData) + deriving (Eq, Ord, Show, FromField, ToField) via UUID + deriving (Display) via ShowInstance UUID + +data PackageIndex = PackageIndex + { packageIndexId :: PackageIndexId + , repository :: Text + , timestamp :: Maybe UTCTime + } + deriving stock (Eq, Show, Generic) + deriving anyclass (FromRow, ToRow, NFData) + deriving + (Entity) + via (GenericEntity '[TableName "package_indexes"] PackageIndex) + +mkPackageIndex :: IOE :> es => Text -> Maybe UTCTime -> Eff es PackageIndex +mkPackageIndex repository timestamp = do + packageIndexId <- PackageIndexId <$> liftIO UUID.nextRandom + pure $ PackageIndex{..} + +getPackageIndexTimestamp :: DB :> es => Text -> Eff es (Maybe UTCTime) +getPackageIndexTimestamp repository = do + res :: Maybe PackageIndex <- dbtToEff $! selectOneByField [field| repository |] (Only repository) + pure $ res >>= timestamp + +updatePackageIndexTimestamp :: (IOE :> es, DB :> es) => Text -> Maybe UTCTime -> Eff es () +updatePackageIndexTimestamp repository timestamp = do + packageIndex <- mkPackageIndex repository timestamp + void $! + dbtToEff $! + selectOneByField @PackageIndex [field| repository |] (Only repository) + >>= maybe + (insert @PackageIndex packageIndex) + (\pkgIx -> update @PackageIndex pkgIx{timestamp}) diff --git a/src/core/Flora/Model/Release/Query.hs b/src/core/Flora/Model/Release/Query.hs index 30a40917..1db24166 100644 --- a/src/core/Flora/Model/Release/Query.hs +++ b/src/core/Flora/Model/Release/Query.hs @@ -9,6 +9,7 @@ module Flora.Model.Release.Query , getPackageReleasesWithoutChangelog , getPackageReleasesWithoutUploadTimestamp , getAllReleases + , getLatestReleaseTime , getNumberOfReleases , getReleaseComponents , getPackagesWithoutReleaseDeprecationInformation @@ -16,11 +17,13 @@ module Flora.Model.Release.Query ) where +import Data.Text (Text) +import Data.Time (UTCTime) import Data.Vector (Vector) import Data.Vector qualified as Vector import Data.Vector.Algorithms.Intro as MVector import Database.PostgreSQL.Entity -import Database.PostgreSQL.Entity.DBT (QueryNature (..), query, queryOne, query_) +import Database.PostgreSQL.Entity.DBT (QueryNature (..), query, queryOne, queryOne_, query_) import Database.PostgreSQL.Entity.Types (field) import Database.PostgreSQL.Simple (In (..), Only (..), Query) import Database.PostgreSQL.Simple.SqlQQ (sql) @@ -42,6 +45,13 @@ getReleases pid = then pure results else pure $! Vector.take 6 $! Vector.reverse $! Vector.modify MVector.sort results +getLatestReleaseTime :: DB :> es => Maybe Text -> Eff es (Maybe UTCTime) +getLatestReleaseTime repo = + dbtToEff $! fmap fromOnly <$> maybe (queryOne_ Select q') (queryOne Select q . Only) repo + where + q = [sql| select max(r0.uploaded_at) from releases as r0 where r0.repository = ? |] + q' = [sql| select max(uploaded_at) from releases |] + getAllReleases :: DB :> es => PackageId -> Eff es (Vector Release) getAllReleases pid = dbtToEff $! do @@ -58,7 +68,7 @@ getVersionFromManyReleaseIds releaseIds = do dbtToEff $! query Select q (Only (In (Vector.toList releaseIds))) where q = - [sql| + [sql| select r0.release_id, r0.version from releases as r0 where r0.release_id in ? @@ -136,8 +146,8 @@ getPackagesWithoutReleaseDeprecationInformation = dbtToEff $! query_ Select q where q = - [sql| - select p1.name, array_agg(r0.release_id) + [sql| + select p1.name, array_agg(r0.release_id) from releases as r0 join packages as p1 on r0.package_id = p1.package_id where r0.metadata ->> 'deprecated' is null diff --git a/src/core/Flora/Model/Release/Types.hs b/src/core/Flora/Model/Release/Types.hs index f0f7afd6..b5784e3a 100644 --- a/src/core/Flora/Model/Release/Types.hs +++ b/src/core/Flora/Model/Release/Types.hs @@ -94,6 +94,8 @@ data Release = Release , changelog :: Maybe TextHtml -- ^ Content of the release's Changelog , changelogStatus :: ImportStatus + -- ^ Repo - where this package has been imported from + , repository :: Maybe Text } deriving stock (Eq, Show, Generic) deriving anyclass (FromRow, ToRow, NFData, FromJSON, ToJSON) diff --git a/test/Flora/ImportSpec.hs b/test/Flora/ImportSpec.hs new file mode 100644 index 00000000..728d8942 --- /dev/null +++ b/test/Flora/ImportSpec.hs @@ -0,0 +1,45 @@ +module Flora.ImportSpec where + +import Data.Foldable (traverse_) +import Data.Maybe (catMaybes) +import Data.Time.Format.ISO8601 +import Log.Backend.StandardOutput (withStdOutLogger) +import Optics.Core + +import Flora.Import.Package.Bulk +import Flora.Model.Package.Query qualified as Query +import Flora.Model.Package.Types +import Flora.Model.PackageIndex +import Flora.Model.Release.Query qualified as Query +import Flora.Model.Release.Types +import Flora.Model.User +import Flora.TestUtils + +spec :: Fixtures -> TestEff TestTree +spec fixtures = + testThese + "import tests" + [ testThis "Import index" $ testImportIndex fixtures + ] + +testImportIndex :: Fixtures -> TestEff () +testImportIndex fixture = withStdOutLogger $ + \logger -> do + let testIndex = "./test/fixtures/test-index.tar.gz" + defaultRepo = "hackage.haskell.org" + importFromIndex + logger + (fixture ^. #hackageUser % #userId) + (Just defaultRepo) + testIndex + True + -- Check the expected timestamp + timestamp <- getPackageIndexTimestamp defaultRepo + expectedTimestamp <- iso8601ParseM "2010-01-01T00:00:00Z" + assertEqual (Just expectedTimestamp) timestamp + -- check the packages have been imported + tars <- traverse (Query.getPackageByNamespaceAndName (Namespace "hackage") . PackageName) ["tar-a", "tar-b"] + releases <- fmap mconcat . traverse (\x -> Query.getReleases (x ^. #packageId)) $ catMaybes tars + assertEqual (length tars) 2 + assertEqual (length releases) 2 + traverse_ (\x -> assertEqual (x ^. #repository) (Just "hackage.haskell.org")) releases diff --git a/test/Flora/TestUtils.hs b/test/Flora/TestUtils.hs index f0eb6cf9..3b9d74e7 100644 --- a/test/Flora/TestUtils.hs +++ b/test/Flora/TestUtils.hs @@ -63,9 +63,10 @@ import Data.Time (UTCTime (UTCTime), fromGregorian, secondsToDiffTime) import Data.UUID (UUID) import Data.UUID qualified as UUID import Data.Word -import Database.PostgreSQL.Entity.DBT () +import Database.PostgreSQL.Entity.DBT (QueryNature (Update), execute) import Database.PostgreSQL.Simple (Connection, SqlError (..), close) import Database.PostgreSQL.Simple.Migration +import Database.PostgreSQL.Simple.SqlQQ (sql) import Database.PostgreSQL.Transact () import Effectful import Effectful.Log qualified as Log @@ -95,7 +96,7 @@ import Effectful.Log (Log, Logger) import Flora.Environment import Flora.Environment.Config (LoggingDestination (..), PoolConfig (..)) import Flora.Import.Categories (importCategories) -import Flora.Import.Package.Bulk (importAllFilesInRelativeDirectory) +import Flora.Import.Package.Bulk (importAllFilesInRelativeDirectory, importFromIndex) import Flora.Logging qualified as Logging import Flora.Model.User import Flora.Model.User.Query qualified as Query @@ -122,6 +123,7 @@ importAllPackages fixtures = Log.withStdOutLogger $ \appLogger -> do importAllFilesInRelativeDirectory appLogger (fixtures ^. #hackageUser % #userId) + Nothing "./test/fixtures/Cabal/" True diff --git a/test/Main.hs b/test/Main.hs index 30260059..ea51e07c 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -14,6 +14,8 @@ import Effectful.Reader.Static (runReader) import Flora.CabalSpec qualified as CabalSpec import Flora.CategorySpec qualified as CategorySpec import Flora.Environment + +import Flora.ImportSpec qualified as ImportSpec import Flora.OddJobSpec qualified as OddJobSpec import Flora.PackageSpec qualified as PackageSpec import Flora.TemplateSpec qualified as TemplateSpec @@ -45,4 +47,5 @@ specs fixtures = , CategorySpec.spec , TemplateSpec.spec , CabalSpec.spec + , ImportSpec.spec fixtures ] diff --git a/test/fixtures/Tarball/tar-a.cabal b/test/fixtures/Tarball/tar-a.cabal new file mode 100644 index 00000000..3b141c4e --- /dev/null +++ b/test/fixtures/Tarball/tar-a.cabal @@ -0,0 +1,35 @@ +cabal-version: 3.0 +-- Initial a.cabal generated by cabal init. For further documentation, see +-- http://haskell.org/cabal/users-guide/ + +name: tar-a +version: 0.1.0.0 +-- synopsis: +-- description: +-- license: +author: Francesco Gazzetta +--maintainer: +-- copyright: +-- category: +build-type: Simple +extra-source-files: ChangeLog.md + +executable e + Main-is: A.hs + default-language: Haskell2010 + build-depends: base >=4 && <5 + , b:{ sublib + , anothersublib + -- You can include sublibraries from hackage, like + --, cabal-plan:{topograph} + } + +library + exposed-modules: A1 + -- other-modules: + -- other-extensions: + build-depends: base >=4 && <5 + , b:{ sublib + , anothersublib } + -- hs-source-dirs: + default-language: Haskell2010 diff --git a/test/fixtures/Tarball/tar-b.cabal b/test/fixtures/Tarball/tar-b.cabal new file mode 100644 index 00000000..484f4da5 --- /dev/null +++ b/test/fixtures/Tarball/tar-b.cabal @@ -0,0 +1,40 @@ +cabal-version: 3.0 +-- Initial b.cabal generated by cabal init. For further documentation, see +-- http://haskell.org/cabal/users-guide/ + +name: tar-b +version: 0.1.0.0 +-- synopsis: +-- description: +-- license: +author: Francesco Gazzetta +--maintainer: +-- copyright: +-- category: +build-type: Simple +extra-source-files: ChangeLog.md + +library + exposed-modules: BTop + -- other-modules: + -- other-extensions: + build-depends: base >=4 && <5 + --, sublib + -- hs-source-dirs: + default-language: Haskell2010 + +library sublib + visibility: public + exposed-modules: BSub + -- other-modules: + -- other-extensions: + build-depends: base >=4 && <5 + -- hs-source-dirs: + default-language: Haskell2010 +library anothersublib + visibility: public + -- other-modules: + -- other-extensions: + build-depends: base >=4 && <5 + -- hs-source-dirs: + default-language: Haskell2010 diff --git a/test/fixtures/test-index.tar.gz b/test/fixtures/test-index.tar.gz new file mode 100644 index 00000000..606a8fe0 Binary files /dev/null and b/test/fixtures/test-index.tar.gz differ