-- |
-- 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 =
  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
    Either HttpException ByteString
ls <-
      IO ByteString -> IO (Either HttpException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (IO ByteString -> IO (Either HttpException ByteString))
-> IO ByteString -> IO (Either HttpException ByteString)
forall a b. (a -> b) -> a -> b
$ Manager -> Metadata -> IO ByteString
forall (m :: * -> *).
MonadIO m =>
Manager -> Metadata -> m ByteString
metadata (Env' withAuth -> Manager
forall (withAuth :: * -> *). Env' withAuth -> Manager
manager Env' withAuth
env) (IAM -> Metadata
IAM (Maybe Text -> IAM
SecurityCredentials Maybe Text
forall a. Maybe a
Nothing))

    case ByteString -> [ByteString]
BS8.lines (ByteString -> [ByteString])
-> Either HttpException ByteString
-> Either HttpException [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either HttpException ByteString
ls of
      Right (ByteString
x : [ByteString]
_) -> Text -> Env' withAuth -> IO Env
forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Text -> Env' withAuth -> m Env
fromNamedInstanceProfile (ByteString -> Text
Text.decodeUtf8 ByteString
x) Env' withAuth
env
      Left HttpException
e -> AuthError -> IO Env
forall e a. Exception e => e -> IO a
Exception.throwIO (HttpException -> AuthError
RetrievalError HttpException
e)
      Either HttpException [ByteString]
_ ->
        AuthError -> IO Env
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO Env) -> AuthError -> IO Env
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
$sel:manager:Env :: forall (withAuth :: * -> *). Env' withAuth -> Manager
manager :: Manager
manager} =
  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
    Auth
keys <- IO AuthEnv -> IO Auth
fetchAuthInBackground IO AuthEnv
getCredentials
    Region
region <- IO Region
getRegionFromIdentity

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

    getRegionFromIdentity :: IO Region
getRegionFromIdentity =
      IO (Either String IdentityDocument)
-> IO (Either HttpException (Either String IdentityDocument))
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (Manager -> IO (Either String IdentityDocument)
forall (m :: * -> *).
MonadIO m =>
Manager -> m (Either String IdentityDocument)
identity Manager
manager)
        IO (Either HttpException (Either String IdentityDocument))
-> (Either HttpException (Either String IdentityDocument)
    -> IO Region)
-> IO Region
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either String IdentityDocument -> Either String Region)
-> (String -> AuthError)
-> Either HttpException (Either String IdentityDocument)
-> IO Region
forall {b} {t} {a} {a}.
Exception b =>
(t -> Either a a) -> (a -> b) -> Either HttpException t -> IO a
handleErr ((IdentityDocument -> Region)
-> Either String IdentityDocument -> Either String Region
forall a b. (a -> b) -> Either String a -> Either String b
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 -> AuthError -> IO a
forall e a. Exception e => e -> IO a
Exception.throwIO (HttpException -> AuthError
RetrievalError HttpException
e)
      Right t
x -> (a -> IO a) -> (a -> IO a) -> Either a a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (b -> IO a
forall e a. Exception e => e -> IO a
Exception.throwIO (b -> IO a) -> (a -> b) -> a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
g) a -> IO a
forall a. a -> IO a
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 (Text -> AuthError) -> Text -> AuthError
forall a b. (a -> b) -> a -> b
$
        [Text] -> Text
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 (Text -> AuthError) -> Text -> AuthError
forall a b. (a -> b) -> a -> b
$
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"Error parsing Instance Identity Document ", String -> Text
Text.pack String
e]