ci: Fix --index-state for hackage roundtrip tests (backport #10285) (#10305)

* hackage-tests: Add --index-state argument to fix the cabal files

We need to fix the index-state we test against so a new bad cabal file
doesn't take down the CI for everyone.

Towards #10284

(cherry picked from commit 8e4d167)

* ci: Fix --index-state for hackage roundtrip tests

As a principle, tests which are required for CI to pass should be
reproducible and not depending on external resources changes or being
modified. The hackage tests currently violate this by depending on the
latest index state from hackage. This is problematic because until the
test is fixed all merges into master are blocked. Even though the
patches in question have nothing to do with the test.

It would be more suitable for a nightly job to run on the latest index
and for normal CI to run with a fixed index which is updated
periodically in a controlled manner.

Fixes #10284

(cherry picked from commit 31507b1)

* Re-enable Windows CI

(cherry picked from commit 4aade2d)

* CI: skip cli-suite on Windows due to #9571 (#10257)

(cherry picked from commit 30d2a38)

---------

Co-authored-by: Matthew Pickering <[email protected]>
Co-authored-by: Javier Sagredo <[email protected]>
Co-authored-by: Artem Pelenitsyn <[email protected]>

Author: 4 people

.github/workflows/validate.yml

@@ -72,6 +72,10 @@ jobs:
         # support, so the PR *must* have a changelog entry.
         ghc: ['9.10.1', '9.8.2', '9.6.4', '9.4.8', '9.2.8', '9.0.2', '8.10.7', '8.8.4', '8.6.5']
         exclude:
+          # Throws fatal "cabal-tests.exe: fd:8: hGetLine: end of file" exception
+          # even with --io-manager=native
+          - os: windows-latest
+            ghc: "9.0.2"
           # corrupts GHA cache or the fabric of reality itself, see https://github.com/haskell/cabal/issues/8356
           - os: windows-latest
             ghc: '8.10.7'
@@ -204,6 +208,7 @@ jobs:
         run: sh validate.sh $FLAGS -s cli-tests
 
       - name: Validate cli-suite
+        if: runner.os != 'Windows'
         run: sh validate.sh $FLAGS -s cli-suite
 
       - name: Validate solver-benchmarks-tests

Cabal-tests/Cabal-tests.cabal

@@ -161,6 +161,7 @@ test-suite hackage-tests
     , deepseq
     , directory
     , filepath
+    , time
 
   build-depends:
       base-compat           >=0.11.0   && <0.14

Cabal-tests/tests/HackageTests.hs

@@ -33,6 +33,7 @@ import System.FilePath                             ((</>))
 import Data.Orphans ()
 
 import qualified Codec.Archive.Tar                      as Tar
+import qualified Codec.Archive.Tar.Entry                as Tar
 import qualified Data.ByteString                        as B
 import qualified Data.ByteString.Char8                  as B8
 import qualified Data.ByteString.Lazy                   as BSL
@@ -56,11 +57,14 @@ import Data.TreeDiff.Instances.Cabal ()
 import Data.TreeDiff.Pretty          (ansiWlEditExprCompact)
 #endif
 
+import Data.Time.Clock.System
+import Data.Time.Format
+
 -------------------------------------------------------------------------------
 -- parseIndex: Index traversal
 -------------------------------------------------------------------------------
 
-parseIndex :: (Monoid a, NFData a) => (FilePath -> Bool)
+parseIndex :: (Monoid a, NFData a) => (Tar.EpochTime -> FilePath -> Bool)
            -> (FilePath -> B.ByteString -> IO a) -> IO a
 parseIndex predicate action = do
     configPath <- getCabalConfigPath
@@ -99,7 +103,7 @@ parseIndex predicate action = do
 
 parseIndex'
     :: (Monoid a, NFData a)
-    => (FilePath -> Bool)
+    => (Tar.EpochTime -> FilePath -> Bool)
     -> (FilePath -> B.ByteString -> IO a) -> FilePath -> IO a
 parseIndex' predicate action path = do
     putStrLn $ "Reading index from: " ++ path
@@ -110,7 +114,7 @@ parseIndex' predicate action path = do
 
   where
     cons entry entries
-        | predicate (Tar.entryPath entry) = entry : entries
+        | predicate (Tar.entryTime entry) (Tar.entryPath entry) = entry : entries
         | otherwise = entries
 
     f entry = case Tar.entryContent entry of
@@ -320,6 +324,13 @@ main = join (O.execParser opts)
         , O.progDesc "tests using Hackage's index"
         ]
 
