Require all packages to solve / compile and include all valid compilers in their metadata

SPEC.md

@@ -234,11 +234,12 @@ For example:
 
 All packages in the registry have an associated metadata file, which is located in the `metadata` directory of the `registry` repository under the package name. For example, the metadata for the `aff` package is located at: https://github.com/purescript/registry/blob/main/metadata/aff.json. Metadata files are the source of truth on all published and unpublished versions for a particular package for what there content is and where the package is located. Metadata files are produced by the registry, not by package authors, though they take some information from package manifests.
 
-Each published version of a package records three fields:
+Each published version of a package records four fields:
 
 - `hash`: a [`Sha256`](#Sha256) of the compressed archive fetched by the registry for the given version
 - `bytes`: the size of the tarball in bytes
 - `publishedTime`: the time the package was published as an `ISO8601` string
+- `compilers`: compiler versions this package is known to work with. This field can be in one of two states: a single version indicates that the package worked with a specific compiler on upload but has not yet been tested with all compilers, whereas a non-empty array of versions indicates the package has been tested with all compilers the registry supports.
 
 Each unpublished version of a package records three fields:
 

app/fixtures/registry/metadata/prelude.json

@@ -6,6 +6,7 @@
   "published": {
     "6.0.1": {
       "bytes": 31142,
+      "compilers": ["0.15.10", "0.15.12"],
       "hash": "sha256-o8p6SLYmVPqzXZhQFd2hGAWEwBoXl1swxLG/scpJ0V0=",
       "publishedTime": "2022-08-18T20:04:00.000Z",
       "ref": "v6.0.1"

app/fixtures/registry/metadata/type-equality.json

@@ -6,6 +6,7 @@
   "published": {
     "4.0.1": {
       "bytes": 2184,
+      "compilers": ["0.15.9", "0.15.10", "0.15.11"],
       "hash": "sha256-Hs9D6Y71zFi/b+qu5NSbuadUQXe5iv5iWx0226vOHUw=",
       "publishedTime": "2022-04-27T18:00:18.000Z",
       "ref": "v4.0.1"

app/src/App/CLI/Purs.purs

@@ -21,6 +21,22 @@ data CompilerFailure
   | MissingCompiler
 
 derive instance Eq CompilerFailure
+derive instance Ord CompilerFailure
+
+compilerFailureCodec :: JsonCodec CompilerFailure
+compilerFailureCodec = CA.codec' decode encode
+  where
+  decode :: Json -> Either JsonDecodeError CompilerFailure
+  decode json =
+    map CompilationError (CA.decode (CA.array compilerErrorCodec) json)
+      <|> map UnknownError (CA.decode CA.string json)
+      <|> map (const MissingCompiler) (CA.decode CA.null json)
+
+  encode :: CompilerFailure -> Json
+  encode = case _ of
+    CompilationError errors -> CA.encode (CA.array compilerErrorCodec) errors
+    UnknownError message -> CA.encode CA.string message
+    MissingCompiler -> CA.encode CA.null unit
 
 type CompilerError =
   { position :: SourcePosition

app/src/App/Effect/Cache.purs

@@ -168,7 +168,6 @@ handleMemoryFs env = case _ of
           case inFs of
             Nothing -> pure $ reply Nothing
             Just entry -> do
-              Log.debug $ "Fell back to on-disk entry for " <> memory
               putMemoryImpl env.ref unit (Key memory (Const entry))
               pure $ reply $ Just $ unCache entry
         Just cached ->
@@ -226,8 +225,7 @@ getMemoryImpl ref (Key id (Reply reply)) = do
   let (unCache :: CacheValue -> b) = unsafeCoerce
   cache <- Run.liftEffect $ Ref.read ref
   case Map.lookup id cache of
-    Nothing -> do
-      Log.debug $ "No cache entry found for " <> id <> " in memory."
+    Nothing ->
       pure $ reply Nothing
     Just cached -> do
       pure $ reply $ Just $ unCache cached
@@ -236,7 +234,6 @@ putMemoryImpl :: forall x r a. CacheRef -> a -> MemoryEncoding Const a x -> Run
 putMemoryImpl ref next (Key id (Const value)) = do
   let (toCache :: x -> CacheValue) = unsafeCoerce
   Run.liftEffect $ Ref.modify_ (Map.insert id (toCache value)) ref
-  Log.debug $ "Wrote cache entry for " <> id <> " in memory."
   pure next
 
 deleteMemoryImpl :: forall x r a. CacheRef -> MemoryEncoding Ignore a x -> Run (LOG + EFFECT + r) a
@@ -275,7 +272,6 @@ getFsImpl cacheDir = case _ of
     let path = Path.concat [ cacheDir, safePath id ]
     Run.liftAff (Aff.attempt (FS.Aff.readFile path)) >>= case _ of
       Left _ -> do
-        Log.debug $ "No cache found for " <> id <> " at path " <> path
         pure $ reply Nothing
       Right buf -> do
         pure $ reply $ Just buf
@@ -284,7 +280,6 @@ getFsImpl cacheDir = case _ of
     let path = Path.concat [ cacheDir, safePath id ]
     Run.liftAff (Aff.attempt (FS.Aff.readTextFile UTF8 path)) >>= case _ of
       Left _ -> do
-        Log.debug $ "No cache file found for " <> id <> " at path " <> path
         pure $ reply Nothing
       Right content -> case Argonaut.Parser.jsonParser content of
         Left parseError -> do
@@ -307,7 +302,6 @@ putFsImpl cacheDir next = case _ of
         Log.warn $ "Failed to write cache entry for " <> id <> " at path " <> path <> " as a buffer: " <> Aff.message fsError
         pure next
       Right _ -> do
-        Log.debug $ "Wrote cache entry for " <> id <> " as a buffer at path " <> path
         pure next
 
   AsJson id codec (Const value) -> do
@@ -317,7 +311,6 @@ putFsImpl cacheDir next = case _ of
         Log.warn $ "Failed to write cache entry for " <> id <> " at path " <> path <> " as JSON: " <> Aff.message fsError
         pure next
       Right _ -> do
-        Log.debug $ "Wrote cache entry for " <> id <> " at path " <> path <> " as JSON."
         pure next
 
 deleteFsImpl :: forall a b r. FilePath -> FsEncoding Ignore a b -> Run (LOG + AFF + r) a

app/src/App/Effect/Registry.purs

@@ -358,7 +358,7 @@ handle env = Cache.interpret _registryCache (Cache.handleMemory env.cacheRef) <<
 
         Just metadata -> do
           Log.debug $ "Successfully read metadata for " <> printedName <> " from path " <> path
-          Log.debug $ "Setting metadata cache to singleton entry (as cache was previosuly empty)."
+          Log.debug $ "Setting metadata cache to singleton entry (as cache was previously empty)."
           Cache.put _registryCache AllMetadata (Map.singleton name metadata)
           pure $ Just metadata
 

app/src/App/Effect/Source.purs

@@ -28,8 +28,15 @@ import Run as Run
 import Run.Except (EXCEPT)
 import Run.Except as Except
 
+-- | Packages can be published via the legacy importer or a user via the API. We
+-- | determine some information differently in these cases, such as the time the
+-- | package was published.
+data ImportType = Old | Recent
+
+derive instance Eq ImportType
+
 -- | An effect for fetching package sources
-data Source a = Fetch PackageSource FilePath Location String (Either String FetchedSource -> a)
+data Source a = Fetch FilePath Location String (Either String FetchedSource -> a)
 
 derive instance Functor Source
 
@@ -41,17 +48,17 @@ _source = Proxy
 type FetchedSource = { path :: FilePath, published :: DateTime }
 
 -- | Fetch the provided location to the provided destination path.
-fetch :: forall r. PackageSource -> FilePath -> Location -> String -> Run (SOURCE + EXCEPT String + r) FetchedSource
-fetch source destination location ref = Except.rethrow =<< Run.lift _source (Fetch source destination location ref identity)
+fetch :: forall r. FilePath -> Location -> String -> Run (SOURCE + EXCEPT String + r) FetchedSource
+fetch destination location ref = Except.rethrow =<< Run.lift _source (Fetch destination location ref identity)
 
 -- | Run the SOURCE effect given a handler.
 interpret :: forall r a. (Source ~> Run r) -> Run (SOURCE + r) a -> Run r a
 interpret handler = Run.interpret (Run.on _source handler Run.send)
 
 -- | Handle the SOURCE effect by downloading package source to the file system.
-handle :: forall r a. Source a -> Run (GITHUB + LOG + AFF + EFFECT + r) a
-handle = case _ of
-  Fetch source destination location ref reply -> map (map reply) Except.runExcept do
+handle :: forall r a. ImportType -> Source a -> Run (GITHUB + LOG + AFF + EFFECT + r) a
+handle importType = case _ of
+  Fetch destination location ref reply -> map (map reply) Except.runExcept do
     Log.info $ "Fetching " <> printJson Location.codec location
     case location of
       Git _ -> do
@@ -92,15 +99,15 @@ handle = case _ of
             Log.debug $ "Getting published time..."
 
             let
-              getRefTime = case source of
-                LegacyPackage -> do
+              getRefTime = case importType of
+                Old -> do
                   timestamp <- Except.rethrow =<< Run.liftAff (Git.gitCLI [ "log", "-1", "--date=iso8601-strict", "--format=%cd", ref ] (Just repoDir))
                   jsDate <- Run.liftEffect $ JSDate.parse timestamp
                   dateTime <- case JSDate.toDateTime jsDate of
                     Nothing -> Except.throw $ "Could not parse timestamp of git ref to a datetime given timestamp " <> timestamp <> " and parsed js date " <> JSDate.toUTCString jsDate
                     Just parsed -> pure parsed
                   pure dateTime
-                CurrentPackage ->
+                Recent ->
                   Run.liftEffect Now.nowDateTime
 
             -- Cloning will result in the `repo` name as the directory name

app/src/App/GitHubIssue.purs

@@ -57,7 +57,7 @@ main = launchAff_ $ do
 
         Right packageOperation -> case packageOperation of
           Publish payload ->
-            API.publish CurrentPackage payload
+            API.publish payload
           Authenticated payload -> do
             -- If we receive an authenticated operation via GitHub, then we
             -- re-sign it with pacchettibotti credentials if and only if the
@@ -97,7 +97,7 @@ main = launchAff_ $ do
       # Registry.interpret (Registry.handle registryEnv)
       # Storage.interpret (Storage.handleS3 { s3: env.spacesConfig, cache })
       # Pursuit.interpret (Pursuit.handleAff env.token)
-      # Source.interpret Source.handle
+      # Source.interpret (Source.handle Source.Recent)
       # GitHub.interpret (GitHub.handle { octokit: env.octokit, cache, ref: githubCacheRef })
       -- Caching & logging
       # Cache.interpret Legacy.Manifest._legacyCache (Cache.handleMemoryFs { cache, ref: legacyCacheRef })

app/src/App/Prelude.purs

@@ -1,6 +1,5 @@
 module Registry.App.Prelude
   ( LogVerbosity(..)
-  , PackageSource(..)
   , PursPublishMethod(..)
   , Retry
   , RetryResult(..)
@@ -22,7 +21,6 @@ module Registry.App.Prelude
   , parseJson
   , partitionEithers
   , printJson
-  , printPackageSource
   , pursPublishMethod
   , readJsonFile
   , scratchDir
@@ -241,15 +239,3 @@ data PursPublishMethod = LegacyPursPublish | PursPublish
 -- | The current purs publish method
 pursPublishMethod :: PursPublishMethod
 pursPublishMethod = LegacyPursPublish
-
--- | Operations can be exercised for old, pre-registry packages, or for packages
--- | which are on the 0.15 compiler series. If a true legacy package is uploaded
--- | then we do not require compilation to succeed and we don't publish docs.
-data PackageSource = LegacyPackage | CurrentPackage
-
-derive instance Eq PackageSource
-
-printPackageSource :: PackageSource -> String
-printPackageSource = case _ of
-  LegacyPackage -> "legacy"
-  CurrentPackage -> "current"

app/src/App/Server.purs

@@ -68,7 +68,7 @@ router env { route, method, body } = HTTPurple.usingCont case route, method of
     lift $ Log.info $ "Received Publish request: " <> printJson Operation.publishCodec publish
     forkPipelineJob publish.name publish.ref PublishJob \jobId -> do
       Log.info $ "Received Publish request, job id: " <> unwrap jobId
-      API.publish CurrentPackage publish
+      API.publish publish
 
   Unpublish, Post -> do
     auth <- HTTPurple.fromJson (jsonDecoder Operation.authenticatedCodec) body
@@ -292,7 +292,7 @@ runEffects env operation = Aff.attempt do
         )
     # Pursuit.interpret (Pursuit.handleAff env.vars.token)
     # Storage.interpret (Storage.handleS3 { s3: { key: env.vars.spacesKey, secret: env.vars.spacesSecret }, cache: env.cacheDir })
-    # Source.interpret Source.handle
+    # Source.interpret (Source.handle Source.Recent)
     # GitHub.interpret (GitHub.handle { octokit: env.octokit, cache: env.cacheDir, ref: env.githubCacheRef })
     # Cache.interpret _legacyCache (Cache.handleMemoryFs { cache: env.cacheDir, ref: env.legacyCacheRef })
     # Except.catch

app/test/App/API.purs

@@ -6,6 +6,7 @@ import Data.Array.NonEmpty as NonEmptyArray
 import Data.Foldable (traverse_)
 import Data.Map as Map
 import Data.Set as Set
+import Data.Set.NonEmpty as NonEmptySet
 import Data.String as String
 import Data.String.NonEmpty as NonEmptyString
 import Effect.Aff as Aff
@@ -68,10 +69,39 @@ spec = do
           Assert.shouldEqual version (Utils.unsafeVersion "1.0.0")
       FS.Extra.remove tmp
 
+  Spec.describe "Finds compatible compilers from dependencies" do
+    Spec.it "Finds intersect of single package" do
+      Assert.Run.runBaseEffects do
+        metadata <- Registry.readAllMetadataFromDisk $ Path.concat [ "app", "fixtures", "registry", "metadata" ]
+        let expected = map Utils.unsafeVersion [ "0.15.10", "0.15.12" ]
+        case API.compatibleCompilers metadata (Map.singleton (Utils.unsafePackageName "prelude") (Utils.unsafeVersion "6.0.1")) of
+          Nothing -> Except.throw $ "Got no compatible compilers, but expected " <> Utils.unsafeStringify (map Version.print expected)
+          Just set -> do
+            let actual = NonEmptySet.toUnfoldable set
+            unless (actual == expected) do
+              Except.throw $ "Expected " <> Utils.unsafeStringify (map Version.print expected) <> " but got " <> Utils.unsafeStringify (map Version.print actual)
+
+    Spec.it "Finds intersect of multiple packages" do
+      Assert.Run.runBaseEffects do
+        metadata <- Registry.readAllMetadataFromDisk $ Path.concat [ "app", "fixtures", "registry", "metadata" ]
+        let
+          expected = map Utils.unsafeVersion [ "0.15.10" ]
+          resolutions = Map.fromFoldable $ map (bimap Utils.unsafePackageName Utils.unsafeVersion)
+            [ Tuple "prelude" "6.0.1"
+            , Tuple "type-equality" "4.0.1"
+            ]
+        case API.compatibleCompilers metadata resolutions of
+          Nothing -> Except.throw $ "Got no compatible compilers, but expected " <> Utils.unsafeStringify (map Version.print expected)
+          Just set -> do
+            let actual = NonEmptySet.toUnfoldable set
+            unless (actual == expected) do
+              Except.throw $ "Expected " <> Utils.unsafeStringify (map Version.print expected) <> " but got " <> Utils.unsafeStringify (map Version.print actual)
+
   Spec.describe "API pipelines run correctly" $ Spec.around withCleanEnv do
     Spec.it "Publish a legacy-converted package with unused deps" \{ workdir, index, metadata, storageDir, githubDir } -> do
-      let testEnv = { workdir, index, metadata, username: "jon", storage: storageDir, github: githubDir }
-      Assert.Run.runTestEffects testEnv do
+      logs <- liftEffect (Ref.new [])
+      let testEnv = { workdir, logs, index, metadata, username: "jon", storage: storageDir, github: githubDir }
+      result <- Assert.Run.runTestEffects testEnv $ Except.runExcept do
         -- We'll publish [email protected] from the fixtures/github-packages
         -- directory, which has an unnecessary dependency on 'type-equality'
         -- inserted into it.
@@ -80,15 +110,15 @@ spec = do
           version = Utils.unsafeVersion "4.0.0"
           ref = "v4.0.0"
           publishArgs =
-            { compiler: Utils.unsafeVersion "0.15.9"
+            { compiler: Utils.unsafeVersion "0.15.10"
             , location: Just $ GitHub { owner: "purescript", repo: "purescript-effect", subdir: Nothing }
             , name
             , ref
             , resolutions: Nothing
             }
 
         -- First, we publish the package.
-        API.publish CurrentPackage publishArgs
+        API.publish publishArgs
 
         -- Then, we can check that it did make it to "Pursuit" as expected
         Pursuit.getPublishedVersions name >>= case _ of
@@ -117,12 +147,33 @@ spec = do
                 , printJson (Internal.Codec.packageMap Range.codec) manifest.dependencies
                 ]
 
+        -- We should verify the resulting metadata file is correct
+        Metadata effectMetadata <- Registry.readMetadata name >>= case _ of
+          Nothing -> Except.throw $ "Expected " <> PackageName.print name <> " to be in metadata."
+          Just m -> pure m
+
+        case Map.lookup version effectMetadata.published of
+          Nothing -> Except.throw $ "Expected " <> formatPackageVersion name version <> " to be in metadata."
+          Just published -> case published.compilers of
+            Left one -> Except.throw $ "Expected " <> formatPackageVersion name version <> " to have a compiler matrix but unfinished single version: " <> Version.print one
+            Right many -> do
+              let many' = NonEmptyArray.toArray many
+              let expected = map Utils.unsafeVersion [ "0.15.10", "0.15.12" ]
+              unless (many' == expected) do
+                Except.throw $ "Expected " <> formatPackageVersion name version <> " to have a compiler matrix of " <> Utils.unsafeStringify (map Version.print expected) <> " but got " <> Utils.unsafeStringify (map Version.print many')
+
         -- Finally, we can verify that publishing the package again should fail
         -- since it already exists.
-        Except.runExcept (API.publish CurrentPackage publishArgs) >>= case _ of
+        Except.runExcept (API.publish publishArgs) >>= case _ of
           Left _ -> pure unit
           Right _ -> Except.throw $ "Expected publishing " <> formatPackageVersion name version <> " twice to fail."
 
+      case result of
+        Left err -> do
+          recorded <- liftEffect (Ref.read logs)
+          Assert.fail $ "Expected to publish [email protected] but got error: " <> err <> "\n\nLogs:\n" <> String.joinWith "\n" (map (\(Tuple _ msg) -> msg) recorded)
+        Right _ -> pure unit
+
   where
   withCleanEnv :: (PipelineEnv -> Aff Unit) -> Aff Unit
   withCleanEnv action = do
@@ -184,7 +235,7 @@ checkBuildPlanToResolutions = do
   Spec.it "buildPlanToResolutions produces expected resolutions file format" do
     Assert.shouldEqual generatedResolutions expectedResolutions
   where
-  dependenciesDir = "testDir"
+  installedResolutions = "testDir"
 
   resolutions = Map.fromFoldable
     [ Tuple (Utils.unsafePackageName "prelude") (Utils.unsafeVersion "1.0.0")
@@ -195,14 +246,14 @@ checkBuildPlanToResolutions = do
   generatedResolutions =
     API.formatPursuitResolutions
       { resolutions
-      , dependenciesDir
+      , installedResolutions
       }
 
   expectedResolutions = Map.fromFoldable do
     packageName /\ version <- (Map.toUnfoldable resolutions :: Array _)
     let
       bowerName = RawPackageName ("purescript-" <> PackageName.print packageName)
-      path = Path.concat [ dependenciesDir, PackageName.print packageName <> "-" <> Version.print version ]
+      path = Path.concat [ installedResolutions, PackageName.print packageName <> "-" <> Version.print version ]
     pure $ Tuple bowerName { path, version }
 
 removeIgnoredTarballFiles :: Spec.Spec Unit

app/test/App/Legacy/PackageSet.purs

@@ -2,6 +2,7 @@ module Test.Registry.App.Legacy.PackageSet (spec) where
 
 import Registry.App.Prelude
 
+import Data.Array.NonEmpty as NonEmptyArray
 import Data.DateTime (DateTime(..))
 import Data.Either as Either
 import Data.Map as Map
@@ -208,6 +209,7 @@ unsafeMetadataEntry (Tuple name version) = do
       { ref: LenientVersion.raw version
       , hash: unsafeFromRight $ Sha256.parse "sha256-gb24ZRec6mgR8TFBVR2eIh5vsMdhuL+zK9VKjWP74Cw="
       , bytes: 0.0
+      , compilers: Right (NonEmptyArray.singleton (Utils.unsafeVersion "0.15.2"))
       , publishedTime: DateTime (Utils.unsafeDate "2022-07-07") bottom
       }