module AWS.Secrets.Fetch where

import AWS.Secrets.Config (SecretsConfig)
import qualified AWS.Secrets.Config as Config
import AWS.Secrets.Name (SecretName, getSecretNameText)
import Control.Applicative (pure)
import Control.Monad.Except (MonadError, throwError)
import Control.Monad.IO.Class (MonadIO)
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString.Lazy as Lazy.ByteString
import Data.Either (Either (..))
import Data.Foldable (fold)
import Data.Function (($), (.))
import Data.Int (Int)
import qualified Data.List as List
import Data.Semigroup ((<>))
import Data.String (String)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy.Text
import qualified Data.Text.Lazy.Builder as Text
import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified System.Exit as Exit
import System.IO (FilePath)
import qualified System.Process.Typed as Process
import Text.Show (Show, show)

-- | Type @result@ may be e.g. 'AWS.Secrets.SecretType.Secret'.
fetchSecret ::
  forall m result.
  (MonadIO m, MonadError Text m, JSON.FromJSON result) =>
  SecretsConfig ->
  SecretName ->
  m result
fetchSecret :: forall (m :: * -> *) result.
(MonadIO m, MonadError Text m, FromJSON result) =>
SecretsConfig -> SecretName -> m result
fetchSecret SecretsConfig
config SecretName
name = do
  let secretNameText :: Text
      secretNameText :: Text
secretNameText = SecretName -> Text
getSecretNameText SecretName
name

      secretNameString :: String
      secretNameString :: String
secretNameString = Text -> String
Text.unpack Text
secretNameText

      secretNameTextBuilder :: Text.Builder
      secretNameTextBuilder :: Builder
secretNameTextBuilder = Text -> Builder
Text.Builder.fromText Text
secretNameText

      awsRegionText :: Text
      awsRegionText :: Text
awsRegionText = AwsRegion -> Text
Config.getAwsRegionText (SecretsConfig -> AwsRegion
Config.getAwsRegion SecretsConfig
config)

      awsRegionString :: String
      awsRegionString :: String
awsRegionString = Text -> String
Text.unpack Text
awsRegionText

      awsRegionTextBuilder :: Text.Builder
      awsRegionTextBuilder :: Builder
awsRegionTextBuilder = Text -> Builder
Text.Builder.fromText Text
awsRegionText

      executableFilePath :: FilePath
      executableFilePath :: String
executableFilePath = AwsCli -> String
Config.getAwsCliFilePath (SecretsConfig -> AwsCli
Config.getAwsCli SecretsConfig
config)

      executableTextBuilder :: Text.Builder
      executableTextBuilder :: Builder
executableTextBuilder = String -> Builder
Text.Builder.fromString String
executableFilePath

      stringArgs :: [String]
      stringArgs :: [String]
stringArgs =
        [ String
Item [String]
"secretsmanager",
          String
Item [String]
"get-secret-value",
          String
Item [String]
"--secret-id",
          String
Item [String]
secretNameString,
          String
Item [String]
"--region",
          String
Item [String]
awsRegionString
        ]

      fullCommandTextBuilder :: Text.Builder
      fullCommandTextBuilder :: Builder
fullCommandTextBuilder =
        [Builder] -> Builder
unwords
          [ Builder
Item [Builder]
"The exact command executed was:",
            forall a. Show a => a -> Builder
showBuilder @[String] (String
executableFilePath String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
stringArgs)
          ]

      descriptionTextBuilder :: Text.Builder
      descriptionTextBuilder :: Builder
descriptionTextBuilder =
        [Builder] -> Builder
