1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
|
{-# LANGUAGE OverloadedLists, OverloadedStrings, DeriveGeneric #-}
module AWS.IAM (tests) where
import AWS.Aeson
import Control.Concurrent (threadDelay)
import Control.Lens hiding ((.=))
import Data.Aeson (encode)
import Data.Aeson.Lens (key, _String, values, _Value)
import Data.Char (toUpper)
import Data.IORef (IORef, readIORef, writeIORef)
import Data.Text as T (Text, pack, unpack, split)
import Data.Text.Encoding (encodeUtf8)
import Data.Text.Lazy as LT (toStrict)
import Data.Text.Lazy.Encoding as E (decodeUtf8)
import GHC.Generics
import Network.Wreq
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (assertBool)
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as DAT
tests :: String -> String -> Options -> IORef String -> Test
tests prefix region baseopts iamTestState = testGroup "iam" [
testCase "listUsers" $ listUsers prefix region baseopts
, testCase "createRole" $ createRole prefix region baseopts iamTestState
, testCase "listRoles" $ listRoles prefix region baseopts
, testCase "putRolePolicy" $ putRolePolicy prefix region baseopts
, testCase "stsAssumeRole" $ stsAssumeRole prefix region baseopts iamTestState
, testCase "deleteRolePolicy" $ deleteRolePolicy prefix region baseopts
, testCase "deleteRole" $ deleteRole prefix region baseopts
]
listUsers :: String -> String -> Options -> IO ()
listUsers _prefix region baseopts = do
let opts = baseopts
& param "Action" .~ ["ListUsers"]
& param "Version" .~ ["2010-05-08"]
& header "Accept" .~ ["application/json"]
r <- getWith opts (iamUrl region)
assertBool "listUsers 200" $ r ^. responseStatus . statusCode == 200
assertBool "listUsers OK" $ r ^. responseStatus . statusMessage == "OK"
createRole :: String -> String -> Options -> IORef String -> IO ()
createRole prefix region baseopts iamTestState = do
let opts = baseopts
& param "Action" .~ ["CreateRole"]
& param "Version" .~ ["2010-05-08"]
& param "RoleName" .~ [T.pack $ prefix ++ roleName]
& param "AssumeRolePolicyDocument" .~ [rolePolicyDoc]
& header "Accept" .~ ["application/json"]
r <- getWith opts (iamUrl region)
assertBool "createRole 200" $ r ^. responseStatus . statusCode == 200
assertBool "createRole OK" $ r ^. responseStatus . statusMessage == "OK"
let [arn] = r ^.. responseBody . key "CreateRoleResponse"
. key "CreateRoleResult"
. key "Role"
. key "Arn" . _String
writeIORef iamTestState $ T.unpack arn
putRolePolicy :: String -> String -> Options -> IO ()
putRolePolicy prefix region baseopts = do
let opts = baseopts
& param "Action" .~ ["PutRolePolicy"]
& param "Version" .~ ["2010-05-08"]
& param "RoleName" .~ [T.pack $ prefix ++ roleName]
& param "PolicyName" .~ [testPolicyName]
& param "PolicyDocument" .~ [policyDoc]
& header "Accept" .~ ["application/json"]
r <- getWith opts (iamUrl region)
assertBool "putRolePolicy 200" $ r ^. responseStatus . statusCode == 200
assertBool "putRolePolicy OK" $ r ^. responseStatus . statusMessage == "OK"
threadDelay $ 30*1000*1000 -- 30 sleep, allow change to propagate to region
deleteRolePolicy :: String -> String -> Options -> IO ()
deleteRolePolicy prefix region baseopts = do
let opts = baseopts
& param "Action" .~ ["DeleteRolePolicy"]
& param "Version" .~ ["2010-05-08"]
& param "RoleName" .~ [T.pack $ prefix ++ roleName]
& param "PolicyName" .~ [testPolicyName]
& param "PolicyDocument" .~ [policyDoc]
& header "Accept" .~ ["application/json"]
r <- getWith opts (iamUrl region)
assertBool "deleteRolePolicy 200" $ r ^. responseStatus . statusCode == 200
assertBool "deleteRolePolicy OK" $ r ^. responseStatus . statusMessage == "OK"
deleteRole :: String -> String -> Options -> IO ()
deleteRole prefix region baseopts = do
let opts = baseopts
& param "Action" .~ ["DeleteRole"]
& param "Version" .~ ["2010-05-08"]
& param "RoleName" .~ [T.pack $ prefix ++ roleName]
& header "Accept" .~ ["application/json"]
r <- getWith opts (iamUrl region)
assertBool "deleteRole 200" $ r ^. responseStatus . statusCode == 200
assertBool "deleteRole OK" $ r ^. responseStatus . statusMessage == "OK"
listRoles :: String -> String -> Options -> IO ()
listRoles prefix region baseopts = do
let opts = baseopts
& param "Action" .~ ["ListRoles"]
& param "Version" .~ ["2010-05-08"]
& header "Accept" .~ ["application/json"]
r <- getWith opts (iamUrl region)
assertBool "listRoles 200" $ r ^. responseStatus . statusCode == 200
assertBool "listRoles OK" $ r ^. responseStatus . statusMessage == "OK"
let arns = r ^.. responseBody . key "ListRolesResponse" .
key "ListRolesResult" .
key "Roles" .
values .
key "Arn" . _String
-- arns are of form: "arn:aws:iam::<acct>:role/ec2-role"
let arns' = map (T.unpack . last . T.split (=='/')) arns
assertBool "listRoles contains test role" $
elem (prefix ++ roleName) arns'
-- Security Token Service (STS)
data Cred = Cred {
accessKeyId :: T.Text,
secretAccessKey :: T.Text,
sessionToken :: T.Text,
expiration :: Int -- Unix epoch
} deriving (Generic, Show, Eq)
instance A.FromJSON Cred where
parseJSON = DAT.genericParseJSON $ DAT.defaultOptions {
DAT.fieldLabelModifier = \(h:t) -> toUpper h:t
}
stsAssumeRole :: String -> String -> Options -> IORef String -> IO ()
stsAssumeRole prefix region baseopts iamTestState = do
arn <- readIORef iamTestState
let opts = baseopts
& param "Action" .~ ["AssumeRole"]
& param "Version" .~ ["2011-06-15"]
& param "RoleArn" .~ [T.pack arn]
& param "ExternalId" .~ [externalId]
& param "RoleSessionName" .~ ["Bob"]
& header "Accept" .~ ["application/json"]
r <- getWith opts (stsUrl region) -- STS call (part of IAM service family)
let v = r ^? responseBody
. key "AssumeRoleResponse"
. key "AssumeRoleResult"
. key "Credentials"
. _Value
assertBool "stsAssumeRole 200" $ r ^. responseStatus . statusCode == 200
assertBool "stsAssumeRole OK" $ r ^. responseStatus . statusMessage == "OK"
-- Now, use the temporary credentials to call an AWS service
let cred = conv v :: Cred
let key' = encodeUtf8 $ accessKeyId cred
let secret' = encodeUtf8 $ secretAccessKey cred
let token' = encodeUtf8 $ sessionToken cred
let baseopts2 = defaults
& auth ?~ awsSessionTokenAuth AWSv4 key' secret' token'
let opts2 = baseopts2
& param "Action" .~ ["ListRoles"]
& param "Version" .~ ["2010-05-08"]
& header "Accept" .~ ["application/json"]
r2 <- getWith opts2 (iamUrl region)
assertBool "listRoles 200" $ r2 ^. responseStatus . statusCode == 200
assertBool "listRoles OK" $ r2 ^. responseStatus . statusMessage == "OK"
let arns = r2 ^.. responseBody . key "ListRolesResponse" .
key "ListRolesResult" .
key "Roles" .
values .
key "Arn" . _String
-- arns are of form: "arn:aws:iam::<acct>:role/ec2-role"
let arns' = map (T.unpack . last . T.split (=='/')) arns
assertBool "listRoles contains test role" $
elem (prefix ++ roleName) arns'
where
conv :: DAT.FromJSON a => Maybe DAT.Value -> a
conv v = case v of
Nothing -> error "1"
Just x ->
case A.fromJSON x of
A.Success r ->
r
A.Error e ->
error $ show e
iamUrl :: String -> String
iamUrl _ =
"https://iam.amazonaws.com/" -- IAM is not region specific
stsUrl :: String -> String
stsUrl _region =
"https://sts.amazonaws.com/" -- keep from needing to enable STS in regions
-- To test region specific behavior, uncomment the line below
-- "https://sts." ++ _region ++ ".amazonaws.com/" -- region specific
-- Note: to access AWS STS in any region other than us-east-1, or the default
-- region (sts.amazonaws.com), STS needs to be enabled in the
-- AWS Management Console under
-- Account Settings > Security Token Service Region
-- If you forget, the AssumeRole call will return a 403 error with:
-- "STS is not activated in this region for account:<acct>.
-- Your account administrator can activate STS in this region using
-- the IAM Console."
roleName :: String
roleName = "test"
testPolicyName :: T.Text
testPolicyName = "testPolicy"
-- Note that ExternalId is a concept used for cross account use cases
-- with 3rd parties. But the check works for same-account as well, which
-- makes it more convenient to test.
-- For more, see:
-- http://docs.aws.amazon.com/STS/latest/UsingSTS/sts-delegating-externalid.html
externalId :: T.Text
externalId = "someExternalId"
rolePolicyDoc :: T.Text
rolePolicyDoc = LT.toStrict . E.decodeUtf8 . encode $
object [
"Version" .= "2012-10-17",
"Statement" .= [
object [
"Effect" .= "Allow",
"Action" .= "sts:AssumeRole",
"Principal" .= object ["AWS" .= "*"],
"Condition" .= object ["StringEquals" .=
object ["sts:ExternalId" .= string externalId]]
]
]
]
policyDoc :: T.Text
policyDoc = LT.toStrict . E.decodeUtf8 . encode $
object [
"Version" .= "2012-10-17",
"Statement" .= [
object [
"Effect" .= "Allow",
"Action" .= ["*"],
"Resource" .= ["*"]
]
]
]
|
