hercules-ci-agent 0.9.0 → 0.9.1

raw patch · 6 files changed

+174/−32 lines, 6 filesdep ~hercules-ci-api-agentPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: hercules-ci-api-agent

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• hercules-ci-agent-worker/Hercules/Agent/Worker.hs +27/−9
• hercules-ci-agent.cabal +2/−11
• hercules-ci-agent/Hercules/Agent/Evaluate.hs +116/−11
• src/Hercules/Agent/NixFile.hs +16/−1
• src/Hercules/Agent/WorkerProtocol/Command/Eval.hs +3/−0

@@ -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

@@ -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@.

@@ -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

@@ -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           }

@@ -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)

@@ -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]