{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}

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.Attribute (attributePathFromString)
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 (getVirtualValueByPath)
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 (runAuthenticatedOrDummy)
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)
import Hercules.CLI.Secret (getSecretsFilePath)
import Hercules.CNix (Store)
import Hercules.CNix.Expr (EvalState, Match (IsAttrs), Value (rtValue), getAttrBool, getDrvFile, match)
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 (..), parseDrvSecretsMap, 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, askUnliftIO)
import UnliftIO.Async (wait, withAsync)
import UnliftIO.Directory (createDirectoryIfMissing, getAppUserDataDirectory)
import UnliftIO.Temporary (withTempDirectory)

commandParser, runParser :: Optparse.Parser (IO ())
commandParser :: Parser (IO ())
commandParser =
  forall a. Mod CommandFields a -> Parser a
subparser
    ( forall a. FilePath -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
        FilePath
"run"
        (forall a. FilePath -> InfoMod a
Optparse.progDesc FilePath
"Run an effect")
        Parser (IO ())
runParser
    )
runParser :: Parser (IO ())
runParser = do
  Text
attr <- Parser Text
ciAttributeArgument
  Maybe ProjectPath
projectOptionMaybe <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ProjectPath
projectOption
  Maybe Text
refMaybe <- Parser (Maybe Text)
asRefOptions
  Bool
requireToken <- forall a. a -> a -> Mod FlagFields a -> Parser a
Optparse.flag Bool
True Bool
False (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-token" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Don't get an API token. Disallows access to state files, but can run in untrusted environment or unconfigured repo.")
  pure $ forall b.
Bool -> RIO (HerculesClientToken, HerculesClientEnv) b -> IO b
runAuthenticatedOrDummy Bool
requireToken do
    let getProjectInfo :: RIO (HerculesClientToken, HerculesClientEnv) ProjectData
getProjectInfo =
          case Maybe ProjectPath
projectOptionMaybe of
            Just ProjectPath
x
              | Bool -> Bool
not Bool
requireToken ->
                  forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    ProjectData
                      { pdProjectPath :: Maybe ProjectPath
pdProjectPath = forall a. a -> Maybe a
Just ProjectPath
x,
                        pdProjectId :: Maybe (Id "project")
pdProjectId = forall a. Maybe a
Nothing,
                        pdToken :: Maybe (Sensitive Text)
pdToken = forall a. Maybe a
Nothing
                      }
            Maybe ProjectPath
_ -> forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
Maybe ProjectPath -> Bool -> RIO r ProjectData
getProjectEffectData Maybe ProjectPath
projectOptionMaybe Bool
requireToken
    forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync RIO (HerculesClientToken, HerculesClientEnv) ProjectData
getProjectInfo \Async ProjectData
projectPathAsync -> do
      forall (m :: * -> *) b.
MonadUnliftIO m =>
(Store -> Ptr EvalState -> m b) -> m b
withNix \Store
store Ptr EvalState
evalState -> do
        Text
ref <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe Text -> IO Text
computeRef Maybe Text
refMaybe
        Derivation
derivation <- Store
-> Ptr EvalState
-> Maybe ProjectPath
-> Text
-> Text
-> RIO (HerculesClientToken, HerculesClientEnv) Derivation
getEffectDrv Store
store Ptr EvalState
evalState Maybe ProjectPath
projectOptionMaybe Text
ref Text
attr
        Bool
isDefaultBranch <-
          if Bool
requireToken
            then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
Git.getIsDefault
            else forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

        Map ByteString ByteString
drvEnv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Derivation -> IO (Map ByteString ByteString)
CNix.getDerivationEnv Derivation
derivation
        Map Text SecretRef
secretsMap <- case Map ByteString ByteString -> Either Text (Map Text SecretRef)
parseDrvSecretsMap Map ByteString ByteString
drvEnv of
          Left Text
e -> forall (m :: * -> *) a. MonadIO m => Text -> m a
exitMsg Text
e
          Right Map Text SecretRef
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text SecretRef
r
        Sensitive (Map Text (Map Text Value))
serverSecrets <- forall r.
Map Text SecretRef -> RIO r (Sensitive (Map Text (Map Text Value)))
loadServerSecrets Map Text SecretRef
secretsMap

        Text
