-- |
-- 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 = IO Env -> m Env
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Env -> m Env) -> IO Env -> m Env
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 <-
    (AuthError -> Maybe (HashMap Text [(Text, Text)]))
-> IO (HashMap Text [(Text, Text)])
-> (HashMap Text [(Text, Text)]
    -> IO (HashMap Text [(Text, Text)]))
-> IO (HashMap Text [(Text, Text)])
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
Exception.catchJust
      (\(AuthError
_ :: AuthError) -> HashMap Text [(Text, Text)] -> Maybe (HashMap Text [(Text, Text)])
forall a. a -> Maybe a
Just HashMap Text [(Text, Text)]
forall a. Monoid a => a
mempty)
      (String -> IO (HashMap Text [(Text, Text)])
loadIniFile String
configFile)
      HashMap Text [(Text, Text)] -> IO (HashMap Text [(Text, Text)])
forall a. a -> IO a
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
      ReaderT (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
-> (ReaderT
      (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
    -> StateT [Text] IO Env)
-> StateT [Text] IO Env
forall a b. a -> (a -> b) -> b
& (ReaderT (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
-> HashMap Text (HashMap Text Text) -> StateT [Text] IO Env
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` HashMap Text (HashMap Text Text)
config)
      StateT [Text] IO Env -> (StateT [Text] IO Env -> IO Env) -> IO Env
forall a b. a -> (a -> b) -> b
& (StateT [Text] IO Env -> [Text] -> IO Env
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`evalStateT` [Text]
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
  IO (Maybe Region)
forall (m :: * -> *). MonadIO m => m (Maybe Region)
lookupRegion IO (Maybe Region) -> (Maybe Region -> Env) -> IO Env
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Maybe Region
Nothing -> Env
env'
    Just Region
region -> Env
env' {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
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> (AuthError -> IO ()) -> AuthError -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthError -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO ()) -> AuthError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> AuthError
MissingFileError String
path
      String -> IO (Either String Ini)
INI.readIniFile String
path IO (Either String Ini)
-> (Either String Ini -> IO (HashMap Text [(Text, Text)]))
-> IO (HashMap Text [(Text, Text)])
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left String
e ->
          AuthError -> IO (HashMap Text [(Text, Text)])
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO (HashMap Text [(Text, Text)]))
-> (String -> AuthError)
-> String
-> IO (HashMap Text [(Text, Text)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AuthError
InvalidFileError (Text -> AuthError) -> (String -> Text) -> String -> AuthError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> IO (HashMap Text [(Text, Text)]))
-> String -> IO (HashMap Text [(Text, Text)])
forall a b. (a -> b) -> a -> b
$ String
path String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e
        Right Ini
ini -> HashMap Text [(Text, Text)] -> IO (HashMap Text [(Text, Text)])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text [(Text, Text)] -> IO (HashMap Text [(Text, Text)]))
-> HashMap Text [(Text, Text)] -> IO (HashMap Text [(Text, Text)])
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 <- ReaderT
  (HashMap Text (HashMap Text Text))
  (StateT [Text] IO)
  (HashMap Text (HashMap Text Text))
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
      case Text
-> HashMap Text (HashMap Text Text) -> Maybe (HashMap Text Text)
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 ->
          IO Env
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall a.
IO a
-> ReaderT (HashMap Text (HashMap Text Text)) (StateT [Text] IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Env
 -> ReaderT
      (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env)
-> (Text -> IO Env)
-> Text
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthError -> IO Env
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO Env) -> (Text -> AuthError) -> Text -> IO Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AuthError
InvalidFileError (Text
 -> ReaderT
      (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env)
-> Text
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall a b. (a -> b) -> a -> b
$
            Text
"Missing profile: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Text -> String
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 ->
            IO Env
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall a.
IO a
-> ReaderT (HashMap Text (HashMap Text Text)) (StateT [Text] IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Env
 -> ReaderT
      (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env)
-> (Text -> IO Env)
-> Text
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthError -> IO Env
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO Env) -> (Text -> AuthError) -> Text -> IO Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AuthError
InvalidFileError (Text
 -> ReaderT
      (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env)
-> Text
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall a b. (a -> b) -> a -> b
$
              Text
"Parse error in profile: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Text -> String
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 ->
                Env
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall a.
a
-> ReaderT (HashMap Text (HashMap Text Text)) (StateT [Text] IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Env' withAuth
env {auth = Identity $ Auth keys}
              AssumeRoleFromProfile Text
roleArn Text
sourceProfileName -> do
                [Text]
seenProfiles <- StateT [Text] IO [Text]
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) [Text]
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HashMap Text (HashMap Text Text)) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT [Text] IO [Text]
forall (m :: * -> *) s. Monad m => StateT s m s
get
                if Text
sourceProfileName Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
seenProfiles
                  then
                    let trace :: [Text]
trace = [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
seenProfiles [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [[Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
seenProfiles]
                        textTrace :: Text
textTrace = Text -> [Text] -> Text
Text.intercalate Text
" -> " [Text]
trace
                     in IO Env
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall a.
IO a
-> ReaderT (HashMap Text (HashMap Text Text)) (StateT [Text] IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                          (IO Env
 -> ReaderT
      (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env)
-> (Text -> IO Env)
-> Text
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthError -> IO Env
forall e a. Exception e => e -> IO a
Exception.throwIO
                          (AuthError -> IO Env) -> (Text -> AuthError) -> Text -> IO Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AuthError
InvalidFileError
                          (Text
 -> ReaderT
      (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env)
-> Text
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall a b. (a -> b) -> a -> b
$ Text
"Infinite source_profile loop: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
textTrace
                  else do
                    StateT [Text] IO ()
-> ReaderT (HashMap Text (HashMap Text Text)) (StateT [Text] IO) ()
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HashMap Text (HashMap Text Text)) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT [Text] IO ()
 -> ReaderT
      (HashMap Text (HashMap Text Text)) (StateT [Text] IO) ())
-> (([Text] -> [Text]) -> StateT [Text] IO ())
-> ([Text] -> [Text])
-> ReaderT (HashMap Text (HashMap Text Text)) (StateT [Text] IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> [Text]) -> StateT [Text] IO ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (([Text] -> [Text])
 -> ReaderT
      (HashMap Text (HashMap Text Text)) (StateT [Text] IO) ())
-> ([Text] -> [Text])
-> ReaderT (HashMap Text (HashMap Text Text)) (StateT [Text] IO) ()
forall a b. (a -> b) -> a -> b
$ (Text
sourceProfileName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
                    Env
sourceEnv <- Text
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
evalConfig Text
sourceProfileName
                    Text
-> Text
-> Env
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
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 -> Env' withAuth
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Env' withAuth -> m Env
fromKeysEnv Env' withAuth
env
                  CredentialSource
Ec2InstanceMetadata -> Env' withAuth
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Env' withAuth -> m Env
fromDefaultInstanceProfile Env' withAuth
env
                  CredentialSource
EcsContainer -> Env' withAuth
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Env' withAuth -> m Env
fromContainerEnv Env' withAuth
env
                Text
-> Text
-> Env
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) 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 ->
                String
-> Text
-> Maybe Text
-> Env' withAuth
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
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 <-
                  IO String
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) String
forall a.
IO a
-> ReaderT (HashMap Text (HashMap Text Text)) (StateT [Text] IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String
 -> ReaderT
      (HashMap Text (HashMap Text Text)) (StateT [Text] IO) String)
-> IO String
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) String
forall a b. (a -> b) -> a -> b
$
                    String -> IO String
configPathRelative (String -> IO String) -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> IO String
forall (m :: * -> *). MonadIO m => Text -> m String
relativeCachedTokenFile Text
startUrl
                String
-> Region
-> Text
-> Text
-> Env' withAuth
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
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.
            Env
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall a.
a
-> ReaderT (HashMap Text (HashMap Text Text)) (StateT [Text] IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Env
 -> ReaderT
      (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env)
-> Env
-> ReaderT
     (HashMap Text (HashMap Text Text)) (StateT [Text] IO) Env
forall a b. (a -> b) -> a -> b
$ case Maybe Region
mRegion of
              Maybe Region
Nothing -> Env
env'
              Just Region
region -> Env
env' {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 =
  (HashMap Text Text -> HashMap Text Text -> HashMap Text Text)
-> HashMap Text (HashMap Text Text)
-> HashMap Text (HashMap Text Text)
-> HashMap Text (HashMap Text Text)
forall k v.
Eq k =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith
    HashMap Text Text -> HashMap Text Text -> HashMap Text Text
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
HashMap.union
    ([(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, Text)] -> HashMap Text Text)
-> HashMap Text [(Text, Text)] -> HashMap Text (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text [(Text, Text)]
creds)
    ([(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, Text)] -> HashMap Text Text)
-> HashMap Text [(Text, Text)] -> HashMap Text (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text [(Text, Text)] -> HashMap Text [(Text, Text)]
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 = (Text -> Text) -> HashMap Text v -> HashMap Text v
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
HashMap.mapKeys ((Text -> Text) -> HashMap Text v -> HashMap Text v)
-> (Text -> Text) -> HashMap Text v -> HashMap Text v
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
stripProfile ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
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 Maybe ConfigProfile
-> (ConfigProfile -> (ConfigProfile, Maybe Region))
-> Maybe (ConfigProfile, Maybe Region)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,Maybe Region
parseRegion)
  where
    parseProfile :: Maybe ConfigProfile
    parseProfile :: Maybe ConfigProfile
parseProfile =
      [Maybe ConfigProfile] -> Maybe ConfigProfile
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' (Text -> Region) -> Maybe Text -> Maybe Region
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Text -> Maybe Text
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 =
      (AuthEnv -> ConfigProfile) -> Maybe AuthEnv -> Maybe ConfigProfile
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AuthEnv -> ConfigProfile
ExplicitKeys (Maybe AuthEnv -> Maybe ConfigProfile)
-> Maybe AuthEnv -> Maybe ConfigProfile
forall a b. (a -> b) -> a -> b
$
        AccessKey
-> Sensitive SecretKey
-> Maybe (Sensitive SessionToken)
-> Maybe ISO8601
-> AuthEnv
AuthEnv
          (AccessKey
 -> Sensitive SecretKey
 -> Maybe (Sensitive SessionToken)
 -> Maybe ISO8601
 -> AuthEnv)
-> Maybe AccessKey
-> Maybe
     (Sensitive SecretKey
      -> Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ByteString -> AccessKey
AccessKey (ByteString -> AccessKey)
-> (Text -> ByteString) -> Text -> AccessKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8
                  (Text -> AccessKey) -> Maybe Text -> Maybe AccessKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"aws_access_key_id" HashMap Text Text
profile
              )
          Maybe
  (Sensitive SecretKey
   -> Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
-> Maybe (Sensitive SecretKey)
-> Maybe
     (Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( SecretKey -> Sensitive SecretKey
forall a. a -> Sensitive a
Sensitive (SecretKey -> Sensitive SecretKey)
-> (Text -> SecretKey) -> Text -> Sensitive SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SecretKey
SecretKey (ByteString -> SecretKey)
-> (Text -> ByteString) -> Text -> SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8
                  (Text -> Sensitive SecretKey)
-> Maybe Text -> Maybe (Sensitive SecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"aws_secret_access_key" HashMap Text Text
profile
              )
          Maybe (Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
-> Maybe (Maybe (Sensitive SessionToken))
-> Maybe (Maybe ISO8601 -> AuthEnv)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Sensitive SessionToken)
-> Maybe (Maybe (Sensitive SessionToken))
forall a. a -> Maybe a
Just
            ( SessionToken -> Sensitive SessionToken
forall a. a -> Sensitive a
Sensitive (SessionToken -> Sensitive SessionToken)
-> (Text -> SessionToken) -> Text -> Sensitive SessionToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SessionToken
SessionToken (ByteString -> SessionToken)
-> (Text -> ByteString) -> Text -> SessionToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8
                (Text -> Sensitive SessionToken)
-> Maybe Text -> Maybe (Sensitive SessionToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"aws_session_token" HashMap Text Text
profile
            )
          Maybe (Maybe ISO8601 -> AuthEnv)
-> Maybe (Maybe ISO8601) -> Maybe AuthEnv
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ISO8601 -> Maybe (Maybe ISO8601)
forall a. a -> Maybe a
Just Maybe ISO8601
forall a. Maybe a
Nothing -- No token expiry in config file
    assumeRoleFromProfile :: Maybe ConfigProfile
assumeRoleFromProfile =
      Text -> Text -> ConfigProfile
AssumeRoleFromProfile
        (Text -> Text -> ConfigProfile)
-> Maybe Text -> Maybe (Text -> ConfigProfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"role_arn" HashMap Text Text
profile
        Maybe (Text -> ConfigProfile) -> Maybe Text -> Maybe ConfigProfile
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> HashMap Text Text -> Maybe Text
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
        (Text -> CredentialSource -> ConfigProfile)
-> Maybe Text -> Maybe (CredentialSource -> ConfigProfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"role_arn" HashMap Text Text
profile
        Maybe (CredentialSource -> ConfigProfile)
-> Maybe CredentialSource -> Maybe ConfigProfile
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"credential_source" HashMap Text Text
profile Maybe Text
-> (Text -> Maybe CredentialSource) -> Maybe CredentialSource
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Text
"Environment" -> CredentialSource -> Maybe CredentialSource
forall a. a -> Maybe a
Just CredentialSource
Environment
                Text
"Ec2InstanceMetadata" -> CredentialSource -> Maybe CredentialSource
forall a. a -> Maybe a
Just CredentialSource
Ec2InstanceMetadata
                Text
"EcsContainer" -> CredentialSource -> Maybe CredentialSource
forall a. a -> Maybe a
Just CredentialSource
EcsContainer
                Text
_ -> Maybe CredentialSource
forall a. Maybe a
Nothing
            )

    assumeRoleWithWebIdentity :: Maybe ConfigProfile
assumeRoleWithWebIdentity =
      Text -> Maybe Text -> String -> ConfigProfile
AssumeRoleWithWebIdentity
        (Text -> Maybe Text -> String -> ConfigProfile)
-> Maybe Text -> Maybe (Maybe Text -> String -> ConfigProfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"role_arn" HashMap Text Text
profile
        Maybe (Maybe Text -> String -> ConfigProfile)
-> Maybe (Maybe Text) -> Maybe (String -> ConfigProfile)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just (Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"role_session_name" HashMap Text Text
profile)
        Maybe (String -> ConfigProfile)
-> Maybe String -> Maybe ConfigProfile
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> String
Text.unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Text -> Maybe Text
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
        (Text -> Region -> Text -> Text -> ConfigProfile)
-> Maybe Text -> Maybe (Region -> Text -> Text -> ConfigProfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"sso_start_url" HashMap Text Text
profile
        Maybe (Region -> Text -> Text -> ConfigProfile)
-> Maybe Region -> Maybe (Text -> Text -> ConfigProfile)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Region
Region' (Text -> Region) -> Maybe Text -> Maybe Region
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"sso_region" HashMap Text Text
profile)
        Maybe (Text -> Text -> ConfigProfile)
-> Maybe Text -> Maybe (Text -> ConfigProfile)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"sso_account_id" HashMap Text Text
profile
        Maybe (Text -> ConfigProfile) -> Maybe Text -> Maybe ConfigProfile
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> HashMap Text Text -> Maybe Text
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
(ConfigProfile -> ConfigProfile -> Bool)
-> (ConfigProfile -> ConfigProfile -> Bool) -> Eq ConfigProfile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigProfile -> ConfigProfile -> Bool
== :: ConfigProfile -> ConfigProfile -> Bool
$c/= :: ConfigProfile -> ConfigProfile -> Bool
/= :: ConfigProfile -> ConfigProfile -> Bool
Eq, Int -> ConfigProfile -> String -> String
[ConfigProfile] -> String -> String
ConfigProfile -> String
(Int -> ConfigProfile -> String -> String)
-> (ConfigProfile -> String)
-> ([ConfigProfile] -> String -> String)
-> Show ConfigProfile
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ConfigProfile -> String -> String
showsPrec :: Int -> ConfigProfile -> String -> String
$cshow :: ConfigProfile -> String
show :: ConfigProfile -> String
$cshowList :: [ConfigProfile] -> String -> String
showList :: [ConfigProfile] -> String -> String
Show, (forall x. ConfigProfile -> Rep ConfigProfile x)
-> (forall x. Rep ConfigProfile x -> ConfigProfile)
-> Generic ConfigProfile
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
$cfrom :: forall x. ConfigProfile -> Rep ConfigProfile x
from :: forall x. ConfigProfile -> Rep ConfigProfile x
$cto :: forall x. Rep ConfigProfile x -> ConfigProfile
to :: forall x. Rep ConfigProfile x -> ConfigProfile
Generic)

data CredentialSource = Environment | Ec2InstanceMetadata | EcsContainer
  deriving stock (CredentialSource -> CredentialSource -> Bool
(CredentialSource -> CredentialSource -> Bool)
-> (CredentialSource -> CredentialSource -> Bool)
-> Eq CredentialSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CredentialSource -> CredentialSource -> Bool
== :: CredentialSource -> CredentialSource -> Bool
$c/= :: CredentialSource -> CredentialSource -> Bool
/= :: CredentialSource -> CredentialSource -> Bool
Eq, Int -> CredentialSource -> String -> String
[CredentialSource] -> String -> String
CredentialSource -> String
(Int -> CredentialSource -> String -> String)
-> (CredentialSource -> String)
-> ([CredentialSource] -> String -> String)
-> Show CredentialSource
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CredentialSource -> String -> String
showsPrec :: Int -> CredentialSource -> String -> String
$cshow :: CredentialSource -> String
show :: CredentialSource -> String
$cshowList :: [CredentialSource] -> String -> String
showList :: [CredentialSource] -> String -> String
Show, (forall x. CredentialSource -> Rep CredentialSource x)
-> (forall x. Rep CredentialSource x -> CredentialSource)
-> Generic CredentialSource
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
$cfrom :: forall x. CredentialSource -> Rep CredentialSource x
from :: forall x. CredentialSource -> Rep CredentialSource x
$cto :: forall x. Rep CredentialSource x -> CredentialSource
to :: forall x. Rep CredentialSource x -> CredentialSource
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 = IO Env -> m Env
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Env -> m Env) -> IO Env -> m Env
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"

  Text -> String -> String -> Env' withAuth -> IO Env
forall (m :: * -> *) (withAuth :: * -> *).
(MonadIO m, Foldable withAuth) =>
Text -> String -> String -> Env' withAuth -> m Env
fromFilePath (Text -> (String -> Text) -> Maybe String -> Text
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 = Getting (First IOException) SomeException IOException
-> IO String -> IO String -> IO String
forall (m :: * -> *) a r.
MonadCatch m =>
Getting (First a) SomeException a -> m r -> m r -> m r
handling_ Getting (First IOException) SomeException IOException
forall t. AsIOException t => Prism' t IOException
Prism' SomeException IOException
_IOException IO String
err IO String
dir
  where
    err :: IO String
err = AuthError -> IO String
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO String) -> AuthError -> IO String
forall a b. (a -> b) -> a -> b
$ String -> AuthError
MissingFileError (String
"$HOME" String -> String -> String
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"
          IO (Maybe String) -> (Maybe String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AuthError -> IO String
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO String) -> AuthError -> IO String
forall a b. (a -> b) -> a -> b
$ String -> AuthError
MissingFileError String
"%USERPROFILE%") String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      String
_ -> IO String
Directory.getHomeDirectory IO String -> (String -> String) -> IO String
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p)