-- |
-- Module      : Amazonka.Auth.ConfigFile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
--
-- Retrieve authentication credentials from AWS config/credentials files.
module Amazonka.Auth.ConfigFile where

import Amazonka.Auth.Container (fromContainerEnv)
import Amazonka.Auth.Exception
import Amazonka.Auth.InstanceProfile (fromDefaultInstanceProfile)
import Amazonka.Auth.Keys (fromKeysEnv)
import Amazonka.Auth.SSO (fromSSO, relativeCachedTokenFile)
import Amazonka.Auth.STS (fromAssumedRole, fromWebIdentity)
import Amazonka.Data
import Amazonka.Env (Env, Env' (..), lookupRegion)
import Amazonka.Prelude
import Amazonka.Types
import qualified Control.Exception as Exception
import Control.Exception.Lens (handling_, _IOException)
import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)
import Control.Monad.Trans.State (StateT, evalStateT, get, modify)
import Data.Foldable (asum)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Ini as INI
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified System.Directory as Directory
import qualified System.Environment as Environment
import System.Info (os)

-- | Retrieve credentials from the AWS config/credentials files, as
-- Amazonka currently understands them:
--
-- * AWS recommends credentials do not live in the config file, but
--   allows it.
--
-- * Sections in the config file start should either be named
--   @[default]@ or @[profile foo]@. Unprefixed @[foo]@ currently
--   "happens to work" but is not officially supported, to match the
--   observed behaviour of the AWS SDK/CLI.
--
-- * Sections in the credentials file are always unprefixed -
--   @[default]@ or @[foo]@.
--
-- /See:/ the 'ConfigProfile' type, to understand the methods Amazonka
-- currently supports.
fromFilePath ::
  forall m withAuth.
  (MonadIO m, Foldable withAuth) =>
  -- | Profile name
  Text ->
  -- | Credentials file
  FilePath ->
  -- | Config file
  FilePath ->
  Env' withAuth ->
  m Env
fromFilePath :: forall (m :: * -> *) (withAuth :: * -> *).
(MonadIO m, Foldable withAuth) =>
Text -> String -> String -> Env' withAuth -> m Env
fromFilePath Text
profile String
credentialsFile String
configFile Env' withAuth
env = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  HashMap Text [(Text, Text)]
credentialsIni <- String -> IO (HashMap Text [(Text, Text)])
loadIniFile String
credentialsFile
  -- If we fail to read the config file, assume it's empty and move
  -- on. It is valid to configure only a credentials file if you only
  -- want to set keys, for example.
  HashMap Text [(Text, Text)]
configIni <-
    forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
Exception.catchJust
      (\(AuthError
_ :: AuthError) -> forall a. a -> Maybe a
Just forall a. Monoid a => a
mempty)
      (String -> IO (HashMap Text [(Text, Text)])
loadIniFile String
configFile)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure

  let config :: HashMap Text (HashMap Text Text)
config = HashMap Text [(Text, Text)]
-> HashMap Text [(Text, Text)] -> HashMap Text (HashMap Text Text)
mergeConfigs HashMap Text [(Text, Text)]
credentialsIni HashMap Text [(Text, Text)]
configIni
  Env
env' <-
    Text
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
evalConfig Text
profile
      forall a b. a -> (a -> b) -> b
