Add support for AWS Session Token Service (AWS STS) credentials.

Network/Wreq.hs

@@ -94,6 +94,7 @@ module Network.Wreq
     , oauth2Bearer
     , oauth2Token
     , awsAuth
+    , awsSessionTokenAuth
     -- ** Proxy settings
     , Proxy(Proxy)
     , Lens.proxy
@@ -525,7 +526,25 @@ oauth2Token = OAuth2Token
 --'getWith' opts \"https:\/\/dynamodb.us-west-2.amazonaws.com\"
 -- @
 awsAuth :: AWSAuthVersion -> S.ByteString -> S.ByteString -> Auth
-awsAuth = AWSAuth
+awsAuth version key secret = AWSAuth version key secret Nothing
+
+-- | AWS v4 request signature using a AWS STS Session Token.
+--
+-- Example (note the use of TLS):
+--
+-- @
+--let opts = 'defaults'
+--           '&' 'Lens.auth'
+--           '?~' 'awsAuth AWSv4' \"key\" \"secret\" \"stsSessionToken\"
+--'getWith' opts \"https:\/\/dynamodb.us-west-2.amazonaws.com\"
+-- @
+awsSessionTokenAuth :: AWSAuthVersion -- ^ Signature version (V4)
+                    -> S.ByteString   -- ^ AWS AccessKeyId
+                    -> S.ByteString   -- ^ AWS SecretAccessKey
+                    -> S.ByteString   -- ^ AWS STS SessionToken
+                    -> Auth
+awsSessionTokenAuth version key secret sessionToken =
+  AWSAuth version key secret (Just sessionToken)
 
 -- | Proxy configuration.
 --

Network/Wreq/Internal.hs

@@ -119,7 +119,7 @@ prepare modify opts url = do
     signRequest :: Request -> IO Request
     signRequest = maybe return f $ auth opts
       where
-        f (AWSAuth versn key secret) = AWS.signRequest versn key secret
+        f (AWSAuth versn key secret _) = AWS.signRequest versn key secret
         f (OAuth1 consumerToken consumerSecret token secret) = OAuth1.signRequest consumerToken consumerSecret token secret
         f _ = return
 
@@ -139,8 +139,9 @@ setAuth = maybe id f . auth
     f (BasicAuth user pass) = HTTP.applyBasicAuth user pass
     f (OAuth2Bearer token)  = setHeader "Authorization" ("Bearer " <> token)
     f (OAuth2Token token)   = setHeader "Authorization" ("token " <> token)
-    -- for AWS request signature, see Internal/AWS
-    f (AWSAuth _ _ _)       = id
+    -- for AWS request signature implementation, see Internal/AWS
+    f (AWSAuth _ _ _ mSessionToken) =
+      maybe id (setHeader "X-Amz-Security-Token") mSessionToken
     f (OAuth1 _ _ _ _)      = id
 
 setProxy :: Options -> Request -> Request

Network/Wreq/Internal/Types.hs

@@ -179,9 +179,9 @@ data Auth = BasicAuth S.ByteString S.ByteString
             -- to be used only by GitHub). This is treated by whoever
             -- accepts it as the equivalent of a username and
             -- password.
-          | AWSAuth AWSAuthVersion S.ByteString S.ByteString
+          | AWSAuth AWSAuthVersion S.ByteString S.ByteString (Maybe S.ByteString)
             -- ^ Amazon Web Services request signing
-            -- AWSAuthVersion key secret
+            -- AWSAuthVersion key secret (optional: session-token)
           | OAuth1 S.ByteString S.ByteString S.ByteString S.ByteString
             -- ^ OAuth1 request signing
             -- OAuth1 consumerToken consumerSecret token secret

changelog.md

@@ -1,5 +1,16 @@
 -*- markdown -*-
 
