Reject deprecated SPDX licenses, but be lenient with committed LICENSE files (#754)

Author: thomashoneyman

SPEC.md

@@ -361,7 +361,7 @@ Alternately, this can be written without an id:
 **[Source](./lib/src/Registry/License.purs)**
 **[Spec](./types/v1/License.dhall)**
 
-All packages in the registry must have a license that grants permission for redistribution of the source code. Concretely, the registry requires that all packages use an SPDX license and specify an [SPDX license identifier](https://spdx.dev/ids/). `AND` and `OR` conjunctions are allowed, and licenses can contain exceptions using the `WITH` preposition. The SPDX specification describes [how licenses can be combined and exceptions applied](https://spdx.dev/ids#how).
+All packages in the registry must have a license that grants permission for redistribution of the source code. Concretely, the registry requires that all packages use an SPDX license and specify an [SPDX license identifier](https://spdx.dev/ids/). `AND` and `OR` conjunctions are allowed, and licenses can contain exceptions using the `WITH` preposition. The SPDX specification describes [how licenses can be combined and exceptions applied](https://spdx.dev/ids#how). Newly submitted manifests must use current canonical SPDX identifiers, but registry readers should remain backward-compatible with historical stored manifests that still use deprecated SPDX spellings.
 
 A `License` is represented as a string, which must be a valid SPDX identifier. For example:
 

app/fixtures/licenses/ambiguous-gfdl/package.json

@@ -0,0 +1,5 @@
+{
+  "name": "ambiguous-gfdl-fixture",
+  "version": "1.0.0",
+  "license": "GFDL-1.3"
+}

app/fixtures/licenses/deprecated-agpl/package.json

@@ -0,0 +1,5 @@
+{
+  "name": "deprecated-agpl-fixture",
+  "version": "1.0.0",
+  "license": "AGPL-3.0"
+}

app/src/App/API.purs

@@ -129,6 +129,20 @@ derive instance Eq ManifestOrigin
 -- | A parsed manifest along with which format it originated from.
 type ParsedManifest = { manifest :: Manifest, origin :: ManifestOrigin }
 
+type ManifestLicenseField = { license :: String }
+
+manifestLicenseFieldCodec :: CJ.Codec ManifestLicenseField
+manifestLicenseFieldCodec = CJ.named "ManifestLicenseField" $ CJ.Record.object
+  { license: CJ.string
+  }
+
+validateCanonicalManifestLicense :: String -> Either String Unit
+validateCanonicalManifestLicense input = do
+  { license } <- case parseJson manifestLicenseFieldCodec input of
+    Left err -> Left $ CJ.DecodeError.print err
+    Right decoded -> Right decoded
+  void $ License.parseCanonical license
+
 -- | Effect row for package set updates. Authentication is done at the API
 -- | boundary, so we don't need GITHUB_EVENT_ENV effects here.
 type PackageSetUpdateEffects r = (REGISTRY + PACKAGE_SETS + LOG + EXCEPT String + r)
@@ -436,13 +450,17 @@ parseSourceManifest { packageDir, name, version, ref, location } = do
         Left error -> do
           Log.error $ "Manifest does not typecheck: " <> error
           Except.throw $ "Found a valid purs.json file in the package source, but it does not typecheck."
-        Right _ -> case parseJson Manifest.codec string of
+        Right _ -> case validateCanonicalManifestLicense string of
           Left err -> do
-            Log.error $ "Failed to parse manifest: " <> CJ.DecodeError.print err
-            Except.throw $ "Found a purs.json file in the package source, but it could not be decoded."
-          Right m -> do
-            Log.debug $ "Read a valid purs.json manifest from the package source:\n" <> stringifyJson Manifest.codec m
-            pure m
+            Log.error $ "Manifest license is not canonical: " <> err
+            Except.throw $ "Found a purs.json file in the package source, but its license field is not canonical."
+          Right _ -> case parseJson Manifest.codec string of
+            Left err -> do
+              Log.error $ "Failed to parse manifest: " <> CJ.DecodeError.print err
+              Except.throw $ "Found a purs.json file in the package source, but it could not be decoded."
+            Right m -> do
+              Log.debug $ "Read a valid purs.json manifest from the package source:\n" <> stringifyJson Manifest.codec m
+              pure m
 
     FromSpagoYaml -> do
       let spagoYamlPath = Path.concat [ packageDir, "spago.yaml" ]
@@ -1308,20 +1326,17 @@ instance FsEncodable PursGraphCache where
       Exists.mkExists $ Cache.AsJson cacheKey codec next
 
 -- | Errors that can occur when validating license consistency
-data LicenseValidationError = LicenseMismatch
-  { manifestLicense :: License
-  , detectedLicenses :: Array License
-  }
+data LicenseValidationError = LicenseMismatch { manifest :: License, detected :: Array License }
 
 derive instance Eq LicenseValidationError
 
 printLicenseValidationError :: LicenseValidationError -> String
 printLicenseValidationError = case _ of
-  LicenseMismatch { manifestLicense, detectedLicenses } -> Array.fold
+  LicenseMismatch licenses -> Array.fold
     [ "License mismatch: The manifest specifies license '"
-    , License.print manifestLicense
+    , License.print licenses.manifest
     , "' but the following license(s) were detected in your repository: "
-    , String.joinWith ", " (map License.print detectedLicenses)
+    , String.joinWith ", " (map License.print licenses.detected)
     , ". Please ensure your manifest license accurately represents all licenses "
     , "in your repository. If multiple licenses apply, join them using SPDX "
     , "conjunctions (e.g., 'MIT AND Apache-2.0' or 'MIT OR Apache-2.0')."
@@ -1344,44 +1359,40 @@ validateLicense packageDir manifestLicense = do
       pure Nothing
     Right detectedStrings -> do
       let
+        -- Best effort: keep detected licenses that parse, which canonicalizes
+        -- deprecated IDs when possible and preserves recognized ambiguous
+        -- deprecated IDs for validation.
         parsedLicenses :: Array License
-        parsedLicenses = Array.mapMaybe (hush <<< License.parse) detectedStrings
+        parsedLicenses =
+          detectedStrings # Array.mapMaybe (hush <<< License.parse)
 
       Log.debug $ "Detected licenses: " <> String.joinWith ", " detectedStrings
 
       if Array.null parsedLicenses then do
         Log.debug "No licenses detected from repository files, nothing to validate."
         pure Nothing
-      else case License.extractIds manifestLicense of
-        Left err -> do
-          -- This shouldn't be possible (we have already validated the license)
-          -- as part of constructing the manifest
-          Log.warn $ "Could not extract license IDs from manifest: " <> err
+      else do
+        let
+          manifestIds = License.extractIds manifestLicense
+          manifestIdSet = Set.fromFoldable manifestIds
+
+          -- A detected license is covered if all its IDs are in the manifest IDs
+          isCovered :: License -> Boolean
+          isCovered license =
+            License.extractIds license # Array.all \id ->
+              Set.member id manifestIdSet
+
+          uncoveredLicenses :: Array License
+          uncoveredLicenses = Array.filter (not <<< isCovered) parsedLicenses
+
+        if Array.null uncoveredLicenses then do
+          Log.debug "All detected licenses are covered by the manifest license."
           pure Nothing
-        Right manifestIds -> do
-          let
-            manifestIdSet = Set.fromFoldable manifestIds
-
-            -- A detected license is covered if all its IDs are in the manifest IDs
-            isCovered :: License -> Boolean
-            isCovered license = case License.extractIds license of
-              Left _ -> false
-              Right ids -> Array.all (\id -> Set.member id manifestIdSet) ids
-
-            uncoveredLicenses :: Array License
-            uncoveredLicenses = Array.filter (not <<< isCovered) parsedLicenses
-
-          if Array.null uncoveredLicenses then do
-            Log.debug "All detected licenses are covered by the manifest license."
-            pure Nothing
-          else do
-            Log.warn $ Array.fold
-              [ "License mismatch detected: manifest has '"
-              , License.print manifestLicense
-              , "' but detected "
-              , String.joinWith ", " (map License.print parsedLicenses)
-              ]
-            pure $ Just $ LicenseMismatch
-              { manifestLicense
-              , detectedLicenses: uncoveredLicenses
-              }
+        else do
+          Log.warn $ Array.fold
+            [ "License mismatch detected: manifest has '"
+            , License.print manifestLicense
+            , "' but detected "
+            , String.joinWith ", " (map License.print parsedLicenses)
+            ]
+          pure $ Just $ LicenseMismatch { manifest: manifestLicense, detected: uncoveredLicenses }

app/src/App/Legacy/Manifest.purs

@@ -15,6 +15,7 @@ import Registry.App.Prelude
 
 import Codec.JSON.DecodeError as CJ.DecodeError
 import Data.Array as Array
+import Data.Array.NonEmpty as NonEmptyArray
 import Data.Codec as Codec
 import Data.Codec.JSON as CJ
 import Data.Codec.JSON.Common as CJ.Common
@@ -74,9 +75,14 @@ bowerfileToPursJson
   :: Bowerfile
   -> Either String { license :: License, description :: Maybe String, dependencies :: Map PackageName Range }
 bowerfileToPursJson (Bowerfile { description, dependencies, license }) = do
-  parsedLicense <- case Array.mapMaybe (hush <<< License.parse) license of
-    [] -> Left "No valid SPDX license found in bower.json"
-    multiple -> Right $ License.joinWith License.And multiple
+  let
+    -- Best effort: keep any licenses that parse cleanly and drop the rest.
+    validLicenses = Array.mapMaybe (hush <<< License.parseCanonical) license
+
+  parsedLicense <-
+    case NonEmptyArray.fromArray validLicenses of
+      Nothing -> Left "No valid SPDX license found in bower.json"
+      Just multiple -> Right $ License.joinWith License.And multiple
 
   parsedDeps <- parseDependencies dependencies
 
@@ -134,7 +140,7 @@ spagoDhallToPursJson
 spagoDhallToPursJson (SpagoDhallJson { license, dependencies, packages }) = do
   parsedLicense <- case license of
     Nothing -> Left "No license found in spago.dhall"
-    Just lic -> case License.parse (NonEmptyString.toString lic) of
+    Just lic -> case License.parseCanonical (NonEmptyString.toString lic) of
       Left _ -> Left $ "Invalid SPDX license in spago.dhall: " <> NonEmptyString.toString lic
       Right l -> Right l
 

app/src/App/Manifest/SpagoYaml.purs

@@ -90,13 +90,20 @@ type PublishConfig =
 publishConfigCodec :: CJ.Codec PublishConfig
 publishConfigCodec = CJ.named "PublishConfig" $ CJ.Record.object
   { version: Version.codec
-  , license: License.codec
+  -- Publish metadata is authored input so it must use canonical SPDX identifiers
+  , license: canonicalLicenseCodec
   , location: CJ.Record.optional Location.codec
   , include: CJ.Record.optional (CJ.array CJ.string)
   , exclude: CJ.Record.optional (CJ.array CJ.string)
   , owners: CJ.Record.optional (CJ.Common.nonEmptyArray Owner.codec)
   }
 
+canonicalLicenseCodec :: CJ.Codec License
+canonicalLicenseCodec = CJ.named "CanonicalLicense" $ Codec.codec' decode encode
+  where
+  encode = CJ.encode CJ.string <<< License.print
+  decode = Codec.decode CJ.string >=> (License.parseCanonical >>> lmap CJ.DecodeError.basic >>> except)
+
 dependenciesCodec :: CJ.Codec (Map PackageName (Maybe SpagoRange))
 dependenciesCodec = Profunctor.dimap toJsonRep fromJsonRep $ CJ.array dependencyCodec
   where

app/test/App/API.purs

@@ -8,6 +8,7 @@ import Data.Map as Map
 import Data.Set as Set
 import Data.String as String
 import Data.String.NonEmpty as NonEmptyString
+import Data.String.Pattern (Pattern(..))
 import Effect.Aff as Aff
 import Effect.Class.Console as Console
 import Effect.Ref as Ref
@@ -27,6 +28,7 @@ import Registry.Foreign.FSExtra as FS.Extra
 import Registry.Foreign.FastGlob as FastGlob
 import Registry.Foreign.Tmp as Tmp
 import Registry.License as License
+import Registry.Location (Location(..))
 import Registry.PackageName as PackageName
 import Registry.Test.Assert as Assert
 import Registry.Test.Assert.Run as Assert.Run
@@ -52,6 +54,9 @@ spec = do
   Spec.describe "Verifies build plans" do
     checkBuildPlanToResolutions
 
+  Spec.describe "Parses source manifests" do
+    parseSourceManifestSpec
+
   Spec.describe "Validates licenses match" do
     licenseValidation
 
@@ -222,6 +227,38 @@ checkBuildPlanToResolutions = do
       path = Path.concat [ installedResolutions, PackageName.print packageName <> "-" <> Version.print version ]
     pure $ Tuple bowerName { path, version }
 
+parseSourceManifestSpec :: Spec.Spec Unit
+parseSourceManifestSpec = do
+  Spec.it "Rejects deprecated SPDX identifiers in purs.json" do
+    resourceEnv <- liftEffect Env.lookupResourceEnv
+    Aff.bracket Tmp.mkTmpDir FS.Extra.remove \packageDir -> do
+      let
+        manifestPath = Path.concat [ packageDir, "purs.json" ]
+        args =
+          { packageDir
+          , name: Utils.unsafePackageName "registry-lib"
+          , version: Utils.unsafeVersion "0.0.1"
+          , ref: "v0.0.1"
+          , location: GitHub { owner: "purescript", repo: "registry-dev", subdir: Nothing }
+          }
+
+      FS.Aff.writeTextFile UTF8 manifestPath
+        """{"name":"registry-lib","version":"0.0.1","license":"AGPL-3.0","location":{"githubOwner":"purescript","githubRepo":"registry-dev"},"ref":"v0.0.1","dependencies":{"prelude":">=6.0.0 <7.0.0"}}"""
+
+      result <-
+        API.parseSourceManifest args
+          # Env.runResourceEnv resourceEnv
+          # Log.interpret (\(Log.Log _ _ next) -> pure next)
+          # Except.runExcept
+          # Run.runBaseAff'
+
+      case result of
+        Left err ->
+          unless (String.contains (Pattern "license field is not canonical") err) do
+            Assert.fail $ "Expected a canonical license error, but got: " <> err
+        Right _ ->
+          Assert.fail "Expected parseSourceManifest to reject deprecated SPDX identifiers"
+
 removeIgnoredTarballFiles :: Spec.Spec Unit
 removeIgnoredTarballFiles = Spec.before runBefore do
   Spec.it "Picks correct files when packaging a tarball" \{ tmp, writeDirectories, writeFiles } -> do
@@ -361,7 +398,10 @@ copySourceFiles = Spec.hoistSpec identity (\_ -> Assert.Run.runBaseEffects) $ Sp
 
 licenseValidation :: Spec.Spec Unit
 licenseValidation = do
-  let fixtures = Path.concat [ "app", "fixtures", "licenses", "halogen-hooks" ]
+  let
+    fixtures = Path.concat [ "app", "fixtures", "licenses", "halogen-hooks" ]
+    deprecatedFixture = Path.concat [ "app", "fixtures", "licenses", "deprecated-agpl" ]
+    ambiguousFixture = Path.concat [ "app", "fixtures", "licenses", "ambiguous-gfdl" ]
 
   Spec.describe "validateLicense" do
     Spec.it "Passes when manifest license covers all detected licenses" do
@@ -375,9 +415,9 @@ licenseValidation = do
       let manifestLicense = unsafeLicense "MIT"
       result <- Assert.Run.runBaseEffects $ validateLicense fixtures manifestLicense
       case result of
-        Just (LicenseMismatch { detectedLicenses }) ->
+        Just (LicenseMismatch { detected }) ->
           -- Should detect that Apache-2.0 is not covered
-          Assert.shouldContain (map License.print detectedLicenses) "Apache-2.0"
+          Assert.shouldContain (map License.print detected) "Apache-2.0"
         _ ->
           Assert.fail "Expected LicenseMismatch error"
 
@@ -386,11 +426,11 @@ licenseValidation = do
       let manifestLicense = unsafeLicense "BSD-3-Clause"
       result <- Assert.Run.runBaseEffects $ validateLicense fixtures manifestLicense
       case result of
-        Just (LicenseMismatch { manifestLicense: ml, detectedLicenses }) -> do
+        Just (LicenseMismatch { manifest: ml, detected }) -> do
           Assert.shouldEqual "BSD-3-Clause" (License.print ml)
           -- Both MIT and Apache-2.0 should be in the detected licenses
-          Assert.shouldContain (map License.print detectedLicenses) "MIT"
-          Assert.shouldContain (map License.print detectedLicenses) "Apache-2.0"
+          Assert.shouldContain (map License.print detected) "MIT"
+          Assert.shouldContain (map License.print detected) "Apache-2.0"
         _ ->
           Assert.fail "Expected LicenseMismatch error"
 
@@ -400,5 +440,23 @@ licenseValidation = do
       result <- Assert.Run.runBaseEffects $ validateLicense fixtures manifestLicense
       Assert.shouldEqual Nothing result
 
+    Spec.it "Canonicalizes deterministic deprecated detected licenses during validation" do
+      let manifestLicense = unsafeLicense "MIT"
+      result <- Assert.Run.runBaseEffects $ validateLicense deprecatedFixture manifestLicense
+      case result of
+        Just (LicenseMismatch { detected }) ->
+          Assert.shouldContain (map License.print detected) "AGPL-3.0-only"
+        _ ->
+          Assert.fail "Expected LicenseMismatch error"
+
+    Spec.it "Preserves ambiguous deprecated detected licenses during validation" do
+      let manifestLicense = unsafeLicense "MIT"
+      result <- Assert.Run.runBaseEffects $ validateLicense ambiguousFixture manifestLicense
+      case result of
+        Just (LicenseMismatch { detected }) ->
+          Assert.shouldContain (map License.print detected) "GFDL-1.3"
+        _ ->
+          Assert.fail "Expected LicenseMismatch error"
+
 unsafeLicense :: String -> License
 unsafeLicense str = unsafeFromRight $ License.parse str

app/test/App/Legacy/Manifest.purs

@@ -6,6 +6,7 @@ import Codec.JSON.DecodeError as CJ.DecodeError
 import Data.Array as Array
 import Data.Codec.JSON as CJ
 import Registry.App.Legacy.Manifest as Legacy.Manifest
+import Registry.License as License
 import Registry.Manifest (Manifest(..))
 import Registry.Test.Assert as Assert
 import Test.Spec (Spec)
@@ -134,6 +135,21 @@ bowerfileToPursJsonSpec = do
           Left err -> Assert.fail $ "Failed to convert bowerfile:\n" <> err
           Right _ -> pure unit
 
+    Spec.it "Drops invalid SPDX identifiers when valid licenses remain" do
+      let
+        input =
+          """
+          { "license": [ "MIT", "AGPL-3.0" ]
+          , "dependencies": { "purescript-prelude": "^6.0.0" }
+          }
+          """
+      case parseJson Legacy.Manifest.bowerfileCodec input of
+        Left err -> Assert.fail $ "Failed to parse bowerfile:\n" <> CJ.DecodeError.print err
+        Right bowerfile -> case Legacy.Manifest.bowerfileToPursJson bowerfile of
+          Left err -> Assert.fail $ "Failed to convert bowerfile:\n" <> err
+          Right result ->
+            Assert.shouldEqual "MIT" (License.print result.license)
+
   Spec.describe "Rejects invalid Bowerfiles" do
     Spec.it "Fails on missing license" do
       let