module Amazonka.Auth.STS where
import Amazonka.Auth.Background (fetchAuthInBackground)
import Amazonka.Auth.Exception
import Amazonka.Core.Lens.Internal (throwingM, (^.))
import Amazonka.Env (Env, Env' (..))
import Amazonka.Prelude
import qualified Amazonka.STS as STS
import qualified Amazonka.STS.AssumeRole as STS
import qualified Amazonka.STS.AssumeRoleWithWebIdentity as STS
import Amazonka.Send (send, sendUnsigned)
import Control.Monad.Trans.Resource (runResourceT)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as UUID
import qualified System.Environment as Environment
fromAssumedRole ::
MonadIO m =>
Text ->
Text ->
Env ->
m Env
fromAssumedRole :: forall (m :: * -> *). MonadIO m => Text -> Text -> Env -> m Env
fromAssumedRole Text
roleArn Text
roleSessionName Env
env = do
let getCredentials :: IO AuthEnv
getCredentials = do
let assumeRole :: AssumeRole
assumeRole = Text -> Text -> AssumeRole
STS.newAssumeRole Text
roleArn Text
roleSessionName
AssumeRoleResponse
resp <- ResourceT IO AssumeRoleResponse -> IO AssumeRoleResponse
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO AssumeRoleResponse -> IO AssumeRoleResponse)
-> ResourceT IO AssumeRoleResponse -> IO AssumeRoleResponse
forall a b. (a -> b) -> a -> b
$ Env -> AssumeRole -> ResourceT IO (AWSResponse AssumeRole)
forall (m :: * -> *) a.
(MonadResource m, AWSRequest a, Typeable a,
Typeable (AWSResponse a)) =>
Env -> a -> m (AWSResponse a)
send Env
env AssumeRole
assumeRole
AuthEnv -> IO AuthEnv
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthEnv -> IO AuthEnv) -> AuthEnv -> IO AuthEnv
forall a b. (a -> b) -> a -> b
$ AssumeRoleResponse
resp AssumeRoleResponse
-> Getting AuthEnv AssumeRoleResponse AuthEnv -> AuthEnv
forall s a. s -> Getting a s a -> a
^. Getting AuthEnv AssumeRoleResponse AuthEnv
Lens' AssumeRoleResponse AuthEnv
STS.assumeRoleResponse_credentials
Auth
keys <- IO Auth -> m Auth
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Auth -> m Auth) -> IO Auth -> m Auth
forall a b. (a -> b) -> a -> b
$ IO AuthEnv -> IO Auth
fetchAuthInBackground IO AuthEnv
getCredentials
Env -> m Env
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Env
env {auth = Identity keys}
fromWebIdentity ::
MonadIO m =>
FilePath ->
Text ->
Maybe Text ->
Env' withAuth ->
m Env
fromWebIdentity :: forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
FilePath -> Text -> Maybe Text -> Env' withAuth -> m Env
fromWebIdentity FilePath
tokenFile Text
roleArn Maybe Text
mSessionName Env' withAuth
env = do
Text
sessionName <-
IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ IO Text -> (Text -> IO Text) -> Maybe Text -> IO Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UUID -> Text
UUID.toText (UUID -> Text) -> IO UUID -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID
UUID.nextRandom) Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
mSessionName
let getCredentials :: IO AuthEnv
getCredentials = do
Text
token <- FilePath -> IO Text
Text.readFile FilePath
tokenFile
let assumeRoleWithWebIdentity :: AssumeRoleWithWebIdentity
assumeRoleWithWebIdentity =
Text -> Text -> Text -> AssumeRoleWithWebIdentity
STS.newAssumeRoleWithWebIdentity
Text
roleArn
Text
sessionName
Text
token
AssumeRoleWithWebIdentityResponse
resp <- ResourceT IO AssumeRoleWithWebIdentityResponse
-> IO AssumeRoleWithWebIdentityResponse
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO AssumeRoleWithWebIdentityResponse
-> IO AssumeRoleWithWebIdentityResponse)
-> ResourceT IO AssumeRoleWithWebIdentityResponse
-> IO AssumeRoleWithWebIdentityResponse
forall a b. (a -> b) -> a -> b
$ Env' withAuth
-> AssumeRoleWithWebIdentity
-> ResourceT IO (AWSResponse AssumeRoleWithWebIdentity)
forall (m :: * -> *) a (withAuth :: * -> *).
(MonadResource m, AWSRequest a, Typeable a,
Typeable (AWSResponse a)) =>
Env' withAuth -> a -> m (AWSResponse a)
sendUnsigned Env' withAuth
env AssumeRoleWithWebIdentity
assumeRoleWithWebIdentity
AuthEnv -> IO AuthEnv
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthEnv -> IO AuthEnv) -> AuthEnv -> IO AuthEnv
forall a b. (a -> b) -> a -> b
$ AssumeRoleWithWebIdentityResponse
resp AssumeRoleWithWebIdentityResponse
-> Getting AuthEnv AssumeRoleWithWebIdentityResponse AuthEnv
-> AuthEnv
forall s a. s -> Getting a s a -> a
^. Getting AuthEnv AssumeRoleWithWebIdentityResponse AuthEnv
Lens' AssumeRoleWithWebIdentityResponse AuthEnv
STS.assumeRoleWithWebIdentityResponse_credentials
Auth
keys <- IO Auth -> m Auth
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Auth -> m Auth) -> IO Auth -> m Auth
forall a b. (a -> b) -> a -> b
$ IO AuthEnv -> IO Auth
fetchAuthInBackground IO AuthEnv
getCredentials
Env -> m Env
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Env' withAuth
env {auth = Identity keys}
fromWebIdentityEnv ::
MonadIO m =>
Env' withAuth ->
m Env
fromWebIdentityEnv :: forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
Env' withAuth -> m Env
fromWebIdentityEnv 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
FilePath
tokenFile <- IO FilePath
lookupTokenFile
Text
roleArn <- IO Text
lookupRoleArn
Maybe Text
mSessionName <- IO (Maybe Text)
lookupSessionName
FilePath -> Text -> Maybe Text -> Env' withAuth -> IO Env
forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
FilePath -> Text -> Maybe Text -> Env' withAuth -> m Env
fromWebIdentity FilePath
tokenFile Text
roleArn Maybe Text
mSessionName Env' withAuth
env
where
lookupTokenFile :: IO FilePath
lookupTokenFile =
FilePath -> IO (Maybe FilePath)
nonEmptyEnv FilePath
"AWS_WEB_IDENTITY_TOKEN_FILE" IO (Maybe FilePath)
-> (Maybe FilePath -> IO FilePath) -> IO FilePath
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just FilePath
v -> FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
v
Maybe FilePath
Nothing ->
AReview SomeException Text -> Text -> IO FilePath
forall (m :: * -> *) b r.
MonadThrow m =>
AReview SomeException b -> b -> m r
throwingM
AReview SomeException Text
forall a. AsAuthError a => Prism' a Text
Prism' SomeException Text
_MissingEnvError
Text
"Unable to read token file name from AWS_WEB_IDENTITY_TOKEN_FILE"
lookupRoleArn :: IO Text
lookupRoleArn =
FilePath -> IO (Maybe FilePath)
nonEmptyEnv FilePath
"AWS_ROLE_ARN" IO (Maybe FilePath) -> (Maybe FilePath -> IO Text) -> IO 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
Just FilePath
v -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack FilePath
v
Maybe FilePath
Nothing ->
AReview SomeException Text -> Text -> IO Text
forall (m :: * -> *) b r.
MonadThrow m =>
AReview SomeException b -> b -> m r
throwingM
AReview SomeException Text
forall a. AsAuthError a => Prism' a Text
Prism' SomeException Text
_MissingEnvError
Text
"Unable to read role ARN from AWS_ROLE_ARN"
lookupSessionName :: IO (Maybe Text)
lookupSessionName = (FilePath -> Text) -> Maybe FilePath -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
Text.pack (Maybe FilePath -> Maybe Text)
-> IO (Maybe FilePath) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
nonEmptyEnv FilePath
"AWS_ROLE_SESSION_NAME"
nonEmptyEnv :: String -> IO (Maybe String)
nonEmptyEnv :: FilePath -> IO (Maybe FilePath)
nonEmptyEnv FilePath
var =
FilePath -> IO (Maybe FilePath)
Environment.lookupEnv FilePath
var IO (Maybe FilePath)
-> (Maybe FilePath -> Maybe FilePath) -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Maybe FilePath
Nothing -> Maybe FilePath
forall a. Maybe a
Nothing
Just FilePath
"" -> Maybe FilePath
forall a. Maybe a
Nothing
Just FilePath
v -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
v