hercules-ci-cli 0.3.5 → 0.3.6

raw patch · 8 files changed

+130/−30 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−0
• hercules-ci-cli.cabal +3/−1
• src/Hercules/CLI/Effect.hs +8/−3
• src/Hercules/CLI/Lock.hs +2/−2
• src/Hercules/CLI/Main.hs +20/−1
• src/Hercules/CLI/Nix.hs +80/−21
• src/Hercules/CLI/Project.hs +1/−1
• src/Hercules/CLI/State.hs +1/−1

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

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

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

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

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

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

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

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