{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BlockArguments #-}

module Hercules.CLI.Secret where

import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import qualified Data.Map as M
import qualified Data.Text as T
import Hercules.CLI.Common (exitMsg, runAuthenticated)
import Hercules.CLI.JSON as JSON
import Hercules.CLI.Options (mkCommand, subparser)
import Hercules.CLI.Project (ProjectPath (projectPathOwner, projectPathSite), getProjectPath, projectOption, projectPathProject)
import Hercules.Formats.Secret (Secret (Secret))
import qualified Hercules.Formats.Secret as Secret
import Hercules.UserException (UserException (UserException))
import qualified Options.Applicative as Optparse
import Protolude
import System.Environment (lookupEnv)
import System.FilePath (takeDirectory, (</>))
import UnliftIO.Directory (XdgDirectory (XdgConfig), createDirectoryIfMissing, doesFileExist, getXdgDirectory)

commandParser, initLocal, add, echo :: Optparse.Parser (IO ())
commandParser :: Parser (IO ())
commandParser =
  forall a. Mod CommandFields a -> Parser a
subparser
    ( forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
        String
"init-local"
        (forall a. String -> InfoMod a
Optparse.progDesc String
"Create a local secrets file in ~/.config/hercules-ci/secrets/<site>/<owner>")
        Parser (IO ())
initLocal
        forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
          String
"add"
          (forall a. String -> InfoMod a
Optparse.progDesc String
"Insert a secret into the local secrets file")
          Parser (IO ())
add
        forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand
          String
"echo"
          (forall a. String -> InfoMod a
Optparse.progDesc String
"Assemble a secret for stdout")
          Parser (IO ())
echo
    )
initLocal :: Parser (IO ())
initLocal = do
  Maybe ProjectPath
projectOptionMaybe <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ProjectPath
projectOption
  pure $ forall b. RIO (HerculesClientToken, HerculesClientEnv) b -> IO b
runAuthenticated do
    ProjectPath
projectPath <- forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
Maybe ProjectPath -> RIO r ProjectPath
getProjectPath Maybe ProjectPath
projectOptionMaybe
    String
secretsFilePath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ProjectPath -> IO String
getSecretsFilePath ProjectPath
projectPath
    forall (m :: * -> *). MonadIO m => String -> m Bool
doesFileExist String
secretsFilePath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
True -> do
        forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText forall a b. (a -> b) -> a -> b
$ Text
"hci: Secrets file already existed. Path: " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertText a b => a -> b
toS String
secretsFilePath
      Bool
False -> do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
secretsFilePath)
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
writeFile String
secretsFilePath Text
"{}"
        forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText forall a b. (a -> b) -> a -> b
$ Text
"hci: Secrets file created. Path: " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertText a b => a -> b
toS String
secretsFilePath
add :: Parser (IO ())
add = do
  Text
secretName <- forall s. IsString s => Mod ArgumentFields s -> Parser s
Optparse.strArgument (forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"SECRET_NAME" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
Optparse.help String
"Organization/account-wide name for the secret")
  Maybe Text -> IO Value
mkJson <- Parser (Maybe Text -> IO Value)
JSON.options
  Maybe ProjectPath
projectOptionMaybe <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ProjectPath
projectOption
  pure $ forall b. RIO (HerculesClientToken, HerculesClientEnv) b -> IO b
runAuthenticated do
    Value
secretDataValue <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Maybe Text -> IO Value
mkJson (forall a. a -> Maybe a
Just Text
secretName))
    Map Text Value
secretData <- case forall a b. (a -> Parser b) -> a -> Result b
A.parse forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
secretDataValue of
      A.Error String
e -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException forall a b. (a -> b) -> a -> b
$ Text
"The secret data must be an object. " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertText a b => a -> b
toS String
e
      A.Success Map Text Value
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Value
a
    ProjectPath
projectPath <- forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
Maybe ProjectPath -> RIO r ProjectPath
getProjectPath Maybe ProjectPath
projectOptionMaybe
    String
secretsFilePath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ProjectPath -> IO String
getSecretsFilePath ProjectPath
projectPath
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *). MonadIO m => String -> m Bool
doesFileExist String
secretsFilePath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
False -> forall (m :: * -> *) a. MonadIO m => Text -> m a
exitMsg forall a b. (a -> b) -> a -> b
$ Text
"No secrets file found. If the account is correct, use `hci init-local`. (path: " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertText a b => a -> b
toS String
secretsFilePath forall a. Semigroup a => a -> a -> a
<> Text
")"
        Bool
True -> forall (f :: * -> *). Applicative f => f ()
pass
    Map Text Value
secrets <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall b. FromJSON b => String -> IO b
readJsonFile String
secretsFilePath
    case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
