Compute releases that are incompatible with base

src/core/Flora/Model/Job.hs

@@ -18,7 +18,7 @@ import Servant (ToHttpApiData)
 
 import Distribution.Orphans.Version ()
 import Flora.Import.Package.Types (ImportOutput)
-import Flora.Model.Package (PackageName (..))
+import Flora.Model.Package
 import Flora.Model.Release.Types (ReleaseId (..))
 
 newtype IntAesonVersion = MkIntAesonVersion {unIntAesonVersion :: Version}
@@ -87,6 +87,7 @@ data FloraOddJobs
   | FetchReleaseDeprecationList PackageName (Vector ReleaseId)
   | RefreshLatestVersions
   | RefreshIndex Text
+  | ComputeIncompatibleReleasesWith Namespace PackageName
   deriving stock (Generic)
 
 -- TODO: Upstream these two ToJSON instances

src/core/Flora/Model/Package/Query.hs

@@ -818,3 +818,22 @@
   FROM transitive_dependencies AS t3
   GROUP BY (t3.dependent_id, t3.dependent_namespace, t3.dependent_name)
 |]
+
+getDependentsOfPackage :: DB :> es => PackageId -> Vector (PackageId, Version, VersionRange)
+getDependentsOfPackage dependencyId = dbtToEff $ query getDependentsOfPackageQuery (Only dependencyId)
+
+getDependentsOfPackageQuery :: SQL
+getDependentsOfPackageQuery =
+  [sql|
+SELECT lv.package_id
+     , r1.version
+     , r3.requirement
+FROM latest_versions AS lv
+     INNER JOIN releases AS r1 ON r1.package_id = lv.package_id
+                              AND r1.version = lv.version
+     INNER JOIN package_components AS p2 ON p2.release_id = r1.release_id
+     INNER JOIN requirements AS r3 ON r3.package_component_id = p2.package_component_id
+WHERE r3.package_id = ?
+  AND r3.requirement <> '>=0'
+GROUP BY lv.name, r1.version, r3.requirement
+  |]

src/jobs-worker/FloraJobs/Runner.hs

@@ -14,7 +14,7 @@ import Data.Vector (Vector)
 import Data.Vector qualified as Vector
 import Database.PostgreSQL.Simple qualified as PG
 import Distribution.Types.Version (Version)
-import Effectful (IOE, Limit (..), Persistence (..), UnliftStrategy (..), runEff, withUnliftStrategy, type (:>))
+import Effectful
 import Effectful.Concurrent (Concurrent)
 import Effectful.Error.Static (Error)
 import Effectful.FileSystem (FileSystem)
@@ -58,10 +58,6 @@ import Flora.Monad
 import FloraJobs.Render (renderMarkdown)
 import FloraJobs.Scheduler (scheduleRefreshIndex)
 import FloraJobs.ThirdParties.Hackage.API
-  ( HackagePackageInfo (..)
-  , HackagePreferredVersions (..)
-  , VersionedPackage (..)
-  )
 import FloraJobs.ThirdParties.Hackage.Client qualified as Hackage
 import FloraJobs.Types
 
@@ -79,6 +75,7 @@ runner job = localDomain "job-runner" $
       FetchReleaseDeprecationList packageName releases -> fetchReleaseDeprecationList packageName releases
       RefreshLatestVersions -> Update.refreshLatestVersions
       RefreshIndex indexName -> refreshIndex indexName
+      ComputeIncompatibleReleasesWith namespace packageName -> computeIncompatibleReleasesWith namespace packageName
 
 makeConfig
   :: RequireCallStack
@@ -289,6 +286,7 @@ refreshIndex indexName = do
       Import.importFromArchive indexName indexDependencies packagesPath
       pool <- getPool
       void $ liftIO $ scheduleRefreshIndex pool indexName
+      void $ liftIO $ scheduleIncompatibleReleaseJob pool (Namespae "hackage") (PackageName "base")
 
 getCabalPackagesDirectory :: FileSystem :> es => FloraM es FilePath
 getCabalPackagesDirectory = do
@@ -300,3 +298,31 @@ getCabalPackagesDirectory = do
       homeDir <- FileSystem.getHomeDirectory
       let legacyPackagesDirectory = homeDir </> ".cabal/packages"
       pure legacyPackagesDirectory
+
+computeIncompatibleReleasesWith
+  :: ( Concurrent :> es
+     , DB :> es
+     , Error ImportError :> es
+     , FileSystem :> es
+     , IOE :> es
+     , Log :> es
+     , Metrics AppMetrics :> es
+     , Reader FloraEnv :> es
+     , Time :> es
+     )
+  => Namespace
+  -> PackageName
+  -> FloraM es ()
+computeIncompatibleReleasesWith namespace packageName = do
+  package <- guardThatPackageExists namespace packageName
+  latestRelease <- Query.getLatestPackageRelease package.packageId
+  dependents <- Query.getDependentsOfPackage package.packageId
+  forM_ dependents $ \(packageId, dependentVersion, dependentRequirement) -> do
+    if latestRelease.version `withinRange` dependentRequirement
+      then pure ()
+      else do
+        Log.logInfo "Incompatible release" $
+          object
+            [ "incompatible_dependent" .= display package.namespace <> "/" <> display package.packageName
+            , "package" .= display namespace <> "/" <> display packageName
+            ]

src/jobs-worker/FloraJobs/Scheduler.hs

@@ -10,6 +10,7 @@ module FloraJobs.Scheduler
   , scheduleReleaseDeprecationListJob
   , scheduleRefreshLatestVersions
   , scheduleRefreshIndex
+  , scheduleIncompatibleReleaseJob
   , checkIfIndexRefreshJobIsPlanned
   , jobTableName
   --   prefer using smart constructors.
@@ -86,6 +87,10 @@ scheduleRefreshIndex pool indexName = withResource pool $ \conn -> do
   now <- Time.getCurrentTime
   scheduleJob conn jobTableName (RefreshIndex indexName) (Time.addUTCTime Time.nominalDay now)
 
+scheduleIncompatibleReleaseJob :: Pool PG.Connection -> Namespace -> PackageName -> IO Job
+scheduleIncompatibleReleaseJob pool namespace packageName =
+  createJobWithResource pool (ComputeIncompatibleReleasesWith namespace packageName)
+
 createJobWithResource :: ToJSON p => Pool PG.Connection -> p -> IO Job
 createJobWithResource pool job =
   withResource pool $ \conn -> createJob conn jobTableName job