From 367e2eaa92d8f5133c2c5ac03a80c0cf25f301b8 Mon Sep 17 00:00:00 2001 From: Potato Hatsue <1793913507@qq.com> Date: Sun, 25 Feb 2024 00:22:55 -0500 Subject: [PATCH] Support keep going on fetch failure (#115) --- README.md | 3 +- src/NvFetcher.hs | 17 ++-- src/NvFetcher/Config.hs | 10 ++- src/NvFetcher/Core.hs | 126 +++++++++++++++-------------- src/NvFetcher/FetchRustGitDeps.hs | 3 +- src/NvFetcher/NixFetcher.hs | 12 ++- src/NvFetcher/Options.hs | 2 + src/NvFetcher/Types.hs | 6 +- src/NvFetcher/Types/ShakeExtras.hs | 7 +- test/FetchRustGitDepsSpec.hs | 3 +- test/PrefetchSpec.hs | 3 +- 11 files changed, 112 insertions(+), 80 deletions(-) diff --git a/README.md b/README.md index bb92aa8..396e08e 100644 --- a/README.md +++ b/README.md @@ -106,7 +106,7 @@ To run nvfetcher as a CLI program, you'll need to provide package sources define Usage: nvfetcher [--version] [--help] [-o|--build-dir DIR] [--commit-changes] [-l|--changelog FILE] [-j NUM] [-r|--retry NUM] [-t|--timing] [-v|--verbose] [-f|--filter REGEX] [-k|--keyfile FILE] - [--keep-old] [TARGET] [-c|--config FILE] + [--keep-old] [--keep-going] [TARGET] [-c|--config FILE] generate nix sources expr for the latest version of packages @@ -128,6 +128,7 @@ Available options: -k,--keyfile FILE Nvchecker keyfile --keep-old Don't remove old files other than generated json and nix before build + --keep-going Don't stop if some packages failed to be fetched TARGET Three targets are available: 1.build 2.clean (remove all generated files) 3.purge (remove shake db) (default: build) diff --git a/src/NvFetcher.hs b/src/NvFetcher.hs index ffa6126..a1715d1 100644 --- a/src/NvFetcher.hs +++ b/src/NvFetcher.hs @@ -57,9 +57,9 @@ import qualified Data.Aeson.Encode.Pretty as A import qualified Data.Aeson.Types as A import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Default -import Data.List ((\\)) +import Data.List (partition, (\\)) import qualified Data.Map.Strict as Map -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust) import Data.Text (Text) import qualified Data.Text as T import Development.Shake @@ -114,7 +114,8 @@ applyCliOptions config CLIOptions {..} = do filterRegex = optPkgNameFilter, retry = optRetry, keyfile = aKeyfile, - keepOldFiles = optKeepOldFiles + keepOldFiles = optKeepOldFiles, + keepGoing = optKeepGoing } logChangesToFile :: FilePath -> Action () @@ -199,10 +200,12 @@ mainRules Config {..} = do putVerbose $ "Removing old files: " <> show oldFiles liftIO $ removeFiles buildDir oldFiles allKeys <- getAllPackageKeys - results <- parallel $ runPackage <$> allKeys + results <- fmap (zip allKeys) $ parallel $ runPackage <$> allKeys + let (fmap (fromJust . snd) -> successResults, fmap fst -> failureKeys) = partition (isJust . snd) results -- Record removed packages to version changes + -- Failure keys are also considered as removed in this run getAllOnDiskVersions - >>= \oldPkgs -> forM_ (Map.keys oldPkgs \\ allKeys) $ + >>= \oldPkgs -> forM_ (Map.keys oldPkgs \\ (allKeys \\ failureKeys)) $ \pkg -> recordVersionChange (coerce pkg) (oldPkgs Map.!? pkg) "∅" getVersionChanges >>= \changes -> if null changes @@ -214,9 +217,9 @@ mainRules Config {..} = do let generatedNixPath = buildDir generatedNixFileName generatedJSONPath = buildDir generatedJsonFileName putVerbose $ "Generating " <> generatedNixPath - writeFileChanged generatedNixPath $ T.unpack $ srouces (T.unlines $ toNixExpr <$> results) <> "\n" + writeFileChanged generatedNixPath $ T.unpack $ srouces (T.unlines $ toNixExpr <$> successResults) <> "\n" putVerbose $ "Generating " <> generatedJSONPath - writeFileChanged generatedJSONPath $ LBS.unpack $ A.encodePretty $ A.object [aesonKey (_prname r) A..= r | r <- results] + writeFileChanged generatedJSONPath $ LBS.unpack $ A.encodePretty $ A.object [aesonKey (_prname r) A..= r | r <- successResults] actionAfterBuild customRules diff --git a/src/NvFetcher/Config.hs b/src/NvFetcher/Config.hs index 909783e..500856c 100644 --- a/src/NvFetcher/Config.hs +++ b/src/NvFetcher/Config.hs @@ -20,7 +20,9 @@ data Config = Config cacheNvchecker :: Bool, keepOldFiles :: Bool, -- | Absolute path - keyfile :: Maybe FilePath + keyfile :: Maybe FilePath, + -- | When set to 'True', nvfetcher will keep going even if some packages failed to /fetch/ + keepGoing :: Bool } instance Default Config where @@ -29,7 +31,8 @@ instance Default Config where { shakeConfig = shakeOptions { shakeProgress = progressSimple, - shakeThreads = 0 + shakeThreads = 0, + shakeVersion = "1" }, buildDir = "_sources", customRules = pure (), @@ -39,5 +42,6 @@ instance Default Config where filterRegex = Nothing, cacheNvchecker = True, keepOldFiles = False, - keyfile = Nothing + keyfile = Nothing, + keepGoing = False } diff --git a/src/NvFetcher/Core.hs b/src/NvFetcher/Core.hs index 8c70620..34cc211 100644 --- a/src/NvFetcher/Core.hs +++ b/src/NvFetcher/Core.hs @@ -43,7 +43,7 @@ coreRules = do -- since the package definition is not tracked at all alwaysRerun lookupPackage pkg >>= \case - Nothing -> fail $ "Unkown package key: " <> show pkg + Nothing -> fail $ "Unknown package key: " <> show pkg Just Package { _pversion = CheckVersion versionSource options, @@ -52,71 +52,75 @@ coreRules = do } -> do _prversion@(NvcheckerResult version _mOldV _isStale) <- checkVersion versionSource options pkg _prfetched <- prefetch (_pfetcher version) _pforcefetch - buildDir <- getBuildDir - -- extract src - _prextract <- - case _pextract of - Just (PackageExtractSrc extract) -> do - result <- HMap.toList <$> extractSrcs _prfetched extract - Just . HMap.fromList - <$> sequence - [ do - -- write extracted files to build dir - -- and read them in nix using 'builtins.readFile' - writeFile' (buildDir path) (T.unpack v) - pure (k, T.pack path) - | (k, v) <- result, - let path = - "./" - <> T.unpack _pname + -- If we fail to prefetch, we should fail on this package + case _prfetched of + Just _prfetched -> do + buildDir <- getBuildDir + -- extract src + _prextract <- + case _pextract of + Just (PackageExtractSrc extract) -> do + result <- HMap.toList <$> extractSrcs _prfetched extract + Just . HMap.fromList + <$> sequence + [ do + -- write extracted files to build dir + -- and read them in nix using 'builtins.readFile' + writeFile' (buildDir path) (T.unpack v) + pure (k, T.pack path) + | (k, v) <- result, + let path = + "./" + <> T.unpack _pname + <> "-" + <> T.unpack (coerce version) + k + ] + _ -> pure Nothing + -- cargo locks + _prcargolock <- + case _pcargo of + Just (PackageCargoLockFiles lockPath) -> do + lockFiles <- HMap.toList <$> extractSrcs _prfetched lockPath + result <- parallel $ + flip fmap lockFiles $ \(lockPath, lockData) -> do + result <- fetchRustGitDeps _prfetched lockPath + let lockPath' = + T.unpack _pname <> "-" <> T.unpack (coerce version) - k - ] - _ -> pure Nothing - -- cargo locks - _prcargolock <- - case _pcargo of - Just (PackageCargoLockFiles lockPath) -> do - lockFiles <- HMap.toList <$> extractSrcs _prfetched lockPath - result <- parallel $ - flip fmap lockFiles $ \(lockPath, lockData) -> do - result <- fetchRustGitDeps _prfetched lockPath - let lockPath' = - T.unpack _pname - <> "-" - <> T.unpack (coerce version) - lockPath - lockPathNix = "./" <> T.pack lockPath' - -- similar to extract src, write lock file to build dir - writeFile' (buildDir lockPath') $ T.unpack lockData - pure (lockPath, (lockPathNix, result)) - pure . Just $ HMap.fromList result - _ -> pure Nothing + lockPath + lockPathNix = "./" <> T.pack lockPath' + -- similar to extract src, write lock file to build dir + writeFile' (buildDir lockPath') $ T.unpack lockData + pure (lockPath, (lockPathNix, result)) + pure . Just $ HMap.fromList result + _ -> pure Nothing - -- Only git version source supports git commit date - _prgitdate <- case versionSource of - Git {..} -> Just <$> getGitCommitDate _vurl (coerce version) _pgitdateformat - _ -> pure Nothing + -- Only git version source supports git commit date + _prgitdate <- case versionSource of + Git {..} -> Just <$> getGitCommitDate _vurl (coerce version) _pgitdateformat + _ -> pure Nothing - -- update changelog - -- always use on disk version - mOldV <- getLastVersionOnDisk pkg - case mOldV of - Nothing -> - recordVersionChange _pname Nothing version - Just old - | old /= version -> - recordVersionChange _pname (Just old) version - _ -> pure () + -- update changelog + -- always use on disk version + mOldV <- getLastVersionOnDisk pkg + case mOldV of + Nothing -> + recordVersionChange _pname Nothing version + Just old + | old /= version -> + recordVersionChange _pname (Just old) version + _ -> pure () - let _prpassthru = if HMap.null passthru then Nothing else Just passthru - _prname = _pname - _prpinned = _ppinned - -- Since we don't save the previous result, we are not able to know if the result changes - -- Depending on this rule leads to RunDependenciesChanged - pure $ RunResult ChangedRecomputeDiff mempty PackageResult {..} + let _prpassthru = if HMap.null passthru then Nothing else Just passthru + _prname = _pname + _prpinned = _ppinned + -- Since we don't save the previous result, we are not able to know if the result changes + -- Depending on this rule leads to RunDependenciesChanged + pure $ RunResult ChangedRecomputeDiff mempty $ Just PackageResult {..} + _ -> pure $ RunResult ChangedRecomputeDiff mempty Nothing -- | 'Core' rule take a 'PackageKey', find the corresponding 'Package', and run all needed rules to get 'PackageResult' -runPackage :: PackageKey -> Action PackageResult +runPackage :: PackageKey -> Action (Maybe PackageResult) runPackage k = apply1 $ WithPackageKey (Core, k) diff --git a/src/NvFetcher/FetchRustGitDeps.hs b/src/NvFetcher/FetchRustGitDeps.hs index d1a9d70..9e03cc9 100644 --- a/src/NvFetcher/FetchRustGitDeps.hs +++ b/src/NvFetcher/FetchRustGitDeps.hs @@ -24,6 +24,7 @@ module NvFetcher.FetchRustGitDeps where import Control.Monad (void) +import Control.Monad.Extra (fromMaybeM) import Data.Binary.Instances () import Data.Coerce (coerce) import Data.HashMap.Strict (HashMap) @@ -54,7 +55,7 @@ fetchRustGitDepsRule = void $ parallel [ case parse gitSrcParser (T.unpack rname) src of Right ParsedGitSrc {..} -> do - (_sha256 -> sha256) <- prefetch (gitFetcher pgurl pgsha) NoForceFetch + (_sha256 -> sha256) <- fromMaybeM (fail $ "Prefetch failed for " <> T.unpack pgurl) $ prefetch (gitFetcher pgurl pgsha) NoForceFetch -- @${name}-${version}@ -> sha256 pure (rname <> "-" <> coerce rversion, sha256) Left err -> fail $ "Failed to parse git source in Cargo.lock: " <> show err diff --git a/src/NvFetcher/NixFetcher.hs b/src/NvFetcher/NixFetcher.hs index 1f3b048..c69abe8 100644 --- a/src/NvFetcher/NixFetcher.hs +++ b/src/NvFetcher/NixFetcher.hs @@ -55,6 +55,7 @@ module NvFetcher.NixFetcher ) where +import Control.Exception (ErrorCall) import Control.Monad (void, when) import qualified Data.Aeson as A import Data.Coerce (coerce) @@ -168,10 +169,17 @@ prefetchRule = void $ addOracleCache $ \(RunFetch force f) -> do when (force == ForceFetch) alwaysRerun putInfo . show $ "#" <+> pretty f - withRetry $ runFetcher f + keepGoing <- nvcheckerKeepGoing + if keepGoing + then -- If fetch failed, always rerun and return Nothing + actionCatch (fmap Just <$> withRetry $ runFetcher f) $ \(e :: ErrorCall) -> do + alwaysRerun + putError $ show e <> "\nKeep going..." + pure Nothing + else fmap Just <$> withRetry $ runFetcher f -- | Run nix fetcher -prefetch :: NixFetcher Fresh -> ForceFetch -> Action (NixFetcher Fetched) +prefetch :: NixFetcher Fresh -> ForceFetch -> Action (Maybe (NixFetcher Fetched)) prefetch f force = askOracle $ RunFetch force f -------------------------------------------------------------------------------- diff --git a/src/NvFetcher/Options.hs b/src/NvFetcher/Options.hs index b57205c..f7279fd 100644 --- a/src/NvFetcher/Options.hs +++ b/src/NvFetcher/Options.hs @@ -46,6 +46,7 @@ data CLIOptions = CLIOptions optPkgNameFilter :: Maybe String, optKeyfile :: Maybe FilePath, optKeepOldFiles :: Bool, + optKeepGoing :: Bool, optTarget :: Target } deriving (Show) @@ -112,6 +113,7 @@ cliOptionsParser = ) ) <*> switch (long "keep-old" <> help "Don't remove old files other than generated json and nix before build") + <*> switch (long "keep-going" <> help "Don't stop if some packages failed to be fetched") <*> argument targetParser ( metavar "TARGET" diff --git a/src/NvFetcher/Types.hs b/src/NvFetcher/Types.hs index a372c0f..f658c1b 100644 --- a/src/NvFetcher/Types.hs +++ b/src/NvFetcher/Types.hs @@ -383,7 +383,8 @@ instance Default ForceFetch where data RunFetch = RunFetch ForceFetch (NixFetcher Fresh) deriving (Show, Eq, Ord, Hashable, NFData, Binary, Typeable, Generic) -type instance RuleResult RunFetch = NixFetcher Fetched +-- Prefetch rule never throws exceptions +type instance RuleResult RunFetch = Maybe (NixFetcher Fetched) -- | If the package is prefetched, then we can obtain the SHA256 data NixFetcher (k :: FetchStatus) @@ -702,7 +703,8 @@ newtype PackageKey = PackageKey PackageName data Core = Core deriving (Eq, Show, Ord, Typeable, Generic, Hashable, Binary, NFData) -type instance RuleResult Core = PackageResult +-- If prefetch fails, we don't want to fail the whole build +type instance RuleResult Core = Maybe PackageResult -- | Decorate a rule's key with 'PackageKey' newtype WithPackageKey k = WithPackageKey (k, PackageKey) diff --git a/src/NvFetcher/Types/ShakeExtras.hs b/src/NvFetcher/Types/ShakeExtras.hs index 3eff3e4..80f2958 100644 --- a/src/NvFetcher/Types/ShakeExtras.hs +++ b/src/NvFetcher/Types/ShakeExtras.hs @@ -40,8 +40,9 @@ module NvFetcher.Types.ShakeExtras getAllOnDiskVersions, getLastVersionUpdated, - -- * Cache nvchecker + -- * Booleans nvcheckerCacheEnabled, + nvcheckerKeepGoing, ) where @@ -175,3 +176,7 @@ getAllOnDiskVersions = do -- | Get if 'cacheNvchecker' is enabled nvcheckerCacheEnabled :: Action Bool nvcheckerCacheEnabled = cacheNvchecker . config <$> getShakeExtras + +-- | Get if 'keepGoing' is enabled +nvcheckerKeepGoing :: Action Bool +nvcheckerKeepGoing = keepGoing . config <$> getShakeExtras diff --git a/test/FetchRustGitDepsSpec.hs b/test/FetchRustGitDepsSpec.hs index ee7809e..e95c285 100644 --- a/test/FetchRustGitDepsSpec.hs +++ b/test/FetchRustGitDepsSpec.hs @@ -3,6 +3,7 @@ module FetchRustGitDepsSpec where +import Control.Monad (join) import Control.Monad.Trans.Reader import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HMap @@ -30,7 +31,7 @@ spec = aroundShake $ ] runPrefetchRule :: NixFetcher Fresh -> ReaderT ActionQueue IO (Maybe (NixFetcher Fetched)) -runPrefetchRule fetcher = runActionChan $ prefetch fetcher NoForceFetch +runPrefetchRule fetcher = fmap join $ runActionChan $ prefetch fetcher NoForceFetch runFetchRustGitDepsRule :: NixFetcher Fetched -> FilePath -> ReaderT ActionQueue IO (Maybe (HashMap Text Checksum)) runFetchRustGitDepsRule fetcher lockPath = runActionChan $ fetchRustGitDeps fetcher lockPath diff --git a/test/PrefetchSpec.hs b/test/PrefetchSpec.hs index 8b19a87..3b3b26c 100644 --- a/test/PrefetchSpec.hs +++ b/test/PrefetchSpec.hs @@ -4,6 +4,7 @@ module PrefetchSpec where import Control.Arrow ((&&&)) +import Control.Monad (join) import Control.Monad.Trans.Reader import NvFetcher.NixFetcher import NvFetcher.Types @@ -72,4 +73,4 @@ runPrefetchRule :: NixFetcher Fresh -> ReaderT ActionQueue IO (Maybe Checksum) runPrefetchRule = runPrefetchRule' _sha256 runPrefetchRule' :: (NixFetcher Fetched -> a) -> NixFetcher Fresh -> ReaderT ActionQueue IO (Maybe a) -runPrefetchRule' g f = runActionChan $ g <$> prefetch f NoForceFetch +runPrefetchRule' g f = fmap join $ runActionChan $ prefetch f NoForceFetch >>= \m -> pure $ g <$> m