+    indexP =
+      fmap cvt <$> O.optional (O.strOption (O.long "index-state" <> O.metavar "YYYY-MM-DD"))
+      where
+       cvt =
+        systemSeconds . utcToSystemTime .
+          parseTimeOrError False defaultTimeLocale "%Y-%m-%d"
+
     optsP = subparser
         [ command "read-fields" readFieldsP
           "Parse outer format (to '[Field]', TODO: apply Quirks)"
@@ -330,20 +341,20 @@ main = join (O.execParser opts)
 
     defaultA = do
         putStrLn "Default action: parsec k"
-        parsecA (mkPredicate ["k"]) False
+        parsecA ["k"] False Nothing
 
-    readFieldsP = readFieldsA <$> prefixP
-    readFieldsA pfx = parseIndex pfx readFieldTest
+    readFieldsP = readFieldsA <$> prefixP <*> indexP
+    readFieldsA pfx idx = parseIndex (mkPredicate pfx idx) readFieldTest
 
-    parsecP = parsecA <$> prefixP <*> keepGoingP
+    parsecP = parsecA <$> prefixP <*> keepGoingP <*> indexP
     keepGoingP =
         O.flag' True  (O.long "keep-going") <|>
         O.flag' False (O.long "no-keep-going") <|>
         pure False
 
-    parsecA pfx keepGoing = do
+    parsecA pfx keepGoing idx = do
         begin <- Clock.getTime Clock.Monotonic
-        ParsecResult n w f <- parseIndex pfx (parseParsecTest keepGoing)
+        ParsecResult n w f <- parseIndex (mkPredicate pfx idx) (parseParsecTest keepGoing)
         end <- Clock.getTime Clock.Monotonic
         let diff = Clock.toNanoSecs $ Clock.diffTimeSpec end begin
 
@@ -353,14 +364,14 @@ main = join (O.execParser opts)
         putStrLn $ showFFloat (Just 6) (fromInteger diff / 1e9                  :: Double) " seconds elapsed"
         putStrLn $ showFFloat (Just 6) (fromInteger diff / 1e6 / fromIntegral n :: Double) " milliseconds per file"
 
-    roundtripP = roundtripA <$> prefixP <*> testFieldsP
-    roundtripA pfx testFieldsTransform = do
-        Sum n <- parseIndex pfx (roundtripTest testFieldsTransform)
+    roundtripP = roundtripA <$> prefixP <*> testFieldsP <*> indexP
+    roundtripA pfx testFieldsTransform idx = do
+        Sum n <- parseIndex (mkPredicate pfx idx) (roundtripTest testFieldsTransform)
         putStrLn $ show n ++ " files processed"
 
-    checkP = checkA <$> prefixP
-    checkA pfx = do
-        CheckResult n w x a b c d e <- parseIndex pfx parseCheckTest
+    checkP = checkA <$> prefixP <*> indexP
+    checkA pfx idx = do
+        CheckResult n w x a b c d e <- parseIndex (mkPredicate pfx idx) parseCheckTest
         putStrLn $ show n ++ " files processed"
         putStrLn $ show w ++ " files have lexer/parser warnings"
         putStrLn $ show x ++ " files have check warnings"
@@ -370,7 +381,7 @@ main = join (O.execParser opts)
         putStrLn $ show d ++ " build dist suspicious warning"
         putStrLn $ show e ++ " build dist inexcusable"
 
-    prefixP = fmap mkPredicate $ many $ O.strArgument $ mconcat
+    prefixP = many $ O.strArgument $ mconcat
         [ O.metavar "PREFIX"
         , O.help "Check only files starting with a prefix"
         ]
@@ -380,8 +391,14 @@ main = join (O.execParser opts)
         , O.help "Test also 'showFields . fromParsecFields . readFields' transform"
         ]
 
