[skip ci] refactor getAWSEnv

tmspzz · Apr 12, 2019 · d5e576c · d5e576c
1 parent 1d00386
commit d5e576c
Show file tree

Hide file tree

Showing 2 changed files with 109 additions and 47 deletions.
diff --git a/src/Lib.hs b/src/Lib.hs
@@ -34,7 +34,8 @@ import           Data.Yaml                    (encodeFile)
 import           Data.IORef                   (newIORef)
 import           Data.Carthage.Cartfile
 import           Data.Carthage.TargetPlatform
-import           Data.Either.Extra            (maybeToEither, eitherToMaybe)
+import           Data.Either.Extra            (maybeToEither, eitherToMaybe, isRight, mapLeft)
+import           Data.Either.Utils            (fromLeft)
 import           Data.Maybe                   (fromMaybe, maybe)
 import           Data.Monoid                  ((<>))
 import           Data.Romefile
@@ -74,31 +75,50 @@ s3EndpointOverride _ = S3.s3
 
 getAWSEnv :: (MonadIO m, MonadCatch m) => ExceptT String m AWS.Env
 getAWSEnv = do
-  region        <- discoverRegion
-  endpointURL   <- runMaybeT . exceptToMaybeT $ discoverEndpoint
-  (auth, _) <- AWS.catching AWS._MissingEnvError AWS.fromEnv $ \_ -> do
-    profile       <-  T.pack . fromMaybe "default" <$> liftIO (lookupEnv (T.unpack "AWS_PROFILE"))
-    credentilas   <- AWS.credentialsFromFile =<< getAWSCredentialsFilePath
-    let roleARN = eitherToMaybe $ AWS.roleARNOf profile credentilas
-    case roleARN of
-      Just role -> do -- There is a role specified so check if there is a source profile
-        let sourceProfile = eitherToMaybe $ AWS.sourceProfileOf profile credentilas
-        case sourceProfile of
-          Just profile -> undefined
-          Nothing -> undefined
-      Nothing -> do
-        let accessKeyId = T.encodeUtf8 <$> AWS.accessKeyIdOf profile credentilas
-        let secretAccessKey = T.encodeUtf8 <$> AWS.secretAccessKeyOf profile credentilas
-        let authEnv = AWS.AuthEnv <$> (AWS.AccessKey <$> accessKeyId) 
-                        <*> (AWS.Sensitive . AWS.SecretKey <$> secretAccessKey)  
-                        <*> pure Nothing 
-                        <*> pure Nothing
-        let auth = (,) <$> (AWS.Auth <$> authEnv) <*> pure (pure region)
-        ExceptT $ pure auth
+  region      <- discoverRegion
+  endpointURL <- runMaybeT . exceptToMaybeT $ discoverEndpoint
+  profile     <- T.pack . fromMaybe "default" <$> liftIO
+    (lookupEnv (T.unpack "AWS_PROFILE"))
+  credentials <-
+    runExceptT $ AWS.credentialsFromFile =<< getAWSCredentialsFilePath
+  (auth, _) <-
+    AWS.catching AWS._MissingEnvError AWS.fromEnv $ \envError -> either
+      throwError
+      (\cred -> do
+        let finalProfile = fromMaybe
+              profile
+              (eitherToMaybe $ AWS.sourceProfileOf profile =<< credentials)
+        let
+          authAndRegion =
+            (,)
+              <$> mapLeft
+                    (\e ->
+                      T.unpack envError
+                        ++ ". "
+                        ++ e
+                        ++ " in file ~/.aws/credentilas"
+                    )
+                    (AWS.authFromCredentilas finalProfile =<< credentials)
+              <*> pure (pure region)
+        liftEither authAndRegion
+      )
+      credentials
   manager <- liftIO (Conduit.newManager Conduit.tlsManagerSettings)
