hercules-ci-cli 0.3.8 → 0.3.9
raw patch · 7 files changed
+288/−133 lines, 7 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Hercules.CLI.Client: instance GHC.Exception.Type.Exception Hercules.CLI.Client.HTTPInternalException
- Hercules.CLI.Client: instance GHC.Show.Show Hercules.CLI.Client.HTTPInternalException
- Hercules.CLI.Credentials: instance GHC.Exception.Type.Exception Hercules.CLI.Credentials.ApiBaseUrlParsingException
- Hercules.CLI.Credentials: instance GHC.Exception.Type.Exception Hercules.CLI.Credentials.CredentialsParsingException
- Hercules.CLI.Credentials: instance GHC.Exception.Type.Exception Hercules.CLI.Credentials.NoCredentialException
- Hercules.CLI.Credentials: instance GHC.Generics.Generic Hercules.CLI.Credentials.Credentials
- Hercules.CLI.Credentials: instance GHC.Generics.Generic Hercules.CLI.Credentials.DomainCredentials
- Hercules.CLI.Credentials: instance GHC.Show.Show Hercules.CLI.Credentials.ApiBaseUrlParsingException
- Hercules.CLI.Credentials: instance GHC.Show.Show Hercules.CLI.Credentials.CredentialsParsingException
- Hercules.CLI.Credentials: instance GHC.Show.Show Hercules.CLI.Credentials.NoCredentialException
- Hercules.CLI.Effect: ProjectData :: Maybe ProjectPath -> Maybe (Id "project") -> Maybe (Sensitive Text) -> ProjectData
- Hercules.CLI.Effect: [pdProjectId] :: ProjectData -> Maybe (Id "project")
- Hercules.CLI.Effect: [pdProjectPath] :: ProjectData -> Maybe ProjectPath
- Hercules.CLI.Effect: [pdToken] :: ProjectData -> Maybe (Sensitive Text)
- Hercules.CLI.Effect: asBranchOption :: Parser Text
- Hercules.CLI.Effect: asRefOption :: Parser Text
- Hercules.CLI.Effect: asRefOptions :: Parser (Maybe Text)
- Hercules.CLI.Effect: ciAttributeArgument :: Parser Text
- Hercules.CLI.Effect: data ProjectData
- Hercules.CLI.Effect: evaluateEffectDerivation :: (Has HerculesClientToken r, Has HerculesClientEnv r) => Ptr EvalState -> Store -> Maybe ProjectPath -> Text -> Text -> RIO r Derivation
- Hercules.CLI.Effect: getEffectDrv :: Store -> Ptr EvalState -> Maybe ProjectPath -> Text -> Text -> RIO (HerculesClientToken, HerculesClientEnv) Derivation
- Hercules.CLI.Effect: getProjectEffectData :: (Has HerculesClientToken r, Has HerculesClientEnv r) => Maybe ProjectPath -> Bool -> RIO r ProjectData
- Hercules.CLI.Effect: loadGitToken :: Text -> GitToken -> RIO r (Maybe (Map Text Value))
- Hercules.CLI.Effect: loadServerSecret :: Text -> SecretRef -> RIO r (Maybe (Map Text Value))
- Hercules.CLI.Effect: loadServerSecrets :: Map Text SecretRef -> RIO r (Sensitive (Map Text (Map Text Value)))
- Hercules.CLI.Effect: prepareDerivation :: MonadIO m => Store -> Derivation -> m ()
- Hercules.CLI.Effect: runParser :: Parser (IO ())
- Hercules.CLI.Project: instance GHC.Show.Show Hercules.CLI.Project.ProjectPath
+ Hercules.CLI.Client: instance GHC.Internal.Exception.Type.Exception Hercules.CLI.Client.HTTPInternalException
+ Hercules.CLI.Client: instance GHC.Internal.Show.Show Hercules.CLI.Client.HTTPInternalException
+ Hercules.CLI.Credentials: instance GHC.Internal.Exception.Type.Exception Hercules.CLI.Credentials.ApiBaseUrlParsingException
+ Hercules.CLI.Credentials: instance GHC.Internal.Exception.Type.Exception Hercules.CLI.Credentials.CredentialsParsingException
+ Hercules.CLI.Credentials: instance GHC.Internal.Exception.Type.Exception Hercules.CLI.Credentials.NoCredentialException
+ Hercules.CLI.Credentials: instance GHC.Internal.Generics.Generic Hercules.CLI.Credentials.Credentials
+ Hercules.CLI.Credentials: instance GHC.Internal.Generics.Generic Hercules.CLI.Credentials.DomainCredentials
+ Hercules.CLI.Credentials: instance GHC.Internal.Show.Show Hercules.CLI.Credentials.ApiBaseUrlParsingException
+ Hercules.CLI.Credentials: instance GHC.Internal.Show.Show Hercules.CLI.Credentials.CredentialsParsingException
+ Hercules.CLI.Credentials: instance GHC.Internal.Show.Show Hercules.CLI.Credentials.NoCredentialException
+ Hercules.CLI.Project: instance GHC.Internal.Show.Show Hercules.CLI.Project.ProjectPath
- Hercules.CLI.Nix: createHerculesCIArgs :: Maybe Text -> IO HerculesCIArgs
+ Hercules.CLI.Nix: createHerculesCIArgs :: Maybe Text -> Maybe ProjectPath -> IO HerculesCIArgs
Files
- CHANGELOG.md +12/−0
- hercules-ci-cli.cabal +4/−4
- src/Hercules/CLI/Effect.hs +235/−98
- src/Hercules/CLI/JSON.hs +1/−1
- src/Hercules/CLI/Lock.hs +1/−1
- src/Hercules/CLI/Nix.hs +28/−24
- src/Hercules/CLI/State.hs +7/−5
CHANGELOG.md view
@@ -5,6 +5,18 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). +## 0.3.9 - 2026-01-06++### Added++- `hci effect eval`: Evaluate an effect and print its derivation path.++- `hci effect list`: List all effects in a `herculesCI` configuration.++### Fixed++- `hci effect run`/`eval` now pass the `primaryRepo.owner` and `primaryRepo.name` fields correctly instead of `null`.+ ## 0.3.8 - 2025-07-18 ### Fixed
hercules-ci-cli.cabal view
@@ -1,7 +1,7 @@ cabal-version: 1.12 name: hercules-ci-cli-version: 0.3.8+version: 0.3.9 synopsis: The hci command for working with Hercules CI homepage: https://docs.hercules-ci.com bug-reports: https://github.com/hercules-ci/hercules-ci-agent/issues@@ -38,7 +38,7 @@ Paths_hercules_ci_cli hs-source-dirs: src- default-extensions: DeriveGeneric DeriveTraversable DisambiguateRecordFields FlexibleContexts InstanceSigs LambdaCase MultiParamTypeClasses NoImplicitPrelude OverloadedStrings RankNTypes TupleSections TypeApplications TypeOperators+ default-extensions: DeriveGeneric DeriveTraversable DisambiguateRecordFields FlexibleContexts InstanceSigs LambdaCase MultiParamTypeClasses NoImplicitPrelude OverloadedRecordDot OverloadedStrings RankNTypes TupleSections TypeApplications TypeOperators ghc-options: -Wall -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-name-shadowing -fwarn-incomplete-patterns build-depends: aeson >= 2@@ -99,7 +99,7 @@ other-modules: hs-source-dirs: hci- default-extensions: DeriveGeneric DeriveTraversable DisambiguateRecordFields FlexibleContexts InstanceSigs LambdaCase MultiParamTypeClasses NoImplicitPrelude OverloadedStrings RankNTypes TupleSections TypeApplications TypeOperators+ default-extensions: DeriveGeneric DeriveTraversable DisambiguateRecordFields FlexibleContexts InstanceSigs LambdaCase MultiParamTypeClasses NoImplicitPrelude OverloadedRecordDot OverloadedStrings RankNTypes TupleSections TypeApplications TypeOperators ghc-options: -Wall -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-name-shadowing -fwarn-incomplete-patterns -threaded -rtsopts -with-rtsopts=-N build-depends: base@@ -115,7 +115,7 @@ Hercules.CLI.JSONSpec hs-source-dirs: test- default-extensions: DeriveGeneric DeriveTraversable DisambiguateRecordFields FlexibleContexts InstanceSigs LambdaCase MultiParamTypeClasses NoImplicitPrelude OverloadedStrings RankNTypes TupleSections TypeApplications TypeOperators+ default-extensions: DeriveGeneric DeriveTraversable DisambiguateRecordFields FlexibleContexts InstanceSigs LambdaCase MultiParamTypeClasses NoImplicitPrelude OverloadedRecordDot OverloadedStrings RankNTypes TupleSections TypeApplications TypeOperators ghc-options: -Wall -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-name-shadowing -fwarn-incomplete-patterns -threaded -rtsopts -with-rtsopts=-N build-depends: aeson
src/Hercules/CLI/Effect.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoFieldSelectors #-} -module Hercules.CLI.Effect where+module Hercules.CLI.Effect (commandParser) where import qualified Data.Aeson as A import qualified Data.ByteString as BS@@ -11,11 +13,11 @@ import qualified Data.Map as M import qualified Data.Text as T import qualified Hercules.API.Agent.Evaluate.EvaluateEvent.AttributeEffectEvent as AttributeEffectEvent-import Hercules.API.Attribute (attributePathFromString)+import Hercules.API.Attribute (attributePathFromString, attributePathToString) import Hercules.API.Id (Id (Id, idUUID)) import qualified Hercules.API.Projects as Projects import qualified Hercules.API.Projects.CreateUserEffectTokenResponse as CreateUserEffectTokenResponse-import Hercules.Agent.NixFile (getVirtualValueByPath)+import Hercules.Agent.NixFile (getHerculesCI, getVirtualValueByPath, homeExprRawValue, loadNixFile, resolveAndInvokeOutputs) import qualified Hercules.Agent.NixFile.GitSource as GitSource import qualified Hercules.Agent.NixFile.HerculesCIArgs as HerculesCIArgs import Hercules.Agent.Sensitive (Sensitive (Sensitive))@@ -27,10 +29,11 @@ import Hercules.CLI.JSON (askPasswordWithKey) import Hercules.CLI.Nix (ciNixAttributeCompleter, computeRef, createHerculesCIArgs, resolveInputs, withNix) import Hercules.CLI.Options (flatCompleter, mkCommand, subparser)-import Hercules.CLI.Project (ProjectPath, getProjectIdAndPath, projectOption, projectPathOwner, projectPathProject, projectPathText)+import Hercules.CLI.Project (ProjectPath, getProjectIdAndPath, getProjectPath, projectOption, projectPathOwner, projectPathProject, projectPathText) import Hercules.CLI.Secret (getSecretsFilePath) import Hercules.CNix (Store)-import Hercules.CNix.Expr (EvalState, Match (IsAttrs), Value (rtValue), getAttrBool, getDrvFile, match)+import Hercules.CNix.Expr (EvalState, Match (IsAttrs), RawValue, Value (rtValue), getAttr, getAttrBool, getAttrs, getDrvFile, isDerivation, match, match')+import Hercules.CNix.Expr.Schema (PSObject (value), dictionaryToMap, (#?)) import qualified Hercules.CNix.Std.Vector as Std.Vector import Hercules.CNix.Store (Derivation, buildPaths, getDerivationInputs, newStorePathWithOutputs) import qualified Hercules.CNix.Store as CNix@@ -46,83 +49,131 @@ import UnliftIO.Directory (createDirectoryIfMissing, getAppUserDataDirectory) import UnliftIO.Temporary (withTempDirectory) -commandParser, runParser :: Optparse.Parser (IO ())+commandParser :: Optparse.Parser (IO ()) commandParser = subparser ( mkCommand "run" (Optparse.progDesc "Run an effect") runParser+ <> mkCommand+ "eval"+ (Optparse.progDesc "Evaluate an effect and print its derivation path")+ evalParser+ <> mkCommand+ "list"+ (Optparse.progDesc "List all effects in the configuration")+ listParser )++-- Options for CI context (project, ref, token)+data CIContextOptions = CIContextOptions+ { projectPath :: Maybe ProjectPath,+ ref :: Maybe Text,+ requireToken :: Bool+ }++ciContextOptionsParser :: Optparse.Parser CIContextOptions+ciContextOptionsParser = do+ projectPath' <- optional projectOption+ ref' <- asRefOptions+ requireToken' <- Optparse.flag True False (long "no-token" <> help "Don't get an API token. Disallows access to state files, but can run in untrusted environment or unconfigured repo.")+ pure $ CIContextOptions {projectPath = projectPath', ref = ref', requireToken = requireToken'}++runParser :: Optparse.Parser (IO ()) runParser = do attr <- ciAttributeArgument- projectOptionMaybe <- optional projectOption- refMaybe <- asRefOptions- requireToken <- Optparse.flag True False (long "no-token" <> help "Don't get an API token. Disallows access to state files, but can run in untrusted environment or unconfigured repo.")- pure $ runAuthenticatedOrDummy requireToken do- let getProjectInfo =- case projectOptionMaybe of- Just x- | not requireToken ->- pure- ProjectData- { pdProjectPath = Just x,- pdProjectId = Nothing,- pdToken = Nothing- }- _ -> getProjectEffectData projectOptionMaybe requireToken- withAsync getProjectInfo \projectPathAsync -> do- withNix \store evalState -> do- ref <- liftIO $ computeRef refMaybe- derivation <- getEffectDrv store evalState projectOptionMaybe ref attr- isDefaultBranch <-- if requireToken- then liftIO Git.getIsDefault- else pure True+ opts <- ciContextOptionsParser+ pure $ runAuthenticatedOrDummy opts.requireToken do+ -- Check if it's a direct derivation path+ isDirectPath <- withNix \store _evalState -> do+ storeDir <- liftIO $ CNix.storeDir store+ pure $ decodeUtf8With lenientDecode storeDir `T.isPrefixOf` attr - drvEnv <- liftIO $ CNix.getDerivationEnv derivation- secretsMap <- case parseDrvSecretsMap drvEnv of- Left e -> exitMsg e- Right r -> pure r- serverSecrets <- loadServerSecrets secretsMap+ if isDirectPath+ then do+ -- Direct derivation path - handle specially+ withNix \store _evalState -> do+ ref <- liftIO $ computeRef opts.ref+ derivation <- liftIO $ do+ -- Support derivation in arbitrary location+ -- Used in hercules-ci-effects test runner+ contents <- BS.readFile $ toS attr+ let stripDrv s = fromMaybe s (T.stripSuffix ".drv" s)+ CNix.getDerivationFromString store (attr & T.takeWhileEnd (/= '/') & stripDrv & encodeUtf8) contents+ prepareDerivation store derivation+ runEffectImpl store derivation ref opts+ else do+ -- Normal effect attribute - use withEffectDerivation+ withEffectDerivation attr opts $ \store _evalState drvPath ref -> do+ -- Get the full derivation from the path+ derivation <- liftIO $ CNix.getDerivation store drvPath+ prepareDerivation store derivation+ runEffectImpl store derivation ref opts - apiBaseURL <- liftIO determineDefaultApiBaseUrl- ProjectData {pdProjectPath = projectPath, pdProjectId = projectId, pdToken = token} <- wait projectPathAsync- secretsJson <- liftIO $ traverse getSecretsFilePath projectPath+-- Execute an effect derivation+runEffectImpl :: Store -> Derivation -> Text -> CIContextOptions -> RIO (HerculesClientToken, HerculesClientEnv) ()+runEffectImpl _store derivation ref opts = do+ let getProjectInfo =+ case opts.projectPath of+ Just x+ | not opts.requireToken ->+ pure+ ProjectData+ { pdProjectPath = Just x,+ pdProjectId = Nothing,+ pdToken = Nothing+ }+ _ -> getProjectEffectData opts.projectPath opts.requireToken+ withAsync getProjectInfo \projectPathAsync -> do+ isDefaultBranch <-+ if opts.requireToken+ then liftIO Git.getIsDefault+ else pure True - logEnv <- liftIO $ initLogEnv mempty "hci"- -- withSystemTempDirectory "hci":- -- ERRO[0000] container_linux.go:370: starting container process caused: process_linux.go:459: container init caused: rootfs_linux.go:59: mounting "/run/user/1000/hci6017/secrets" to rootfs at "/run/user/1000/hci6017/runc-state/rootfs/secrets" caused: operation not permitted- dataDir <- liftIO $ getAppUserDataDirectory "hercules-ci"- createDirectoryIfMissing True dataDir- let secretContextMaybe =- projectPath <&> \p ->- Secret.SecretContext- { ownerName = projectPathOwner p,- repoName = projectPathProject p,- isDefaultBranch = isDefaultBranch,- ref = ref- }- exitCode <- withTempDirectory dataDir "tmp-effect-" \workDir -> do- runKatipContextT logEnv () mempty $- runEffect- RunEffectParams- { runEffectDerivation = derivation,- runEffectToken = token,- runEffectSecretsConfigPath = secretsJson,- runEffectServerSecrets = serverSecrets,- runEffectApiBaseURL = apiBaseURL,- runEffectDir = workDir,- runEffectProjectId = projectId,- runEffectProjectPath = projectPathText <$> projectPath,- runEffectSecretContext = secretContextMaybe,- runEffectUseNixDaemonProxy = False, -- FIXME Enable proxy for ci/dev parity. Requires access to agent binaries. Unified executable?- runEffectExtraNixOptions = [],- runEffectFriendly = True,- runEffectConfiguredMountables = mempty -- FIXME: provide hosts?- }- throwIO exitCode+ drvEnv <- liftIO $ CNix.getDerivationEnv derivation+ secretsMap <- case parseDrvSecretsMap drvEnv of+ Left e -> exitMsg e+ Right r -> pure r+ serverSecrets <- loadServerSecrets secretsMap + apiBaseURL <- liftIO determineDefaultApiBaseUrl+ ProjectData {pdProjectPath = projectPath, pdProjectId = projectId, pdToken = token} <- wait projectPathAsync+ secretsJson <- liftIO $ traverse getSecretsFilePath projectPath++ logEnv <- liftIO $ initLogEnv mempty "hci"+ -- withSystemTempDirectory "hci":+ -- ERRO[0000] container_linux.go:370: starting container process caused: process_linux.go:459: container init caused: rootfs_linux.go:59: mounting "/run/user/1000/hci6017/secrets" to rootfs at "/run/user/1000/hci6017/runc-state/rootfs/secrets" caused: operation not permitted+ dataDir <- liftIO $ getAppUserDataDirectory "hercules-ci"+ createDirectoryIfMissing True dataDir+ let secretContextMaybe =+ projectPath <&> \p ->+ Secret.SecretContext+ { ownerName = projectPathOwner p,+ repoName = projectPathProject p,+ isDefaultBranch = isDefaultBranch,+ ref = ref+ }+ exitCode <- withTempDirectory dataDir "tmp-effect-" \workDir -> do+ runKatipContextT logEnv () mempty $+ runEffect+ RunEffectParams+ { runEffectDerivation = derivation,+ runEffectToken = token,+ runEffectSecretsConfigPath = secretsJson,+ runEffectServerSecrets = serverSecrets,+ runEffectApiBaseURL = apiBaseURL,+ runEffectDir = workDir,+ runEffectProjectId = projectId,+ runEffectProjectPath = projectPathText <$> projectPath,+ runEffectSecretContext = secretContextMaybe,+ runEffectUseNixDaemonProxy = False, -- FIXME Enable proxy for ci/dev parity. Requires access to agent binaries. Unified executable?+ runEffectExtraNixOptions = [],+ runEffectFriendly = True,+ runEffectConfiguredMountables = mempty -- FIXME: provide hosts?+ }+ throwIO exitCode+ loadServerSecrets :: Map Text AttributeEffectEvent.SecretRef -> RIO r (Sensitive (Map Text (Map Text A.Value))) loadServerSecrets secrets = secrets & M.traverseMaybeWithKey loadServerSecret <&> Sensitive @@ -139,44 +190,130 @@ M.fromList [token <&> A.String] -getEffectDrv :: Store -> Ptr EvalState -> Maybe ProjectPath -> Text -> Text -> RIO (HerculesClientToken, HerculesClientEnv) Derivation-getEffectDrv store evalState projectOptionMaybe ref attr = do- storeDir <- liftIO $ CNix.storeDir store- derivation <-- if decodeUtf8With lenientDecode storeDir `T.isPrefixOf` attr- then liftIO $ do- -- Support derivation in arbitrary location- -- Used in hercules-ci-effects test runner- let path = attr- contents <- BS.readFile $ toS path- let stripDrv s = fromMaybe s (T.stripSuffix ".drv" s)- CNix.getDerivationFromString store (path & T.takeWhileEnd (/= '/') & stripDrv & encodeUtf8) contents- else evaluateEffectDerivation evalState store projectOptionMaybe ref attr- prepareDerivation store derivation- pure derivation+-- Higher-order function to evaluate effect and pass its path to a callback+withEffectDerivation :: Text -> CIContextOptions -> (Store -> Ptr EvalState -> CNix.StorePath -> Text -> RIO (HerculesClientToken, HerculesClientEnv) a) -> RIO (HerculesClientToken, HerculesClientEnv) a+withEffectDerivation attr opts callback = do+ withNix \store evalState -> do+ ref <- liftIO $ computeRef opts.ref+ storeDir <- liftIO $ CNix.storeDir store+ drvPath <-+ if decodeUtf8With lenientDecode storeDir `T.isPrefixOf` attr+ then do+ -- Support derivation in arbitrary location+ -- Used in hercules-ci-effects test runner+ liftIO $ CNix.parseStorePath store (encodeUtf8 attr)+ else evaluateEffectPath evalState opts.projectPath ref attr+ callback store evalState drvPath ref -evaluateEffectDerivation :: (Has HerculesClientToken r, Has HerculesClientEnv r) => Ptr EvalState -> Store -> Maybe ProjectPath -> Text -> Text -> RIO r Derivation-evaluateEffectDerivation evalState store projectOptionMaybe ref attr = do- args <- liftIO $ createHerculesCIArgs (Just ref)- let attrPath = attributePathFromString attr- nixFile = GitSource.outPath $ HerculesCIArgs.primaryRepo args+evalParser :: Optparse.Parser (IO ())+evalParser = do+ attr <- ciAttributeArgument+ opts <- ciContextOptionsParser+ pure $ runAuthenticatedOrDummy opts.requireToken do+ withEffectDerivation attr opts $ \store _evalState drvPath _ref -> do+ -- For eval, just print the derivation path+ drvPathBS <- liftIO $ CNix.storePathToPath store drvPath+ liftIO $ putStrLn $ decodeUtf8With lenientDecode drvPathBS++listParser :: Optparse.Parser (IO ())+listParser = do+ opts <- ciContextOptionsParser+ pure $ runAuthenticatedOrDummy opts.requireToken do+ withNix \_store evalState -> do+ ref <- liftIO $ computeRef opts.ref+ projectPath <- getProjectPath opts.projectPath+ args <- liftIO $ createHerculesCIArgs (Just ref) (Just projectPath)+ let nixFile = GitSource.outPath $ HerculesCIArgs.primaryRepo args+ homeExprEither <- liftIO $ loadNixFile evalState (toS nixFile) (HerculesCIArgs.primaryRepo args)+ homeExpr <- case homeExprEither of+ Left err -> exitMsg $ toS err+ Right h -> pure h++ uio <- askUnliftIO+ let resolveInputsFn = liftIO . resolveInputs uio evalState (Just projectPath)++ flip runReaderT evalState do+ herculesCIMaybe <- getHerculesCI homeExpr args+ case herculesCIMaybe of+ Nothing -> do+ -- Traditional format: walk the root directly for effects+ effects <- liftIO $ walkEffects evalState [] (homeExprRawValue homeExpr)+ for_ effects \path ->+ liftIO $ putStrLn $ attributePathToString path+ Just hci -> do+ -- Modern format: enumerate jobs using schema types+ -- Effects are only allowed in the "effects" attribute+ let listJobs handlerName handler = do+ jobs <- dictionaryToMap handler+ for_ (M.toList jobs) \(jobNameBS, job) -> do+ let jobName = decodeUtf8With lenientDecode jobNameBS+ prefix = [handlerName, jobName, "effects"]+ outputs <- resolveAndInvokeOutputs job resolveInputsFn+ effectsAttr <- liftIO $ getEffectsAttr evalState (value outputs)+ for_ effectsAttr \effectsValue -> do+ effects <- liftIO $ walkEffects evalState prefix effectsValue+ for_ effects \path ->+ liftIO $ putStrLn $ attributePathToString path+ hci #? #onPush >>= traverse_ (listJobs "onPush")+ hci #? #onSchedule >>= traverse_ (listJobs "onSchedule")++-- | Get the "effects" attribute from an attrset, if it exists.+getEffectsAttr :: Ptr EvalState -> RawValue -> IO (Maybe RawValue)+getEffectsAttr evalState rawValue = do+ match' evalState rawValue >>= \case+ IsAttrs attrsValue -> getAttr evalState attrsValue "effects"+ _ -> pure Nothing++-- | Recursively walk the attribute tree and collect effect paths.+walkEffects :: Ptr EvalState -> [Text] -> RawValue -> IO [[Text]]+walkEffects evalState prefix rawValue = do+ match' evalState rawValue >>= \case+ IsAttrs attrsValue -> do+ isDeriv <- isDerivation evalState rawValue+ if isDeriv+ then do+ isEff <- getAttrBool evalState attrsValue "isEffect"+ case isEff of+ Right (Just True) -> pure [prefix]+ _ -> pure []+ else do+ attrs <- getAttrs evalState attrsValue+ fmap concat $ for (M.toList attrs) \(name, childValue) ->+ walkEffects evalState (prefix ++ [decodeUtf8With lenientDecode name]) childValue+ _ -> pure []++-- | Evaluate a herculesCI attribute path.+-- Returns the value at the path (if found) and the nix file path for error messages.+evalHerculesCIAttr ::+ (Has HerculesClientToken r, Has HerculesClientEnv r) =>+ Ptr EvalState ->+ Maybe ProjectPath ->+ Text ->+ [Text] ->+ RIO r (Maybe RawValue, Text)+evalHerculesCIAttr evalState projectOptionMaybe ref attrPath = do+ projectPath <- getProjectPath projectOptionMaybe+ args <- liftIO $ createHerculesCIArgs (Just ref) (Just projectPath)+ let nixFile = GitSource.outPath $ HerculesCIArgs.primaryRepo args uio <- askUnliftIO- valMaybe <- liftIO $ getVirtualValueByPath evalState (toS nixFile) args (resolveInputs uio evalState projectOptionMaybe) (map encodeUtf8 attrPath)- -- valMaybe <- liftIO $ attrByPath evalState rootValue+ valMaybe <- liftIO $ getVirtualValueByPath evalState (toS nixFile) args (resolveInputs uio evalState (Just projectPath)) (map encodeUtf8 attrPath)+ pure (valMaybe, nixFile)++-- | Evaluate an effect attribute and get its derivation path.+evaluateEffectPath :: (Has HerculesClientToken r, Has HerculesClientEnv r) => Ptr EvalState -> Maybe ProjectPath -> Text -> Text -> RIO r CNix.StorePath+evaluateEffectPath evalState projectOptionMaybe ref attr = do+ let attrPath = attributePathFromString attr+ (valMaybe, nixFile) <- evalHerculesCIAttr evalState projectOptionMaybe ref attrPath attrValue <- case valMaybe of- Nothing -> do- exitMsg $ "Could not find an attribute at path " <> show attrPath <> " in " <> nixFile+ Nothing -> exitMsg $ "Could not find an attribute at path " <> show attrPath <> " in " <> nixFile Just v -> liftIO (match evalState v) >>= escalate effectAttrs <- case attrValue of IsAttrs attrs -> pure attrs- _ -> do- exitMsg $ "Attribute is not an Effect at path " <> show attrPath <> " in " <> nixFile-+ _ -> exitMsg $ "Attribute is not an Effect at path " <> show attrPath <> " in " <> nixFile isEffect <- liftIO $ getAttrBool evalState effectAttrs "isEffect" >>= escalate when (isEffect /= Just True) do exitMsg $ "Attribute is not an Effect at path " <> show attrPath <> " in " <> nixFile- drvPath <- getDrvFile evalState (rtValue effectAttrs)- liftIO $ CNix.getDerivation store drvPath+ getDrvFile evalState (rtValue effectAttrs) prepareDerivation :: (MonadIO m) => Store -> Derivation -> m () prepareDerivation store derivation = do
src/Hercules/CLI/JSON.hs view
@@ -36,7 +36,7 @@ (AK.fromText child .=) <$> mergeLeafPaths (context ++ [child]) (map (first NEL.tail) (groupItem : groupItems)) )- <&> object+ <&> object showPath :: [Text] -> Text showPath [] = "the root"
src/Hercules/CLI/Lock.hs view
@@ -166,7 +166,7 @@ (_, _, _, processHandle) <- System.Process.createProcess procSpec System.Process.waitForProcess processHandle )- )+ ) `UnliftIO.finally` do (_ :: NoContent) <- retryOnFail "lock release" (deleteLockLease stateClient leaseId) putErrText "hci: lock released"
src/Hercules/CLI/Nix.hs view
@@ -20,7 +20,7 @@ import Hercules.CLI.Common (runAuthenticated) import Hercules.CLI.Git (getGitRoot, getRef, getRev, getUpstreamURL, guessForgeTypeFromURL) import Hercules.CLI.Options (scanOption)-import Hercules.CLI.Project (ProjectPath (projectPathProject), getProjectPath, projectPathReadM, projectResourceClientByPath)+import Hercules.CLI.Project (ProjectPath (projectPathOwner, projectPathProject), getProjectPath, projectPathReadM, projectResourceClientByPath) import Hercules.CNix (Store) import Hercules.CNix.Expr as Expr (EvalState, Match (IsAttrs), NixAttrs, RawValue, Value, getAttr, getAttrs, getFlakeFromGit, init, isDerivation, match', toValue, withEvalState, withStore) import qualified Hercules.CNix.Util as CNix.Util@@ -31,8 +31,8 @@ import RIO (RIO) import UnliftIO (MonadUnliftIO, UnliftIO (UnliftIO), askUnliftIO) -createHerculesCIArgs :: Maybe Text -> IO HerculesCIArgs-createHerculesCIArgs passedRef = do+createHerculesCIArgs :: Maybe Text -> Maybe ProjectPath -> IO HerculesCIArgs+createHerculesCIArgs passedRef maybeProjectPath = do gitRoot <- getGitRoot gitRev <- getRev ref <- computeRef passedRef@@ -52,8 +52,8 @@ remoteSshUrl = remoteSshUrl, webUrl = guessWebUrlFromHttpUrl <$> remoteHttpUrl, forgeType = guessForgeTypeFromURL upstreamURL,- owner = Nothing {- TODO; agent only for now -},- name = Nothing {- TODO; agent only for now -}+ owner = maybeProjectPath <&> projectPathOwner,+ name = maybeProjectPath <&> projectPathProject } url <- determineDefaultApiBaseUrl pure $ HerculesCIArgs.fromGitSource gitSource HerculesCIArgs.HerculesCIMeta {apiBaseUrl = url, ciSystems = CISystems Nothing}@@ -69,19 +69,23 @@ Maybe ProjectPath -> Map ByteString InputDeclaration -> IO (Value NixAttrs)-resolveInputs uio evalState projectMaybe inputs = do- projectPath <- unliftIO uio $ getProjectPath projectMaybe- let resolveInput :: ByteString -> InputDeclaration -> IO RawValue- resolveInput _name (SiblingInput input) = unliftIO uio do- let resourceClient = projectResourceClientByPath (projectPath {projectPathProject = InputDeclaration.project input})- jobNames = []- immutableGitInput <- retryOnFail "get job source" (getJobSource resourceClient (InputDeclaration.ref input) jobNames)- liftIO $ mkImmutableGitInputFlakeThunk evalState immutableGitInput- resolveInput _name InputDeclaration.BogusInput {} = panic "resolveInput: not implemented yet"- inputs- & M.mapWithKey (,)- & mapConcurrently (uncurry resolveInput)- & (>>= toValue evalState)+resolveInputs uio evalState projectMaybe inputDeclarations = do+ inputValueMap <-+ if M.null inputDeclarations+ then pure mempty+ else do+ projectPath <- unliftIO uio $ getProjectPath projectMaybe+ let resolveInput :: ByteString -> InputDeclaration -> IO RawValue+ resolveInput _name (SiblingInput input) = unliftIO uio do+ let resourceClient = projectResourceClientByPath (projectPath {projectPathProject = InputDeclaration.project input})+ jobNames = []+ immutableGitInput <- retryOnFail "get job source" (getJobSource resourceClient (InputDeclaration.ref input) jobNames)+ liftIO $ mkImmutableGitInputFlakeThunk evalState immutableGitInput+ resolveInput _name InputDeclaration.BogusInput {} = panic "resolveInput: not implemented yet"+ inputDeclarations+ & M.mapWithKey (,)+ & mapConcurrently (uncurry resolveInput)+ toValue evalState inputValueMap refBranchToRef :: Maybe Text -> Maybe Text -> Maybe Text refBranchToRef ref branch = ref <|> (("refs/heads/" <>) <$> branch)@@ -107,8 +111,8 @@ -- so we only filter when necessary. pure [ item- | item@(_, suggestionText) <- r,- input `T.isPrefixOf` suggestionText+ | item@(_, suggestionText) <- r,+ input `T.isPrefixOf` suggestionText ] else innerCompleter input )@@ -135,8 +139,8 @@ -- so we only filter when necessary. pure [ item- | item@(_, suggestionText) <- r,- input `T.isPrefixOf` suggestionText+ | item@(_, suggestionText) <- r,+ input `T.isPrefixOf` suggestionText ] else innerCompleter input )@@ -176,7 +180,7 @@ scanOption "--project" <&> \maybeStr -> do s <- maybeStr rightToMaybe (runExcept (runReaderT (unReadM projectPathReadM) (toS s)))- args <- createHerculesCIArgs ref+ args <- createHerculesCIArgs ref projectMaybe runAuthenticated do uio <- askUnliftIO liftIO $@@ -202,7 +206,7 @@ matchIsDeriv <- ma & traverse (isDerivation evalState)- <&> fromMaybe False+ <&> fromMaybe False pure $ matches & map (\match -> (mempty {Optparse.cioAddSpace = matchIsDeriv, Optparse.cioFiles = False}, (partialPath ++ [match], not matchIsDeriv)))
src/Hercules/CLI/State.hs view
@@ -54,11 +54,7 @@ bytes <- retryStreamOnFail "state get" (\token -> getStateData projectStateClient name versionMaybe token) \case Left e -> throwIO e Right (Headers stream headers) -> do-#if MIN_VERSION_servant(0,20,0)- s <- fromSourceIO stream-#else- let s = fromSourceIO stream-#endif+ s <- getSource stream bl <- runConduitRes $ s .| mapC (BB.byteString . fromRawBytes) .| sinkLazyBuilder let lenH :: ResponseHeader "Content-Length" Integer lenH `HCons` _ = headers@@ -72,6 +68,12 @@ case file of "-" -> BS.putStr bytes _ -> BS.writeFile file bytes+ where+#if MIN_VERSION_servant(0,20,0)+ getSource stream = fromSourceIO stream+#else+ getSource stream = pure $ fromSourceIO stream+#endif putCommandParser = do projectMaybe <- optional projectOption name <- nameOption