-    mkPredicate [] = const True
-    mkPredicate pfxs = \n -> any (`isPrefixOf` n) pfxs
+    indexPredicate :: Maybe Tar.EpochTime -> (k -> Bool) -> (Tar.EpochTime -> k -> Bool)
+    indexPredicate Nothing k = const k
+    indexPredicate (Just indexDate) k =
+        \e -> if (e <= indexDate) then k else const False
+
+    mkPredicate :: [String] -> Maybe Tar.EpochTime -> (Tar.EpochTime -> FilePath -> Bool)
+    mkPredicate [] idx = indexPredicate idx (const True)
+    mkPredicate pfxs idx = indexPredicate idx (\n -> any (`isPrefixOf` n) pfxs)
 
     command name p desc = O.command name
                           (O.info (p <**> O.helper) (O.progDesc desc))

validate.sh

@@ -324,6 +324,9 @@ CABAL_TESTSUITE_BDIR="$(pwd)/$BUILDDIR/build/$ARCH/$BASEHC/cabal-testsuite-3"
 CABALNEWBUILD="${CABAL} build $JOBS -w $HC --builddir=$BUILDDIR --project-file=$PROJECTFILE"
 CABALLISTBIN="${CABAL} list-bin --builddir=$BUILDDIR --project-file=$PROJECTFILE"
 
+# See https://github.com/haskell/cabal/issues/9571 for why we set this for Windows
+RTSOPTS="$([ $ARCH = "x86_64-windows" ] && [ "$($HC --numeric-version)" != "9.0.2" ] && [ "$(echo -e "$(ghc --numeric-version)\n9.0.2" | sort -V | head -n1)" = "9.0.2" ] && echo "+RTS --io-manager=native" || echo "")"
+
 # header
 #######################################################################
 
@@ -409,14 +412,18 @@ CMD="$($CABALLISTBIN Cabal-tests:test:rpmvercmp) $TESTSUITEJOBS --hide-successes
 CMD="$($CABALLISTBIN Cabal-tests:test:no-thunks-test) $TESTSUITEJOBS --hide-successes"
 (cd Cabal-tests && timed $CMD) || exit 1
 
+
+# See #10284 for why this value is pinned.
+HACKAGE_TESTS_INDEX_STATE="--index-state=2024-08-25"
+
 CMD=$($CABALLISTBIN Cabal-tests:test:hackage-tests)
-(cd Cabal-tests && timed $CMD read-fields) || exit 1
+(cd Cabal-tests && timed $CMD read-fields $HACKAGE_TESTS_INDEX_STATE) || exit 1
 if $HACKAGETESTSALL; then
-    (cd Cabal-tests && timed $CMD parsec)    || exit 1
-    (cd Cabal-tests && timed $CMD roundtrip) || exit 1
+    (cd Cabal-tests && timed $CMD parsec $HACKAGE_TESTS_INDEX_STATE)    || exit 1
+    (cd Cabal-tests && timed $CMD roundtrip $HACKAGE_TESTS_INDEX_STATE) || exit 1
 else
-    (cd Cabal-tests && timed $CMD parsec d)    || exit 1
-    (cd Cabal-tests && timed $CMD roundtrip k) || exit 1
+    (cd Cabal-tests && timed $CMD parsec d $HACKAGE_TESTS_INDEX_STATE)    || exit 1
+    (cd Cabal-tests && timed $CMD roundtrip k $HACKAGE_TESTS_INDEX_STATE) || exit 1
 fi
 }