+2017-12-23 0.5.1.1
+
+* Add awsSessionTokenAuth (in addition to the existing awsAuth) to
+  support AWS Session Token Service (AWS STS) credentials. These look
+  like regular AWS credentials but have an additional session token as
+  a 3rd element. This mechanism is needed to be able to (a) use EC2
+  instance profiles, (b) make calls form AWS Lambda, (c) is useful for
+  delegated role access (assumeRole within and across accounts), and (d)
+  enables MFA-protected access scenarios.
+  See tests/AWS/IAM.hs for a test and simple example.
+
 2017-01-09 0.5.1.0
 
 * Add Session-specific version of Network.Wreq.customPayloadMethodWith

tests/AWS.hs

@@ -14,12 +14,9 @@ To configure and run these tests you need an AWS account. We assume
 that you are familiar with AWS concepts and the charging model.
 
 ** ENABLING AWS TESTS **
-For now, enable AWS tests by setting the WREQ_AWS_ACCESS_KEY_ID
-env variable per below.
-
-TODO| To enable AWS tests use the `-faws` flag as part of
-TODO|   $ cabal configure --enable-tests -faws ...
-TODO| To capture code coverage information, add the `-fdeveloper` flag.
+To enable AWS tests use the `-faws` flag as part of
+  $ cabal configure --enable-tests -faws ...
+To capture code coverage information, add the `-fdeveloper` flag.
 
 ** REQUIRED CLIENT CONFIGURATION **
 The tests require two environment variables:
@@ -76,20 +73,6 @@ import qualified AWS.SQS (tests)
 
 tests :: IO Test
 tests = do
-  -- TODO - use ... configure -faws ... in the future
-  --        but couldn't figure out (yet) how to get
-  --        a hold of the flag value in test code.
-  -- Workaround: for now, the presence of the
-  --   WREQ_AWS_ACCESS_KEY_ID
-  -- env variable enables the tests.
-  flag <- (getEnv "WREQ_AWS_ACCESS_KEY_ID" >> return True) `E.catch`
-          \(_::IOException) -> return False
-  tests0 flag
-
-tests0 :: Bool -> IO Test
-tests0 False =
-  return $ testGroup "aws" [] -- skip AWS tests
-tests0 True = do
   region <- env "us-west-2" "WREQ_AWS_REGION"
   key <- BS8.pack `fmap` getEnv "WREQ_AWS_ACCESS_KEY_ID"
   secret <- BS8.pack `fmap` getEnv "WREQ_AWS_SECRET_ACCESS_KEY"

tests/AWS/IAM.hs

@@ -1,19 +1,24 @@
-{-# LANGUAGE OverloadedLists, OverloadedStrings #-}
+{-# LANGUAGE OverloadedLists, OverloadedStrings, DeriveGeneric #-}
 module AWS.IAM (tests) where
 
 import AWS.Aeson
 import Control.Concurrent (threadDelay)
 import Control.Lens hiding ((.=))
-import Data.Aeson.Encode (encode)
-import Data.Aeson.Lens (key, _String, values)
+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" [
@@ -111,8 +116,20 @@ listRoles prefix region baseopts = do
     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
+stsAssumeRole prefix region baseopts iamTestState = do
   arn <- readIORef iamTestState
   let opts = baseopts
              & param  "Action"  .~ ["AssumeRole"]
@@ -122,9 +139,49 @@ stsAssumeRole _prefix region baseopts iamTestState = do
              & 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
@@ -183,4 +240,4 @@ policyDoc = LT.toStrict . E.decodeUtf8 . encode $
           "Resource" .= ["*"]
         ]
       ]
-  ]
+  ]

tests/UnitTests.hs

@@ -12,7 +12,7 @@ import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
 import Control.Exception (Exception, throwIO)
 import Control.Lens ((^.), (^?), (.~), (?~), (&), iso, ix, Traversal')
 import Control.Monad (unless, void)
-import Data.Aeson
+import Data.Aeson hiding (Options)
 import Data.Aeson.Lens (key, AsValue, _Object)
 import Data.ByteString (ByteString)
 import Data.Char (toUpper)

wreq.cabal

@@ -1,5 +1,5 @@
 name:                wreq
-version:             0.5.1.0
+version:             0.5.1.1
 synopsis:            An easy-to-use HTTP client library.
 description:
   .