hercules-ci-cli 0.3.2 → 0.3.3

raw patch · 5 files changed

+120/−12 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• hercules-ci-cli.cabal +1/−1
• src/Hercules/CLI/Effect.hs +30/−3
• src/Hercules/CLI/Git.hs +53/−4
• src/Hercules/CLI/Nix.hs +22/−4

@@ -5,6 +5,20 @@ 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.3 - 2022-11-15++### Added++ - `hci effect run` can now run `onSchedule.<name>.*` effect attributes.++ - Basic support for the `GitToken` secret type. You may enter a personal access token+   by hand.++### Fixed++ - Fix a common error when an explicit upstream is missing but only one remote exists.+   This was sufficient data to determine the project context, and now it works.+ ## 0.3.2 - 2022-06-21  ### Added

@@ -1,7 +1,7 @@ cabal-version: 1.12  name:           hercules-ci-cli-version:        0.3.2+version:        0.3.3 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

@@ -5,13 +5,16 @@  module Hercules.CLI.Effect where +import qualified Data.Aeson as A import qualified Data.ByteString as BS import Data.Has (Has)+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.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 Hercules.Agent.NixFile (getVirtualValueByPath) import qualified Hercules.Agent.NixFile.GitSource as GitSource import qualified Hercules.Agent.NixFile.HerculesCIArgs as HerculesCIArgs import Hercules.Agent.Sensitive (Sensitive (Sensitive))@@ -20,6 +23,7 @@ import Hercules.CLI.Exception (exitMsg) import Hercules.CLI.Git (getAllBranches, getHypotheticalRefs) import qualified Hercules.CLI.Git as Git+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)@@ -29,7 +33,7 @@ import qualified Hercules.CNix.Std.Vector as Std.Vector import Hercules.CNix.Store (Derivation, buildPaths, getDerivationInputs, newStorePathWithOutputs) import qualified Hercules.CNix.Store as CNix-import Hercules.Effect (RunEffectParams (..), runEffect)+import Hercules.Effect (RunEffectParams (..), parseDrvSecretsMap, runEffect) import Hercules.Error (escalate) import qualified Hercules.Secrets as Secret import Katip (initLogEnv, runKatipContextT)@@ -75,6 +79,12 @@             then liftIO Git.getIsDefault             else pure True +        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@@ -99,6 +109,7 @@                 { runEffectDerivation = derivation,                   runEffectToken = token,                   runEffectSecretsConfigPath = secretsJson,+                  runEffectServerSecrets = serverSecrets,                   runEffectApiBaseURL = apiBaseURL,                   runEffectDir = workDir,                   runEffectProjectId = projectId,@@ -110,6 +121,22 @@                 }         throwIO exitCode +loadServerSecrets :: Map Text AttributeEffectEvent.SecretRef -> RIO r (Sensitive (Map Text (Map Text A.Value)))+loadServerSecrets secrets = secrets & M.traverseMaybeWithKey loadServerSecret <&> Sensitive++loadServerSecret :: Text -> AttributeEffectEvent.SecretRef -> RIO r (Maybe (Map Text A.Value))+loadServerSecret name sr = case sr of+  AttributeEffectEvent.SimpleSecret _ -> pure Nothing+  AttributeEffectEvent.GitToken gitToken -> loadGitToken name gitToken++loadGitToken :: Text -> AttributeEffectEvent.GitToken -> RIO r (Maybe (Map Text A.Value))+loadGitToken name _noDetail = do+  -- TODO: read gh hosts.yaml file?+  token <- liftIO $ askPasswordWithKey (Just name) "token"+  purer $+    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@@ -132,7 +159,7 @@   let attrPath = T.split (== '.') attr       nixFile = GitSource.outPath $ HerculesCIArgs.primaryRepo args   uio <- askUnliftIO-  valMaybe <- liftIO $ getOnPushOutputValueByPath evalState (toS nixFile) args (resolveInputs uio evalState projectOptionMaybe) (map encodeUtf8 attrPath)+  valMaybe <- liftIO $ getVirtualValueByPath evalState (toS nixFile) args (resolveInputs uio evalState projectOptionMaybe) (map encodeUtf8 attrPath)   -- valMaybe <- liftIO $ attrByPath evalState rootValue   attrValue <- case valMaybe of     Nothing -> do

