diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,7 +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.1] - 2022-03-18 +### Added + + - The built-in flake support now has the `sourceInfo` attributes. + +### Changed + + - Flakes are checked out by Nix rather than custom local checkout. + ## [0.9.0] - 2022-03-15 This release comes with an [Upgrade Guide! ✨](https://docs.hercules-ci.com/hercules-ci/guides/upgrade-to-agent-0.9/) @@ -534,6 +543,7 @@ - Initial release +[0.9.1]: https://github.com/hercules-ci/hercules-ci-agent/compare/hercules-ci-agent-0.9.0...hercules-ci-agent-0.9.1 [0.9.0]: https://github.com/hercules-ci/hercules-ci-agent/compare/hercules-ci-agent-0.8.7...hercules-ci-agent-0.9.0 [0.8.7]: https://github.com/hercules-ci/hercules-ci-agent/compare/hercules-ci-agent-0.8.6...hercules-ci-agent-0.8.7 [0.8.6]: https://github.com/hercules-ci/hercules-ci-agent/compare/hercules-ci-agent-0.8.5...hercules-ci-agent-0.8.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 @@ -35,6 +35,7 @@ import Hercules.API.Agent.Evaluate.EvaluateEvent.OnPushHandlerEvent (OnPushHandlerEvent (OnPushHandlerEvent)) import qualified Hercules.API.Agent.Evaluate.EvaluateEvent.OnPushHandlerEvent import qualified Hercules.API.Agent.Evaluate.EvaluateTask as EvaluateTask +import qualified Hercules.API.Agent.Evaluate.EvaluateTask.OnPush as OnPush import qualified Hercules.API.Agent.Evaluate.ImmutableGitInput as API.ImmutableGitInput import qualified Hercules.API.Agent.Evaluate.ImmutableInput as API.ImmutableInput import qualified Hercules.API.Agent.LifeCycle.ServiceInfo @@ -44,6 +45,7 @@ import Hercules.API.Logs.LogMessage (LogMessage) import qualified Hercules.API.Logs.LogMessage as LogMessage import Hercules.Agent.NixFile (HerculesCISchema, getHerculesCI, homeExprRawValue, loadNixFile, parseExtraInputs) +import qualified Hercules.Agent.NixFile as NixFile import Hercules.Agent.NixFile.HerculesCIArgs (CISystems (CISystems), HerculesCIMeta (HerculesCIMeta), fromGitSource) import qualified Hercules.Agent.NixFile.HerculesCIArgs import Hercules.Agent.Sensitive @@ -75,7 +77,7 @@ import qualified Hercules.Agent.WorkerProtocol.Event.AttributeError as AttributeError import qualified Hercules.Agent.WorkerProtocol.LogSettings as LogSettings 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, init, isDerivation, isFunctor, match, rawValueType, rtValue, toRawValue, withEvalStateConduit) +import Hercules.CNix.Expr (Match (IsAttrs, IsString), NixAttrs, RawValue, addAllowedPath, addInternalAllowedPaths, autoCallFunction, evalArgs, getAttrBool, getAttrList, getAttrs, getDrvFile, getFlakeFromArchiveUrl, getFlakeFromGit, getRecurseForDerivations, getStringIgnoreContext, init, 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, requireDict, (#.), (#?), (#?!), ($?)) @@ -481,6 +483,7 @@ for_ (Eval.extraNixOptions eval) $ liftIO . uncurry setGlobalOption for_ (Eval.extraNixOptions eval) $ liftIO . uncurry setOption let store = nixStore hStore + isFlake = Eval.isFlakeJob eval s <- storeUri store UnliftIO unlift <- lift askUnliftIO let decode = decodeUtf8With lenientDecode @@ -556,7 +559,7 @@ evalArgs evalState (autoArgArgs (Eval.autoArguments eval)) Data.Conduit.handleC (yieldAttributeError []) $ do - homeExpr <- escalateAs UserException =<< liftIO (loadNixFile evalState (toS $ Eval.cwd eval) (coerce $ Eval.gitSource eval)) + homeExpr <- getHomeExpr evalState eval let hargs = fromGitSource (coerce $ Eval.gitSource eval) meta meta = HerculesCIMeta {apiBaseUrl = Eval.apiBaseUrl eval, ciSystems = CISystems (Eval.ciSystems eval)} liftIO (flip runReaderT evalState $ getHerculesCI homeExpr hargs) >>= \case @@ -567,17 +570,31 @@ case Event.fromViaJSON (Eval.selector eval) of EvaluateTask.ConfigOrLegacy -> do yield Event.JobConfig - sendConfig evalState herculesCI + sendConfig evalState isFlake herculesCI EvaluateTask.OnPush onPush -> transPipe (`runReaderT` evalState) do walkOnPush store evalState onPush herculesCI yield Event.EvaluationDone -walkOnPush :: (MonadEval m, MonadUnliftIO m, KatipContext m, MonadThrow m) => Store -> Ptr EvalState -> EvaluateTask.OnPush -> PSObject HerculesCISchema -> ConduitT i Event m () +getHomeExpr :: (MonadThrow m, MonadIO m) => Ptr EvalState -> Eval -> m NixFile.HomeExpr +getHomeExpr evalState eval = + if Eval.isFlakeJob eval + then + NixFile.Flake <$> liftIO do + srcInput <- case Eval.srcInput eval of + Just x -> pure x + Nothing -> panic "srcInput is required for flake job" + raw <- mkImmutableGitInputFlakeThunk evalState (Event.fromViaJSON srcInput) + let pso :: PSObject (Schema.Attrs '[]) + pso = Schema.PSObject {value = raw, provenance = Schema.Other "flake.nix"} + toValue evalState pso + else escalateAs UserException =<< liftIO (loadNixFile evalState (toS $ Eval.cwd eval) (coerce $ Eval.gitSource eval)) + +walkOnPush :: (MonadEval m, MonadUnliftIO m, KatipContext m, MonadThrow m) => Store -> Ptr EvalState -> OnPush.OnPush -> PSObject HerculesCISchema -> ConduitT i Event m () walkOnPush store evalState onPushParams herculesCI = do - onPushHandler <- herculesCI #?! #onPush >>= requireDict (EvaluateTask.name onPushParams) + onPushHandler <- herculesCI #?! #onPush >>= requireDict (OnPush.name onPushParams) inputs <- liftIO $ do - inputs <- for (EvaluateTask.inputs onPushParams) \input -> do + inputs <- for (OnPush.inputs onPushParams) \input -> do inputToValue evalState input toRawValue evalState inputs outputsFun <- onPushHandler #. #outputs @@ -597,8 +614,8 @@ (API.ImmutableGitInput.ref git) (API.ImmutableGitInput.rev git) -sendConfig :: MonadIO m => Ptr EvalState -> PSObject HerculesCISchema -> ConduitT i Event m () -sendConfig evalState herculesCI = flip runReaderT evalState $ do +sendConfig :: MonadIO m => Ptr EvalState -> Bool -> PSObject HerculesCISchema -> ConduitT i Event m () +sendConfig evalState isFlake herculesCI = flip runReaderT evalState $ do herculesCI #? #onPush >>= traverse_ \onPushes -> do attrs <- dictionaryToMap onPushes for_ (M.mapWithKey (,) attrs) \(name, onPush) -> do @@ -607,7 +624,8 @@ when enable . lift . yield . Event.OnPushHandler . ViaJSON $ OnPushHandlerEvent { handlerName = decodeUtf8 name, - handlerExtraInputs = M.mapKeys decodeUtf8 (fromMaybe mempty ei) + handlerExtraInputs = M.mapKeys decodeUtf8 (fromMaybe mempty ei), + isFlake = isFlake } -- | Documented in @docs/modules/ROOT/pages/evaluation.adoc@. 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.0 +version: 0.9.1 synopsis: Runs Continuous Integration tasks on your machines category: Nix, CI, Testing, DevOps homepage: https://docs.hercules-ci.com @@ -104,8 +104,6 @@ Hercules.UserException Data.Conduit.Extras Data.Conduit.Katip.Orphans - - other-modules: Paths_hercules_ci_agent autogen-modules: Paths_hercules_ci_agent @@ -195,9 +193,6 @@ Hercules.Agent.SecureDirectory Hercules.Agent.ServiceInfo Hercules.Agent.Token - Paths_hercules_ci_agent - autogen-modules: - Paths_hercules_ci_agent hs-source-dirs: hercules-ci-agent default-extensions: DeriveGeneric DeriveTraversable DisambiguateRecordFields FlexibleContexts InstanceSigs LambdaCase MultiParamTypeClasses NoImplicitPrelude OverloadedStrings RankNTypes TupleSections TypeApplications TypeOperators @@ -223,7 +218,7 @@ , filepath , hercules-ci-agent , hercules-ci-api-core == 0.1.4.0 - , hercules-ci-api-agent == 0.4.2.0 + , hercules-ci-api-agent == 0.4.3.0 , hostname , http-client , http-client-tls @@ -274,13 +269,10 @@ Hercules.Agent.Worker.Build.Logger Hercules.Agent.Worker.Build.Logger.Context Hercules.Agent.Worker.Effect - Paths_hercules_ci_agent Hercules.Agent.Worker.HerculesStore Hercules.Agent.Worker.HerculesStore.Context Hercules.Agent.Worker.Logging Hercules.Agent.Worker.NixDaemon - autogen-modules: - Paths_hercules_ci_agent hs-source-dirs: hercules-ci-agent-worker @@ -368,7 +360,6 @@ Hercules.Agent.WorkerProcessSpec Hercules.Secrets Hercules.SecretsSpec - Paths_hercules_ci_agent Spec hs-source-dirs: src 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 @@ -41,6 +41,9 @@ import qualified Hercules.API.Agent.Evaluate.EvaluateEvent.Message as Message import qualified Hercules.API.Agent.Evaluate.EvaluateEvent.PushedAll as PushedAll import qualified Hercules.API.Agent.Evaluate.EvaluateTask as EvaluateTask +import Hercules.API.Agent.Evaluate.ImmutableGitInput (ImmutableGitInput) +import qualified Hercules.API.Agent.Evaluate.ImmutableGitInput as ImmutableGitInput +import qualified Hercules.API.Agent.Evaluate.ImmutableInput as ImmutableInput import Hercules.API.Servant (noContent) import qualified Hercules.Agent.Cache as Agent.Cache import qualified Hercules.Agent.Cachix.Env as Cachix.Env @@ -100,11 +103,108 @@ fix $ \continue -> joinSTM $ listen batchProducer (\b -> withSync b (postBatch task' . catMaybes) *> continue) pure +getSrcInput :: MonadIO m => EvaluateTask.EvaluateTask -> m (Maybe ImmutableGitInput) +getSrcInput task = case M.lookup "src" (EvaluateTask.inputs task) of + Just (ImmutableInput.Git x) -> + purer x + Nothing -> do + throwIO $ FatalError $ "No src input provided" <> show task + Just {} -> do + pure Nothing + produceEvaluationTaskEvents :: Store -> EvaluateTask.EvaluateTask -> (Syncing EvaluateEvent.EvaluateEvent -> App ()) -> App () +produceEvaluationTaskEvents store task writeToBatch | EvaluateTask.isFlakeJob task = withWorkDir "eval" $ \tmpdir -> do + logLocM DebugS "Retrieving evaluation task (flake)" + let emitSingle = writeToBatch . Syncable + sync = syncer writeToBatch + msgCounter <- liftIO $ newIORef 0 + let fixIndex :: + MonadIO m => + EvaluateEvent.EvaluateEvent -> + m EvaluateEvent.EvaluateEvent + fixIndex (EvaluateEvent.Message m) = do + i <- liftIO $ atomicModifyIORef msgCounter (\i0 -> (i0 + 1, i0)) + pure $ EvaluateEvent.Message m {Message.index = i} + fixIndex other = pure other + eventCounter <- liftIO $ newIORef 0 + topDerivationPaths <- liftIO $ newIORef mempty + let emit :: EvaluateEvent.EvaluateEvent -> App () + emit update = do + n <- liftIO $ atomicModifyIORef eventCounter $ \n -> dup (n + 1) + if n > eventLimit + then do + truncMsg <- + fixIndex $ + EvaluateEvent.Message + Message.Message + { index = -1, + typ = Message.Error, + message = + "Evaluation limit reached. Does your nix expression produce infinite attributes? Please make sure that your project is finite. If it really does require more than " + <> show eventLimit + <> " attributes or messages, please contact info@hercules-ci.com." + } + emitSingle truncMsg + panic "Evaluation limit reached." + else emitSingle =<< fixIndex update + let allowedPaths = [] + + TraversalQueue.with $ \(derivationQueue :: Queue StorePath) -> + let doIt = + ( do + Async.Lifted.concurrently_ evaluation emitDrvs + -- derivationInfo upload has finished + -- allAttrPaths :: IORef has been populated + ) + `finally` pushDrvs + uploadDrvInfos drvPath = do + TraversalQueue.enqueue derivationQueue drvPath + TraversalQueue.waitUntilDone derivationQueue + addTopDerivation drvPath = do + TraversalQueue.enqueue derivationQueue drvPath + liftIO $ atomicModifyIORef topDerivationPaths ((,()) . S.insert drvPath) + evaluation = do + let evalProc = + do runEvalProcess + tmpdir -- unused + "" + mempty + mempty + captureAttrDrvAndEmit + uploadDrvInfos + sync + task + allowedPaths + evalProc `finally` do + -- Always upload drv infos, even in case of a crash in the worker + TraversalQueue.waitUntilDone derivationQueue + `finally` TraversalQueue.close derivationQueue + pushDrvs = do + caches <- activePushCaches + paths <- liftIO $ readIORef topDerivationPaths + forM_ caches $ \cache -> do + withNamedContext "cache" cache $ logLocM DebugS "Pushing derivations" + Agent.Cache.push cache (toList paths) pushEvalWorkers + emit $ EvaluateEvent.PushedAll $ PushedAll.PushedAll {cache = cache} + captureAttrDrvAndEmit msg = do + case msg of + EvaluateEvent.Attribute ae -> do + storePath <- liftIO $ parseStorePath store (encodeUtf8 $ AttributeEvent.derivationPath ae) + addTopDerivation storePath + _ -> pass + emit msg + emitDrvs = + TraversalQueue.work derivationQueue $ \recurse drvPath -> do + drvInfo <- retrieveDerivationInfo store drvPath + for_ (M.keys $ DerivationInfo.inputDerivations drvInfo) \inp -> do + inputStorePath <- liftIO $ parseStorePath store (encodeUtf8 inp) + recurse inputStorePath -- asynchronously + emit $ EvaluateEvent.DerivationInfo drvInfo + in doIt produceEvaluationTaskEvents store task writeToBatch = withWorkDir "eval" $ \tmpdir -> do logLocM DebugS "Retrieving evaluation task" let emitSingle = writeToBatch . Syncable @@ -133,12 +233,6 @@ projectDir <- case M.lookup "src" inputLocations of Nothing -> panic "No primary source provided" Just x -> pure x - (ref, rev) <- case M.lookup "src" (EvaluateTask.inputMetadata task) of - 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 "rev" . traverse . _String) nixPath <- EvaluateTask.nixPath task & ( traverse @@ -250,7 +344,6 @@ uploadDrvInfos sync task - (ref, rev) allowedPaths evalProc `finally` do -- Always upload drv infos, even in case of a crash in the worker @@ -301,16 +394,26 @@ (StorePath -> App ()) -> App () -> EvaluateTask.EvaluateTask -> - (Text, Text) -> [ByteString] -> App () -runEvalProcess projectDir file autoArguments nixPath emit uploadDerivationInfos flush task (ref, rev) allowedPaths = do +runEvalProcess projectDir file autoArguments nixPath emit uploadDerivationInfos flush task allowedPaths = do extraOpts <- Nix.askExtraOptions bulkBaseURL <- asks (ServiceInfo.bulkSocketBaseURL . Env.serviceInfo) apiBaseUrl <- asks (toS . showBaseUrl . Env.herculesBaseUrl) cfg <- asks Env.config - let gitSource = fromRefRevPath ref rev (toS projectDir) - eval = + srcInput <- getSrcInput task + gitSource <- + case srcInput of + Just git -> pure $ fromRefRevPath (ImmutableGitInput.ref git) (ImmutableGitInput.rev git) (toS projectDir) + Nothing -> do + (ref, rev) <- case M.lookup "src" (EvaluateTask.inputMetadata task) of + 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 "rev" . traverse . _String) + pure $ fromRefRevPath ref rev (toS projectDir) + let eval = Eval.Eval { Eval.cwd = projectDir, Eval.file = toS file, @@ -323,9 +426,11 @@ baseURL = toS $ Network.URI.uriToString identity bulkBaseURL "" }, Eval.gitSource = ViaJSON gitSource, + Eval.srcInput = ViaJSON <$> srcInput, Eval.apiBaseUrl = apiBaseUrl, Eval.ciSystems = EvaluateTask.ciSystems task, Eval.selector = ViaJSON $ EvaluateTask.selector task, + Eval.isFlakeJob = EvaluateTask.isFlakeJob task, Eval.allowInsecureBuiltinFetchers = Config.allowInsecureBuiltinFetchers cfg, Eval.allowedPaths = allowedPaths } diff --git a/src/Hercules/Agent/NixFile.hs b/src/Hercules/Agent/NixFile.hs --- a/src/Hercules/Agent/NixFile.hs +++ b/src/Hercules/Agent/NixFile.hs @@ -50,6 +50,7 @@ match', toRawValue, unsafeAssertType, + valueFromExpressionString, ) import Hercules.CNix.Expr.Raw (RawValue) import Hercules.CNix.Expr.Schema (Attrs, Dictionary, MonadEval, PSObject (PSObject), Provenance (Other), StringWithoutContext, basicAttrsWithProvenance, dictionaryToMap, fromPSObject, toPSObject, (#.), (#?), ($?), (.$), (>>$.), type (->.), type (->?), type (::.), type (::?)) @@ -142,6 +143,12 @@ '[ "addDefaults" ::. Attrs '[] ->. Attrs '[] ->. HerculesCISchema ] +exprString :: forall a m. MonadEval m => ByteString -> m (PSObject a) +exprString bs = do + evalState <- ask + value <- liftIO $ valueFromExpressionString evalState bs "/var/lib/empty/hercules-ci-agent-builtin" + pure PSObject {value = value, provenance = Schema.Other "hercules-ci-agent built-in expression"} + getHerculesCI :: MonadEval m => HomeExpr -> HerculesCIArgs -> m (Maybe (PSObject HerculesCISchema)) getHerculesCI homeExpr args = do home <- getHomeExprObject homeExpr @@ -153,10 +160,18 @@ herculesCI $? args' Flake flake -> Just <$> do + -- fixup primaryRepo.outPath, which we didn't set to the right value for + -- flakes earlier, because we don't have a local checkout. + args'' <- + exprString @(Attrs _ ->. HomeSchema ->. Attrs _) + "args': flake: args' // { primaryRepo = args'.primaryRepo // { outPath = flake.outPath; }; }" + >>$. pure args' + >>$. pure home + dh <- loadDefaultHerculesCI fn <- dh #. #addDefaults let flakeObj = basicAttrsWithProvenance flake $ Schema.Other "your flake" - hci <- fn .$ flakeObj >>$. pure args' + hci <- fn .$ flakeObj >>$. pure args'' pure hci {Schema.provenance = Other "the herculesCI attribute of your flake (after adding defaults)"} parseExtraInputs :: MonadEval m => PSObject ExtraInputsSchema -> m (Map ByteString InputDeclaration) diff --git a/src/Hercules/Agent/WorkerProtocol/Command/Eval.hs b/src/Hercules/Agent/WorkerProtocol/Command/Eval.hs --- a/src/Hercules/Agent/WorkerProtocol/Command/Eval.hs +++ b/src/Hercules/Agent/WorkerProtocol/Command/Eval.hs @@ -4,6 +4,7 @@ import Data.Binary import qualified Hercules.API.Agent.Evaluate.EvaluateTask as EvaluateTask +import Hercules.API.Agent.Evaluate.ImmutableGitInput (ImmutableGitInput) import Hercules.Agent.NixFile.GitSource (GitSource) import Hercules.Agent.WorkerProtocol.Event (ViaJSON) import Hercules.Agent.WorkerProtocol.LogSettings @@ -19,9 +20,11 @@ -- (as of now, we use one worker process per evaluation) extraNixOptions :: [(Text, Text)], gitSource :: ViaJSON GitSource, + srcInput :: Maybe (ViaJSON ImmutableGitInput), apiBaseUrl :: Text, logSettings :: LogSettings, selector :: ViaJSON EvaluateTask.Selector, + isFlakeJob :: Bool, ciSystems :: Maybe (Map Text ()), allowInsecureBuiltinFetchers :: Bool, allowedPaths :: [ByteString]