unwords
          [ Builder
Item [Builder]
"AWS command",
            Builder -> Builder
quote Builder
executableTextBuilder,
            Builder
Item [Builder]
"to get secret",
            Builder -> Builder
quote Builder
secretNameTextBuilder,
            Builder
Item [Builder]
"from region",
            Builder -> Builder
quote (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder
awsRegionTextBuilder
          ]

  (ExitCode
exitCode :: Exit.ExitCode, ByteString
output :: Lazy.ByteString, ByteString
error :: Lazy.ByteString) <-
    ProcessConfig () () () -> m (ExitCode, ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
Process.readProcess (String -> [String] -> ProcessConfig () () ()
Process.proc String
executableFilePath [String]
stringArgs)

  let -- Shows what came out on stdout
      normalOutputMessage :: Text.Builder
      normalOutputMessage :: Builder
normalOutputMessage =
        if ByteString -> Bool
Lazy.ByteString.null ByteString
output
          then Builder
"It produced no output."
          else
            [Builder] -> Builder
unwords
              [ Builder
Item [Builder]
"Its output was:",
                forall a. Show a => a -> Builder
showBuilder @Lazy.ByteString ByteString
output
              ]

      -- Shows what came out on stderr
      errorOutputMessage :: Text.Builder
      errorOutputMessage :: Builder
errorOutputMessage =
        if ByteString -> Bool
Lazy.ByteString.null ByteString
error
          then Builder
"It produced no error output."
          else
            [Builder] -> Builder
unwords
              [ Builder
Item [Builder]
"Its error output was:",
                forall a. Show a => a -> Builder
showBuilder @Lazy.ByteString ByteString
error
              ]

      -- What to do if the JSON on stdout couldn't be parsed
      throwParseError :: forall x. String -> m x
      throwParseError :: forall x. String -> m x
throwParseError String
parseError =
        (Text -> m x
forall a. Text -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m x) -> ([Builder] -> Text) -> [Builder] -> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
render (Builder -> Text) -> ([Builder] -> Builder) -> [Builder] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
unlines)
          [ [Builder] -> Builder
unwords
              [ Builder
Item [Builder]
descriptionTextBuilder,
                Builder
Item [Builder]
"failed to produce valid JSON"
              ],
            Builder
Item [Builder]
fullCommandTextBuilder,
            Builder
Item [Builder]
normalOutputMessage,
            [Builder] -> Builder
unwords
              [ Builder
Item [Builder]
"The output from the parser is:",
                String -> Builder
Text.Builder.fromString String
parseError
              ]
          ]

      -- What to do if AWS command returns a failure exit code
      throwExitCodeError :: forall x. Int -> m x
      throwExitCodeError :: forall x. Int -> m x
throwExitCodeError Int
exitCodeInt =
        (Text -> m x
forall a. Text -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m x) -> ([Builder] -> Text) -> [Builder] -> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
render (Builder -> Text) -> ([Builder] -> Builder) -> [Builder] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
unlines)
          [ [Builder] -> Builder
unwords
              [ Builder
Item [Builder]
descriptionTextBuilder,
                Builder
Item [Builder]
"failed with exit code",
                Builder -> Builder
quote (forall a. Show a => a -> Builder
showBuilder @Int Int
exitCodeInt)
              ],
            Builder
Item [Builder]
fullCommandTextBuilder,
            Builder
Item [Builder]
errorOutputMessage
          ]

  case ExitCode
exitCode of
    ExitCode
Exit.ExitSuccess -> case forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecode @result ByteString
output of
      Right result
x -> result -> m result
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure result
x
      Left String
e -> String -> m result
forall x. String -> m x
throwParseError String
e
    Exit.ExitFailure Int
exitCodeInt ->
      Int -> m result
forall x. Int -> m x
throwExitCodeError Int
exitCodeInt

quote :: Text.Builder -> Text.Builder
quote :: Builder -> Builder
quote Builder
x = Builder
"‘" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"’"

unwords :: [Text.Builder] -> Text.Builder
unwords :: [Builder] -> Builder
unwords = [Builder] -> Builder
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Builder] -> Builder)
-> ([Builder] -> [Builder]) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
List.intersperse Builder
" "

unlines :: [Text.Builder] -> Text.Builder
unlines :: [Builder] -> Builder
unlines = [Builder] -> Builder
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Builder] -> Builder)
-> ([Builder] -> [Builder]) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
List.intersperse Builder
"\n"

showBuilder :: Show a => a -> Text.Builder
showBuilder :: forall a. Show a => a -> Builder
showBuilder = String -> Builder
Text.Builder.fromString (String -> Builder) -> (a -> String) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

render :: Text.Builder -> Text
render :: Builder -> Text
render = LazyText -> Text
Lazy.Text.toStrict (LazyText -> Text) -> (Builder -> LazyText) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
Text.Builder.toLazyText