@@ -1,10 +1,12 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Hercules.CLI.Git where  import Data.List (dropWhileEnd) import qualified Data.Text as T import Hercules.CLI.Exception (exitMsg)+import Network.URI (URI (uriAuthority), URIAuth (uriRegName), parseURI) import Protolude import System.Directory (doesDirectoryExist) import System.Process (readProcess)@@ -71,6 +73,10 @@       (getBranchUpstream >>= getRemoteURL) `onException` do         putErrText "hci: could not determine git upstream repository url" +getUpstreamRef :: IO Text+getUpstreamRef =+  toS <$> readProcessString "git" ["rev-parse", "--symbolic-full-name", "@{u}"] mempty+ getBranchUpstream :: IO Text getBranchUpstream = do   upstreamRef <-@@ -82,13 +88,56 @@     else do       exitMsg "upstream branch is not remote" +getCurrentBranchMaybe :: IO (Maybe Text)+getCurrentBranchMaybe =+  do+    x <- readProcessString "git" ["rev-parse", "--symbolic-full-name", "HEAD"] mempty++    case x of+      'r' : 'e' : 'f' : 's' : '/' : 'h' : 'e' : 'a' : 'd' : 's' : '/' : branch -> pure (Just (toS branch))+      _ -> pure Nothing+    `catch` \(_e :: SomeException) ->+      pure Nothing+ 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)+  try getUpstreamRef >>= \case+    Right _upstreamRef ->+      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)+        `onException` putErrText "hci: could not determine whether branch matches default branch"+    Left (_ :: SomeException) -> do+      getCurrentBranchMaybe >>= \case+        Nothing ->+          exitMsg "hci: Can't infer the context of your effect when you're on a git detached head."+        Just x -> do+          remotes <- getRemotes+          case remotes of+            [upstream] -> do+              putErrText "hci: Your branch does not seem to have an upstream. Assuming the local branch name and the single remote."+              upstreamDefaultRef <- readProcessString "git" ["rev-parse", "--symbolic-full-name", toS upstream <> "/HEAD"] mempty+              pure $ upstreamDefaultRef == "refs/heads/" ++ toS x+            [] ->+              exitMsg "hci: Can't infer whether you're on the default branch, because the repository does not have a remote."+            _multiple ->+              exitMsg "hci: Can't infer whether you're on the default branch, because the current branch does not have an upstream, and multiple remotes exist. Please set the upstream for the current branch."  getRemoteURL :: Text -> IO Text getRemoteURL remoteName =   readProcessItem "git" ["remote", "get-url", toS remoteName] mempty++-- TODO: store forge type in credentials.json+guessForgeTypeFromURL :: Text -> Maybe Text+guessForgeTypeFromURL urlString = do+  uri <- parseURI (toS urlString)+  autho <- uriAuthority uri+  let host = uriRegName autho+  if "github" `isInfixOf` host+    then Just "github"+    else+      if "gitlab" `isInfixOf` host+        then Just "gitlab"+        else Nothing

@@ -12,13 +12,13 @@ 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 Hercules.Agent.NixFile (getVirtualValueByPath) 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.Git (getGitRoot, getRef, getRev, getUpstreamURL, guessForgeTypeFromURL) import Hercules.CLI.Options (scanOption) import Hercules.CLI.Project (ProjectPath (projectPathProject), getProjectPath, projectPathReadM, projectResourceClientByPath) import Hercules.CNix (Store)@@ -36,7 +36,25 @@   gitRoot <- getGitRoot   gitRev <- getRev   ref <- computeRef passedRef-  let gitSource = GitSource.fromRefRevPath ref gitRev (toS gitRoot)+  upstreamURL <- getUpstreamURL+  let remoteHttpUrl = upstreamURL <$ guard ("http" `T.isPrefixOf` upstreamURL)+      remoteSshUrl = upstreamURL <$ guard (not ("http" `T.isPrefixOf` upstreamURL))+      guessWebUrlFromHttpUrl url = T.stripSuffix ".git" url & fromMaybe url+  let gitSource =+        GitSource.GitSource+          { outPath = toS gitRoot,+            ref = ref,+            rev = gitRev,+            shortRev = GitSource.shortRevFromRev gitRev,+            branch = GitSource.branchFromRef ref,+            tag = GitSource.tagFromRef ref,+            remoteHttpUrl = remoteHttpUrl,+            remoteSshUrl = remoteSshUrl,+            webUrl = guessWebUrlFromHttpUrl <$> remoteHttpUrl,+            forgeType = guessForgeTypeFromURL upstreamURL,+            owner = Nothing {- TODO; agent only for now -},+            name = Nothing {- TODO; agent only for now -}+          }   url <- determineDefaultApiBaseUrl   pure $ HerculesCIArgs.fromGitSource gitSource HerculesCIArgs.HerculesCIMeta {apiBaseUrl = url, ciSystems = CISystems Nothing} @@ -97,7 +115,7 @@     runAuthenticated do       uio <- askUnliftIO       liftIO $-        getOnPushOutputValueByPath 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 <$> prefix) >>= \case           Nothing -> pure []           Just focusValue -> do             match' evalState focusValue >>= \case