& (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` HashMap Text (HashMap Text Text)
config)
      forall a b. a -> (a -> b) -> b
& (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`evalStateT` forall a. Monoid a => a
mempty)

  -- A number of settings in the AWS config files should be
  -- overridable by environment variables, but aren't. We make a point
  -- of at least respecting the AWS_REGION variable, but leave the
  -- rest to future work.
  --
  -- See: https://docs.aws.amazon.com/cli/latest/userguide/cli-configure-files.html
  forall (m :: * -> *). MonadIO m => m (Maybe Region)
lookupRegion forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Maybe Region
Nothing -> Env
env'
    Just Region
region -> Env
env' {Region
$sel:region:Env :: Region
region :: Region
region}
  where
    loadIniFile :: FilePath -> IO (HashMap Text [(Text, Text)])
    loadIniFile :: String -> IO (HashMap Text [(Text, Text)])
loadIniFile String
path = do
      Bool
exists <- String -> IO Bool
Directory.doesFileExist String
path
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
Exception.throwIO forall a b. (a -> b) -> a -> b
$ String -> AuthError
MissingFileError String
path
      String -> IO (Either String Ini)
INI.readIniFile String
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left String
e ->
          forall e a. Exception e => e -> IO a
Exception.throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AuthError
InvalidFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
path forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> String
e
        Right Ini
ini -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Ini -> HashMap Text [(Text, Text)]
INI.iniSections Ini
ini

    -- Parse the matched config, and extract auth credentials from it,
    -- recursively if necessary.
    evalConfig ::
      Text ->
      ReaderT
        (HashMap Text (HashMap Text Text)) -- Map of profiles and their settings
        (StateT [Text] IO) -- List of source_profiles we've seen already
        Env
    evalConfig :: Text
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
evalConfig Text
pName = do
      HashMap Text (HashMap Text Text)
config <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
      case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
pName HashMap Text (HashMap Text Text)
config of
        Maybe (HashMap Text Text)
Nothing ->
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
Exception.throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AuthError
InvalidFileError forall a b. (a -> b) -> a -> b
$
            Text
"Missing profile: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Text
pName)
        Just HashMap Text Text
p -> case HashMap Text Text -> Maybe (ConfigProfile, Maybe Region)
parseConfigProfile HashMap Text Text
p of
          Maybe (ConfigProfile, Maybe Region)
Nothing ->
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
Exception.throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AuthError
InvalidFileError forall a b. (a -> b) -> a -> b
$
              Text
"Parse error in profile: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Text
pName)
          Just (ConfigProfile
cp, Maybe Region
mRegion) -> do
            Env
env' <- case ConfigProfile
cp of
              ExplicitKeys AuthEnv
keys ->
                forall (f :: * -> *) a. Applicative f => a -> f a
pure Env' withAuth
env {$sel:auth:Env :: Identity Auth
auth = forall a. a -> Identity a
Identity forall a b. (a -> b) -> a -> b
$ AuthEnv -> Auth
Auth AuthEnv
keys}
              AssumeRoleFromProfile Text
roleArn Text
sourceProfileName -> do
                [Text]
seenProfiles <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) s. Monad m => StateT s m s
get
                if Text
sourceProfileName forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
seenProfiles
                  then
                    let trace :: [Text]
trace = forall a. [a] -> [a]
reverse [Text]
seenProfiles forall a. [a] -> [a] -> [a]
++ [forall a. [a] -> a
last [Text]
seenProfiles]
                        textTrace :: Text
textTrace = Text -> [Text] -> Text
Text.intercalate Text
" -> " [Text]
trace
                     in forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
Exception.throwIO
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AuthError
InvalidFileError
                          forall a b. (a -> b) -> a -> b
$ Text
"Infinite source_profile loop: " forall a. Semigroup a => a -> a -> a
<> Text
textTrace
                  else do
                    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ (Text
sourceProfileName forall a. a -> [a] -> [a]
:)
                    Env
sourceEnv <- Text
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
evalConfig Text
sourceProfileName
                    forall (m :: * -> *). MonadIO m => Text -> Text -> Env -> m Env
fromAssumedRole Text
roleArn Text
"amazonka-assumed-role" Env
sourceEnv
              AssumeRoleFromCredentialSource Text
roleArn CredentialSource
source -> do
                Env
sourceEnv <- case CredentialSource
source of
                  CredentialSource
Environment -> forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Env' withAuth -> m Env
fromKeysEnv Env' withAuth
env
                  CredentialSource
Ec2InstanceMetadata -> forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Env' withAuth -> m Env
fromDefaultInstanceProfile Env' withAuth
env
                  CredentialSource
EcsContainer -> forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Env' withAuth -> m Env
fromContainerEnv Env' withAuth
env
                forall (m :: * -> *). MonadIO m => Text -> Text -> Env -> m Env
fromAssumedRole Text
roleArn Text
"amazonka-assumed-role" Env
sourceEnv
              AssumeRoleWithWebIdentity Text
roleArn Maybe Text
mRoleSessionName String
tokenFile ->
                forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
String -> Text -> Maybe Text -> Env' withAuth -> m Env
fromWebIdentity String
tokenFile Text
roleArn Maybe Text
mRoleSessionName Env' withAuth
env
              AssumeRoleViaSSO Text
startUrl Region
ssoRegion Text
accountId Text
roleName -> do
                String
cachedTokenFile <-
                  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                    String -> IO String
configPathRelative forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => Text -> m String
relativeCachedTokenFile Text
startUrl
                forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
String -> Region -> Text -> Text -> Env' withAuth -> m Env
fromSSO String
cachedTokenFile Region
ssoRegion Text
accountId Text
roleName Env' withAuth
env

            -- Once we have the env from the profile, apply the region
            -- if we parsed one out.
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Maybe Region
mRegion of
              Maybe Region
Nothing -> Env
env'
              Just Region
region -> Env
env' {Region
region :: Region
$sel:region:Env :: Region
region}

mergeConfigs ::
  -- | Credentials
  HashMap Text [(Text, Text)] ->
  -- | Config
  HashMap Text [(Text, Text)] ->
  HashMap Text (HashMap Text Text)
mergeConfigs :: HashMap Text [(Text, Text)]
-> HashMap Text [(Text, Text)] -> HashMap Text (HashMap Text Text)
mergeConfigs HashMap Text [(Text, Text)]
creds HashMap Text [(Text, Text)]
confs =
  forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith
    forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HashMap.union
    (forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text [(Text, Text)]
creds)
    (forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v. HashMap Text v -> HashMap Text v
stripProfiles HashMap Text [(Text, Text)]
confs)
  where
    stripProfiles :: HashMap Text v -> HashMap Text v
    stripProfiles :: forall v. HashMap Text v -> HashMap Text v
stripProfiles = forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
HashMap.mapKeys forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
stripProfile forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.words

    stripProfile :: [Text] -> [Text]
stripProfile = \case
      [Text
w] -> [Text
w]
      (Text
"profile" : [Text]
ws) -> [Text]
ws
      [Text]
ws -> [Text]
ws

parseConfigProfile :: HashMap Text Text -> Maybe (ConfigProfile, Maybe Region)
parseConfigProfile :: HashMap Text Text -> Maybe (ConfigProfile, Maybe Region)
parseConfigProfile HashMap Text Text
profile = Maybe ConfigProfile
parseProfile forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,Maybe Region
parseRegion)
  where
    parseProfile :: Maybe ConfigProfile
    parseProfile :: Maybe ConfigProfile
parseProfile =
      forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ Maybe ConfigProfile
explicitKey,
          Maybe ConfigProfile
assumeRoleFromProfile,
          Maybe ConfigProfile
assumeRoleFromCredentialSource,
          Maybe ConfigProfile
assumeRoleWithWebIdentity,
          Maybe ConfigProfile
assumeRoleViaSSO
        ]

    parseRegion :: Maybe Region
    parseRegion :: Maybe Region
parseRegion = Text -> Region
Region' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"region" HashMap Text Text
profile

    explicitKey :: Maybe ConfigProfile
explicitKey =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AuthEnv -> ConfigProfile
ExplicitKeys forall a b. (a -> b) -> a -> b
$
        AccessKey
-> Sensitive SecretKey
-> Maybe (Sensitive SessionToken)
-> Maybe ISO8601
-> AuthEnv
AuthEnv
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ByteString -> AccessKey
AccessKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"aws_access_key_id" HashMap Text Text
profile
              )
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( forall a. a -> Sensitive a
Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SecretKey
SecretKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"aws_secret_access_key" HashMap Text Text
profile
              )
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> Maybe a
Just
            ( forall a. a -> Sensitive a
Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SessionToken
SessionToken forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"aws_session_token" HashMap Text Text
profile
            )
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> Maybe a
Just forall a. Maybe a
Nothing -- No token expiry in config file
    assumeRoleFromProfile :: Maybe ConfigProfile
assumeRoleFromProfile =
      Text -> Text -> ConfigProfile
AssumeRoleFromProfile
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"role_arn" HashMap Text Text
profile
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"source_profile" HashMap Text Text
profile

    assumeRoleFromCredentialSource :: Maybe ConfigProfile
assumeRoleFromCredentialSource =
      Text -> CredentialSource -> ConfigProfile
AssumeRoleFromCredentialSource
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"role_arn" HashMap Text Text
profile
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"credential_source" HashMap Text Text
profile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Text
"Environment" -> forall a. a -> Maybe a
Just CredentialSource
Environment
                Text
"Ec2InstanceMetadata" -> forall a. a -> Maybe a
Just CredentialSource
Ec2InstanceMetadata
                Text
"EcsContainer" -> forall a. a -> Maybe a
Just CredentialSource
EcsContainer
                Text
_ -> forall a. Maybe a
Nothing
            )

    assumeRoleWithWebIdentity :: Maybe ConfigProfile
assumeRoleWithWebIdentity =
      Text -> Maybe Text -> String -> ConfigProfile
AssumeRoleWithWebIdentity
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"role_arn" HashMap Text Text
profile
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> Maybe a
Just (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"role_session_name" HashMap Text Text
profile)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> String
Text.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"web_identity_token_file" HashMap Text Text
profile)

    assumeRoleViaSSO :: Maybe ConfigProfile
assumeRoleViaSSO =
      Text -> Region -> Text -> Text -> ConfigProfile
AssumeRoleViaSSO
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"sso_start_url" HashMap Text Text
profile
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Region
Region' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"sso_region" HashMap Text Text
profile)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"sso_account_id" HashMap Text Text
profile
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"sso_role_name" HashMap Text Text
profile

data ConfigProfile
  = -- | Recognizes @aws_access_key_id@, @aws_secret_access_key@, and
    -- optionally @aws_session_token@.
    ExplicitKeys AuthEnv
  | -- | Recognizes @role_arn@ and @source_profile@.
    AssumeRoleFromProfile Text Text
  | -- | Recognizes @role_arn@ and @credential_source@.
    AssumeRoleFromCredentialSource Text CredentialSource
  | -- | Recognizes @role_arn@, @role_session_name@, and
    -- @web_identity_token_file@.
    AssumeRoleWithWebIdentity Text (Maybe Text) FilePath
  | -- | Recognizes @sso_start_url@, @sso_region@, @sso_account_id@, and
    -- @sso_role_name@.
    AssumeRoleViaSSO Text Region Text Text
  deriving stock (ConfigProfile -> ConfigProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigProfile -> ConfigProfile -> Bool
$c/= :: ConfigProfile -> ConfigProfile -> Bool
== :: ConfigProfile -> ConfigProfile -> Bool
$c== :: ConfigProfile -> ConfigProfile -> Bool
Eq, Int -> ConfigProfile -> ShowS
[ConfigProfile] -> ShowS
ConfigProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigProfile] -> ShowS
$cshowList :: [ConfigProfile] -> ShowS
show :: ConfigProfile -> String
$cshow :: ConfigProfile -> String
showsPrec :: Int -> ConfigProfile -> ShowS
$cshowsPrec :: Int -> ConfigProfile -> ShowS
Show, forall x. Rep ConfigProfile x -> ConfigProfile
forall x. ConfigProfile -> Rep ConfigProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfigProfile x -> ConfigProfile
$cfrom :: forall x. ConfigProfile -> Rep ConfigProfile x
Generic)

data CredentialSource = Environment | Ec2InstanceMetadata | EcsContainer
  deriving stock (CredentialSource -> CredentialSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CredentialSource -> CredentialSource -> Bool
$c/= :: CredentialSource -> CredentialSource -> Bool
== :: CredentialSource -> CredentialSource -> Bool
$c== :: CredentialSource -> CredentialSource -> Bool
Eq, Int -> CredentialSource -> ShowS
[CredentialSource] -> ShowS
CredentialSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CredentialSource] -> ShowS
$cshowList :: [CredentialSource] -> ShowS
show :: CredentialSource -> String
$cshow :: CredentialSource -> String
showsPrec :: Int -> CredentialSource -> ShowS
$cshowsPrec :: Int -> CredentialSource -> ShowS
Show, forall x. Rep CredentialSource x -> CredentialSource
forall x. CredentialSource -> Rep CredentialSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CredentialSource x -> CredentialSource
$cfrom :: forall x. CredentialSource -> Rep CredentialSource x
Generic)

-- | Loads the default config/credentials INI files and selects a
-- profile by environment variable (@AWS_PROFILE@).
--
-- Throws 'MissingFileError' if 'credFile' is missing, or 'InvalidFileError'
-- if an error occurs during parsing.
--
-- This looks in in the @HOME@ directory as determined by the
-- <http://hackage.haskell.org/package/directory directory> library.
--
-- * Not Windows: @$HOME\/.aws\/credentials@
--
-- * Windows: @%USERPROFILE%\\.aws\\credentials@
fromFileEnv ::
  (MonadIO m, Foldable withAuth) => Env' withAuth -> m Env
fromFileEnv :: forall (m :: * -> *) (withAuth :: * -> *).
(MonadIO m, Foldable withAuth) =>
Env' withAuth -> m Env
fromFileEnv Env' withAuth
env = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Maybe String
mProfile <- String -> IO (Maybe String)
Environment.lookupEnv String
"AWS_PROFILE"
  String
cred <- String -> IO String
configPathRelative String
"/.aws/credentials"
  String
conf <- String -> IO String
configPathRelative String
"/.aws/config"

  forall (m :: * -> *) (withAuth :: * -> *).
(MonadIO m, Foldable withAuth) =>
Text -> String -> String -> Env' withAuth -> m Env
fromFilePath (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"default" String -> Text
Text.pack Maybe String
mProfile) String
cred String
conf Env' withAuth
env

configPathRelative :: String -> IO String
configPathRelative :: String -> IO String
configPathRelative String
p = forall (m :: * -> *) a r.
MonadCatch m =>
Getting (First a) SomeException a -> m r -> m r -> m r
handling_ forall t. AsIOException t => Prism' t IOException
_IOException IO String
err IO String
dir
  where
    err :: IO String
err = forall e a. Exception e => e -> IO a
Exception.throwIO forall a b. (a -> b) -> a -> b
$ String -> AuthError
MissingFileError (String
"$HOME" forall a. [a] -> [a] -> [a]
++ String
p)
    dir :: IO String
dir = case String
os of
      String
"mingw32" ->
        String -> IO (Maybe String)
Environment.lookupEnv String
"USERPROFILE"
          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. Exception e => e -> IO a
Exception.throwIO forall a b. (a -> b) -> a -> b
$ String -> AuthError
MissingFileError String
"%USERPROFILE%") forall (f :: * -> *) a. Applicative f => a -> f a
pure
      String
_ -> IO String
Directory.getHomeDirectory forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (forall a. [a] -> [a] -> [a]
++ String
p)