@@ -48,6 +48,7 @@ import qualified Network.AWS.Env as AWS (Env (..), retryConnectionF
48
48
import qualified Network.AWS.Data as AWS (fromText )
49
49
import qualified Network.AWS.Data.Sensitive as AWS (Sensitive (.. ))
50
50
import qualified Network.AWS.S3 as S3
51
+ import qualified Network.AWS.STS.AssumeRole as STS (assumeRole , arrsCredentials )
51
52
import qualified Network.AWS.Utils as AWS
52
53
import qualified Network.HTTP.Conduit as Conduit
53
54
@@ -73,6 +74,18 @@ s3EndpointOverride (URL (Absolute h) _ _) =
73
74
S3. s3
74
75
s3EndpointOverride _ = S3. s3
75
76
77
+ -- | Tries to get authentication details and region to perform
78
+ -- | requests to AWS.
79
+ -- | The `AWS_PROFILE` is read from the environment
80
+ -- | or falls back to `default`.
81
+ -- | The `AWS_REGION` is first read from the environment, if not found
82
+ -- | it is read from `~/.aws/config` based on the profile discovered in the previous step.
83
+ -- | The `AWS_ACCESS_KEY_ID` & `AWS_SECRET_ACCESS_KEY` are first
84
+ -- | read from the environment. If not found, then the `~/.aws/crendetilas`
85
+ -- | file is read. If `source_profile` key is present the reading of the
86
+ -- | authentication details happens from this profile rather then the `AWS_PROFILE`.
87
+ -- | Finally, if `role_arn` is specified, the crendials gathered up to now are used
88
+ -- | to obtain new credentials with STS esclated to `role_arn`.
76
89
getAWSEnv :: (MonadIO m , MonadCatch m ) => ExceptT String m AWS. Env
77
90
getAWSEnv = do
78
91
region <- discoverRegion
@@ -106,19 +119,33 @@ getAWSEnv = do
106
119
manager <- liftIO (Conduit. newManager Conduit. tlsManagerSettings)
107
120
ref <- liftIO (newIORef Nothing )
108
121
let roleARN = eitherToMaybe $ AWS. roleARNOf profile =<< credentials
122
+ let curerntEnv = AWS. Env region
123
+ (\ _ _ -> pure () )
124
+ (AWS. retryConnectionFailure 3 )
125
+ mempty
126
+ manager
127
+ ref
128
+ auth
109
129
case roleARN of
110
- Just role -> do
111
- undefined -- Make request to STS
130
+ Just role -> newEnvFromRole role curerntEnv
131
+ Nothing -> return
132
+ $ AWS. configure (maybe S3. s3 s3EndpointOverride endpointURL) curerntEnv
133
+
134
+ newEnvFromRole :: MonadIO m => T. Text -> AWS. Env -> ExceptT String m AWS. Env
135
+ newEnvFromRole roleARN currentEnv = do
136
+ assumeRoleResult <-
137
+ liftIO
138
+ $ AWS. runResourceT
139
+ . AWS. runAWS currentEnv
140
+ $ AWS. send
141
+ $ STS. assumeRole roleARN " rome-cache-operation"
142
+ let maybeAuth = AWS. Auth <$> assumeRoleResult ^. STS. arrsCredentials
143
+ case maybeAuth of
112
144
Nothing ->
113
- let env = AWS. Env region
114
- (\ _ _ -> pure () )
115
- (AWS. retryConnectionFailure 3 )
116
- mempty
117
- manager
118
- ref
119
- auth
120
- in return
121
- $ AWS. configure (maybe S3. s3 s3EndpointOverride endpointURL) env
145
+ throwError
146
+ $ " Could not create AWS Auth from STS response: "
147
+ ++ show assumeRoleResult
148
+ Just newAuth -> return $ currentEnv & AWS. envAuth .~ newAuth
122
149
123
150
getAWSRegion :: (MonadIO m , MonadCatch m ) => ExceptT String m AWS. Env
124
151
getAWSRegion = do
0 commit comments