diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,21 @@ 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.6 - 2023-03-07 + +### Fixed + + - `hci effect run`: Attribute names with spaces, periods and/or quotes can now be specified on the command line. + +### Added + + - `hci effect run --pretend-branch` and `--pretend-ref` can now be used to replace `--as-*`. + This command allows an effect to run locally for development, instead of on `hercules-ci-agent`. + + `--as-*` flags are still available, for those who don't want to switch right away, to remain compatible with outdated installations of `hci`. + + - `--version` + ## 0.3.5 - 2022-12-29 ### Fixed diff --git a/hercules-ci-cli.cabal b/hercules-ci-cli.cabal --- a/hercules-ci-cli.cabal +++ b/hercules-ci-cli.cabal @@ -1,7 +1,7 @@ cabal-version: 1.12 name: hercules-ci-cli -version: 0.3.5 +version: 0.3.6 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 @@ -34,6 +34,8 @@ Hercules.CLI.Secret Hercules.CLI.State Hercules.CLI.Options + other-modules: + Paths_hercules_ci_cli hs-source-dirs: src default-extensions: DeriveGeneric DeriveTraversable DisambiguateRecordFields FlexibleContexts InstanceSigs LambdaCase MultiParamTypeClasses NoImplicitPrelude OverloadedStrings RankNTypes TupleSections TypeApplications TypeOperators 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 @@ -11,6 +11,7 @@ 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.Id (Id (Id, idUUID)) import qualified Hercules.API.Projects as Projects import qualified Hercules.API.Projects.CreateUserEffectTokenResponse as CreateUserEffectTokenResponse @@ -156,7 +157,7 @@ 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 = T.split (== '.') attr + let attrPath = attributePathFromString attr nixFile = GitSource.outPath $ HerculesCIArgs.primaryRepo args uio <- askUnliftIO valMaybe <- liftIO $ getVirtualValueByPath evalState (toS nixFile) args (resolveInputs uio evalState projectOptionMaybe) (map encodeUtf8 attrPath) @@ -193,10 +194,14 @@ <> completer ciNixAttributeCompleter asBranchOption :: Optparse.Parser Text -asBranchOption = strOption $ long "as-branch" <> metavar "BRANCH" <> help "Pretend we're on another git branch" <> completer (flatCompleter getAllBranches) +asBranchOption = + strOption (long "pretend-branch" <> metavar "BRANCH" <> help "Pretend we're on another git branch" <> completer (flatCompleter getAllBranches)) + <|> strOption (long "as-branch" <> metavar "BRANCH" <> help "Alias for --pretend-branch") asRefOption :: Optparse.Parser Text -asRefOption = strOption $ long "as-ref" <> metavar "REF" <> help "Pretend we're on another git ref" <> completer (flatCompleter getHypotheticalRefs) +asRefOption = + strOption (long "pretend-ref" <> metavar "REF" <> help "Pretend we're on another git ref" <> completer (flatCompleter getHypotheticalRefs)) + <|> strOption (long "as-ref" <> metavar "REF" <> help "Alias for --pretend-ref") asRefOptions :: Optparse.Parser (Maybe Text) asRefOptions = optional (asRefOption <|> (("refs/heads/" <>) <$> asBranchOption)) 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 @@ -14,11 +14,11 @@ import qualified Data.UUID.V4 as UUID4 import Hercules.API (Id, NoContent) import qualified Hercules.API.Accounts.SimpleAccount as SimpleAccount +import qualified Hercules.API.Forge.SimpleForge as SimpleForge import Hercules.API.Id (Id (Id), idText) 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)) @@ -270,7 +270,7 @@ jobUrl = Hercules.Frontend.job links - (SimpleSite.name $ SimpleAccount.site $ SimpleProject.owner project) + (SimpleForge.name $ SimpleAccount.site $ SimpleProject.owner project) (SimpleAccount.name $ SimpleProject.owner project) (SimpleProject.name project) (fromIntegral (SimpleJob.index job)) 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 @@ -5,6 +5,7 @@ ) where +import Data.Version (showVersion) import Hercules.CLI.Client (prettyPrintHttpErrors) import qualified Hercules.CLI.Effect as Effect import qualified Hercules.CLI.Exception as Exception @@ -19,6 +20,7 @@ import Hercules.CNix.Verbosity (setShowTrace) import qualified Language.C.Inline.Cpp.Exception as C import qualified Options.Applicative as Optparse +import Paths_hercules_ci_cli import Protolude main :: IO () @@ -26,6 +28,12 @@ prettyPrintErrors $ Exception.handleUserException $ prettyPrintHttpErrors $ do + args <- getArgs + case args of + -- optparse-applicative doesn't allow commands prefixed by `--`. + ["--version"] -> do + exitVersion + _ -> pass join $ execParser opts initNix :: IO () @@ -64,9 +72,16 @@ (commands <**> helper) (Optparse.fullDesc <> Optparse.header "Command line interface to Hercules CI") +exitVersion :: IO () +exitVersion = do + putText ("hci " <> ver) + exitSuccess + where + ver = toS (showVersion Paths_hercules_ci_cli.version) + setCommonOpts :: Optparse.Parser (IO ()) setCommonOpts = - Optparse.flag pass (setShowTrace True) (Optparse.long "show-trace") + Optparse.flag pass (setShowTrace True) (Optparse.long "show-trace" <> Optparse.help "Print evaluation stack traces in full") commands :: Optparse.Parser (IO ()) commands = @@ -81,6 +96,10 @@ "state" (Optparse.progDesc "Perform operations on state files") State.commandParser + <> mkCommand + "version" + (Optparse.progDesc "Print the command name and version") + (pure exitVersion) <> mkCommand "effect" (Optparse.progDesc "Run effects locally") 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 @@ -5,11 +5,11 @@ 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.API.Agent.Evaluate.EvaluateEvent.InputDeclaration (InputDeclaration (SiblingInput)) import qualified Hercules.API.Agent.Evaluate.EvaluateEvent.InputDeclaration as InputDeclaration +import Hercules.API.Attribute (attributePathFromString, attributePathToString) import qualified Hercules.API.Inputs.ImmutableGitInput as API.ImmutableGitInput import Hercules.API.Projects (getJobSource) import Hercules.Agent.NixFile (getVirtualValueByPath) @@ -94,28 +94,93 @@ UnliftIO uio <- askUnliftIO liftIO $ withStore \store -> withEvalState store (uio . f store) +mkSemanticTextCompleter :: (Text -> IO [(CompletionItemOptions, Text)]) -> Completer +mkSemanticTextCompleter f = + mkTextCompleter + ( \input -> do + let startsEscape = input & T.reverse & T.takeWhile (== '\\') & T.length & odd + innerCompleter = isoCompleter decodeBash encodeBash f + if startsEscape + then do + r <- innerCompleter (T.dropEnd 1 input) + -- Requiring input to be a prefix of the suggestions prevents corrections, + -- so we only filter when necessary. + pure + [ item + | item@(_, suggestionText) <- r, + input `T.isPrefixOf` suggestionText + ] + else innerCompleter input + ) + +mkAttributePathCompleter :: (([Text], Text) -> IO [(CompletionItemOptions, ([Text], Bool))]) -> Completer +mkAttributePathCompleter f = + mkSemanticTextCompleter + ( \input -> do + let startsEscape = + (input & T.reverse & T.takeWhile (== '\\') & T.length & odd) + || (".\"" `T.isSuffixOf` input) + decode s + | ".\"\"" `T.isSuffixOf` s = + (attributePathFromString s, "") + decode s = + let path = attributePathFromString s + in (initSafe path, lastMay path & fromMaybe "") + encode (path, dot) = attributePathToString path <> if dot then "." else "" + innerCompleter = nestedCompleter decode encode f + if startsEscape + then do + r <- innerCompleter (T.dropEnd 1 input) + -- Requiring input to be a prefix of the suggestions prevents corrections, + -- so we only filter when necessary. + pure + [ item + | item@(_, suggestionText) <- r, + input `T.isPrefixOf` suggestionText + ] + else innerCompleter input + ) + +isoCompleter :: (b -> a) -> (a -> b) -> (a -> IO [(CompletionItemOptions, a)]) -> (b -> IO [(CompletionItemOptions, b)]) +isoCompleter = nestedCompleter + +nestedCompleter :: (a -> b) -> (c -> d) -> (b -> IO [(CompletionItemOptions, c)]) -> (a -> IO [(CompletionItemOptions, d)]) +nestedCompleter parse unparse f = fmap (fmap (fmap unparse)) . f . parse + +encodeBash :: Text -> Text +encodeBash = toS . f . toS + where + f ('"' : s) = '\\' : '"' : f s + f ('\'' : s) = '\\' : '\'' : f s + f ('\\' : s) = '\\' : '\\' : f s + f (' ' : s) = '\\' : ' ' : f s + f (c : s) = c : f s + f "" = "" + +decodeBash :: Text -> Text +decodeBash = toS . g . toS + where + g ('\\' : c : s) = c : g s + g (c : s) = c : g s + g "" = "" + ciNixAttributeCompleter :: Optparse.Completer -ciNixAttributeCompleter = mkTextCompleter \partial -> do +ciNixAttributeCompleter = mkAttributePathCompleter \(partialPath, partialComponent) -> do withNix \_store evalState -> do CNix.Verbosity.setVerbosity CNix.Verbosity.Error ref <- do - ref <- scanOption "--as-ref" - branch <- scanOption "--as-branch" + ref <- liftA2 (<|>) (scanOption "--as-ref") (scanOption "--pretend-ref") + branch <- liftA2 (<|>) (scanOption "--as-branch") (scanOption "--pretend-branch") pure $ refBranchToRef ref branch 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]) runAuthenticated do uio <- askUnliftIO liftIO $ - getVirtualValueByPath evalState (toS $ GitSource.outPath $ HerculesCIArgs.primaryRepo args) args (resolveInputs uio evalState projectMaybe) (encodeUtf8 <$> prefix) >>= \case + getVirtualValueByPath evalState (toS $ GitSource.outPath $ HerculesCIArgs.primaryRepo args) args (resolveInputs uio evalState projectMaybe) (encodeUtf8 <$> partialPath) >>= \case Nothing -> pure [] Just focusValue -> do match' evalState focusValue >>= \case @@ -123,7 +188,7 @@ attrs <- getAttrs evalState attrset isDeriv <- isDerivation evalState focusValue if isDeriv - then pure [(mempty {Optparse.cioFiles = False}, prefixStr)] + then pure [(mempty {Optparse.cioFiles = False}, (partialPath, False))] else let matches = attrs @@ -138,19 +203,13 @@ 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 = matchIsDeriv, Optparse.cioFiles = False}, (partialPath ++ [match], not matchIsDeriv))) _ -> pure $ matches - & map (\match -> (mempty {Optparse.cioAddSpace = False, Optparse.cioFiles = False}, addPrefix match)) + & map (\match -> (mempty {Optparse.cioAddSpace = False, Optparse.cioFiles = False}, (partialPath ++ [match], False))) _ -> pure [] attrByPath :: Ptr EvalState -> RawValue -> [ByteString] -> IO (Maybe RawValue) 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 @@ -22,7 +22,7 @@ import Network.HTTP.Types (Status (Status, statusCode)) import Options.Applicative (bashCompleter, completer, help, long, metavar, option, strOption) import qualified Options.Applicative as Optparse -import Protolude hiding (option) +import Protolude import RIO (RIO) import Servant.Client.Core (ClientError (FailureResponse), ResponseF (responseStatusCode)) import Servant.Client.Core.Response (ResponseF (Response)) diff --git a/src/Hercules/CLI/State.hs b/src/Hercules/CLI/State.hs --- a/src/Hercules/CLI/State.hs +++ b/src/Hercules/CLI/State.hs @@ -14,7 +14,7 @@ import Hercules.CLI.Project (ProjectPath (projectPathOwner, projectPathProject, projectPathSite), findProjectContextually, projectOption) import Options.Applicative (auto, bashCompleter, completer, help, long, metavar, option, strOption) import qualified Options.Applicative as Optparse -import Protolude hiding (option) +import Protolude import RIO (RIO, runRIO, withBinaryFile) import Servant.API (Headers (Headers), fromSourceIO, toSourceIO) import Servant.Client.Generic (AsClientT)