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
fromContainer ::
MonadIO m =>
Text ->
Env' withAuth ->
m Env
fromContainer :: forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Text -> Env' withAuth -> m Env
fromContainer Text
url 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
Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
Client.parseUrlThrow (String -> IO Request) -> String -> IO Request
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)
Env -> IO Env
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Env' withAuth
env {auth = Identity 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 (Manager -> IO (Response ByteString))
-> Manager -> IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Env' withAuth -> Manager
forall (withAuth :: * -> *). Env' withAuth -> Manager
manager Env' withAuth
env
(String -> IO AuthEnv)
-> (AuthEnv -> IO AuthEnv) -> Either String AuthEnv -> IO AuthEnv
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(AuthError -> IO AuthEnv
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO AuthEnv)
-> (String -> AuthError) -> String -> IO AuthEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AuthError
invalidIdentityErr)
AuthEnv -> IO AuthEnv
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(ByteString -> Either String AuthEnv
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (Response ByteString -> ByteString
forall body. Response body -> body
Client.responseBody Response ByteString
rs))
invalidIdentityErr :: String -> AuthError
invalidIdentityErr =
Text -> AuthError
InvalidIAMError
(Text -> AuthError) -> (String -> Text) -> String -> AuthError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"Error parsing Task Identity Document "
(Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
fromContainerEnv ::
MonadIO m =>
Env' withAuth ->
m Env
fromContainerEnv :: forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Env' withAuth -> m Env
fromContainerEnv 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
String
uriRel <-
String -> IO (Maybe String)
Environment.lookupEnv String
"AWS_CONTAINER_CREDENTIALS_RELATIVE_URI"
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
$ Text -> AuthError
MissingEnvError Text
"Unable to read AWS_CONTAINER_CREDENTIALS_RELATIVE_URI")
String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Text -> Env' withAuth -> IO Env
forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Text -> Env' withAuth -> m Env
fromContainer (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"http://169.254.170.2" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
uriRel) Env' withAuth
env