-- |
-- Module      : Amazonka.Auth.InstanceProfile
-- 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 EC2 instance profiles.
module Amazonka.Auth.InstanceProfile where

import Amazonka.Auth.Background
import Amazonka.Auth.Exception
import Amazonka.Data
import Amazonka.EC2.Metadata hiding (region)
import qualified Amazonka.EC2.Metadata as IdentityDocument (IdentityDocument (..))
import Amazonka.Env (Env, Env' (..))
import Amazonka.Prelude
import qualified Control.Exception as Exception
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy.Char8 as LBS8
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

-- | Retrieve the default IAM Profile from the local EC2 instance-data.
--
-- The default IAM profile is determined by Amazon as the first profile found
-- in the response from:
-- @http://169.254.169.254/latest/meta-data/iam/security-credentials/@
--
-- Throws 'RetrievalError' if the HTTP call fails, or 'InvalidIAMError' if
-- the default IAM profile cannot be read.
fromDefaultInstanceProfile ::
  MonadIO m =>
  Env' withAuth ->
  m Env
fromDefaultInstanceProfile :: forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Env' withAuth -> m Env
fromDefaultInstanceProfile Env' withAuth
env =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Either HttpException ByteString
ls <-
      forall e a. Exception e => IO a -> IO (Either e a)
Exception.try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
Manager -> Metadata -> m ByteString
metadata (forall (withAuth :: * -> *). Env' withAuth -> Manager
manager Env' withAuth
env) (IAM -> Metadata
IAM (Maybe Text -> IAM
SecurityCredentials forall a. Maybe a
Nothing))

    case ByteString -> [ByteString]
BS8.lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either HttpException ByteString
ls of
      Right (ByteString
x : [ByteString]
_) -> forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Text -> Env' withAuth -> m Env
fromNamedInstanceProfile (ByteString -> Text
Text.decodeUtf8 ByteString
x) Env' withAuth
env
      Left HttpException
e -> forall e a. Exception e => e -> IO a
Exception.throwIO (HttpException -> AuthError
RetrievalError HttpException
e)
      Either HttpException [ByteString]
_ ->
        forall e a. Exception e => e -> IO a
Exception.throwIO forall a b. (a -> b) -> a -> b
$
          Text -> AuthError
InvalidIAMError Text
"Unable to get default IAM Profile from EC2 metadata"

-- | Lookup a specific IAM Profile by name from the local EC2 instance-data.
--
-- Additionally starts a refresh thread for the given authentication environment.
--
-- The resulting 'IORef' wrapper + timer is designed so that multiple concurrent
-- accesses of 'AuthEnv' from the 'AWS' environment are not required to calculate
-- expiry and sequentially queue to update it.
--
-- The forked timer ensures a singular owner and pre-emptive refresh of the
-- temporary session credentials before expiration.
--
-- A weak reference is used to ensure that the forked thread will eventually
-- terminate when 'Auth' is no longer referenced.
--
-- If no session token or expiration time is present the credentials will
-- be returned verbatim.
fromNamedInstanceProfile ::
  MonadIO m =>
  Text ->
  Env' withAuth ->
  m Env
fromNamedInstanceProfile :: forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Text -> Env' withAuth -> m Env
fromNamedInstanceProfile Text
name env :: Env' withAuth
env@Env {Manager
manager :: Manager
$sel:manager:Env :: forall (withAuth :: * -> *). Env' withAuth -> Manager
manager} =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Auth
keys <- IO AuthEnv -> IO Auth
fetchAuthInBackground IO AuthEnv
getCredentials
    Region
region <- IO Region
getRegionFromIdentity

    forall (f :: * -> *) a. Applicative f => a -> f a
pure Env' withAuth
env {$sel:auth:Env :: Identity Auth
auth = forall a. a -> Identity a
Identity Auth
keys, Region
$sel:region:Env :: Region
region :: Region
region}
  where
    getCredentials :: IO AuthEnv
getCredentials =
      forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (forall (m :: * -> *).
MonadIO m =>
Manager -> Metadata -> m ByteString
metadata Manager
manager (IAM -> Metadata
IAM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> IAM
SecurityCredentials forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
name))
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {b} {t} {a} {a}.
Exception b =>
(t -> Either a a) -> (a -> b) -> Either HttpException t -> IO a
handleErr (forall a. FromJSON a => ByteString -> Either String a
eitherDecode' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS8.fromStrict) String -> AuthError
invalidIAMErr

    getRegionFromIdentity :: IO Region
getRegionFromIdentity =
      forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (forall (m :: * -> *).
MonadIO m =>
Manager -> m (Either String IdentityDocument)
identity Manager
manager)
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {b} {t} {a} {a}.
Exception b =>
(t -> Either a a) -> (a -> b) -> Either HttpException t -> IO a
handleErr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IdentityDocument -> Region
IdentityDocument.region) String -> AuthError
invalidIdentityErr

    handleErr :: (t -> Either a a) -> (a -> b) -> Either HttpException t -> IO a
handleErr t -> Either a a
f a -> b
g = \case
      Left HttpException
e -> forall e a. Exception e => e -> IO a
Exception.throwIO (HttpException -> AuthError
RetrievalError HttpException
e)
      Right t
x -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e a. Exception e => e -> IO a
Exception.throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
g) forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Either a a
f t
x)

    invalidIAMErr :: String -> AuthError
invalidIAMErr String
e =
      Text -> AuthError
InvalidIAMError forall a b. (a -> b) -> a -> b
$
        forall a. Monoid a => [a] -> a
mconcat [Text
"Error parsing IAM profile '", Text
name, Text
"' ", String -> Text
Text.pack String
e]

    invalidIdentityErr :: String -> AuthError
invalidIdentityErr String
e =
      Text -> AuthError
InvalidIAMError forall a b. (a -> b) -> a -> b
$
        forall a. Monoid a => [a] -> a
mconcat [Text
"Error parsing Instance Identity Document ", String -> Text
Text.pack String
e]