-  ref <- liftIO (newIORef Nothing)
-  let env = AWS.Env region (\_ _ -> pure ()) (AWS.retryConnectionFailure 3) mempty manager ref auth
-  return $ AWS.configure (maybe S3.s3 s3EndpointOverride endpointURL) env 
+  ref     <- liftIO (newIORef Nothing)
+  let roleARN = eitherToMaybe $ AWS.roleARNOf profile =<< credentials
+  case roleARN of
+    Just role -> do
+      undefined -- Make request to STS
+    Nothing ->
+      let env = AWS.Env region
+                        (\_ _ -> pure ())
+                        (AWS.retryConnectionFailure 3)
+                        mempty
+                        manager
+                        ref
+                        auth
+      in  return
+            $ AWS.configure (maybe S3.s3 s3EndpointOverride endpointURL) env
 
 getAWSRegion :: (MonadIO m, MonadCatch m) => ExceptT String m AWS.Env
 getAWSRegion = do
@@ -1231,7 +1251,9 @@ discoverRegion = do
   let eitherEnvRegion = ExceptT . return $ envRegion >>= AWS.fromText . T.pack
   let
     eitherFileRegion =
-      (getAWSConfigFilePath >>= flip getRegionFromFile (fromMaybe "default" profile))
+      (   getAWSConfigFilePath
+        >>= flip getRegionFromFile (fromMaybe "default" profile)
+        )
         `catch` \(e :: IOError) -> ExceptT . return . Left . show $ e
   eitherEnvRegion <|> eitherFileRegion
 
@@ -1243,9 +1265,10 @@ getRegionFromFile
   => FilePath -- ^ The path to the file containing the `AWS.Region`
   -> String -- ^ The name of the profile to use
   -> ExceptT String m AWS.Region
-getRegionFromFile f profile = fromFile f $ \fileContents -> ExceptT . return $ do
-  config <- AWS.parseConfigFile fileContents
-  AWS.regionOf (T.pack profile) config
+getRegionFromFile f profile =
+  fromFile f $ \fileContents -> ExceptT . return $ do
+    config <- AWS.parseConfigFile fileContents
+    AWS.regionOf (T.pack profile) config
 
 
 
@@ -1261,12 +1284,11 @@ discoverEndpoint = do
           $   maybeString
           >>= importURL
   profile <- liftIO $ lookupEnv "AWS_PROFILE"
-  let
-    fileEndPointURL =
-      (   getAWSConfigFilePath
-        >>= flip getEndpointFromFile (fromMaybe "default" profile)
-        )
-        `catch` \(e :: IOError) -> ExceptT . return . Left . show $ e
+  let fileEndPointURL =
+        (   getAWSConfigFilePath
+          >>= flip getEndpointFromFile (fromMaybe "default" profile)
+          )
+          `catch` \(e :: IOError) -> ExceptT . return . Left . show $ e
   (ExceptT . return $ envEndpointURL) <|> fileEndPointURL
 
 
@@ -1278,6 +1300,7 @@ getEndpointFromFile
   => String -- ^ The name of the profile to use
   -> FilePath -- ^ The path to the file containing the `AWS.Region`
   -> ExceptT String m URL
