Fail loudly when existing manifest entries cannot be read

app-e2e/src/Test/E2E/Support/Env.purs

@@ -321,17 +321,19 @@ readManifestIndexEntry packageName = do
   { stateDir } <- ask
   let indexPath = Path.concat [ stateDir, "scratch", "registry-index" ]
   liftAff $ ManifestIndex.readEntryFile indexPath packageName >>= case _ of
-    Left err -> Aff.throwError $ Aff.error $ "Failed to read manifest index for " <> PackageName.print packageName <> ": " <> err
-    Right manifests -> pure $ Array.fromFoldable manifests
+    ManifestIndex.EntryFileError err -> Aff.throwError $ Aff.error $ "Failed to read manifest index for " <> PackageName.print packageName <> ": " <> err
+    ManifestIndex.EntryFileMissing -> Aff.throwError $ Aff.error $ "No manifest index entry for " <> PackageName.print packageName
+    ManifestIndex.EntryFileValid manifests -> pure $ Array.fromFoldable manifests
 
 -- | Check if a specific package version exists in the manifest index.
 manifestIndexEntryExists :: PackageFixture -> E2E Boolean
 manifestIndexEntryExists pkg = do
   { stateDir } <- ask
   let indexPath = Path.concat [ stateDir, "scratch", "registry-index" ]
   liftAff $ ManifestIndex.readEntryFile indexPath pkg.name >>= case _ of
-    Left _ -> pure false
-    Right manifests -> pure $ Array.any (\(Manifest m) -> m.version == pkg.version) $ Array.fromFoldable manifests
+    ManifestIndex.EntryFileError err -> Aff.throwError $ Aff.error $ "Failed to read manifest index for " <> PackageName.print pkg.name <> ": " <> err
+    ManifestIndex.EntryFileMissing -> pure false
+    ManifestIndex.EntryFileValid manifests -> pure $ Array.any (\(Manifest m) -> m.version == pkg.version) $ Array.fromFoldable manifests
 
 -- | Assert that both git repos (registry and registry-index) have no uncommitted changes.
 assertReposClean :: E2E Unit

app/src/App/Effect/Registry.purs

@@ -786,7 +786,11 @@ readManifestIndexFromDisk root = do
       , Array.foldMap (\(Tuple path err) -> "\n  - " <> path <> ": " <> err) packages.fail
       ]
 
-  entries <- map partitionEithers $ for packages.success (ManifestIndex.readEntryFile root)
+  entries <- map partitionEithers $ for packages.success \name ->
+    ManifestIndex.readEntryFile root name >>= case _ of
+      ManifestIndex.EntryFileError error -> pure $ Left error
+      ManifestIndex.EntryFileMissing -> pure $ Left $ "No manifest index entry for " <> PackageName.print name
+      ManifestIndex.EntryFileValid manifests -> pure $ Right manifests
   case entries.fail of
     [] -> case ManifestIndex.fromSet ManifestIndex.ConsiderRanges $ Set.fromFoldable $ Array.foldMap NonEmptyArray.toArray entries.success of
       Left errors -> do

lib/src/ManifestIndex.purs