apiBaseURL <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Text
determineDefaultApiBaseUrl
        ProjectData {pdProjectPath :: ProjectData -> Maybe ProjectPath
pdProjectPath = Maybe ProjectPath
projectPath, pdProjectId :: ProjectData -> Maybe (Id "project")
pdProjectId = Maybe (Id "project")
projectId, pdToken :: ProjectData -> Maybe (Sensitive Text)
pdToken = Maybe (Sensitive Text)
token} <- forall (m :: * -> *) a. MonadIO m => Async a -> m a
wait Async ProjectData
projectPathAsync
        Maybe FilePath
secretsJson <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ProjectPath -> IO FilePath
getSecretsFilePath Maybe ProjectPath
projectPath

        LogEnv
logEnv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Namespace -> Environment -> IO LogEnv
initLogEnv forall a. Monoid a => a
mempty Environment
"hci"
        -- withSystemTempDirectory "hci":
        --     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
        FilePath
dataDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => FilePath -> m FilePath
getAppUserDataDirectory FilePath
"hercules-ci"
        forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
createDirectoryIfMissing Bool
True FilePath
dataDir
        let secretContextMaybe :: Maybe SecretContext
secretContextMaybe =
              Maybe ProjectPath
projectPath forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ProjectPath
p ->
                Secret.SecretContext
                  { ownerName :: Text
ownerName = ProjectPath -> Text
projectPathOwner ProjectPath
p,
                    repoName :: Text
repoName = ProjectPath -> Text
projectPathProject ProjectPath
p,
                    isDefaultBranch :: Bool
isDefaultBranch = Bool
isDefaultBranch,
                    ref :: Text
ref = Text
ref
                  }
        ExitCode
exitCode <- forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> FilePath -> (FilePath -> m a) -> m a
withTempDirectory FilePath
dataDir FilePath
"tmp-effect-" \FilePath
workDir -> do
          forall c (m :: * -> *) a.
LogItem c =>
LogEnv -> c -> Namespace -> KatipContextT m a -> m a
runKatipContextT LogEnv
logEnv () forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *).
(MonadThrow m, KatipContext m) =>
RunEffectParams -> m ExitCode
runEffect
              RunEffectParams
                { runEffectDerivation :: Derivation
runEffectDerivation = Derivation
derivation,
                  runEffectToken :: Maybe (Sensitive Text)
runEffectToken = Maybe (Sensitive Text)
token,
                  runEffectSecretsConfigPath :: Maybe FilePath
runEffectSecretsConfigPath = Maybe FilePath
secretsJson,
                  runEffectServerSecrets :: Sensitive (Map Text (Map Text Value))
runEffectServerSecrets = Sensitive (Map Text (Map Text Value))
serverSecrets,
                  runEffectApiBaseURL :: Text
runEffectApiBaseURL = Text
apiBaseURL,
                  runEffectDir :: FilePath
runEffectDir = FilePath
workDir,
                  runEffectProjectId :: Maybe (Id "project")
runEffectProjectId = Maybe (Id "project")
projectId,
                  runEffectProjectPath :: Maybe Text
runEffectProjectPath = ProjectPath -> Text
projectPathText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ProjectPath
projectPath,
                  runEffectSecretContext :: Maybe SecretContext
runEffectSecretContext = Maybe SecretContext
secretContextMaybe,
                  runEffectUseNixDaemonProxy :: Bool
runEffectUseNixDaemonProxy = Bool
False, -- FIXME Enable proxy for ci/dev parity. Requires access to agent binaries. Unified executable?
                  runEffectExtraNixOptions :: [(Text, Text)]
runEffectExtraNixOptions = [],
                  runEffectFriendly :: Bool
runEffectFriendly = Bool
True
                }
        forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ExitCode
exitCode

loadServerSecrets :: Map Text AttributeEffectEvent.SecretRef -> RIO r (Sensitive (Map Text (Map Text A.Value)))
loadServerSecrets :: forall r.
Map Text SecretRef -> RIO r (Sensitive (Map Text (Map Text Value)))
loadServerSecrets Map Text SecretRef
secrets = Map Text SecretRef
secrets forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
M.traverseMaybeWithKey forall r. Text -> SecretRef -> RIO r (Maybe (Map Text Value))
loadServerSecret forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. a -> Sensitive a
Sensitive

loadServerSecret :: Text -> AttributeEffectEvent.SecretRef -> RIO r (Maybe (Map Text A.Value))
loadServerSecret :: forall r. Text -> SecretRef -> RIO r (Maybe (Map Text Value))
loadServerSecret Text
name SecretRef
sr = case SecretRef
sr of
  AttributeEffectEvent.SimpleSecret SimpleSecret
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  AttributeEffectEvent.GitToken GitToken
gitToken -> forall r. Text -> GitToken -> RIO r (Maybe (Map Text Value))
loadGitToken Text
name GitToken
gitToken

