diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/hercules-ci-cli.cabal b/hercules-ci-cli.cabal --- a/hercules-ci-cli.cabal +++ b/hercules-ci-cli.cabal @@ -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 diff --git a/src/Hercules/CLI/Effect.hs b/src/Hercules/CLI/Effect.hs --- a/src/Hercules/CLI/Effect.hs +++ b/src/Hercules/CLI/Effect.hs @@ -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 diff --git a/src/Hercules/CLI/Exception.hs b/src/Hercules/CLI/Exception.hs --- a/src/Hercules/CLI/Exception.hs +++ b/src/Hercules/CLI/Exception.hs @@ -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 = diff --git a/src/Hercules/CLI/Git.hs b/src/Hercules/CLI/Git.hs --- a/src/Hercules/CLI/Git.hs +++ b/src/Hercules/CLI/Git.hs @@ -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 diff --git a/src/Hercules/CLI/JSON.hs b/src/Hercules/CLI/JSON.hs --- a/src/Hercules/CLI/JSON.hs +++ b/src/Hercules/CLI/JSON.hs @@ -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) diff --git a/src/Hercules/CLI/Lock.hs b/src/Hercules/CLI/Lock.hs --- a/src/Hercules/CLI/Lock.hs +++ b/src/Hercules/CLI/Lock.hs @@ -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 diff --git a/src/Hercules/CLI/Main.hs b/src/Hercules/CLI/Main.hs --- a/src/Hercules/CLI/Main.hs +++ b/src/Hercules/CLI/Main.hs @@ -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 + ) diff --git a/src/Hercules/CLI/Nix.hs b/src/Hercules/CLI/Nix.hs --- a/src/Hercules/CLI/Nix.hs +++ b/src/Hercules/CLI/Nix.hs @@ -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) diff --git a/src/Hercules/CLI/Project.hs b/src/Hercules/CLI/Project.hs --- a/src/Hercules/CLI/Project.hs +++ b/src/Hercules/CLI/Project.hs @@ -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) diff --git a/src/Hercules/CLI/Secret.hs b/src/Hercules/CLI/Secret.hs --- a/src/Hercules/CLI/Secret.hs +++ b/src/Hercules/CLI/Secret.hs @@ -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