@@ -8,6 +8,7 @@
 module Registry.ManifestIndex
   ( ManifestIndex
   , IncludeRanges(..)
+  , EntryFileResult(..)
   , delete
   , dependants
   , empty
@@ -270,15 +271,24 @@ printEntry =
     <<< Array.sortBy (comparing (_.version <<< un Manifest))
     <<< Array.fromFoldable
 
+data EntryFileResult
+  = EntryFileMissing
+  | EntryFileError String
+  | EntryFileValid (NonEmptyArray Manifest)
+
 -- | Given the root of a manifest index on the file system and a package name,
 -- | retrieve the manifests associated with that package, in sorted order from
 -- | lowest to highest version.
-readEntryFile :: forall m. MonadAff m => FilePath -> PackageName -> m (Either String (NonEmptyArray Manifest))
+readEntryFile :: forall m. MonadAff m => FilePath -> PackageName -> m EntryFileResult
 readEntryFile indexPath package = do
   let entryPath = Path.concat [ indexPath, packageEntryFilePath package ]
-  liftAff (Aff.attempt (FS.Aff.readTextFile UTF8 entryPath)) >>= case _ of
-    Left error -> pure $ Left $ "Failed to read entry: " <> Aff.message error
-    Right contents -> pure $ parseEntry contents
+  liftEffect (FS.Sync.exists entryPath) >>= case _ of
+    false -> pure EntryFileMissing
+    true -> liftAff (Aff.attempt (FS.Aff.readTextFile UTF8 entryPath)) >>= case _ of
+      Left error -> pure $ EntryFileError $ "Failed to read entry " <> entryPath <> ": " <> Aff.message error
+      Right contents -> pure $ case parseEntry contents of
+        Left error -> EntryFileError $ "Invalid entry " <> entryPath <> ": " <> error
+        Right manifests -> EntryFileValid manifests
 
 -- | Given the root of a manifest index on the file system, encode the provided
 -- | list of manifests as a package entry in the JSON Lines format. This will
@@ -310,31 +320,28 @@ writeEntryFile indexPath manifests = do
 -- | does not yet exist.
 insertIntoEntryFile :: forall m. MonadAff m => FilePath -> Manifest -> m (Either String Unit)
 insertIntoEntryFile indexPath manifest@(Manifest { name }) = do
-  entry <- readEntryFile indexPath name
-
-  let
-    existing :: Maybe (NonEmptySet Manifest)
-    existing = case entry of
-      Left _ -> Nothing
-      Right previous -> Just (NonEmptySet.fromFoldable1 previous)
-
-    modified :: NonEmptySet Manifest
-    modified = case existing of
-      Nothing -> NonEmptySet.singleton manifest
-      Just previous -> NonEmptySet.insert manifest previous
-
-  case existing of
-    Just previous | previous == modified -> pure (Right unit)
-    _ -> writeEntryFile indexPath modified
+  readEntryFile indexPath name >>= case _ of
+    EntryFileError error -> pure $ Left error
+    EntryFileMissing -> writeEntryFile indexPath (NonEmptySet.singleton manifest)
+    EntryFileValid manifests -> do
+      let
+        previous = NonEmptySet.fromFoldable1 manifests
+        modified = NonEmptySet.insert manifest previous
+      if previous == modified then
+        pure $ Right unit
+      else
+        writeEntryFile indexPath modified
 
 -- | Given the root of a manifest index on the file system, remove the specified
 -- | package version from the package entry.
 removeFromEntryFile :: forall m. MonadAff m => FilePath -> PackageName -> Version -> m (Either String Unit)
 removeFromEntryFile indexPath name version = do
   readEntryFile indexPath name >>= case _ of
-    Left error ->
+    EntryFileError error ->
       pure $ Left error
-    Right contents -> do
+    EntryFileMissing ->
+      pure $ Left $ "No manifest index entry for " <> PackageName.print name
+    EntryFileValid contents -> do
       let entryPath = Path.concat [ indexPath, packageEntryFilePath name ]
       case NonEmptySet.fromFoldable $ NonEmptyArray.filter (\(Manifest m) -> m.version /= version) contents of
         Nothing ->

lib/test/Registry/ManifestIndex.purs

@@ -20,8 +20,11 @@ import Data.Set.NonEmpty as NonEmptySet
 import Data.String as String
 import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested ((/\))
+import Effect.Aff as Aff
 import Effect.Exception (Error)
 import JSON as JSON
+import Node.Encoding (Encoding(..))
+import Node.FS.Aff as FS.Aff
 import Node.Path as Path
 import Registry.Internal.Codec as Internal.Codec
 import Registry.LimitedString as LimitedString
@@ -46,6 +49,34 @@ spec = do
     let parsedContext = ManifestIndex.parseEntry contextEntry
     contextEntry `Assert.shouldEqualRight` map (ManifestIndex.printEntry <<< NonEmptySet.fromFoldable1) parsedContext
 
+  Spec.it "Preserves an invalid entry file when inserting a manifest" do
+    let cleanup path = FS.Aff.rm' path { force: true, recursive: true, maxRetries: 0, retryDelay: 0 }
+    Aff.bracket (FS.Aff.mkdtemp "manifest-index-test-") cleanup \indexPath -> do
+      let
+        previous = unsafeManifest "prelude" "1.0.0" []
+        next = unsafeManifest "prelude" "2.0.0" []
+        entryPath = Path.concat [ indexPath, ManifestIndex.packageEntryFilePath (un Manifest previous).name ]
+        contents = ManifestIndex.printEntry (NonEmptySet.singleton previous) <> "\n{}"
+      ManifestIndex.readEntryFile indexPath (un Manifest previous).name >>= case _ of
+        ManifestIndex.EntryFileMissing -> pure unit
+        _ -> Assert.fail "Expected a missing entry before insertion."
+      created <- ManifestIndex.insertIntoEntryFile indexPath previous
+      created `Assert.shouldEqual` Right unit
+      appended <- ManifestIndex.insertIntoEntryFile indexPath next
+      appended `Assert.shouldEqual` Right unit
+      ManifestIndex.readEntryFile indexPath (un Manifest previous).name >>= case _ of
+        ManifestIndex.EntryFileValid manifests -> Array.fromFoldable manifests `Assert.shouldEqual` [ previous, next ]
+        _ -> Assert.fail "Expected a valid entry containing both versions."
+      FS.Aff.writeTextFile UTF8 entryPath contents
+
+      result <- ManifestIndex.insertIntoEntryFile indexPath next
+      remaining <- FS.Aff.readTextFile UTF8 entryPath
+      remaining `Assert.shouldEqual` contents
+      case result of
+        Left error -> unless (String.contains (String.Pattern entryPath) error) do
+          Assert.fail "Expected the error to identify the invalid entry file."
+        Right _ -> Assert.fail "Expected insertion to reject an invalid existing entry."
+
   Spec.it "Produces correct entry file paths" do
     let
       entries =