loadGitToken :: Text -> AttributeEffectEvent.GitToken -> RIO r (Maybe (Map Text A.Value))
loadGitToken :: forall r. Text -> GitToken -> RIO r (Maybe (Map Text Value))
loadGitToken Text
name GitToken
_noDetail = do
  -- TODO: read gh hosts.yaml file?
  (Text, Text)
token <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> IO (Text, Text)
askPasswordWithKey (forall a. a -> Maybe a
Just Text
name) Text
"token"
  forall (f :: * -> *) (g :: * -> *) a.
(Applicative f, Applicative g) =>
a -> f (g a)
purer forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
      [(Text, Text)
token forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Value
A.String]

getEffectDrv :: Store -> Ptr EvalState -> Maybe ProjectPath -> Text -> Text -> RIO (HerculesClientToken, HerculesClientEnv) Derivation
getEffectDrv :: Store
-> Ptr EvalState
-> Maybe ProjectPath
-> Text
-> Text
-> RIO (HerculesClientToken, HerculesClientEnv) Derivation
getEffectDrv Store
store Ptr EvalState
evalState Maybe ProjectPath
projectOptionMaybe Text
ref Text
attr = do
  ByteString
storeDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Store -> m ByteString
CNix.storeDir Store
store
  Derivation
derivation <-
    if OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
storeDir Text -> Text -> Bool
`T.isPrefixOf` Text
attr
      then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        -- Support derivation in arbitrary location
        -- Used in hercules-ci-effects test runner
        let path :: Text
path = Text
attr
        ByteString
contents <- FilePath -> IO ByteString
BS.readFile forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS Text
path
        let stripDrv :: Text -> Text
stripDrv Text
s = forall a. a -> Maybe a -> a
fromMaybe Text
s (Text -> Text -> Maybe Text
T.stripSuffix Text
".drv" Text
s)
        Store -> ByteString -> ByteString -> IO Derivation
CNix.getDerivationFromString Store
store (Text
path forall a b. a -> (a -> b) -> b
& (Char -> Bool) -> Text -> Text
T.takeWhileEnd (forall a. Eq a => a -> a -> Bool
/= Char
'/') forall a b. a -> (a -> b) -> b
& Text -> Text
stripDrv forall a b. a -> (a -> b) -> b
& Text -> ByteString
encodeUtf8) ByteString
contents
      else forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
Ptr EvalState
-> Store -> Maybe ProjectPath -> Text -> Text -> RIO r Derivation
evaluateEffectDerivation Ptr EvalState
evalState Store
store Maybe ProjectPath
projectOptionMaybe Text
ref Text
attr
  forall (m :: * -> *). MonadIO m => Store -> Derivation -> m ()
prepareDerivation Store
store Derivation
derivation
  pure Derivation
derivation

evaluateEffectDerivation :: (Has HerculesClientToken r, Has HerculesClientEnv r) => Ptr EvalState -> Store -> Maybe ProjectPath -> Text -> Text -> RIO r Derivation
evaluateEffectDerivation :: forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
Ptr EvalState
-> Store -> Maybe ProjectPath -> Text -> Text -> RIO r Derivation
evaluateEffectDerivation Ptr EvalState
evalState Store
store Maybe ProjectPath
projectOptionMaybe Text
ref Text
attr = do
  HerculesCIArgs
args <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe Text -> IO HerculesCIArgs
createHerculesCIArgs (forall a. a -> Maybe a
Just Text
ref)
  let attrPath :: [Text]
attrPath = Text -> [Text]
attributePathFromString Text
attr
      nixFile :: Text
nixFile = GitSource -> Text
GitSource.outPath forall a b. (a -> b) -> a -> b
$ HerculesCIArgs -> GitSource
HerculesCIArgs.primaryRepo HerculesCIArgs
args
  UnliftIO (RIO r)
uio <- forall (m :: * -> *). MonadUnliftIO m => m (UnliftIO m)
askUnliftIO
  Maybe RawValue
