diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,16 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [0.9.3] - 2022-04-08 + +### Added + + - The evaluator now caches build statuses and ignores redundant rebuild requests, giving a significant performance boost to IFD-heavy jobs. + +### Fixed + + - The branch name in flake-based jobs is now handled correctly when special characters are present. + ## [0.9.2] - 2022-03-30 ### Added diff --git a/hercules-ci-agent-worker/Hercules/Agent/Worker.hs b/hercules-ci-agent-worker/Hercules/Agent/Worker.hs --- a/hercules-ci-agent-worker/Hercules/Agent/Worker.hs +++ b/hercules-ci-agent-worker/Hercules/Agent/Worker.hs @@ -4,6 +4,7 @@ {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} module Hercules.Agent.Worker @@ -99,6 +100,7 @@ import System.IO (BufferMode (LineBuffering), hSetBuffering) import System.Posix.Signals (Handler (Catch), installHandler, raiseSignal, sigINT, sigTERM) import System.Timeout (timeout) +import qualified UnliftIO import UnliftIO.Async (wait, withAsync) import UnliftIO.Exception (bracket, catch) import Prelude () @@ -441,6 +443,10 @@ Eval.LiteralArg s -> ["--argstr", encodeUtf8 k, s] Eval.ExprArg s -> ["--arg", encodeUtf8 k, s] +-- Ensure that a nested build invocation does not happen by a mistake in wiring. +-- +-- (It does not happen, but this de-escalates a potential recursion bug to just +-- an error.) withDrvInProgress :: MonadUnliftIO m => HerculesState -> StorePath -> m a -> m a withDrvInProgress HerculesState {drvsInProgress = ref} drvPath = bracket acquire release . const @@ -494,6 +500,22 @@ BuildResult.DependencyFailure -> throwIO $ BuildException plainDrvText (Just "A dependency could not be built.") BuildResult.Success -> pass +mkCache :: forall k a m. (MonadUnliftIO m, Ord k) => IO (k -> m a -> m a) +mkCache = do + doneRef <- liftIO $ newIORef mempty + let hasBeenBuilt :: k -> m (Maybe (Either SomeException a)) + hasBeenBuilt p = liftIO $ readIORef doneRef <&> \c -> M.lookup p c + cacheBy p io = do + b <- hasBeenBuilt p + case b of + Just x -> liftIO $ escalate x + Nothing -> do + r <- UnliftIO.tryAny io + liftIO do + modifyIORef doneRef (M.insert p (r :: Either SomeException a)) + escalate r + pure cacheBy + runEval :: forall i m. (MonadResource m, KatipContext m, MonadUnliftIO m, MonadThrow m) => @@ -508,18 +530,19 @@ s <- storeUri store UnliftIO unlift <- lift askUnliftIO let decode = decodeUtf8With lenientDecode - liftIO $ - setBuilderCallback hStore $ - traverseSPWOs $ \storePathWithOutputs -> unlift $ do - drvStorePath <- liftIO $ getStorePath storePathWithOutputs - drvPath <- liftIO $ CNix.storePathToPath store drvStorePath + + cachingBuilt <- liftIO mkCache + + liftIO . setBuilderCallback hStore $ + traverseSPWOs $ \storePathWithOutputs -> unlift $ do + drvStorePath <- liftIO $ getStorePath storePathWithOutputs + drvPath <- liftIO $ CNix.storePathToPath store drvStorePath + cachingBuilt drvPath do let pathText = decode drvPath outputs <- liftIO $ getOutputs storePathWithOutputs katipAddContext (sl "fullpath" pathText) $ for_ outputs $ \outputName -> do - logLocM DebugS "Building" withDrvInProgress st drvStorePath $ do - liftIO $ writeChan shortcutChan $ Just $ Event.Build drvPath (decode outputName) Nothing derivation <- liftIO $ getDerivation store drvStorePath drvName <- liftIO $ getDerivationNameFromPath drvStorePath drvOutputs <- liftIO $ getDerivationOutputs store drvName derivation @@ -531,43 +554,56 @@ Nothing -> -- FIXME ca-derivations panic $ "output path unknown for output " <> show outputName <> " on " <> pathText <> ". ca-derivations is not supported yet." - katipAddContext (sl "outputPath" (show outputPath :: Text)) $ - logLocM DebugS "Naively calling ensurePath" - liftIO (ensurePath (wrappedStore st) outputPath) `catch` \e0 -> do - katipAddContext (sl "message" (show (e0 :: SomeException) :: Text)) $ - logLocM DebugS "Recovering from failed wrapped.ensurePath" - (attempt0, result) <- - liftIO $ - atomically $ do - c <- readTVar drvsCompl - anyAlternative $ M.lookup drvStorePath c - liftIO $ maybeThrowBuildException result (decode drvPath) - liftIO clearSubstituterCaches - liftIO $ clearPathInfoCache store - liftIO (ensurePath (wrappedStore st) outputPath) `catch` \e1 -> do - katipAddContext (sl "message" (show (e1 :: SomeException) :: Text)) $ - logLocM DebugS "Recovering from fresh ensurePath" - liftIO $ writeChan shortcutChan $ Just $ Event.Build drvPath (decode outputName) (Just attempt0) - -- TODO sync - result' <- - liftIO $ - atomically $ do - c <- readTVar drvsCompl - (attempt1, r) <- anyAlternative $ M.lookup drvStorePath c - guard (attempt1 /= attempt0) - pure r - liftIO $ maybeThrowBuildException result' (decode drvPath) - liftIO clearSubstituterCaches - liftIO $ clearPathInfoCache store - liftIO (ensurePath (wrappedStore st) outputPath) `catch` \e2 -> - liftIO $ - throwIO $ - BuildException - (decode drvPath) - ( Just $ - "It could not be retrieved on the evaluating agent, despite a successful rebuild. Exception: " - <> show (e2 :: SomeException) - ) + + isValid <- liftIO $ isValidPath store outputPath + if isValid + then do + logLocM DebugS "Output already valid" + -- Report IFD + liftIO $ writeChan shortcutChan $ Just $ Event.Build drvPath (decode outputName) Nothing False + else do + logLocM DebugS "Building" + liftIO $ writeChan shortcutChan $ Just $ Event.Build drvPath (decode outputName) Nothing True + ( katipAddContext (sl "outputPath" (show outputPath :: Text)) do + logLocM DebugS "Attempting early ensurePath" + liftIO (ensurePath (wrappedStore st) outputPath) + ) + `catch` \e0 -> do + katipAddContext (sl "message" (show (e0 :: SomeException) :: Text)) $ + logLocM DebugS "Recovering from failed wrapped.ensurePath" + (attempt0, result) <- + liftIO $ + atomically $ do + c <- readTVar drvsCompl + anyAlternative $ M.lookup drvStorePath c + liftIO $ maybeThrowBuildException result (decode drvPath) + liftIO clearSubstituterCaches + liftIO $ clearPathInfoCache store + liftIO (ensurePath (wrappedStore st) outputPath) `catch` \e1 -> do + katipAddContext (sl "message" (show (e1 :: SomeException) :: Text)) $ + logLocM DebugS "Recovering from fresh ensurePath" + liftIO $ writeChan shortcutChan $ Just $ Event.Build drvPath (decode outputName) (Just attempt0) True + -- TODO sync + result' <- + liftIO $ + atomically $ do + c <- readTVar drvsCompl + (attempt1, r) <- anyAlternative $ M.lookup drvStorePath c + guard (attempt1 /= attempt0) + pure r + liftIO $ maybeThrowBuildException result' (decode drvPath) + liftIO clearSubstituterCaches + liftIO $ clearPathInfoCache store + liftIO (ensurePath (wrappedStore st) outputPath) `catch` \e2 -> + liftIO $ + throwIO $ + BuildException + (decode drvPath) + ( Just $ + "It could not be retrieved on the evaluating agent, despite a successful rebuild. Exception: " + <> show (e2 :: SomeException) + ) + liftIO $ addTemporaryRoot store outputPath logLocM DebugS "Built" withEvalStateConduit store $ \evalState -> do liftIO do diff --git a/hercules-ci-agent.cabal b/hercules-ci-agent.cabal --- a/hercules-ci-agent.cabal +++ b/hercules-ci-agent.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: hercules-ci-agent -version: 0.9.2 +version: 0.9.3 synopsis: Runs Continuous Integration tasks on your machines category: Nix, CI, Testing, DevOps homepage: https://docs.hercules-ci.com diff --git a/hercules-ci-agent/Hercules/Agent/Evaluate.hs b/hercules-ci-agent/Hercules/Agent/Evaluate.hs --- a/hercules-ci-agent/Hercules/Agent/Evaluate.hs +++ b/hercules-ci-agent/Hercules/Agent/Evaluate.hs @@ -512,39 +512,38 @@ Message.message = e } continue - Event.Build drv outputName notAttempt -> do + Event.Build drv outputName notAttempt waitForStatus -> do store <- asks (Cachix.Env.nixStore . Env.cachixEnv) storePath <- liftIO (parseStorePath store drv) let drvText = decode drv - status <- - withNamedContext "derivation" (decode drv) $ do - currentIndex <- liftIO $ atomicModifyIORef buildRequiredIndex (\i -> (i + 1, i)) - emit $ - EvaluateEvent.BuildRequired - BuildRequired.BuildRequired - { BuildRequired.derivationPath = drvText, - BuildRequired.index = currentIndex, - BuildRequired.outputName = outputName - } - let pushDerivations = do - caches <- activePushCaches - forM_ caches $ \cache -> do - withNamedContext "cache" cache $ logLocM DebugS "Pushing derivations for import from derivation" - Agent.Cache.push cache [storePath] pushEvalWorkers - Async.Lifted.concurrently_ - (uploadDerivationInfos storePath) - pushDerivations - emit $ - EvaluateEvent.BuildRequest - BuildRequest.BuildRequest - { derivationPath = drvText, - forceRebuild = isJust notAttempt - } + withNamedContext "derivation" (decode drv) $ do + currentIndex <- liftIO $ atomicModifyIORef buildRequiredIndex (\i -> (i + 1, i)) + emit $ + EvaluateEvent.BuildRequired + BuildRequired.BuildRequired + { BuildRequired.derivationPath = drvText, + BuildRequired.index = currentIndex, + BuildRequired.outputName = outputName + } + let pushDerivations = do + caches <- activePushCaches + forM_ caches $ \cache -> do + withNamedContext "cache" cache $ logLocM DebugS "Pushing derivations for import from derivation" + Agent.Cache.push cache [storePath] pushEvalWorkers + Async.Lifted.concurrently_ + (uploadDerivationInfos storePath) + pushDerivations + emit $ + EvaluateEvent.BuildRequest + BuildRequest.BuildRequest + { derivationPath = drvText, + forceRebuild = isJust notAttempt + } + when waitForStatus do flush status <- drvPoller notAttempt drvText logLocM DebugS $ "Got derivation status " <> logStr (show status :: Text) - return status - writeChan commandChan $ Just $ Command.BuildResult $ uncurry (BuildResult.BuildResult drvText) status + writeChan commandChan $ Just $ Command.BuildResult $ uncurry (BuildResult.BuildResult drvText) status continue Event.OnPushHandler (ViaJSON e) -> do emit $ EvaluateEvent.OnPushHandlerEvent e diff --git a/src/Hercules/Agent/WorkerProtocol/Event.hs b/src/Hercules/Agent/WorkerProtocol/Event.hs --- a/src/Hercules/Agent/WorkerProtocol/Event.hs +++ b/src/Hercules/Agent/WorkerProtocol/Event.hs @@ -19,7 +19,7 @@ | AttributeError AttributeError | EvaluationDone | Error Text - | Build ByteString Text (Maybe UUID) + | Build ByteString Text (Maybe UUID) Bool | BuildResult BuildResult | EffectResult Int | JobConfig