module Stackctl.AWS.STS
  ( awsGetCallerIdentityAccount
  ) where

import Stackctl.Prelude

import Amazonka.STS.GetCallerIdentity
import Stackctl.AWS.Core

awsGetCallerIdentityAccount
  :: (MonadResource m, MonadReader env m, HasAwsEnv env) => m AccountId
awsGetCallerIdentityAccount :: forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
m AccountId
awsGetCallerIdentityAccount = do
  forall (m :: * -> *) env a b.
(MonadResource m, MonadReader env m, HasAwsEnv env, AWSRequest a,
 Typeable a, Typeable (AWSResponse a)) =>
Text -> a -> (AWSResponse a -> Maybe b) -> m b
awsSimple Text
"GetCallerIdentity" GetCallerIdentity
newGetCallerIdentity forall a b. (a -> b) -> a -> b
$ \AWSResponse GetCallerIdentity
resp -> do
    Text -> AccountId
AccountId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AWSResponse GetCallerIdentity
resp forall s a. s -> Getting a s a -> a
^. Lens' GetCallerIdentityResponse (Maybe Text)
getCallerIdentityResponse_account