diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,7 @@ # Change Log ## [1.4.3](https://github.com/brendanhay/amazonka/tree/1.4.3) -Released: **09 June, 2016**, Compare: [1.4.3](https://github.com/brendanhay/amazonka/compare/1.4.2...1.4.3) +Released: **09 June, 2016**, Compare: [1.4.2](https://github.com/brendanhay/amazonka/compare/1.4.2...1.4.3) ### Fixed @@ -9,14 +9,14 @@ - CloudWatchLogs `FilterLogEvents` pagination now correctly returns all results. [\#296](https://github.com/brendanhay/amazonka/issues/296) - Documentation code samples for IoT, Lambda, and Discovery are now correctly Haddock formatted. -### Changes +### Changed - Documentation is now formatted more consistently at the expense of longer line columns. - `POSIX` timestamps no longer have unecessary (and misleading) Text/XML instances. ## [1.4.2](https://github.com/brendanhay/amazonka/tree/1.4.2) -Released: **03 June, 2016**, Compare: [1.4.2](https://github.com/brendanhay/amazonka/compare/1.4.1...1.4.2) +Released: **03 June, 2016**, Compare: [1.4.1](https://github.com/brendanhay/amazonka/compare/1.4.1...1.4.2) ### Fixed @@ -24,7 +24,7 @@ - APIGateway now correctly parses and encodes `ISO8601` formatted timestamps. [\#291](https://github.com/brendanhay/amazonka/issues/291) - `~/.aws/credentials` now correctly parses with leading newlines. [\#290](https://github.com/brendanhay/amazonka/issues/290) -### Changes +### Changed - `SerializeError` now contains the unparsed response body. [\#293](https://github.com/brendanhay/amazonka/pull/293) @@ -44,14 +44,14 @@ ## [1.4.1](https://github.com/brendanhay/amazonka/tree/1.4.1) -Released: **09 May, 2016**, Compare: [1.4.1](https://github.com/brendanhay/amazonka/compare/1.4.0...1.4.1) +Released: **09 May, 2016**, Compare: [1.4.0](https://github.com/brendanhay/amazonka/compare/1.4.0...1.4.1) ### Fixed - AutoScaling `DescribeAutoScalingInstances` response field `LaunchConfigurationName` is now optional. [\#281](https://github.com/brendanhay/amazonka/issues/281) - SWF `PollForDecisionTask` and `PollForActivityTask` response fields are now optional. [\#285](https://github.com/brendanhay/amazonka/issues/285) -### Changes +### Changed - `NFData` instances generated for all eligible types. [\#283](https://github.com/brendanhay/amazonka/issues/283) - Additional retry cases for HTTP `5XX` response codes. [c5e494e](https://github.com/brendanhay/amazonka/commit/c5e494e2a97fcf2e9210527ed5e8547f1be898de) @@ -99,7 +99,7 @@ ## [1.4.0](https://github.com/brendanhay/amazonka/tree/1.4.0) -Released: **21 March, 2016**, Compare: [1.4.0](https://github.com/brendanhay/amazonka/compare/1.3.7...1.4.0) +Released: **21 March, 2016**, Compare: [1.3.7](https://github.com/brendanhay/amazonka/compare/1.3.7...1.4.0) ### Fixed @@ -158,13 +158,13 @@ ## [1.3.7](https://github.com/brendanhay/amazonka/tree/1.3.7) -Released: **18 December, 2015**, Compare: [1.3.7](https://github.com/brendanhay/amazonka/compare/1.3.6...1.3.7) +Released: **18 December, 2015**, Compare: [1.3.6](https://github.com/brendanhay/amazonka/compare/1.3.6...1.3.7) ### Fixed - Fix SWF `PollFor{Activity,Decision}Task` response deserialisation. [\#257](https://github.com/brendanhay/amazonka/issues/257) -### Changes +### Changed - The `ErrorCode` type constructor is now exported. [\#258](https://github.com/brendanhay/amazonka/issues/258) - Add `Bounded` instances for all enumerations with stable values. [\#255](https://github.com/brendanhay/amazonka/issues/255) @@ -189,7 +189,7 @@ ## [1.3.6](https://github.com/brendanhay/amazonka/tree/1.3.6) -Released: **18 November, 2015**, Compare: [1.3.6](https://github.com/brendanhay/amazonka/compare/1.3.5.1...1.3.6) +Released: **18 November, 2015**, Compare: [1.3.5.1](https://github.com/brendanhay/amazonka/compare/1.3.5.1...1.3.6) ### Fixed @@ -197,7 +197,7 @@ - Fix S3 `BucketLocationConstraint` type de/serialisation. [\#249](https://github.com/brendanhay/amazonka/issues/249) - Fix S3 `PutBucketACL` header vs request body serialisation. [\#241](https://github.com/brendanhay/amazonka/issues/241) -### Changes +### Changed - `await` responses now indicate request fulfillment. [\#245](https://github.com/brendanhay/amazonka/issues/245) @@ -216,7 +216,7 @@ ## [1.3.5.1](https://github.com/brendanhay/amazonka/tree/1.3.5.1) -Released: **18 November, 2015**, Compare: [1.3.5.1](https://github.com/brendanhay/amazonka/compare/1.3.5...1.3.5.1) +Released: **18 November, 2015**, Compare: [1.3.5](https://github.com/brendanhay/amazonka/compare/1.3.5...1.3.5.1) ### Fixed @@ -225,7 +225,7 @@ ## [1.3.5](https://github.com/brendanhay/amazonka/tree/1.3.5) -Released: **27 October, 2015**, Compare: [1.3.5](https://github.com/brendanhay/amazonka/compare/1.3.4...1.3.5) +Released: **27 October, 2015**, Compare: [1.3.4](https://github.com/brendanhay/amazonka/compare/1.3.4...1.3.5) ### Updated Services Definitions @@ -239,7 +239,7 @@ ## [1.3.4](https://github.com/brendanhay/amazonka/tree/1.3.4) -Released: **25 October, 2015**, Compare: [1.3.4](https://github.com/brendanhay/amazonka/compare/1.3.3...1.3.4) +Released: **25 October, 2015**, Compare: [1.3.3](https://github.com/brendanhay/amazonka/compare/1.3.3...1.3.4) ### Updated Services Definitions diff --git a/amazonka.cabal b/amazonka.cabal --- a/amazonka.cabal +++ b/amazonka.cabal @@ -1,5 +1,5 @@ name: amazonka -version: 1.4.3 +version: 1.4.4 synopsis: Comprehensive Amazon Web Services SDK. homepage: https://github.com/brendanhay/amazonka bug-reports: https://github.com/brendanhay/amazonka/issues @@ -55,14 +55,14 @@ , Network.AWS.Internal.Logger build-depends: - amazonka-core == 1.4.3.* - , base >= 4.7 && < 5 + amazonka-core == 1.4.4.* + , base >= 4.7 && < 5 , bytestring >= 0.9 , conduit >= 1.1 , conduit-extra >= 1.1 , directory >= 1.2 , exceptions >= 0.6 - , http-conduit >= 2.1.4 + , http-conduit >= 2.2 && < 3 , ini >= 0.3.5 , mmorph >= 1 , monad-control >= 1 diff --git a/src/Control/Monad/Trans/AWS.hs b/src/Control/Monad/Trans/AWS.hs --- a/src/Control/Monad/Trans/AWS.hs +++ b/src/Control/Monad/Trans/AWS.hs @@ -430,7 +430,7 @@ The updated configuration is then passed to the 'Env' during setup: -> e <- newEnv Frankfurt Discover <&> configure dynamo +> e <- newEnv Discover <&> configure dynamo > runResourceT . runAWS e $ do > -- This S3 operation will communicate with remote AWS APIs. > x <- send listBuckets @@ -444,7 +444,7 @@ You can also scope the 'Endpoint' modifications (or any other 'Service' configuration) to specific actions: -> e <- newEnv Ireland Discover +> e <- newEnv Discover > runResourceT . runAWS e $ do > -- Service operations here will communicate with AWS, even DynamoDB. > x <- send listTables diff --git a/src/Network/AWS.hs b/src/Network/AWS.hs --- a/src/Network/AWS.hs +++ b/src/Network/AWS.hs @@ -299,17 +299,20 @@ * 'await' -To utilise these, you will need to specify what 'Region' you wish to operate in -and your Amazon credentials for AuthN/AuthZ purposes. +These functions have constraints that types from the @amazonka-*@ libraries +satisfy. To utilise these, you will need to specify what 'Region' you wish to +operate in and your Amazon credentials for AuthN/AuthZ purposes. 'Credentials' can be supplied in a number of ways. Either via explicit keys, -via session profiles, or have Amazonka determine the credentials from an +via session profiles, or have Amazonka retrieve the credentials from an underlying IAM Role/Profile. As a basic example, you might wish to store an object in an S3 bucket using : @ +{-# LANGUAGE OverloadedStrings #-} + import Control.Lens import Network.AWS import Network.AWS.S3 @@ -317,20 +320,26 @@ example :: IO PutObjectResponse example = do - -- To specify configuration preferences, 'newEnv' is used to create a new 'Env'. The 'Region' denotes the AWS region requests will be performed against, - -- and 'Credentials' is used to specify the desired mechanism for supplying or retrieving AuthN/AuthZ information. - -- In this case, 'Discover' will cause the library to try a number of options such as default environment variables, or an instance's IAM Profile: - e <- newEnv Frankfurt Discover + -- A new 'Logger' to replace the default noop logger is created, with the logger + -- set to print debug information and errors to stdout: + lgr <- newLogger Debug stdout - -- A new 'Logger' to replace the default noop logger is created, with the logger set to print debug information and errors to stdout: - l <- newLogger Debug stdout + -- To specify configuration preferences, 'newEnv' is used to create a new + -- configuration environment. The 'Credentials' parameter is used to specify + -- mechanism for supplying or retrieving AuthN/AuthZ information. + -- In this case 'Discover' will cause the library to try a number of options such + -- as default environment variables, or an instance's IAM Profile and identity document: + env <- newEnv Discover - -- The payload (and hash) for the S3 object is retrieved from a FilePath: - b <- sourceFileIO "local\/path\/to\/object-payload" + -- The payload (and hash) for the S3 object is retrieved from a 'FilePath': + body <- sourceFileIO "local\/path\/to\/object-payload" - -- We now run the AWS computation with the overriden logger, performing the PutObject request: - runResourceT . runAWS (e & envLogger .~ l) $ - send (putObject "bucket-name" "object-key" b) + -- We now run the 'AWS' computation with the overriden logger, performing the + -- 'PutObject' request. 'envRegion' or 'within' can be used to set the + -- remote AWS 'Region': + runResourceT $ runAWS (env & envLogger .~ lgr) $ + within Frankfurt $ + send (putObject "bucket-name" "object-key" body) @ -} diff --git a/src/Network/AWS/Auth.hs b/src/Network/AWS/Auth.hs --- a/src/Network/AWS/Auth.hs +++ b/src/Network/AWS/Auth.hs @@ -65,6 +65,7 @@ import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class +import Control.Monad.Trans.Maybe (MaybeT (..)) import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy.Char8 as LBS8 import Data.Char (isSpace) @@ -78,7 +79,7 @@ import Network.AWS.EC2.Metadata import Network.AWS.Lens (catching, catching_, exception, throwingM, _IOException) -import Network.AWS.Lens (Prism', prism) +import Network.AWS.Lens (Prism', prism, (<&>)) import Network.AWS.Prelude import Network.AWS.Types import Network.HTTP.Conduit @@ -98,10 +99,14 @@ envSessionToken :: Text -- ^ AWS_SESSION_TOKEN envSessionToken = "AWS_SESSION_TOKEN" --- | Credentials profile environment variable. +-- | Default credentials profile environment variable. envProfile :: Text -- ^ AWS_PROFILE envProfile = "AWS_PROFILE" +-- | Default region environment variable +envRegion :: Text -- ^ AWS_REGION +envRegion = "AWS_REGION" + -- | Credentials INI file access key variable. credAccessKey :: Text -- ^ aws_access_key_id credAccessKey = "aws_access_key_id" @@ -159,9 +164,9 @@ | FromSession AccessKey SecretKey SessionToken -- ^ Explicit access key, secret key and a session token. See 'fromSession'. - | FromEnv Text Text (Maybe Text) - -- ^ Lookup specific environment variables for access key, secret key, and - -- an optional session token respectively. + | FromEnv Text Text (Maybe Text) (Maybe Text) + -- ^ Lookup specific environment variables for access key, secret key, + -- an optional session token, and an optional region, respectively. | FromProfile Text -- ^ An IAM Profile name to lookup from the local EC2 instance-data. @@ -175,11 +180,12 @@ | Discover -- ^ Attempt credentials discovery via the following steps: -- - -- * Read the 'envAccessKey' and 'envSecretKey' from the environment if they are set. + -- * Read the 'envAccessKey', 'envSecretKey', and 'envRegion' from the environment if they are set. -- -- * Read the credentials file if 'credFile' exists. -- - -- * Retrieve the first available IAM profile if running on EC2. + -- * Retrieve the first available IAM profile and read + -- the 'Region' from the instance identity document, if running on EC2. -- -- An attempt is made to resolve rather than directly -- retrieving for IAM profile information. @@ -189,12 +195,18 @@ instance ToLog Credentials where build = \case - FromKeys a _ -> "FromKeys " <> build a <> " ****" - FromSession a _ _ -> "FromSession " <> build a <> " **** ****" - FromEnv a s t -> "FromEnv " <> build a <> " " <> build s <> " " <> m t - FromProfile n -> "FromProfile " <> build n - FromFile n f -> "FromFile " <> build n <> " " <> build f - Discover -> "Discover" + FromKeys a _ -> + "FromKeys " <> build a <> " ****" + FromSession a _ _ -> + "FromSession " <> build a <> " **** ****" + FromEnv a s t r -> + "FromEnv " <> build a <> " " <> build s <> " " <> m t <> " " <> m r + FromProfile n -> + "FromProfile " <> build n + FromFile n f -> + "FromFile " <> build n <> " " <> build f + Discover -> + "Discover" where m (Just x) = "(Just " <> build x <> ")" m Nothing = "Nothing" @@ -206,6 +218,7 @@ data AuthError = RetrievalError HttpException | MissingEnvError Text + | InvalidEnvError Text | MissingFileError FilePath | InvalidFileError Text | InvalidIAMError Text @@ -217,6 +230,7 @@ build = \case RetrievalError e -> build e MissingEnvError e -> "[MissingEnvError] { message = " <> build e <> "}" + InvalidEnvError e -> "[InvalidEnvError] { message = " <> build e <> "}" MissingFileError f -> "[MissingFileError] { path = " <> build f <> "}" InvalidFileError e -> "[InvalidFileError] { message = " <> build e <> "}" InvalidIAMError e -> "[InvalidIAMError] { message = " <> build e <> "}" @@ -230,9 +244,12 @@ -- the local metadata endpoint. _RetrievalError :: Prism' a HttpException - -- | An error occured looking up a named environment variable. + -- | The named environment variable was not found. _MissingEnvError :: Prism' a Text + -- | An error occured parsing named environment variable's value. + _InvalidEnvError :: Prism' a Text + -- | The specified credentials file could not be found. _MissingFileError :: Prism' a FilePath @@ -244,6 +261,7 @@ _RetrievalError = _AuthError . _RetrievalError _MissingEnvError = _AuthError . _MissingEnvError + _InvalidEnvError = _AuthError . _InvalidEnvError _MissingFileError = _AuthError . _MissingFileError _InvalidFileError = _AuthError . _InvalidFileError _InvalidIAMError = _AuthError . _InvalidIAMError @@ -262,6 +280,10 @@ MissingEnvError e -> Right e x -> Left x + _InvalidEnvError = prism InvalidEnvError $ \case + InvalidEnvError e -> Right e + x -> Left x + _MissingFileError = prism MissingFileError $ \case MissingFileError f -> Right f x -> Left x @@ -281,14 +303,14 @@ getAuth :: (Applicative m, MonadIO m, MonadCatch m) => Manager -> Credentials - -> m Auth + -> m (Auth, Maybe Region) getAuth m = \case - FromKeys a s -> return (fromKeys a s) - FromSession a s t -> return (fromSession a s t) - FromEnv a s t -> fromEnvKeys a s t - FromProfile n -> fromProfileName m n - FromFile n f -> fromFilePath n f - Discover -> + FromKeys a s -> return (fromKeys a s, Nothing) + FromSession a s t -> return (fromSession a s t, Nothing) + FromEnv a s t r -> fromEnvKeys a s t r + FromProfile n -> fromProfileName m n + FromFile n f -> fromFilePath n f + Discover -> -- Don't try and catch InvalidFileError, or InvalidIAMProfile, -- let both errors propagate. catching_ _MissingEnvError fromEnv $ @@ -309,8 +331,13 @@ -- cannot be read, but not if the session token is absent. -- -- /See:/ 'envAccessKey', 'envSecretKey', 'envSessionToken' -fromEnv :: (Applicative m, MonadIO m, MonadThrow m) => m Auth -fromEnv = fromEnvKeys envAccessKey envSecretKey (Just envSessionToken) +fromEnv :: (Applicative m, MonadIO m, MonadThrow m) => m (Auth, Maybe Region) +fromEnv = + fromEnvKeys + envAccessKey + envSecretKey + (Just envSessionToken) + (Just envRegion) -- | Retrieve access key, secret key and a session token from specific -- environment variables. @@ -321,13 +348,26 @@ => Text -- ^ Access key environment variable. -> Text -- ^ Secret key environment variable. -> Maybe Text -- ^ Session token environment variable. - -> m Auth -fromEnvKeys a s t = fmap Auth $ AuthEnv - <$> (AccessKey <$> req a) - <*> (SecretKey <$> req s) - <*> (fmap SessionToken <$> opt t) - <*> pure Nothing + -> Maybe Text -- ^ Region environment variable. + -> m (Auth, Maybe Region) +fromEnvKeys access secret session region = + (,) <$> fmap Auth lookupKeys <*> lookupRegion where + lookupKeys = AuthEnv + <$> (req access <&> AccessKey . BS8.pack) + <*> (req secret <&> SecretKey . BS8.pack) + <*> (opt session <&> fmap (SessionToken . BS8.pack)) + <*> return Nothing + + lookupRegion :: (MonadIO m, MonadThrow m) => m (Maybe Region) + lookupRegion = runMaybeT $ do + k <- MaybeT (return region) + r <- MaybeT (opt region) + case fromText (Text.pack r) of + Right x -> return x + Left e -> throwM . InvalidEnvError $ + "Unable to parse ENV variable: " <> k <> ", " <> Text.pack e + req k = do m <- opt (Just k) maybe (throwM . MissingEnvError $ "Unable to read ENV variable: " <> k) @@ -335,7 +375,7 @@ m opt Nothing = return Nothing - opt (Just k) = fmap BS8.pack <$> liftIO (lookupEnv (Text.unpack k)) + opt (Just k) = liftIO (lookupEnv (Text.unpack k)) -- | Loads the default @credentials@ INI file using the default profile name. -- @@ -343,12 +383,11 @@ -- if an error occurs during parsing. -- -- /See:/ 'credProfile', 'credFile', and 'envProfile' -fromFile :: (Applicative m, MonadIO m, MonadCatch m) => m Auth +fromFile :: (Applicative m, MonadIO m, MonadCatch m) => m (Auth, Maybe Region) fromFile = do - f <- credFile - ep <- liftIO (lookupEnv (Text.unpack envProfile)) - let p = Text.pack (fromMaybe (Text.unpack credProfile) ep) - fromFilePath p f + p <- liftIO (lookupEnv (Text.unpack envProfile)) + fromFilePath (maybe credProfile Text.pack p) + =<< credFile -- | Retrieve the access, secret and session token from the specified section -- (profile) in a valid INI @credentials@ file. @@ -358,17 +397,18 @@ fromFilePath :: (Applicative m, MonadIO m, MonadCatch m) => Text -> FilePath - -> m Auth + -> m (Auth, Maybe Region) fromFilePath n f = do p <- liftIO (doesFileExist f) unless p $ throwM (MissingFileError f) - i <- liftIO (INI.readIniFile f) >>= either (invalidErr Nothing) return - fmap Auth $ AuthEnv - <$> (AccessKey <$> req credAccessKey i) - <*> (SecretKey <$> req credSecretKey i) - <*> (fmap SessionToken <$> opt credSessionToken i) - <*> pure Nothing + ini <- either (invalidErr Nothing) return =<< liftIO (INI.readIniFile f) + env <- AuthEnv + <$> (req credAccessKey ini <&> AccessKey) + <*> (req credSecretKey ini <&> SecretKey) + <*> (opt credSessionToken ini <&> fmap SessionToken) + <*> return Nothing + return (Auth env, Nothing) where req k i = case INI.lookupValue n k i of @@ -396,7 +436,7 @@ -- -- Throws 'RetrievalError' if the HTTP call fails, or 'InvalidIAMError' if -- the default IAM profile cannot be read. -fromProfile :: (MonadIO m, MonadCatch m) => Manager -> m Auth +fromProfile :: (MonadIO m, MonadCatch m) => Manager -> m (Auth, Maybe Region) fromProfile m = do ls <- try $ metadata m (IAM (SecurityCredentials Nothing)) case BS8.lines `liftM` ls of @@ -419,23 +459,36 @@ -- -- Throws 'RetrievalError' if the HTTP call fails, or 'InvalidIAMError' if -- the specified IAM profile cannot be read. -fromProfileName :: (MonadIO m, MonadCatch m) => Manager -> Text -> m Auth -fromProfileName m name = auth >>= start +fromProfileName :: (MonadIO m, MonadCatch m) + => Manager + -> Text + -> m (Auth, Maybe Region) +fromProfileName m name = do + auth <- getCredentials >>= start + reg <- getRegion + return (auth, Just reg) where - auth :: (MonadIO m, MonadCatch m) => m AuthEnv - auth = do - bs <- try $ metadata m (IAM . SecurityCredentials $ Just name) - case bs of - Left e -> throwM (RetrievalError e) - Right x -> - either (throwM . invalidErr) - return - (eitherDecode' (LBS8.fromStrict x)) + getCredentials :: (MonadIO m, MonadCatch m) => m AuthEnv + getCredentials = + try (metadata m (IAM . SecurityCredentials $ Just name)) >>= + handleErr (eitherDecode' . LBS8.fromStrict) invalidIAMErr - invalidErr = InvalidIAMError + getRegion :: (MonadIO m, MonadCatch m) => m Region + getRegion = + try (identity m) >>= + handleErr (fmap _region) invalidIdentityErr + + handleErr _ _ (Left e) = throwM (RetrievalError e) + handleErr f g (Right x) = either (throwM . g) return (f x) + + invalidIAMErr = InvalidIAMError . mappend ("Error parsing IAM profile '" <> name <> "' ") . Text.pack + invalidIdentityErr = InvalidIAMError + . mappend "Error parsing Instance Identity Document " + . Text.pack + start :: MonadIO m => AuthEnv -> m Auth start !a = liftIO $ case _authExpiry a of @@ -455,8 +508,8 @@ loop :: Weak (IORef AuthEnv) -> ThreadId -> UTCTime -> IO () loop w !p !x = do diff x <$> getCurrentTime >>= threadDelay - ea <- try auth - case ea of + env <- try getCredentials + case env of Left e -> throwTo p (RetrievalError e) Right !a -> do mr <- deRefWeak w diff --git a/src/Network/AWS/EC2/Metadata.hs b/src/Network/AWS/EC2/Metadata.hs --- a/src/Network/AWS/EC2/Metadata.hs +++ b/src/Network/AWS/EC2/Metadata.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} -- | -- Module : Network.AWS.EC2.Metadata @@ -27,13 +28,32 @@ , dynamic , metadata , userdata + , identity -- ** Path Constructors - , Dynamic (..) - , Metadata (..) - , Mapping (..) - , Info (..) - , Interface (..) + , Dynamic (..) + , Metadata (..) + , Mapping (..) + , Info (..) + , Interface (..) + + -- ** Identity Document + , IdentityDocument (..) + + -- *** Lenses + , devpayProductCodes + , billingProducts + , version + , privateIP + , availabilityZone + , region + , instanceID + , instanceType + , accountID + , imageID + , kernelID + , ramdiskID + , architecture ) where import Control.Monad @@ -43,6 +63,8 @@ import qualified Data.ByteString.Lazy as LBS import Data.Monoid import qualified Data.Text as Text +import Network.AWS.Data.JSON +import Network.AWS.Lens (Lens', lens) import Network.AWS.Prelude hiding (request) import Network.HTTP.Conduit @@ -55,6 +77,7 @@ | Document -- ^ JSON containing instance attributes, such as instance-id, -- private IP address, etc. + -- /See:/ 'identity', 'InstanceDocument'. | PKCS7 -- ^ Used to verify the document's authenticity and content against the -- signature. @@ -305,11 +328,115 @@ userdata m = do x <- try $ get m (latest <> "user-data") case x of - Right b -> return (Just b) - Left (StatusCodeException s _ _) - | fromEnum s == 404 -> return Nothing - Left e -> throwM e + Left (HttpExceptionRequest _ (StatusCodeException rs _)) + | fromEnum (responseStatus rs) == 404 + -> return Nothing + Left e -> throwM e + Right b -> return (Just b) +-- | Represents an instance's identity document. +-- +-- /Note:/ Fields such as '_instanceType' are represented as unparsed 'Text' and +-- will need to be manually parsed using 'fromText' when the relevant types +-- from a library such as "Network.AWS.EC2" are brought into scope. +data IdentityDocument = IdentityDocument + { _devpayProductCodes :: Maybe Text + , _billingProducts :: Maybe Text + , _version :: Text + , _privateIP :: Text + , _availabilityZone :: Text + , _region :: !Region + , _instanceID :: Text + , _instanceType :: Text + , _accountID :: Text + , _imageID :: Text + , _kernelID :: Text + , _ramdiskID :: Maybe Text + , _architecture :: Text + } deriving (Eq, Show) + +devpayProductCodes :: Lens' IdentityDocument (Maybe Text) +devpayProductCodes = lens _devpayProductCodes (\s a -> s { _devpayProductCodes = a }) + +billingProducts :: Lens' IdentityDocument (Maybe Text) +billingProducts = lens _billingProducts (\s a -> s { _billingProducts = a }) + +version :: Lens' IdentityDocument Text +version = lens _version (\s a -> s { _version = a }) + +privateIP :: Lens' IdentityDocument Text +privateIP = lens _privateIP (\s a -> s { _privateIP = a }) + +availabilityZone :: Lens' IdentityDocument Text +availabilityZone = lens _availabilityZone (\s a -> s { _availabilityZone = a }) + +region :: Lens' IdentityDocument Region +region = lens _region (\s a -> s { _region = a }) + +instanceID :: Lens' IdentityDocument Text +instanceID = lens _instanceID (\s a -> s { _instanceID = a }) + +instanceType :: Lens' IdentityDocument Text +instanceType = lens _instanceType (\s a -> s { _instanceType = a }) + +accountID :: Lens' IdentityDocument Text +accountID = lens _accountID (\s a -> s { _accountID = a }) + +imageID :: Lens' IdentityDocument Text +imageID = lens _imageID (\s a -> s { _imageID = a }) + +kernelID :: Lens' IdentityDocument Text +kernelID = lens _kernelID (\s a -> s { _kernelID = a }) + +ramdiskID :: Lens' IdentityDocument (Maybe Text) +ramdiskID = lens _ramdiskID (\s a -> s { _ramdiskID = a }) + +architecture :: Lens' IdentityDocument Text +architecture = lens _architecture (\s a -> s { _architecture = a }) + +instance FromJSON IdentityDocument where + parseJSON = withObject "dynamic/instance-identity/document" $ \o -> + IdentityDocument + <$> o .:? "devpayProductCodes" + <*> o .:? "availabilityZone" + <*> o .: "privateIp" + <*> o .: "version" + <*> o .: "region" + <*> o .: "instanceId" + <*> o .: "billingProducts" + <*> o .: "instanceType" + <*> o .: "accountId" + <*> o .: "imageId" + <*> o .: "kernelId" + <*> o .:? "ramdiskId" + <*> o .: "architecture" + +instance ToJSON IdentityDocument where + toJSON IdentityDocument{..} = + object + [ "devpayProductCodes" .= _devpayProductCodes + , "availabilityZone" .= _availabilityZone + , "privateIp" .= _privateIP + , "version" .= _version + , "region" .= _region + , "instanceId" .= _instanceID + , "billingProducts" .= _billingProducts + , "instanceType" .= _instanceType + , "accountId" .= _accountID + , "imageId" .= _imageID + , "kernelId" .= _kernelID + , "ramdiskId" .= _ramdiskID + , "architecture" .= _architecture + ] + +-- | Retrieve the instance's identity document, detailing various EC2 metadata. +-- +-- /See:/ . +identity :: (MonadIO m, MonadThrow m) + => Manager + -> m (Either String IdentityDocument) +identity m = (eitherDecode . LBS.fromStrict) `liftM` dynamic m Document + get :: (MonadIO m, MonadThrow m) => Manager -> Text -> m ByteString get m url = liftIO (strip `liftM` request m url) where @@ -319,6 +446,6 @@ request :: Manager -> Text -> IO ByteString request m url = do - rq <- parseUrl (Text.unpack url) + rq <- parseUrlThrow (Text.unpack url) rs <- httpLbs rq m return . LBS.toStrict $ responseBody rs diff --git a/src/Network/AWS/Env.hs b/src/Network/AWS/Env.hs --- a/src/Network/AWS/Env.hs +++ b/src/Network/AWS/Env.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} @@ -37,6 +38,7 @@ , retryConnectionFailure ) where +import Data.Maybe (fromMaybe) import Control.Applicative import Control.Monad.Catch import Control.Monad.IO.Class @@ -170,6 +172,11 @@ -- and uses 'getAuth' to expand/discover the supplied 'Credentials'. -- Lenses from 'HasEnv' can be used to further configure the resulting 'Env'. -- +-- /Since:/ @1.5.0@ - The region is now retrieved from the @AWS_REGION@ environment +-- variable (identical to official SDKs), or defaults to @us-east-1@. +-- You can override the 'Env' region by using 'envRegion', or the current operation's +-- region by using 'within'. +-- -- /Since:/ @1.3.6@ - The default logic for retrying 'HttpException's now uses -- 'retryConnectionFailure' to retry specific connection failure conditions up to 3 times. -- Previously only service specific errors were automatically retried. @@ -180,33 +187,41 @@ -- -- /See:/ 'newEnvWith'. newEnv :: (Applicative m, MonadIO m, MonadCatch m) - => Region -- ^ Initial region to operate in. - -> Credentials -- ^ Credential discovery mechanism. + => Credentials -- ^ Credential discovery mechanism. -> m Env -newEnv r c = liftIO (newManager conduitManagerSettings) - >>= newEnvWith r c Nothing +newEnv c = + liftIO (newManager conduitManagerSettings) + >>= newEnvWith c Nothing -- | /See:/ 'newEnv' -- +-- The 'Maybe' 'Bool' parameter is used by the EC2 instance check. By passing a +-- value of 'Nothing', the check will be performed. 'Just' 'True' would cause +-- the check to be skipped and the host treated as an EC2 instance. +-- -- Throws 'AuthError' when environment variables or IAM profiles cannot be read. newEnvWith :: (Applicative m, MonadIO m, MonadCatch m) - => Region -- ^ Initial region to operate in. - -> Credentials -- ^ Credential discovery mechanism. - -> Maybe Bool -- ^ Dictate if the instance is running on EC2. (Preload memoisation.) + => Credentials -- ^ Credential discovery mechanism. + -> Maybe Bool -- ^ Preload the EC2 instance check. -> Manager -> m Env -newEnvWith r c p m = +newEnvWith c p m = do + (a, fromMaybe NorthVirginia -> r) <- getAuth m c Env r (\_ _ -> pure ()) (retryConnectionFailure 3) mempty m <$> liftIO (newIORef p) - <*> getAuth m c + <*> pure a -- | Retry the subset of transport specific errors encompassing connection -- failure up to the specific number of times. retryConnectionFailure :: Int -> Int -> HttpException -> Bool -retryConnectionFailure limit n = \case - _ | n >= limit -> False - NoResponseDataReceived -> True - FailedConnectionException {} -> True - FailedConnectionException2 {} -> True - TlsException {} -> True - _ -> False +retryConnectionFailure _ _ InvalidUrlException {} = False +retryConnectionFailure limit n (HttpExceptionRequest _ ex) + | n >= limit = False + | otherwise = + case ex of + NoResponseDataReceived -> True + ConnectionTimeout -> True + ConnectionClosed -> True + ConnectionFailure {} -> True + InternalException {} -> True + _ -> False