valMaybe <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Ptr EvalState
-> FilePath
-> HerculesCIArgs
-> (Map ByteString InputDeclaration -> IO (Value NixAttrs))
-> [ByteString]
-> IO (Maybe RawValue)
getVirtualValueByPath Ptr EvalState
evalState (forall a b. ConvertText a b => a -> b
toS Text
nixFile) HerculesCIArgs
args (forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
UnliftIO (RIO r)
-> Ptr EvalState
-> Maybe ProjectPath
-> Map ByteString InputDeclaration
-> IO (Value NixAttrs)
resolveInputs UnliftIO (RIO r)
uio Ptr EvalState
evalState Maybe ProjectPath
projectOptionMaybe) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> ByteString
encodeUtf8 [Text]
attrPath)
  -- valMaybe <- liftIO $ attrByPath evalState rootValue
  Match
attrValue <- case Maybe RawValue
valMaybe of
    Maybe RawValue
Nothing -> do
      forall (m :: * -> *) a. MonadIO m => Text -> m a
exitMsg forall a b. (a -> b) -> a -> b
$ Text
"Could not find an attribute at path " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv FilePath b) => a -> b
show [Text]
attrPath forall a. Semigroup a => a -> a -> a
<> Text
" in " forall a. Semigroup a => a -> a -> a
<> Text
nixFile
    Just RawValue
v -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr EvalState -> RawValue -> IO (Either SomeException Match)
match Ptr EvalState
evalState RawValue
v) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall exc (m :: * -> *) a.
(Exception exc, MonadThrow m) =>
Either exc a -> m a
escalate
  Value NixAttrs
effectAttrs <- case Match
attrValue of
    IsAttrs Value NixAttrs
attrs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Value NixAttrs
attrs
    Match
_ -> do
      forall (m :: * -> *) a. MonadIO m => Text -> m a
exitMsg forall a b. (a -> b) -> a -> b
$ Text
"Attribute is not an Effect at path " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv FilePath b) => a -> b
show [Text]
attrPath forall a. Semigroup a => a -> a -> a
<> Text
" in " forall a. Semigroup a => a -> a -> a
<> Text
nixFile

  Maybe Bool
isEffect <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Ptr EvalState
-> Value NixAttrs
-> ByteString
-> IO (Either SomeException (Maybe Bool))
getAttrBool Ptr EvalState
evalState Value NixAttrs
effectAttrs ByteString
"isEffect" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall exc (m :: * -> *) a.
(Exception exc, MonadThrow m) =>
Either exc a -> m a
escalate
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Bool
isEffect forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Bool
True) do
    forall (m :: * -> *) a. MonadIO m => Text -> m a
exitMsg forall a b. (a -> b) -> a -> b
$ Text
"Attribute is not an Effect at path " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv FilePath b) => a -> b
show [Text]
attrPath forall a. Semigroup a => a -> a -> a
<> Text
" in " forall a. Semigroup a => a -> a -> a
<> Text
nixFile
  StorePath
drvPath <- forall (m :: * -> *).
MonadIO m =>
Ptr EvalState -> RawValue -> m StorePath
getDrvFile Ptr EvalState
evalState (forall a. Value a -> RawValue
rtValue Value NixAttrs
effectAttrs)
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Store -> StorePath -> IO Derivation
CNix.getDerivation Store
store StorePath
drvPath

prepareDerivation :: MonadIO m => Store -> Derivation -> m ()
prepareDerivation :: forall (m :: * -> *). MonadIO m => Store -> Derivation -> m ()
prepareDerivation Store
store Derivation
derivation = do
  [(StorePath, [ByteString])]
inputs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Store -> Derivation -> IO [(StorePath, [ByteString])]
getDerivationInputs Store
store Derivation
derivation
  StdVector NixStorePathWithOutputs
storePathsWithOutputs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. HasStdVector a => IO (StdVector a)
Std.Vector.new
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(StorePath, [ByteString])]
inputs \(StorePath
input, [ByteString]
outputs) -> do
    StorePathWithOutputs
swo <- StorePath -> [ByteString] -> IO StorePathWithOutputs
newStorePathWithOutputs StorePath
input [ByteString]
outputs
    forall a' a.
