hercules-ci-cli 0.2.6 → 0.3.0
raw patch · 11 files changed
+264/−113 lines, 11 filesdep +asyncdep +hercules-ci-api-agentdep ~aeson
Dependencies added: async, hercules-ci-api-agent
Dependency ranges changed: aeson
Files
- CHANGELOG.md +19/−0
- hercules-ci-cli.cabal +5/−3
- src/Hercules/CLI/Effect.hs +31/−9
- src/Hercules/CLI/Exception.hs +1/−9
- src/Hercules/CLI/Git.hs +7/−0
- src/Hercules/CLI/JSON.hs +1/−1
- src/Hercules/CLI/Lock.hs +7/−5
- src/Hercules/CLI/Main.hs +38/−28
- src/Hercules/CLI/Nix.hs +103/−49
- src/Hercules/CLI/Project.hs +15/−2
- src/Hercules/CLI/Secret.hs +37/−7
CHANGELOG.md view
@@ -5,6 +5,25 @@ 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.0 - 2022-03-15++### Added++ - `hci secret echo` to assemble a secret and print it on stdout.+ Not unlike `hci secret add` but for people who don't have local+ secrets as part of their setup.++ - `hci secret add/echo --password` to ask a password on the terminal.++ - `hci secret add/echo` add a default `condition` to the secret.++ - Parity with hercules-ci-agent 0.9.0: flake support, `onPush` jobs+ in `hci effect run`.++### Fixed++ - Nix warnings don't pollute the shell completions anymore+ ## 0.2.6 - 2022-03-09 ### Added
hercules-ci-cli.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 name: hercules-ci-cli-version: 0.2.6+version: 0.3.0 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 author: Hercules CI contributors maintainer: info@hercules-ci.com-copyright: 2018-2020 Hercules CI+copyright: 2018-2021 Hercules CI license: Apache-2.0 build-type: Simple extra-source-files:@@ -39,8 +39,9 @@ default-extensions: DeriveGeneric DeriveTraversable DisambiguateRecordFields FlexibleContexts InstanceSigs LambdaCase MultiParamTypeClasses NoImplicitPrelude 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+ aeson >= 2 , aeson-pretty+ , async , atomic-write , attoparsec , base >=4.7 && <5@@ -53,6 +54,7 @@ , filepath , hercules-ci-agent , hercules-ci-api+ , hercules-ci-api-agent , hercules-ci-api-core , hercules-ci-cnix-expr , hercules-ci-cnix-store
src/Hercules/CLI/Effect.hs view
@@ -9,14 +9,18 @@ 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 (getOnPushOutputValueByPath)+import qualified Hercules.Agent.NixFile.GitSource as GitSource+import qualified Hercules.Agent.NixFile.HerculesCIArgs as HerculesCIArgs import Hercules.Agent.Sensitive (Sensitive (Sensitive)) import Hercules.CLI.Client (HerculesClientEnv, HerculesClientToken, determineDefaultApiBaseUrl, projectsClient, runHerculesClient) import Hercules.CLI.Common (runAuthenticated) import Hercules.CLI.Exception (exitMsg) import Hercules.CLI.Git (getAllBranches, getHypotheticalRefs)-import Hercules.CLI.Nix (attrByPath, callCiNix, ciNixAttributeCompleter, withNix)+import qualified Hercules.CLI.Git as Git+import Hercules.CLI.Nix (ciNixAttributeCompleter, computeRef, createHerculesCIArgs, resolveInputs, withNix) import Hercules.CLI.Options (flatCompleter, mkCommand, subparser)-import Hercules.CLI.Project (ProjectPath, getProjectIdAndPath, projectOption, projectPathText)+import Hercules.CLI.Project (ProjectPath, getProjectIdAndPath, projectOption, projectPathOwner, projectPathProject, projectPathText) import Hercules.CLI.Secret (getSecretsFilePath) import Hercules.CNix (Store) import Hercules.CNix.Expr (Match (IsAttrs), Value (rtValue), getAttrBool, getDrvFile, match)@@ -25,11 +29,12 @@ import qualified Hercules.CNix.Store as CNix import Hercules.Effect (RunEffectParams (..), runEffect) import Hercules.Error (escalate)+import qualified Hercules.Secrets as Secret import Katip (initLogEnv, runKatipContextT) import Options.Applicative (completer, help, long, metavar, strArgument, strOption) import qualified Options.Applicative as Optparse import Protolude hiding (evalState, wait, withAsync)-import RIO (RIO)+import RIO (RIO, askUnliftIO) import UnliftIO.Async (wait, withAsync) import UnliftIO.Directory (createDirectoryIfMissing, getAppUserDataDirectory) import UnliftIO.Temporary (withTempDirectory)@@ -50,21 +55,26 @@ pure $ runAuthenticated do withAsync (getProjectEffectData projectOptionMaybe requireToken) \projectPathAsync -> do withNix \store evalState -> do- (nixFile, rootValue) <- liftIO $ callCiNix evalState refMaybe+ ref <- liftIO $ computeRef refMaybe+ isDefaultBranch <- liftIO Git.getIsDefault+ args <- liftIO $ createHerculesCIArgs (Just ref) let attrPath = T.split (== '.') attr- valMaybe <- liftIO $ attrByPath evalState rootValue (map encodeUtf8 attrPath)+ nixFile = GitSource.outPath $ HerculesCIArgs.primaryRepo args+ uio <- askUnliftIO+ valMaybe <- liftIO $ getOnPushOutputValueByPath evalState (toS nixFile) args (resolveInputs uio evalState projectOptionMaybe) (map encodeUtf8 attrPath)+ -- valMaybe <- liftIO $ attrByPath evalState rootValue attrValue <- case valMaybe of Nothing -> do- exitMsg $ "Could not find an attribute at path " <> show attrPath <> " in " <> toS nixFile+ 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 " <> toS 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 " <> toS nixFile+ exitMsg $ "Attribute is not an Effect at path " <> show attrPath <> " in " <> nixFile drvPath <- getDrvFile evalState (rtValue effectAttrs) derivation <- prepareDerivation store drvPath apiBaseURL <- liftIO determineDefaultApiBaseUrl@@ -75,6 +85,14 @@ -- 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@@ -85,7 +103,11 @@ runEffectApiBaseURL = apiBaseURL, runEffectDir = workDir, runEffectProjectId = projectId,- runEffectProjectPath = projectPathText <$> projectPath+ runEffectProjectPath = projectPathText <$> projectPath,+ runEffectSecretContext = secretContextMaybe,+ runEffectUseNixDaemonProxy = False, -- FIXME Enable proxy for ci/dev parity. Requires access to agent binaries. Unified executable?+ runEffectExtraNixOptions = [],+ runEffectFriendly = True } throwIO exitCode
src/Hercules/CLI/Exception.hs view
@@ -1,17 +1,9 @@ module Hercules.CLI.Exception where import qualified Control.Exception.Safe+import Hercules.UserException (UserException (UserException)) import Protolude hiding (handle, show) import System.IO (hIsTerminalDevice)-import Text.Show--data UserException = UserException Text--instance Exception UserException where- displayException = show--instance Show UserException where- show (UserException msg) = "error: " <> toS msg handleUserException :: IO a -> IO a handleUserException =
src/Hercules/CLI/Git.hs view
@@ -82,6 +82,13 @@ else do exitMsg "upstream branch is not remote" +getIsDefault :: IO Bool+getIsDefault = do+ upstream <- getBranchUpstream+ upstreamRef <- readProcessString "git" ["rev-parse", "--symbolic-full-name", "@{u}"] mempty+ upstreamDefaultRef <- readProcessString "git" ["rev-parse", "--symbolic-full-name", toS upstream <> "/HEAD"] mempty+ pure (upstreamRef == upstreamDefaultRef)+ getRemoteURL :: Text -> IO Text getRemoteURL remoteName = readProcessItem "git" ["remote", "get-url", toS remoteName] mempty
src/Hercules/CLI/JSON.hs view
@@ -13,7 +13,7 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.List.NonEmpty as NEL import qualified Data.Text as T-import Hercules.CLI.Exception (UserException (UserException))+import Hercules.UserException (UserException (UserException)) import qualified Options.Applicative as Optparse import Protolude import System.AtomicWrite.Writer.ByteString (atomicWriteFile)
src/Hercules/CLI/Lock.hs view
@@ -15,8 +15,10 @@ import Hercules.API (Id, NoContent) import qualified Hercules.API.Accounts.SimpleAccount as SimpleAccount import Hercules.API.Id (Id (Id), idText)-import qualified Hercules.API.Projects.Project as Project+import Hercules.API.Name (nameText) import qualified Hercules.API.Projects.SimpleJob as SimpleJob+import qualified Hercules.API.Projects.SimpleProject as SimpleProject+import qualified Hercules.API.SourceHostingSite.SimpleSite as SimpleSite import Hercules.API.State (ProjectStateResourceGroup (acquireLock), StateAPI (deleteLockLease, updateLockLease)) import qualified Hercules.API.State.StateLockAcquireRequest as StateLockAcquireRequest import Hercules.API.State.StateLockAcquireResponse (StateLockAcquireResponse (Acquired, Blocked))@@ -260,7 +262,7 @@ putErrText "blocked by lease:" putErrText $ " description: " <> StateLockLease.description lease for_ (StateLockLease.user lease) \user ->- putErrText $ " user: " <> SimpleAccount.displayName user <> " (" <> SimpleAccount.name user <> ")"+ putErrText $ " user: " <> SimpleAccount.displayName user <> " (" <> nameText (SimpleAccount.name user) <> ")" for_ (StateLockLease.job lease) \job -> do baseUri <- liftIO getLinksBase let links = mkLinks baseUri@@ -268,9 +270,9 @@ jobUrl = Hercules.Frontend.job links- (Project.siteSlug project)- (Project.ownerSlug project)- (Project.slug project)+ (SimpleSite.name $ SimpleAccount.site $ SimpleProject.owner project)+ (SimpleAccount.name $ SimpleProject.owner project)+ (SimpleProject.name project) (fromIntegral (SimpleJob.index job)) putErrText $ " job: " <> jobUrl
src/Hercules/CLI/Main.hs view
@@ -13,6 +13,8 @@ import Hercules.CLI.Options (execParser, helper, mkCommand, subparser) import qualified Hercules.CLI.Secret as Secret import qualified Hercules.CLI.State as State+import qualified Hercules.CNix.Exception+import Hercules.CNix.Verbosity (setShowTrace) import qualified Options.Applicative as Optparse import Protolude @@ -24,12 +26,14 @@ join $ execParser opts prettyPrintErrors :: IO a -> IO a-prettyPrintErrors = handle \e ->- case fromException e :: Maybe ExitCode of- Just _ -> throwIO e- Nothing -> do- putErrLn $ "hci: " <> displayException e- exitFailure+prettyPrintErrors = handleHaskell . Hercules.CNix.Exception.handleExceptions+ where+ handleHaskell = handle \e ->+ case fromException e :: Maybe ExitCode of+ Just _ -> throwIO e+ Nothing -> do+ putErrLn $ "hci: " <> displayException e+ exitFailure opts :: Optparse.ParserInfo (IO ()) opts =@@ -37,27 +41,33 @@ (commands <**> helper) (Optparse.fullDesc <> Optparse.header "Command line interface to Hercules CI") +setCommonOpts :: Optparse.Parser (IO ())+setCommonOpts =+ Optparse.flag pass (setShowTrace True) (Optparse.long "show-trace")+ commands :: Optparse.Parser (IO ()) commands =- subparser- ( mkCommand- "login"- (Optparse.progDesc "Configure token for authentication to hercules-ci.com")- Login.commandParser- <> mkCommand- "state"- (Optparse.progDesc "Perform operations on state files")- State.commandParser- <> mkCommand- "effect"- (Optparse.progDesc "Run effects locally")- Effect.commandParser- <> mkCommand- "secret"- (Optparse.progDesc "Manipulate locally stored secrets")- Secret.commandParser- <> mkCommand- "lock"- (Optparse.progDesc "Opt-in locking for use with state")- Lock.commandParser- )+ (*>)+ <$> setCommonOpts+ <*> subparser+ ( mkCommand+ "login"+ (Optparse.progDesc "Configure token for authentication to hercules-ci.com")+ Login.commandParser+ <> mkCommand+ "state"+ (Optparse.progDesc "Perform operations on state files")+ State.commandParser+ <> mkCommand+ "effect"+ (Optparse.progDesc "Run effects locally")+ Effect.commandParser+ <> mkCommand+ "secret"+ (Optparse.progDesc "Manipulate locally stored secrets")+ Secret.commandParser+ <> mkCommand+ "lock"+ (Optparse.progDesc "Opt-in locking for use with state")+ Lock.commandParser+ )
src/Hercules/CLI/Nix.hs view
@@ -2,32 +2,69 @@ module Hercules.CLI.Nix where +import Control.Concurrent.Async (mapConcurrently)+import Control.Monad.IO.Unlift (unliftIO)+import Data.Has (Has) import qualified Data.List as L import qualified Data.Map as M import qualified Data.Text as T-import Hercules.Agent.NixFile (findNixFile)-import Hercules.CLI.Exception (UserException (UserException))+import Hercules.API.Agent.Evaluate.EvaluateEvent.InputDeclaration (InputDeclaration (SiblingInput))+import qualified Hercules.API.Agent.Evaluate.EvaluateEvent.InputDeclaration as InputDeclaration+import qualified Hercules.API.Inputs.ImmutableGitInput as API.ImmutableGitInput+import Hercules.API.Projects (getJobSource)+import Hercules.Agent.NixFile (getOnPushOutputValueByPath)+import qualified Hercules.Agent.NixFile.GitSource as GitSource+import Hercules.Agent.NixFile.HerculesCIArgs (CISystems (CISystems), HerculesCIArgs)+import qualified Hercules.Agent.NixFile.HerculesCIArgs as HerculesCIArgs+import Hercules.CLI.Client (HerculesClientEnv, HerculesClientToken, determineDefaultApiBaseUrl, runHerculesClient)+import Hercules.CLI.Common (runAuthenticated) import Hercules.CLI.Git (getGitRoot, getRef, getRev) import Hercules.CLI.Options (scanOption)+import Hercules.CLI.Project (ProjectPath (projectPathProject), getProjectPath, projectPathReadM, projectResourceClientByPath) import Hercules.CNix (Store)-import Hercules.CNix.Expr as Expr (EvalState, Match (IsAttrs), RawValue, autoCallFunction, evalArgs, evalFile, getAttr, getAttrs, init, isDerivation, match', withEvalState, withStore)+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-import Hercules.Error (escalateAs)+import qualified Hercules.CNix.Verbosity as CNix.Verbosity import Options.Applicative as Optparse+import Options.Applicative.Types (unReadM) import Protolude hiding (evalState)+import RIO (RIO) import UnliftIO (MonadUnliftIO, UnliftIO (UnliftIO), askUnliftIO) -callCiNix :: Ptr EvalState -> Maybe Text -> IO (FilePath, RawValue)-callCiNix evalState passedRef = do+createHerculesCIArgs :: Maybe Text -> IO HerculesCIArgs+createHerculesCIArgs passedRef = do gitRoot <- getGitRoot gitRev <- getRev- gitRef <- getRef- nixFile <- findNixFile gitRoot >>= escalateAs UserException- let ref = fromMaybe gitRef passedRef- args <- evalArgs evalState ["--arg", "src", "{ ref = ''" <> encodeUtf8 ref <> "''; rev = ''" <> encodeUtf8 gitRev <> "''; outPath = ''" <> encodeUtf8 (toS gitRoot) <> "''; }"]- rootValueOrFunction <- evalFile evalState nixFile- (nixFile,) <$> autoCallFunction evalState rootValueOrFunction args+ ref <- computeRef passedRef+ let gitSource = GitSource.fromRefRevPath ref gitRev (toS gitRoot)+ url <- determineDefaultApiBaseUrl+ pure $ HerculesCIArgs.fromGitSource gitSource HerculesCIArgs.HerculesCIMeta {apiBaseUrl = url, ciSystems = CISystems Nothing} +computeRef :: Maybe Text -> IO Text+computeRef Nothing = getRef+computeRef (Just passedRef) = pure passedRef++resolveInputs ::+ (Has HerculesClientToken r, Has HerculesClientEnv r) =>+ UnliftIO (RIO r) ->+ Ptr EvalState ->+ 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 <- runHerculesClient (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)+ refBranchToRef :: Maybe Text -> Maybe Text -> Maybe Text refBranchToRef ref branch = ref <|> (("refs/heads/" <>) <$> branch) @@ -36,58 +73,66 @@ liftIO do Expr.init CNix.Util.installDefaultSigINTHandler- UnliftIO unliftIO <- askUnliftIO- liftIO $ withStore \store -> withEvalState store (unliftIO . f store)+ UnliftIO uio <- askUnliftIO+ liftIO $ withStore \store -> withEvalState store (uio . f store) ciNixAttributeCompleter :: Optparse.Completer ciNixAttributeCompleter = mkTextCompleter \partial -> do withNix \_store evalState -> do+ CNix.Verbosity.setVerbosity CNix.Verbosity.Error ref <- do ref <- scanOption "--as-ref" branch <- scanOption "--as-branch" pure $ refBranchToRef ref branch- (_, rootValue) <- callCiNix evalState ref+ projectMaybe <-+ scanOption "--project" <&> \maybeStr -> do+ s <- maybeStr+ rightToMaybe (runExcept (runReaderT (unReadM projectPathReadM) (toS s)))+ args <- createHerculesCIArgs ref let partialComponents = T.split (== '.') partial prefix = L.init partialComponents partialComponent = lastMay partialComponents & fromMaybe "" prefixStr = T.intercalate "." prefix addPrefix x = T.intercalate "." (prefix <> [x])- attrByPath evalState rootValue (encodeUtf8 <$> prefix) >>= \case- Nothing -> pure []- Just focusValue -> do- match' evalState focusValue >>= \case- IsAttrs attrset -> do- attrs <- getAttrs attrset- isDeriv <- isDerivation evalState focusValue- if isDeriv- then pure [(mempty {Optparse.cioFiles = False}, prefixStr)]- else- let matches =- attrs- & M.keys- & map decodeUtf8- & filter (/= "recurseForDerivations")- & filter (T.isPrefixOf partialComponent)- in case matches of- [singleMatch] -> do- ma <- getAttr evalState attrset (encodeUtf8 singleMatch)- matchIsDeriv <-- ma & traverse (isDerivation evalState)- <&> fromMaybe False- if matchIsDeriv- then- pure $- matches- & map (\match -> (mempty {Optparse.cioAddSpace = True, Optparse.cioFiles = False}, addPrefix match))- else+ runAuthenticated do+ uio <- askUnliftIO+ liftIO $+ getOnPushOutputValueByPath evalState (toS $ GitSource.outPath $ HerculesCIArgs.primaryRepo args) args (resolveInputs uio evalState projectMaybe) (encodeUtf8 <$> prefix) >>= \case+ Nothing -> pure []+ Just focusValue -> do+ match' evalState focusValue >>= \case+ IsAttrs attrset -> do+ attrs <- getAttrs attrset+ isDeriv <- isDerivation evalState focusValue+ if isDeriv+ then pure [(mempty {Optparse.cioFiles = False}, prefixStr)]+ else+ let matches =+ attrs+ & M.keys+ & map decodeUtf8+ & filter (/= "recurseForDerivations")+ & filter (T.isPrefixOf partialComponent)+ in case matches of+ [singleMatch] -> do+ ma <- getAttr evalState attrset (encodeUtf8 singleMatch)+ matchIsDeriv <-+ ma & traverse (isDerivation evalState)+ <&> fromMaybe False+ if matchIsDeriv+ then+ pure $+ matches+ & map (\match -> (mempty {Optparse.cioAddSpace = True, Optparse.cioFiles = False}, addPrefix match))+ else+ pure $+ matches+ & map (\match -> (mempty {Optparse.cioAddSpace = False, Optparse.cioFiles = False}, addPrefix match <> "."))+ _ -> pure $ matches- & map (\match -> (mempty {Optparse.cioAddSpace = False, Optparse.cioFiles = False}, addPrefix match <> "."))- _ ->- pure $- matches- & map (\match -> (mempty {Optparse.cioAddSpace = False, Optparse.cioFiles = False}, addPrefix match))- _ -> pure []+ & map (\match -> (mempty {Optparse.cioAddSpace = False, Optparse.cioFiles = False}, addPrefix match))+ _ -> pure [] attrByPath :: Ptr EvalState -> RawValue -> [ByteString] -> IO (Maybe RawValue) attrByPath _ v [] = pure (Just v)@@ -101,3 +146,12 @@ mkTextCompleter :: (Text -> IO [(Optparse.CompletionItemOptions, Text)]) -> Completer mkTextCompleter f = Optparse.mkCompleterWithOptions (fmap (fmap (uncurry CompletionItem . fmap toS)) . f . toS)++mkImmutableGitInputFlakeThunk :: Ptr EvalState -> API.ImmutableGitInput.ImmutableGitInput -> IO RawValue+mkImmutableGitInputFlakeThunk evalState git = do+ -- TODO: allow picking ssh/http url+ getFlakeFromGit+ evalState+ (API.ImmutableGitInput.httpURL git)+ (API.ImmutableGitInput.ref git)+ (API.ImmutableGitInput.rev git)
src/Hercules/CLI/Project.hs view
@@ -1,12 +1,14 @@+{-# LANGUAGE TypeFamilies #-}+ module Hercules.CLI.Project where import qualified Data.Attoparsec.Text as A import Data.Has (Has) import qualified Data.UUID-import Hercules.API (Id)+import Hercules.API (ClientAuth, Id, enterApiE) import Hercules.API.Id (Id (Id)) import Hercules.API.Name (Name (Name))-import Hercules.API.Projects (findProjects)+import Hercules.API.Projects (ProjectResourceGroup, ProjectsAPI (byProjectName), findProjects) import qualified Hercules.API.Projects as Projects import Hercules.API.Projects.Project (Project) import qualified Hercules.API.Projects.Project as Project@@ -24,6 +26,8 @@ import RIO (RIO) import Servant.Client.Core (ClientError (FailureResponse), ResponseF (responseStatusCode)) import Servant.Client.Core.Response (ResponseF (Response))+import Servant.Client.Generic (AsClientT)+import Servant.Client.Streaming (ClientM) import UnliftIO.Environment (lookupEnv) import qualified Prelude @@ -135,3 +139,12 @@ [p] -> pure p _ -> do exitMsg $ "Project ambiguous: " <> show project++projectResourceClientByPath :: ProjectPath -> ProjectResourceGroup ClientAuth (AsClientT ClientM)+projectResourceClientByPath projectPath =+ projectsClient `enterApiE` \api ->+ byProjectName+ api+ (Name $ projectPathSite projectPath)+ (Name $ projectPathOwner projectPath)+ (Name $ projectPathProject projectPath)
src/Hercules/CLI/Secret.hs view
@@ -10,7 +10,10 @@ import Hercules.CLI.Common (exitMsg, runAuthenticated) import Hercules.CLI.JSON as JSON import Hercules.CLI.Options (mkCommand, subparser)-import Hercules.CLI.Project (ProjectPath (projectPathOwner, projectPathSite), getProjectPath, projectOption)+import Hercules.CLI.Project (ProjectPath (projectPathOwner, projectPathSite), getProjectPath, projectOption, projectPathProject)+import Hercules.Formats.Secret (Secret (Secret))+import qualified Hercules.Formats.Secret as Secret+import Hercules.UserException (UserException (UserException)) import qualified Options.Applicative as Optparse import Protolude import System.FilePath (takeDirectory, (</>))@@ -49,7 +52,10 @@ mkJson <- JSON.options projectOptionMaybe <- optional projectOption pure $ runAuthenticated do- secretData <- liftIO (mkJson (Just secretName))+ secretDataValue <- liftIO (mkJson (Just secretName))+ secretData <- case A.parse A.parseJSON secretDataValue of+ A.Error e -> throwIO $ UserException $ "The secret data must be an object. " <> toS e+ A.Success a -> pure a projectPath <- getProjectPath projectOptionMaybe secretsFilePath <- liftIO $ getSecretsFilePath projectPath liftIO $@@ -61,19 +67,43 @@ Just _ -> do exitMsg $ "Secret " <> secretName <> " already exists in " <> toS secretsFilePath <> "." Nothing -> pass- let secrets' = secrets & M.insert secretName (A.object ["kind" A..= A.String "Secret", "data" A..= secretData])+ let secret =+ Secret+ { data_ = secretData,+ condition =+ Just $+ Secret.And+ [ Secret.IsOwner (projectPathOwner projectPath),+ Secret.IsRepo (projectPathProject projectPath),+ Secret.IsDefaultBranch+ ]+ }++ secrets' = secrets & M.insert secretName (A.toJSON secret) liftIO $ writeJsonFile secretsFilePath secrets'- putErrText $ "hci: successfully wrote " <> secretName <> " to " <> toS secretsFilePath- putErrText "NOTE: Remember to synchronize this file with your agents!"+ putErrText $ "hci: Successfully wrote " <> secretName <> " to " <> toS secretsFilePath+ putErrText " It is only available for the detected or passed project's default branch."+ putErrText " You can edit the condition to suit your needs."+ putErrText " NOTE: Remember to synchronize this file with your agents!" echo = do mkJson <- JSON.options+ projectOptionMaybe <- optional projectOption pure do secretDataValue <- liftIO (mkJson Nothing) secretData <- case A.parse A.parseJSON secretDataValue of- A.Error e -> exitMsg $ "The secret data must be an object. " <> toS e+ A.Error e -> throwIO $ UserException $ "The secret data must be an object. " <> toS e A.Success a -> pure a let secret =- A.object ["kind" A..= A.String "Secret", "data" A..= (secretData :: Map Text A.Value)]+ Secret+ { data_ = secretData,+ condition =+ projectOptionMaybe <&> \projectPath ->+ Secret.And+ [ Secret.IsOwner (projectPathOwner projectPath),+ Secret.IsRepo (projectPathProject projectPath),+ Secret.IsDefaultBranch+ ]+ } liftIO $ JSON.printJson secret getSecretsFilePath :: ProjectPath -> IO FilePath