diff --git a/src/Lib.hs b/src/Lib.hs index ecbf8ed..fb57fb7 100644 --- 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 index ab73687..65f3499 100644 --- 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