(Coercible a' (ForeignPtr a), HasStdVector a) =>
StdVector a -> a' -> IO ()
Std.Vector.pushBackFP StdVector NixStorePathWithOutputs
storePathsWithOutputs StorePathWithOutputs
swo
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Store -> StdVector NixStorePathWithOutputs -> IO ()
buildPaths Store
store StdVector NixStorePathWithOutputs
storePathsWithOutputs

ciAttributeArgument :: Optparse.Parser Text
ciAttributeArgument :: Parser Text
ciAttributeArgument =
  forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"CI_NIX_ATTRIBUTE"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Attribute to run"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
ciNixAttributeCompleter

asBranchOption :: Optparse.Parser Text
asBranchOption :: Parser Text
asBranchOption =
  forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"pretend-branch" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"BRANCH" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Pretend we're on another git branch" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (IO [Text] -> Completer
flatCompleter IO [Text]
getAllBranches))
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"as-branch" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"BRANCH" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Alias for --pretend-branch")

asRefOption :: Optparse.Parser Text
asRefOption :: Parser Text
asRefOption =
  forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"pretend-ref" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"REF" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Pretend we're on another git ref" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (IO [Text] -> Completer
flatCompleter IO [Text]
getHypotheticalRefs))
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"as-ref" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"REF" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Alias for --pretend-ref")

asRefOptions :: Optparse.Parser (Maybe Text)
asRefOptions :: Parser (Maybe Text)
asRefOptions = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text
asRefOption forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Text
"refs/heads/" forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
asBranchOption))

data ProjectData = ProjectData
  { ProjectData -> Maybe ProjectPath
pdProjectPath :: Maybe ProjectPath,
    ProjectData -> Maybe (Id "project")
pdProjectId :: Maybe (Id "project"),
    ProjectData -> Maybe (Sensitive Text)
pdToken :: Maybe (Sensitive Text)
  }

getProjectEffectData :: (Has HerculesClientToken r, Has HerculesClientEnv r) => Maybe ProjectPath -> Bool -> RIO r ProjectData
getProjectEffectData :: forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
Maybe ProjectPath -> Bool -> RIO r ProjectData
getProjectEffectData Maybe ProjectPath
maybeProjectPathParam Bool
requireToken = do
  (Maybe (Id Project)
projectIdMaybe, ProjectPath
path) <- forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
Maybe ProjectPath -> RIO r (Maybe (Id Project), ProjectPath)
getProjectIdAndPath Maybe ProjectPath
maybeProjectPathParam
  if Bool
requireToken
    then do
      Id Project
projectId <- case Maybe (Id Project)
projectIdMaybe of
        Just Id Project
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Id Project
x
        Maybe (Id Project)
Nothing -> do
          forall (m :: * -> *) a. MonadIO m => Text -> m a
exitMsg forall a b. (a -> b) -> a -> b
$ Text
"Can not access " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv FilePath b) => a -> b
show ProjectPath
path forall a. Semigroup a => a -> a -> a
<> Text
". Make sure you have installed Hercules CI on the organization and repository and that you have access to it."
      CreateUserEffectTokenResponse
response <- forall a r.
(NFData a, Has HerculesClientToken r, Has HerculesClientEnv r) =>
(Token -> ClientM a) -> RIO r a
runHerculesClient (forall auth f.
ProjectsAPI auth f
-> f
   :- (Summary "Create a token for local effect execution"
       :> ("projects"
           :> (Capture' '[Required, Strict] "projectId" (Id Project)
               :> (auth
                   :> ("create-user-effect-token"
                       :> Post '[JSON] CreateUserEffectTokenResponse)))))
Projects.createUserEffectToken ProjectsAPI ClientAuth (AsClientT ClientM)
projectsClient Id Project
projectId)
      let token :: Sensitive Text
token = forall a. a -> Sensitive a
Sensitive (CreateUserEffectTokenResponse -> Text
CreateUserEffectTokenResponse.token CreateUserEffectTokenResponse
response)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectData {pdProjectPath :: Maybe ProjectPath
pdProjectPath = forall a. a -> Maybe a
Just ProjectPath
path, pdProjectId :: Maybe (Id "project")
pdProjectId = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k (a :: k). UUID -> Id a
Id forall a b. (a -> b) -> a -> b
$ forall k (a :: k). Id a -> UUID
idUUID Id Project
projectId, pdToken :: Maybe (Sensitive Text)
pdToken = forall a. a -> Maybe a
Just Sensitive Text
token}
    else
      forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ProjectData
          { pdProjectPath :: Maybe ProjectPath
pdProjectPath = forall a. Maybe a
Nothing,
            pdProjectId :: Maybe (Id "project")
pdProjectId = forall a. Maybe a
Nothing,
            pdToken :: Maybe (Sensitive Text)
pdToken = forall a. Maybe a
Nothing
          }