diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,7 +5,22 @@ 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.10] - 2022-12-29 +### Fixed + + - Detect stack overflows correctly in Nix evaluation + + - Retry errors from Nix-native (non-cachix) caches + +### Added + + - Cachix 1.1 compatibility + +### Changed + + - Unwrap some error messages for readability + ## [0.9.9] - 2022-12-02 ### Fixed @@ -641,6 +656,8 @@ - Initial release +[0.9.10]: https://github.com/hercules-ci/hercules-ci-agent/compare/hercules-ci-agent-0.9.9...hercules-ci-agent-0.9.10 +[0.9.9]: https://github.com/hercules-ci/hercules-ci-agent/compare/hercules-ci-agent-0.9.8...hercules-ci-agent-0.9.9 [0.9.8]: https://github.com/hercules-ci/hercules-ci-agent/compare/hercules-ci-agent-0.9.7...hercules-ci-agent-0.9.8 [0.9.7]: https://github.com/hercules-ci/hercules-ci-agent/compare/hercules-ci-agent-0.9.6...hercules-ci-agent-0.9.7 [0.9.6]: https://github.com/hercules-ci/hercules-ci-agent/compare/hercules-ci-agent-0.9.5...hercules-ci-agent-0.9.6 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 @@ -14,7 +14,6 @@ import qualified Control.Exception.Lifted as EL import Control.Monad.Except import Control.Monad.IO.Unlift -import Control.Monad.Trans.Control import qualified Data.Conduit import Data.Conduit.Extras (sinkChan, sinkChanTerminate, sourceChan) import Data.Conduit.Katip.Orphans () @@ -60,7 +59,7 @@ import qualified Hercules.Agent.WorkerProtocol.Event as Event import qualified Hercules.Agent.WorkerProtocol.LogSettings as LogSettings import Hercules.CNix as CNix -import Hercules.CNix.Expr (init) +import Hercules.CNix.Expr (init, setExtraStackOverflowHandlerToSleep) import Hercules.CNix.Util (installDefaultSigINTHandler) import Hercules.CNix.Verbosity (setShowTrace) import Hercules.Error @@ -83,6 +82,7 @@ _ <- installHandler sigTERM (Catch $ raiseSignal sigINT) Nothing installDefaultSigINTHandler Logger.initLogger + setExtraStackOverflowHandlerToSleep args <- Environment.getArgs case args of [options] -> taskWorker options @@ -190,7 +190,7 @@ .| sinkChan ch ) -runCommand :: (MonadUnliftIO m, MonadBaseControl IO m, KatipContext m, MonadThrow m) => HerculesState -> Chan (Maybe Event) -> Command -> m () +runCommand :: (MonadUnliftIO m, KatipContext m, MonadThrow m) => HerculesState -> Chan (Maybe Event) -> Command -> m () -- runCommand' :: HerculesState -> Command -> ConduitM Command Event (ResourceT IO) () runCommand herculesState ch command = do -- TODO don't do this @@ -203,24 +203,24 @@ Logger.withTappedStderr Logger.tapper $ connectCommand ch $ do liftIO $ restrictEval eval - void $ - liftIO $ - flip - forkFinally - (escalateAs \e -> FatalError $ "Failed to fork: " <> show e) - $ unlift $ - runConduitRes - ( Data.Conduit.handleC - ( \e -> do - yield . Event.Error . exceptionTextMessage =<< liftIO (renderException e) - liftIO $ throwTo mainThread e - ) - ( do - runEval herculesState eval - liftIO $ throwTo mainThread ExitSuccess - ) - .| sinkChanTerminate (shortcutChannel herculesState) - ) + void + $ liftIO + $ flip + forkFinally + (escalateAs \e -> FatalError $ "Failed to fork: " <> show e) + $ unlift + $ runConduitRes + ( Data.Conduit.handleC + ( \e -> do + yield . Event.Error . exceptionTextMessage =<< liftIO (renderException e) + liftIO $ throwTo mainThread e + ) + ( do + runEval herculesState eval + liftIO $ throwTo mainThread ExitSuccess + ) + .| sinkChanTerminate (shortcutChannel herculesState) + ) awaitForever $ \case Command.BuildResult (BuildResult.BuildResult path attempt result) -> do katipAddContext (sl "path" path <> sl "result" (show result :: Text)) $ @@ -234,7 +234,8 @@ katipAddNamespace "Build" $ Logger.withLoggerConduit (logger (Build.logSettings build) protocolVersion) $ Logger.withTappedStderr Logger.tapper $ - connectCommand ch $ runBuild (wrappedStore herculesState) build + connectCommand ch $ + runBuild (wrappedStore herculesState) build Command.Effect effect -> katipAddNamespace "Effect" $ Logger.withLoggerConduit (logger (Effect.logSettings effect) protocolVersion) $ diff --git a/hercules-ci-agent-worker/Hercules/Agent/Worker/Build/Logger/Context.hs b/hercules-ci-agent-worker/Hercules/Agent/Worker/Build/Logger/Context.hs --- a/hercules-ci-agent-worker/Hercules/Agent/Worker/Build/Logger/Context.hs +++ b/hercules-ci-agent-worker/Hercules/Agent/Worker/Build/Logger/Context.hs @@ -24,7 +24,8 @@ context :: C.Context context = - C.cppCtx <> C.fptrCtx + C.cppCtx + <> C.fptrCtx <> C.bsCtx <> loggerContext diff --git a/hercules-ci-agent-worker/Hercules/Agent/Worker/Error.hs b/hercules-ci-agent-worker/Hercules/Agent/Worker/Error.hs --- a/hercules-ci-agent-worker/Hercules/Agent/Worker/Error.hs +++ b/hercules-ci-agent-worker/Hercules/Agent/Worker/Error.hs @@ -51,7 +51,7 @@ renderException e | Just (C.CppStdException ex _msg _ty) <- fromException e = renderStdException ex renderException e | Just (C.CppNonStdException _ex maybeType) <- fromException e = - pure $ basicExceptionText $ "Unexpected C++ exception" <> foldMap (\t -> " of type " <> decodeUtf8With lenientDecode t) maybeType + pure $ basicExceptionText $ "Unexpected C++ exception" <> foldMap (\t -> " of type " <> decodeUtf8With lenientDecode t) maybeType renderException e | Just (FatalError msg) <- fromException e = pure $ basicExceptionText msg renderException e = pure $ basicExceptionText $ toS $ displayException e diff --git a/hercules-ci-agent-worker/Hercules/Agent/Worker/Evaluate.hs b/hercules-ci-agent-worker/Hercules/Agent/Worker/Evaluate.hs --- a/hercules-ci-agent-worker/Hercules/Agent/Worker/Evaluate.hs +++ b/hercules-ci-agent-worker/Hercules/Agent/Worker/Evaluate.hs @@ -51,7 +51,7 @@ import qualified Hercules.Agent.WorkerProtocol.Event.AttributeIFD as Event.AttributeIFD import qualified Hercules.Agent.WorkerProtocol.ViaJSON as ViaJSON import Hercules.CNix as CNix -import Hercules.CNix.Expr (Match (IsAttrs, IsString), NixAttrs, RawValue, addAllowedPath, addInternalAllowedPaths, autoCallFunction, evalArgs, getAttrBool, getAttrList, getAttrs, getDrvFile, getFlakeFromArchiveUrl, getFlakeFromGit, getRecurseForDerivations, getStringIgnoreContext, isDerivation, isFunctor, match, rawValueType, rtValue, toRawValue, toValue, withEvalStateConduit) +import Hercules.CNix.Expr (Match (IsAttrs, IsString), NixAttrs, RawValue, addAllowedPath, addInternalAllowedPaths, autoCallFunction, evalArgs, getAttrBool, getAttrList, getAttrs, getDrvFile, getFlakeFromArchiveUrl, getFlakeFromGit, getRecurseForDerivations, getStringIgnoreContext, initThread, isDerivation, isFunctor, match, rawValueType, rtValue, toRawValue, toValue, withEvalStateConduit) import Hercules.CNix.Expr.Context (EvalState) import qualified Hercules.CNix.Expr.Raw import Hercules.CNix.Expr.Schema (MonadEval, PSObject, dictionaryToMap, fromPSObject, provenance, requireDict, traverseArray, (#.), (#?), (#?!), (#??), ($?), (|!), type (->?), type (.)) @@ -172,6 +172,7 @@ runEval st@HerculesState {herculesStore = hStore, shortcutChannel = shortcutChan, drvsCompleted = drvsCompl} eval = do for_ (Eval.extraNixOptions eval) $ liftIO . uncurry setGlobalOption for_ (Eval.extraNixOptions eval) $ liftIO . uncurry setOption + liftIO initThread let store = nixStore hStore isFlake = Eval.isFlakeJob eval s <- storeUri store @@ -738,14 +739,14 @@ ( lastMay path == Just "recurseForDerivations" && vt - == Hercules.CNix.Expr.Raw.Bool + == Hercules.CNix.Expr.Raw.Bool ) - $ logLocM DebugS $ - logStr $ - "Ignoring " - <> show path - <> " : " - <> (show vt :: Text) + $ logLocM DebugS + $ logStr + $ "Ignoring " + <> show path + <> " : " + <> (show vt :: Text) pass in start @@ -767,7 +768,7 @@ Just True | effectsAnywhere || inEffects path -> - throwE $ Right Attribute.Effect + throwE $ Right Attribute.Effect Just True | otherwise -> throwE $ Left $ toException $ UserException "This derivation is marked as an effect, but effects are only allowed below the effects attribute." _ -> pass isDependenciesOnly <- liftEitherAs Left =<< liftIO (getAttrBool evalState attrValue "buildDependenciesOnly") diff --git a/hercules-ci-agent-worker/Hercules/Agent/Worker/HerculesStore/Context.hs b/hercules-ci-agent-worker/Hercules/Agent/Worker/HerculesStore/Context.hs --- a/hercules-ci-agent-worker/Hercules/Agent/Worker/HerculesStore/Context.hs +++ b/hercules-ci-agent-worker/Hercules/Agent/Worker/HerculesStore/Context.hs @@ -24,7 +24,8 @@ context :: C.Context context = - C.cppCtx <> C.fptrCtx + C.cppCtx + <> C.fptrCtx <> C.bsCtx <> stdVectorCtx <> Store.context 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.9 +version: 0.9.10 synopsis: Runs Continuous Integration tasks on your machines category: Nix, CI, Testing, DevOps homepage: https://docs.hercules-ci.com @@ -221,7 +221,7 @@ , hercules-ci-agent , hercules-ci-api , hercules-ci-api-core == 0.1.5.0 - , hercules-ci-api-agent == 0.4.6.0 + , hercules-ci-api-agent == 0.4.6.1 , hostname , http-client , http-client-tls diff --git a/hercules-ci-agent/Data/Functor/Partitioner.hs b/hercules-ci-agent/Data/Functor/Partitioner.hs --- a/hercules-ci-agent/Data/Functor/Partitioner.hs +++ b/hercules-ci-agent/Data/Functor/Partitioner.hs @@ -93,5 +93,5 @@ -- -- It uses 'WithKey' to maintain the invariant that all keys and values are -- preserved when returning @Just@ from 'partWithKey'. -partitionMap :: Ord k => Partitioner (WithKey k a) b -> M.Map k a -> b +partitionMap :: Partitioner (WithKey k a) b -> M.Map k a -> b partitionMap p = partitionList p . coerce . M.toAscList diff --git a/hercules-ci-agent/Hercules/Agent.hs b/hercules-ci-agent/Hercules/Agent.hs --- a/hercules-ci-agent/Hercules/Agent.hs +++ b/hercules-ci-agent/Hercules/Agent.hs @@ -180,7 +180,11 @@ report' (Left e) = withNamedContext "message" (displayException e) $ withNamedContext "exception" (show e :: Text) do logLocM ErrorS "Exception in task" - report $ TaskStatus.Exceptional $ toS $ displayException e + case fromException e of + Just (FatalError msg) -> + report $ TaskStatus.Exceptional msg + _ -> + report $ TaskStatus.Exceptional $ toS $ displayException e -- TODO use socket report status = retry (cap 60 exponential) $ diff --git a/hercules-ci-agent/Hercules/Agent/Build.hs b/hercules-ci-agent/Hercules/Agent/Build.hs --- a/hercules-ci-agent/Hercules/Agent/Build.hs +++ b/hercules-ci-agent/Hercules/Agent/Build.hs @@ -140,7 +140,9 @@ emitEvents :: BuildTask -> [BuildEvent.BuildEvent] -> App () emitEvents buildTask = - noContent . defaultRetry . runHerculesClient + noContent + . defaultRetry + . runHerculesClient . API.Build.updateBuild Hercules.Agent.Client.buildClient (BuildTask.id buildTask) diff --git a/hercules-ci-agent/Hercules/Agent/Cache.hs b/hercules-ci-agent/Hercules/Agent/Cache.hs --- a/hercules-ci-agent/Hercules/Agent/Cache.hs +++ b/hercules-ci-agent/Hercules/Agent/Cache.hs @@ -16,6 +16,7 @@ import qualified Hercules.CNix.Std.Set as Std.Set import Hercules.CNix.Store (StorePath) import qualified Hercules.CNix.Store as Store +import Hercules.Error (defaultRetry) import qualified Hercules.Formats.NixCache as NixCache import Katip import Protolude @@ -45,7 +46,7 @@ -- | Number of concurrent upload threads Int -> App () -push cacheName paths concurrency = katipAddContext (sl "cacheName" cacheName) do +push cacheName paths concurrency = katipAddNamespace "Push" $ katipAddContext (sl "cacheName" cacheName) do caches <- asks Env.binaryCaches let maybeNix = Config.nixCaches caches & M.lookup cacheName & fmap \cache -> @@ -68,7 +69,7 @@ katipAddContext (sl "num-signatures" signed <> sl "num-paths" total) $ logLocM DebugS "Signed" liftIO $ CNix.clearPathInfoCache store - CNix.withStoreFromURI (NixCache.storeURI cacheConf) $ \cache -> do + defaultRetry . CNix.withStoreFromURI (NixCache.storeURI cacheConf) $ \cache -> do liftIO (CNix.copyClosure store cache paths) signClosure :: CNix.Store -> ForeignPtr CNix.SecretKey -> StdSet Store.NixStorePath -> IO (Sum Int, Sum Int) diff --git a/hercules-ci-agent/Hercules/Agent/Cachix.hs b/hercules-ci-agent/Hercules/Agent/Cachix.hs --- a/hercules-ci-agent/Hercules/Agent/Cachix.hs +++ b/hercules-ci-agent/Hercules/Agent/Cachix.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Hercules.Agent.Cachix ( module Hercules.Agent.Cachix, activePushCaches, @@ -5,6 +6,7 @@ where import qualified Cachix.Client.Push as Cachix.Push +import Cachix.Types.BinaryCache (CompressionMethod(XZ)) import Control.Monad.IO.Unlift import qualified Data.Map as M import qualified Hercules.Agent.Cachix.Env as Agent.Cachix @@ -48,7 +50,12 @@ on401 = throwIO $ FatalError "Cachix push is unauthorized", onError = \err -> throwIO $ FatalError $ "Error pushing to cachix: " <> show err, onDone = ctx $ logLocM DebugS "push done", +#if MIN_VERSION_cachix(1,1,0) + compressionMethod = XZ, + compressionLevel = 2, +#else withXzipCompressor = Cachix.Push.defaultWithXzipCompressor, +#endif omitDeriver = False } } diff --git a/hercules-ci-agent/Hercules/Agent/Client.hs b/hercules-ci-agent/Hercules/Agent/Client.hs --- a/hercules-ci-agent/Hercules/Agent/Client.hs +++ b/hercules-ci-agent/Hercules/Agent/Client.hs @@ -26,7 +26,6 @@ import Hercules.API.Servant (useApi) import Protolude import Servant.API -import Servant.API.Generic import Servant.Auth.Client () import Servant.Client.Generic (AsClientT) import Servant.Client.Streaming (ClientM) 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 @@ -442,7 +442,8 @@ Nothing -> do panic $ "No primary source metadata provided" <> show task Just meta -> pure $ fromMaybe (panic "no ref/rev in primary source metadata") do - (,) <$> (meta ^? at "ref" . traverse . _String) + (,) + <$> (meta ^? at "ref" . traverse . _String) <*> (meta ^? at "rev" . traverse . _String) pure $ GitSource.GitSource @@ -490,14 +491,14 @@ let decode = decodeUtf8With lenientDecode toGitConfigEnv items = M.fromList $ - ("GIT_CONFIG_COUNT", show (length items)) : - concatMap - ( \(i, (k, v)) -> - [ ("GIT_CONFIG_KEY_" <> show i, k), - ("GIT_CONFIG_VALUE_" <> show i, v) - ] - ) - (zip [0 :: Int ..] items) + ("GIT_CONFIG_COUNT", show (length items)) + : concatMap + ( \(i, (k, v)) -> + [ ("GIT_CONFIG_KEY_" <> show i, k), + ("GIT_CONFIG_VALUE_" <> show i, v) + ] + ) + (zip [0 :: Int ..] items) envSettings = WorkerProcess.WorkerEnvSettings { nixPath = nixPath, diff --git a/hercules-ci-agent/Hercules/Agent/Log.hs b/hercules-ci-agent/Hercules/Agent/Log.hs --- a/hercules-ci-agent/Hercules/Agent/Log.hs +++ b/hercules-ci-agent/Hercules/Agent/Log.hs @@ -35,8 +35,8 @@ stderrLineHandler callerContext _processRole _ ln | "@katip " `BS.isPrefixOf` ln, Just item <- A.decode (LBS.fromStrict $ BS.drop 7 ln) = - -- "This is the lowest level function [...] useful when implementing centralised logging services." - Katip.Core.logKatipItem (Katip.Core.SimpleLogPayload . M.toList . fmap (Katip.Core.AnyLogPayload :: A.Value -> Katip.Core.AnyLogPayload) . extendContext <$> item) + -- "This is the lowest level function [...] useful when implementing centralised logging services." + Katip.Core.logKatipItem (Katip.Core.SimpleLogPayload . M.toList . fmap (Katip.Core.AnyLogPayload :: A.Value -> Katip.Core.AnyLogPayload) . extendContext <$> item) where extendContext workerItem = M.union workerItem callerContext stderrLineHandler _ processRole pid ln = diff --git a/hercules-ci-agent/Hercules/Agent/Options.hs b/hercules-ci-agent/Hercules/Agent/Options.hs --- a/hercules-ci-agent/Hercules/Agent/Options.hs +++ b/hercules-ci-agent/Hercules/Agent/Options.hs @@ -17,7 +17,8 @@ parseOptions :: Parser Options parseOptions = - Options <$> parseConfigPath + Options + <$> parseConfigPath <*> parseMode data Mode = Test | Run @@ -32,7 +33,8 @@ parseConfigPath = TomlPath <$> strOption - ( long "config" <> metavar "FILE" + ( long "config" + <> metavar "FILE" <> help "File path to the configuration file (TOML)" ) @@ -41,7 +43,8 @@ parserInfo = info (parseOptions <**> helper) - ( fullDesc <> progDesc "Accepts tasks from Hercules CI and runs them." + ( fullDesc + <> progDesc "Accepts tasks from Hercules CI and runs them." <> header ("hercules-ci-agent " <> toS herculesAgentVersion) ) diff --git a/src/Hercules/Agent/Producer.hs b/src/Hercules/Agent/Producer.hs --- a/src/Hercules/Agent/Producer.hs +++ b/src/Hercules/Agent/Producer.hs @@ -108,7 +108,7 @@ -- where trav = -- deriving (Functor) ---instance Applicative Syncing where +-- instance Applicative Syncing where -- pure = Synced Nothing -- Synced sf f <*> Synced af a = Synced (sf <> af) (f a) @@ -138,38 +138,38 @@ doPerformBatch [] = pure () doPerformBatch buf = writeBatch (reverse buf) readItems 0 buf = do - --logLocM DebugS "batch on full" + -- logLocM DebugS "batch on full" doPerformBatch buf beginReading readItems bufferRemaining buf = joinSTM ( onQueueRead <$> producerQueueRead sourceP <|> onFlush - <$ readTQueue flushes + <$ readTQueue flushes ) where onQueueRead (Payload a) = readItems (bufferRemaining - 1) (a : buf) onQueueRead (Close r) = do - --logLocM DebugS $ "batch on close: " <> logStr (show (length buf)) + -- logLocM DebugS $ "batch on close: " <> logStr (show (length buf)) doPerformBatch buf pure r onQueueRead (Exception e) = do - --logLocM DebugS $ "batch on exception: " <> logStr (show (length buf)) + -- logLocM DebugS $ "batch on exception: " <> logStr (show (length buf)) doPerformBatch buf liftIO $ throwIO e onFlush = do - --logLocM DebugS $ "batch on flush: " <> logStr (show (length buf)) + -- logLocM DebugS $ "batch on flush: " <> logStr (show (length buf)) doPerformBatch buf beginReading in beginReading - liftIO $ - withAsync + liftIO + $ withAsync ( forever $ do threadDelay maxDelay atomically $ writeTQueue flushes () ) - $ \_flusher -> unlift $ withProducer producer f + $ \_flusher -> unlift $ withProducer producer f syncer :: MonadIO m => (Syncing a -> m ()) -> m () syncer writer = do