-getEndpointFromFile profile f = fromFile f $ \fileContents -> ExceptT . return $ do
-  config <- AWS.parseConfigFile fileContents
-  AWS.endPointOf (T.pack profile) config
+getEndpointFromFile profile f =
+  fromFile f $ \fileContents -> ExceptT . return $ do
+    config <- AWS.parseConfigFile fileContents
+    AWS.endPointOf (T.pack profile) config
diff --git a/src/Network/AWS/Utils.hs b/src/Network/AWS/Utils.hs
@@ -3,6 +3,7 @@
 module Network.AWS.Utils
   ( ConfigFile
   , credentialsFromFile
+  , authFromCredentilas
   , parseConfigFile
   , regionOf
   , endPointOf
@@ -19,11 +20,14 @@ module Network.AWS.Utils
 
 import           Control.Monad     ((<=<))
 import           Data.Either.Utils (maybeToEither)
+import           Data.Either.Extra (mapLeft)
 import           Data.Ini          (Ini, lookupValue, parseIni)
 import qualified Data.Text         as T (Text, null, unpack)
+import qualified Data.Text.Encoding           as T (encodeUtf8)
 import qualified Data.Text.IO      as T (readFile)
 import qualified Network.AWS       as AWS
 import qualified Network.AWS.Data  as AWS
+import qualified Network.AWS.Data.Sensitive   as AWS (Sensitive (..))
 import           Network.URL
 import           Control.Monad.IO.Class (MonadIO, liftIO)
 import           Control.Monad.Except (ExceptT (..), withExceptT)
@@ -41,15 +45,26 @@ instance FromIni CredentialsFile where
   asIni = _awsCredentialsIni
 
 -- | Reads `CredentialsFile` from a file at a given path
-credentialsFromFile 
+credentialsFromFile
   :: MonadIO m
   => FilePath -- ^ The path to the file containing the credentials. Usually `~/.aws/credentials`
   -> ExceptT String m CredentialsFile
 credentialsFromFile filePath = do
   file <- liftIO (T.readFile filePath)
   withExceptT (("Could not parse " <> filePath <> ": ") <>) (action file)
-  where
-    action a = ExceptT . return $ parseCredentialsFile a
+  where action a = ExceptT . return $ parseCredentialsFile a
+
+authFromCredentilas :: T.Text -> CredentialsFile -> Either String AWS.Auth
+authFromCredentilas profile credentials = AWS.Auth <$> authEnv
+ where
+  accessKeyId     = T.encodeUtf8 <$> accessKeyIdOf profile credentials
+  secretAccessKey = T.encodeUtf8 <$> secretAccessKeyOf profile credentials
+  authEnv =
+    AWS.AuthEnv
+      <$> (AWS.AccessKey <$> accessKeyId)
+      <*> (AWS.Sensitive . AWS.SecretKey <$> secretAccessKey)
+      <*> pure Nothing
+      <*> pure Nothing
 
 regionOf :: T.Text -> ConfigFile -> Either String AWS.Region
 regionOf profile = parseRegion <=< lookupValue profile "region" . asIni
@@ -70,20 +85,44 @@ endPointOf profile = parseURL <=< lookupValue profile "endpoint" . asIni
       . T.unpack
       $ s
 
-getPropertyFromCredentials :: T.Text -> T.Text -> CredentialsFile -> Either String T.Text
-getPropertyFromCredentials profile property = lookupValue profile property . asIni
+getPropertyFromCredentials
+  :: T.Text -> T.Text -> CredentialsFile -> Either String T.Text
+getPropertyFromCredentials profile property =
+  lookupValue profile property . asIni
 
 sourceProfileOf :: T.Text -> CredentialsFile -> Either String T.Text
-sourceProfileOf profile = getPropertyFromCredentials profile "source_profile"
+sourceProfileOf profile credFile =
+  getPropertyFromCredentials profile "source_profile" credFile
+    `withError` const (missingKeyError key profile)
+  where key = "source_profile"
 
 roleARNOf :: T.Text -> CredentialsFile -> Either String T.Text
-roleARNOf profile = getPropertyFromCredentials profile "role_arn"
+roleARNOf profile credFile = getPropertyFromCredentials profile key credFile
+  `withError` const (missingKeyError key profile)
+  where key = "role_arn"
 
 accessKeyIdOf :: T.Text -> CredentialsFile -> Either String T.Text
-accessKeyIdOf profile = getPropertyFromCredentials profile "aws_access_key_id"
+accessKeyIdOf profile credFile =
+  getPropertyFromCredentials profile key credFile
+    `withError` const (missingKeyError key profile)
+  where key = "aws_access_key_id"
+
+missingKeyError :: T.Text -> T.Text -> String
+missingKeyError key profile =
+  "Could not find key `"
+    ++ T.unpack key
+    ++ "` for profile `"
+    ++ T.unpack profile
+    ++ "`"
+
+withError :: Either a b -> (a -> c) -> Either c b
+withError = flip mapLeft
 
 secretAccessKeyOf :: T.Text -> CredentialsFile -> Either String T.Text
-secretAccessKeyOf profile = getPropertyFromCredentials profile "aws_secret_access_key"
+secretAccessKeyOf profile credFile =
+  getPropertyFromCredentials profile key credFile
+    `withError` const (missingKeyError key profile)
+  where key = "aws_secret_access_key"
 
 parseConfigFile :: T.Text -> Either String ConfigFile
 parseConfigFile = fmap ConfigFile . parseIni