secretName Map Text Value
secrets of
      Just Value
_ -> do
        forall (m :: * -> *) a. MonadIO m => Text -> m a
exitMsg forall a b. (a -> b) -> a -> b
$ Text
"Secret " forall a. Semigroup a => a -> a -> a
<> Text
secretName forall a. Semigroup a => a -> a -> a
<> Text
" already exists in " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertText a b => a -> b
toS String
secretsFilePath forall a. Semigroup a => a -> a -> a
<> Text
"."
      Maybe Value
Nothing -> forall (f :: * -> *). Applicative f => f ()
pass
    let secret :: Secret
secret =
          Secret
            { data_ :: Map Text Value
data_ = Map Text Value
secretData,
              condition :: Maybe Condition
condition =
                forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
                  [Condition] -> Condition
Secret.And
                    [ Text -> Condition
Secret.IsOwner (ProjectPath -> Text
projectPathOwner ProjectPath
projectPath),
                      Text -> Condition
Secret.IsRepo (ProjectPath -> Text
projectPathProject ProjectPath
projectPath),
                      Condition
Secret.IsDefaultBranch
                    ]
            }

        secrets' :: Map Text Value
secrets' = Map Text Value
secrets forall a b. a -> (a -> b) -> b
& forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
secretName (forall a. ToJSON a => a -> Value
A.toJSON Secret
secret)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => String -> a -> IO ()
writeJsonFile String
secretsFilePath Map Text Value
secrets'
    forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText forall a b. (a -> b) -> a -> b
$ Text
"hci: Successfully wrote " forall a. Semigroup a => a -> a -> a
<> Text
secretName forall a. Semigroup a => a -> a -> a
<> Text
" to " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertText a b => a -> b
toS String
secretsFilePath
    forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText Text
"     It is only available for the detected or passed project's default branch."
    forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText Text
"     You can edit the condition to suit your needs."
    forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText Text
"     NOTE: Remember to synchronize this file with your agents!"
echo :: Parser (IO ())
echo = do
  Maybe Text -> IO Value
mkJson <- Parser (Maybe Text -> IO Value)
JSON.options
  Maybe ProjectPath
projectOptionMaybe <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ProjectPath
projectOption
  pure do
    Value
secretDataValue <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Maybe Text -> IO Value
mkJson forall a. Maybe a
Nothing)
    Map Text Value
secretData <- case forall a b. (a -> Parser b) -> a -> Result b
A.parse forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
secretDataValue of
      A.Error String
e -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException forall a b. (a -> b) -> a -> b
$ Text
"The secret data must be an object. " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertText a b => a -> b
toS String
e
      A.Success Map Text Value
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Value
a
    let secret :: Secret
secret =
          Secret
            { data_ :: Map Text Value
data_ = Map Text Value
secretData,
              condition :: Maybe Condition
condition =
                Maybe ProjectPath
projectOptionMaybe forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ProjectPath
projectPath ->
                  [Condition] -> Condition
Secret.And
                    [ Text -> Condition
Secret.IsOwner (ProjectPath -> Text
projectPathOwner ProjectPath
projectPath),
                      Text -> Condition
Secret.IsRepo (ProjectPath -> Text
projectPathProject ProjectPath
projectPath),
                      Condition
Secret.IsDefaultBranch
                    ]
            }
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> IO ()
JSON.printJson Secret
secret

getSecretsFilePath :: ProjectPath -> IO FilePath
getSecretsFilePath :: ProjectPath -> IO String
getSecretsFilePath ProjectPath
projectPath = do
  String -> IO (Maybe String)
lookupEnv String
"HERCULES_CI_SECRETS_JSON" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe String
Nothing -> ProjectPath -> IO String
getSecretsFilePathXdg ProjectPath
projectPath
    Just String
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
x

getSecretsFilePathXdg :: ProjectPath -> IO FilePath
getSecretsFilePathXdg :: ProjectPath -> IO String
getSecretsFilePathXdg ProjectPath
projectPath = do
  String
dir <- forall (m :: * -> *).
MonadIO m =>
XdgDirectory -> String -> m String
getXdgDirectory XdgDirectory
XdgConfig String
"hercules-ci"
  let toPathElement :: Text -> String
toPathElement = forall a b. ConvertText a b => a -> b
toS forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map (\case Char
'/' -> Char
'_'; Char
x -> Char
x)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"secrets" String -> String -> String
</> Text -> String
toPathElement (ProjectPath -> Text
projectPathSite ProjectPath
projectPath) String -> String -> String
</> Text -> String
toPathElement (ProjectPath -> Text
projectPathOwner ProjectPath
projectPath) String -> String -> String
</> String
"secrets.json"