{-# 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"
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,
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
(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
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)
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
}