-- |
-- Module      : Amazonka.Auth
-- 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)
--
-- Fetch credentials from a metadata service when running in an ECS
-- Container.
module Amazonka.Auth.Container where

import Amazonka.Auth.Background (fetchAuthInBackground)
import Amazonka.Auth.Exception
import Amazonka.Data
import Amazonka.Env (Env, Env' (..))
import Amazonka.Prelude
import Amazonka.Types
import qualified Control.Exception as Exception
import qualified Data.Text as Text
import qualified Network.HTTP.Client as Client
import qualified System.Environment as Environment

-- | Obtain credentials exposed to a task via the ECS container agent, as
-- described in the <http://docs.aws.amazon.com/AmazonECS/latest/developerguide/task-iam-roles.html IAM Roles for Tasks>
-- section of the AWS ECS documentation. The credentials are obtained by making
-- a request to the given URL.
--
-- The ECS container agent provides an access key, secret key, session token,
-- and expiration time. As these are temporary credentials, this function also
-- starts a refresh thread that will periodically fetch fresh credentials before
-- the current ones expire.
fromContainer ::
  MonadIO m =>
  -- | Absolute URL
  Text ->
  Env' withAuth ->
  m Env
fromContainer :: forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Text -> Env' withAuth -> m Env
fromContainer Text
url Env' withAuth
env =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Request
req <- forall (m :: * -> *). MonadThrow m => String -> m Request
Client.parseUrlThrow forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
url
    Auth
keys <- IO AuthEnv -> IO Auth
fetchAuthInBackground (Request -> IO AuthEnv
renew Request
req)

    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}
  where
    renew :: ClientRequest -> IO AuthEnv
    renew :: Request -> IO AuthEnv
renew Request
req = do
      Response ByteString
rs <- Request -> Manager -> IO (Response ByteString)
Client.httpLbs Request
req forall a b. (a -> b) -> a -> b
$ forall (withAuth :: * -> *). Env' withAuth -> Manager
manager Env' withAuth
env

      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
. String -> AuthError
invalidIdentityErr)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (forall a. FromJSON a => ByteString -> Either String a
eitherDecode (forall body. Response body -> body
Client.responseBody Response ByteString
rs))

    invalidIdentityErr :: String -> AuthError
invalidIdentityErr =
      Text -> AuthError
InvalidIAMError
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend Text
"Error parsing Task Identity Document "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

-- | Obtain credentials from the ECS container agent, by querying
-- <http://169.254.170.2> at the path contained by the
-- @AWS_CONTAINER_CREDENTIALS_RELATIVE_URI@ environment variable.
--
-- Throws 'MissingEnvError' if the @AWS_CONTAINER_CREDENTIALS_RELATIVE_URI@
-- environment variable is not set or 'InvalidIAMError' if the payload returned
-- by the ECS container agent is not of the expected format.
--
-- __NOTE:__ We do not currently respect the
-- @AWS_CONTAINER_CREDENTIALS_FULL_URI@ or @AWS_CONTAINTER_AUTHORIZATION_TOKEN@
-- environment variable. If you need support for these, please file a PR.
fromContainerEnv ::
  MonadIO m =>
  Env' withAuth ->
  m Env
fromContainerEnv :: forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Env' withAuth -> m Env
fromContainerEnv Env' withAuth
env = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  String
uriRel <-
    String -> IO (Maybe String)
Environment.lookupEnv String
"AWS_CONTAINER_CREDENTIALS_RELATIVE_URI"
      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
$ Text -> AuthError
MissingEnvError Text
"Unable to read AWS_CONTAINER_CREDENTIALS_RELATIVE_URI")
        forall (f :: * -> *) a. Applicative f => a -> f a
pure
  forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Text -> Env' withAuth -> m Env
fromContainer (String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
"http://169.254.170.2" forall a. Semigroup a => a -> a -> a
<> String
uriRel) Env' withAuth
env