diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,48 @@ # Change Log +## [1.5.0](https://github.com/brendanhay/amazonka/tree/1.5.0) +fReleased: **15 November, 2017**, Compare: [1.4.5](https://github.com/brendanhay/amazonka/compare/1.4.5...1.5.0) + +### Fixed + +- V4 Signing Metadata is now correctly calculated for chunked request bodies. [\#403](https://github.com/brendanhay/amazonka/pull/403) +- DynamoDB Query/Scan pagination will correctly return all available items. [\#392](https://github.com/brendanhay/amazonka/pull/392) +- S3 `ReplicationStatus` is now parsed correctly. [\#372](https://github.com/brendanhay/amazonka/pull/372) +- OpsWorks `LayerAttributes` now correctly returns `Maybe` for `Map` values. [\#398](https://github.com/brendanhay/amazonka/pull/398) +- `newLogger` now (correctly) does not set binary mode for any passed handle. [\#381](https://github.com/brendanhay/amazonka/pull/381) +- Improved support for handling S3's `list-type=2` query strings. [\#391](https://github.com/brendanhay/amazonka/pull/391) +- Cabal files now have their `license-field` changed from `OtherLicense` to the correct `MPL-2.0`. + +### Added + +- Add AWS Signer for V2 Header Authentication. [\#383](https://github.com/brendanhay/amazonka/pull/383) +- Add support for ECS credentials discovery via the ECS container agent. [\#388](https://github.com/brendanhay/amazonka/pull/388) +- Add new regions `Montreal` (ca-central-1) and `London` (eu-west-2). [\#367](https://github.com/brendanhay/amazonka/pull/367) +- Add `hashedFileRange` and `chunkedFileRange` for preparing request bodies from file ranges. [\#359](https://github.com/brendanhay/amazonka/pull/359) + +### New Libraries + +- `amazonka-mobile`: Add and configure features for mobile apps, including authentication, data storage, backend logic, push notifications, content delivery, and analytics. [Overview](https://aws.amazon.com/mobile) +- `amazonka-pricing`: Price lists, pricing details, and pricing overview. [Overview](https://aws.amazon.com/pricing) +- `amazonka-athena`: An interactive query service that makes it easy to analyze data in Amazon S3 using standard SQL. [Overview](https://aws.amazon.com/athena) +- `amazonka-cloudhsmv2`: The newest (incompatible) API of AWS CloudHSM. [Overview](https://aws.amazon.com/cloudhsmv2) +- `amazonka-codestar`: Use a variety of project templates to start developing applications on Amazon EC2, AWS Lambda, and AWS Elastic Beanstalk. [Overview](https://aws.amazon.com/codestar) +- `amazonka-dynamodb-dax`: DynamoDB Accelerator (DAX) is a fully managed, highly available, in-memory cache for DynamoDB that delivers up to a 10x performance improvement. [Overview](https://aws.amazon.com/dynamodb/dax) +- `amazonka-glue`: A fully managed extract, transform, and load (ETL) service that makes it easy for customers to prepare and load their data for analytics. [Overview](https://aws.amazon.com/glue) +- `amazonka-greengrass`: Run local compute, messaging, data caching, and sync capabilities for connected devices in a secure way. [Overview](https://aws.amazon.com/greengrass) +- `amazonka-lex-runtime`: Build applications using a speech or text interface powered by the same technology that powers Amazon Alexa. [Overview](https://aws.amazon.com/lex) +- `amazonka-lex-models`: Build applications using a speech or text interface powered by the same technology that powers Amazon Alexa. [Overview](https://aws.amazon.com/lex) +- `amazonka-marketplace-entitlement`: Markplace entitlements service. [Overview](https://aws.amazon.com/marketplace) +- `amazonka-resourcegroupstagging`: Group and tag AWS resources. [Overview](https://docs.aws.amazon.com/resourcegroupstagging) + +### Updated Service Definitions + +> All service definitions and services have been updated and regenerated. +Please see each individual library's commits for a list of changes. + + ## [1.4.5](https://github.com/brendanhay/amazonka/tree/1.4.5) -Released: **04 December, 2016**, Compare: [1.4.5](https://github.com/brendanhay/amazonka/compare/1.4.4...1.4.5) +Released: **04 December, 2016**, Compare: [1.4.4](https://github.com/brendanhay/amazonka/compare/1.4.4...1.4.5) ### Fixed diff --git a/amazonka.cabal b/amazonka.cabal --- a/amazonka.cabal +++ b/amazonka.cabal @@ -1,13 +1,13 @@ name: amazonka -version: 1.4.5 +version: 1.5.0 synopsis: Comprehensive Amazon Web Services SDK. homepage: https://github.com/brendanhay/amazonka bug-reports: https://github.com/brendanhay/amazonka/issues -license: OtherLicense +license: MPL-2.0 license-file: LICENSE author: Brendan Hay -maintainer: Brendan Hay -copyright: Copyright (c) 2013-2016 Brendan Hay +maintainer: Brendan Hay +copyright: Copyright (c) 2013-2017 Brendan Hay category: Network, AWS, Cloud, Distributed Computing build-type: Simple extra-source-files: README.md CHANGELOG.md @@ -31,14 +31,19 @@ GHC 7.8.4 and higher is officially supported. source-repository head - type: git - location: git://github.com/brendanhay/amazonka.git + type: git + location: git://github.com/brendanhay/amazonka.git + subdir: amazonka library default-language: Haskell2010 hs-source-dirs: src - ghc-options: -Wall + ghc-options: + -Wall + -fwarn-incomplete-uni-patterns + -fwarn-incomplete-record-updates + -funbox-strict-fields exposed-modules: Control.Monad.Trans.AWS @@ -55,7 +60,7 @@ , Network.AWS.Internal.Logger build-depends: - amazonka-core == 1.4.5.* + amazonka-core == 1.5.0.* , base >= 4.7 && < 5 , bytestring >= 0.9 , conduit >= 1.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 @@ -14,9 +14,9 @@ -- | -- Module : Control.Monad.Trans.AWS --- Copyright : (c) 2013-2016 Brendan Hay +-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0. --- Maintainer : Brendan Hay +-- Maintainer : Brendan Hay -- Stability : provisional -- Portability : non-portable (GHC extensions) -- @@ -127,6 +127,12 @@ , trying , catching + -- ** Building Error Prisms + , Error._MatchServiceError + , Error.hasService + , Error.hasStatus + , Error.hasCode + -- * Logging -- $logging @@ -150,34 +156,37 @@ , RsBody ) where -import Control.Applicative -import Control.Monad.Base -import Control.Monad.Catch -import Control.Monad.Error.Class (MonadError (..)) -import Control.Monad.Morph -import Control.Monad.Reader -import Control.Monad.State.Class -import Control.Monad.Trans.Control -import Control.Monad.Trans.Resource -import Control.Monad.Writer.Class -import Data.Conduit hiding (await) -import Data.Conduit.Lazy (MonadActive (..)) -import Data.IORef -import Data.Monoid -import Network.AWS.Auth -import qualified Network.AWS.EC2.Metadata as EC2 -import Network.AWS.Env -import Network.AWS.Internal.Body -import Network.AWS.Internal.HTTP -import Network.AWS.Internal.Logger -import Network.AWS.Lens (catching, throwingM, trying, - view) -import Network.AWS.Pager (AWSPager (..)) -import Network.AWS.Prelude as AWS -import qualified Network.AWS.Presign as Sign -import Network.AWS.Request (requestURL) -import Network.AWS.Types hiding (LogLevel (..)) -import Network.AWS.Waiter (Accept, Wait) +import Control.Applicative +import Control.Monad.Base +import Control.Monad.Catch +import Control.Monad.Error.Class (MonadError (..)) +import Control.Monad.Morph +import Control.Monad.Reader +import Control.Monad.State.Class +import Control.Monad.Trans.Control +import Control.Monad.Trans.Resource +import Control.Monad.Writer.Class + +import Data.Conduit hiding (await) +import Data.Conduit.Lazy (MonadActive (..)) +import Data.IORef +import Data.Monoid + +import Network.AWS.Auth +import Network.AWS.Env +import Network.AWS.Internal.Body +import Network.AWS.Internal.HTTP +import Network.AWS.Internal.Logger +import Network.AWS.Lens (catching, throwingM, trying, view) +import Network.AWS.Pager (AWSPager (..)) +import Network.AWS.Prelude as AWS +import Network.AWS.Request (requestURL) +import Network.AWS.Types hiding (LogLevel (..)) +import Network.AWS.Waiter (Accept, Wait) + +import qualified Network.AWS.EC2.Metadata as EC2 +import qualified Network.AWS.Error as Error +import qualified Network.AWS.Presign as Sign type AWST = AWST' Env diff --git a/src/Network/AWS.hs b/src/Network/AWS.hs --- a/src/Network/AWS.hs +++ b/src/Network/AWS.hs @@ -6,9 +6,9 @@ -- | -- Module : Network.AWS --- Copyright : (c) 2013-2016 Brendan Hay +-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0. --- Maintainer : Brendan Hay +-- Maintainer : Brendan Hay -- Stability : provisional -- Portability : non-portable (GHC extensions) -- @@ -78,6 +78,7 @@ -- *** Request Bodies , ToHashedBody (..) , hashedFile + , hashedFileRange , hashedBody -- *** Chunked Request Bodies @@ -85,6 +86,7 @@ , ChunkSize (..) , defaultChunkSize , chunkedFile + , chunkedFileRange , unsafeChunkedBody -- *** Response Bodies @@ -123,6 +125,12 @@ , AWST.trying , AWST.catching + -- ** Building Error Prisms + , AWST._MatchServiceError + , AWST.hasService + , AWST.hasStatus + , AWST.hasCode + -- * Logging -- $logging @@ -146,39 +154,42 @@ , RsBody ) where -import Control.Applicative -import Control.Monad.Catch (MonadCatch) -import Control.Monad.IO.Class (MonadIO) -import Control.Monad.Morph (hoist) -import qualified Control.Monad.RWS.Lazy as LRW -import qualified Control.Monad.RWS.Strict as RW -import qualified Control.Monad.State.Lazy as LS -import qualified Control.Monad.State.Strict as S -import Control.Monad.Trans.AWS (AWST) -import qualified Control.Monad.Trans.AWS as AWST -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Identity (IdentityT) -import Control.Monad.Trans.List (ListT) -import Control.Monad.Trans.Maybe (MaybeT) -import Control.Monad.Trans.Reader (ReaderT) -import Control.Monad.Trans.Resource -import qualified Control.Monad.Writer.Lazy as LW -import qualified Control.Monad.Writer.Strict as W -import Data.Conduit (Source) -import Data.Monoid -import Network.AWS.Auth -import qualified Network.AWS.EC2.Metadata as EC2 -import Network.AWS.Env (Env, HasEnv (..), newEnv) -import qualified Network.AWS.Env as Env -import Network.AWS.Internal.Body -import Network.AWS.Internal.Logger -import Network.AWS.Lens ((^.)) -import Network.AWS.Pager (AWSPager) -import Network.AWS.Prelude -import Network.AWS.Types hiding (LogLevel (..)) -import Network.AWS.Waiter (Wait) +import Control.Applicative +import Control.Monad.Catch (MonadCatch) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.Morph (hoist) +import Control.Monad.Trans.AWS (AWST) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT) +import Control.Monad.Trans.Identity (IdentityT) +import Control.Monad.Trans.List (ListT) +import Control.Monad.Trans.Maybe (MaybeT) +import Control.Monad.Trans.Reader (ReaderT) +import Control.Monad.Trans.Resource +import Data.Conduit (Source) +import Data.Monoid + +import Network.AWS.Auth +import Network.AWS.Env (Env, HasEnv (..), newEnv) +import Network.AWS.Internal.Body +import Network.AWS.Internal.Logger +import Network.AWS.Lens ((^.)) +import Network.AWS.Pager (AWSPager) +import Network.AWS.Prelude +import Network.AWS.Types hiding (LogLevel (..)) +import Network.AWS.Waiter (Wait) + +import qualified Control.Monad.RWS.Lazy as LRW +import qualified Control.Monad.RWS.Strict as RW +import qualified Control.Monad.State.Lazy as LS +import qualified Control.Monad.State.Strict as S +import qualified Control.Monad.Trans.AWS as AWST +import qualified Control.Monad.Writer.Lazy as LW +import qualified Control.Monad.Writer.Strict as W +import qualified Network.AWS.EC2.Metadata as EC2 +import qualified Network.AWS.Env as Env + -- | A specialisation of the 'AWST' transformer. type AWS = AWST (ResourceT IO) @@ -331,8 +342,10 @@ -- 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': - body <- sourceFileIO "local\/path\/to\/object-payload" + -- The payload (and hash) for the S3 object is retrieved from a 'FilePath', + -- either 'hashedFile' or 'chunkedFile' can be used, with the latter ensuring + -- the contents of the file is enumerated exactly once, during send: + body <- chunkedFile defaultChunkSize "local\/path\/to\/object-payload" -- We now run the 'AWS' computation with the overriden logger, performing the -- 'PutObject' request. 'envRegion' or 'within' can be used to set the 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 @@ -3,12 +3,13 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} -- | -- Module : Network.AWS.Auth --- Copyright : (c) 2013-2016 Brendan Hay +-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0. --- Maintainer : Brendan Hay +-- Maintainer : Brendan Hay -- Stability : provisional -- Portability : non-portable (GHC extensions) -- @@ -23,7 +24,7 @@ -- ** Retrieving Authentication getAuth , Credentials (..) - , Auth + , Auth (..) -- ** Defaults -- *** Environment @@ -43,12 +44,14 @@ , fromKeys , fromSession + , fromTemporarySession , fromEnv , fromEnvKeys , fromFile , fromFilePath , fromProfile , fromProfileName + , fromContainer -- ** Keys , AccessKey (..) @@ -60,32 +63,36 @@ , AuthError (..) ) where -import Control.Applicative -import Control.Concurrent -import Control.Monad -import Control.Monad.Catch -import Control.Monad.IO.Class -import Control.Monad.Trans.Maybe (MaybeT (..)) +import Control.Concurrent +import Control.Monad +import Control.Monad.Catch +import Control.Monad.IO.Class +import Control.Monad.Trans.Maybe (MaybeT (..)) + +import Data.Char (isSpace) +import Data.IORef +import Data.Monoid +import Data.Time (diffUTCTime, getCurrentTime) + +import Network.AWS.Data.Log +import Network.AWS.Data.JSON +import Network.AWS.EC2.Metadata +import Network.AWS.Lens (catching, catching_, exception, throwingM, + _IOException) +import Network.AWS.Lens (Prism', prism, (<&>)) +import Network.AWS.Prelude +import Network.HTTP.Conduit + +import System.Directory (doesFileExist, getHomeDirectory) +import System.Environment +import System.Mem.Weak + import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy.Char8 as LBS8 -import Data.Char (isSpace) import qualified Data.Ini as INI -import Data.IORef -import Data.Monoid import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import Data.Time (diffUTCTime, getCurrentTime) -import Network.AWS.Data.Log -import Network.AWS.EC2.Metadata -import Network.AWS.Lens (catching, catching_, exception, - throwingM, _IOException) -import Network.AWS.Lens (Prism', prism, (<&>)) -import Network.AWS.Prelude -import Network.AWS.Types -import Network.HTTP.Conduit -import System.Directory (doesFileExist, getHomeDirectory) -import System.Environment -import System.Mem.Weak +import qualified Network.HTTP.Conduit as HTTP -- | Default access key environment variable. envAccessKey :: Text -- ^ AWS_ACCESS_KEY_ID @@ -107,6 +114,11 @@ envRegion :: Text -- ^ AWS_REGION envRegion = "AWS_REGION" +-- | Path to obtain container credentials environment variable (see +-- 'FromContainer'). +envContainerCredentialsURI :: Text -- ^ AWS_CONTAINER_CREDENTIALS_RELATIVE_URI +envContainerCredentialsURI = "AWS_CONTAINER_CREDENTIALS_RELATIVE_URI" + -- | Credentials INI file access key variable. credAccessKey :: Text -- ^ aws_access_key_id credAccessKey = "aws_access_key_id" @@ -150,12 +162,28 @@ -- | Explicit access and secret keys. fromKeys :: AccessKey -> SecretKey -> Auth -fromKeys a s = Auth (AuthEnv a s Nothing Nothing) +fromKeys a s = Auth (AuthEnv a (Sensitive s) Nothing Nothing) --- | A session containing the access key, secret key, and a session token. +-- | Temporary credentials from a STS session consisting of +-- the access key, secret key, and session token. +-- +-- /See:/ 'fromTemporarySession' fromSession :: AccessKey -> SecretKey -> SessionToken -> Auth -fromSession a s t = Auth (AuthEnv a s (Just t) Nothing) +fromSession a s t = + Auth (AuthEnv a (Sensitive s) (Just (Sensitive t)) Nothing) +-- | Temporary credentials from a STS session consisting of +-- the access key, secret key, session token, and expiration time. +-- +-- /See:/ 'fromSession' +fromTemporarySession :: AccessKey + -> SecretKey + -> SessionToken + -> UTCTime + -> Auth +fromTemporarySession a s t e = + Auth (AuthEnv a (Sensitive s) (Just (Sensitive t)) (Just (Time e))) + -- | Determines how AuthN/AuthZ information is retrieved. data Credentials = FromKeys AccessKey SecretKey @@ -177,6 +205,12 @@ -- ^ A credentials profile name (the INI section) and the path to the AWS -- file. + | FromContainer + -- ^ Obtain credentials by attempting to contact the ECS container agent + -- at using the path in 'envContainerCredentialsURI'. + -- See + -- in the AWS documentation for more information. + | Discover -- ^ Attempt credentials discovery via the following steps: -- @@ -184,6 +218,9 @@ -- -- * Read the credentials file if 'credFile' exists. -- + -- * Obtain credentials from the ECS container agent if + -- 'envContainerCredentialsURI' is set. + -- -- * Retrieve the first available IAM profile and read -- the 'Region' from the instance identity document, if running on EC2. -- @@ -205,6 +242,8 @@ "FromProfile " <> build n FromFile n f -> "FromFile " <> build n <> " " <> build f + FromContainer -> + "FromContainer" Discover -> "Discover" where @@ -310,19 +349,22 @@ FromEnv a s t r -> fromEnvKeys a s t r FromProfile n -> fromProfileName m n FromFile n f -> fromFilePath n f + FromContainer -> fromContainer m Discover -> -- Don't try and catch InvalidFileError, or InvalidIAMProfile, -- let both errors propagate. catching_ _MissingEnvError fromEnv $ -- proceed, missing env keys - catching _MissingFileError fromFile $ \f -> do + catching _MissingFileError fromFile $ \f -> -- proceed, missing credentials file - p <- isEC2 m - unless p $ - -- not an EC2 instance, rethrow the previous error. - throwingM _MissingFileError f - -- proceed, check EC2 metadata for IAM information. - fromProfile m + catching_ _MissingEnvError (fromContainer m) $ do + -- proceed, missing env key + p <- isEC2 m + unless p $ + -- not an EC2 instance, rethrow the previous error. + throwingM _MissingFileError f + -- proceed, check EC2 metadata for IAM information. + fromProfile m -- | Retrieve access key, secret key, and a session token from the default -- environment variables. @@ -355,8 +397,8 @@ where lookupKeys = AuthEnv <$> (req access <&> AccessKey . BS8.pack) - <*> (req secret <&> SecretKey . BS8.pack) - <*> (opt session <&> fmap (SessionToken . BS8.pack)) + <*> (req secret <&> Sensitive . SecretKey . BS8.pack) + <*> (opt session <&> fmap (Sensitive . SessionToken . BS8.pack)) <*> return Nothing lookupRegion :: (MonadIO m, MonadThrow m) => m (Maybe Region) @@ -405,8 +447,8 @@ ini <- either (invalidErr Nothing) return =<< liftIO (INI.readIniFile f) env <- AuthEnv <$> (req credAccessKey ini <&> AccessKey) - <*> (req credSecretKey ini <&> SecretKey) - <*> (opt credSessionToken ini <&> fmap SessionToken) + <*> (req credSecretKey ini <&> Sensitive . SecretKey) + <*> (opt credSessionToken ini <&> fmap (Sensitive . SessionToken)) <*> return Nothing return (Auth env, Nothing) where @@ -447,28 +489,31 @@ -- | Lookup a specific IAM Profile by name from the local EC2 instance-data. -- --- The resulting IONewRef wrapper + timer is designed so that multiple concurrent +-- Additionally starts a refresh thread for the given authentication environment. +-- +-- The resulting 'IORef' wrapper + timer is designed so that multiple concurrent -- accesses of 'AuthEnv' from the 'AWS' environment are not required to calculate -- expiry and sequentially queue to update it. -- -- The forked timer ensures a singular owner and pre-emptive refresh of the --- temporary session credentials. +-- temporary session credentials before expiration. -- -- A weak reference is used to ensure that the forked thread will eventually -- terminate when 'Auth' is no longer referenced. -- --- Throws 'RetrievalError' if the HTTP call fails, or 'InvalidIAMError' if --- the specified IAM profile cannot be read. +-- If no session token or expiration time is present the credentials will +-- be returned verbatim. +-- fromProfileName :: (MonadIO m, MonadCatch m) => Manager -> Text -> m (Auth, Maybe Region) fromProfileName m name = do - auth <- getCredentials >>= start + auth <- liftIO $ fetchAuthInBackground getCredentials reg <- getRegion return (auth, Just reg) where - getCredentials :: (MonadIO m, MonadCatch m) => m AuthEnv + getCredentials :: IO AuthEnv getCredentials = try (metadata m (IAM . SecurityCredentials $ Just name)) >>= handleErr (eitherDecode' . LBS8.fromStrict) invalidIAMErr @@ -489,26 +534,80 @@ . mappend "Error parsing Instance Identity Document " . Text.pack - start :: MonadIO m => AuthEnv -> m Auth - start !a = liftIO $ - case _authExpiry a of - Nothing -> return (Auth a) - Just x -> do - r <- newIORef a - p <- myThreadId - s <- timer r p x - return (Ref s r) +-- | Obtain credentials exposed to a task via the ECS container agent, as +-- described in the +-- section of the AWS ECS documentation. The credentials are obtained by making +-- a request to at the path contained by the +-- 'envContainerCredentialsURI' environment variable. +-- +-- The ECS container agent provides an access key, secret key, session token, +-- and expiration time, but it does not include a region, so the region will +-- attempt to be determined from the 'envRegion' environment variable if it is +-- set. +-- +-- Like 'fromProfileName', additionally starts a refresh thread that will +-- periodically fetch fresh credentials before the current ones expire. +-- +-- Throws 'MissingEnvError' if the 'envContainerCredentialsURI' environment +-- variable is not set or 'InvalidIAMError' if the payload returned by the ECS +-- container agent is not of the expected format. +fromContainer :: (MonadIO m, MonadThrow m) + => Manager + -> m (Auth, Maybe Region) +fromContainer m = do + req <- getCredentialsURI + auth <- liftIO $ fetchAuthInBackground (renew req) + reg <- getRegion + return (auth, reg) + where + getCredentialsURI :: (MonadIO m, MonadThrow m) => m HTTP.Request + getCredentialsURI = do + mp <- liftIO (lookupEnv (Text.unpack envContainerCredentialsURI)) + p <- maybe (throwM . MissingEnvError $ "Unable to read ENV variable: " <> envContainerCredentialsURI) + return + mp + parseUrlThrow $ "http://169.254.170.2" <> p - timer :: IORef AuthEnv -> ThreadId -> UTCTime -> IO ThreadId - timer !r !p !x = forkIO $ do + renew :: HTTP.Request -> IO AuthEnv + renew req = do + rs <- httpLbs req m + either (throwM . invalidIdentityErr) return (eitherDecode (responseBody rs)) + + invalidIdentityErr = InvalidIAMError + . mappend "Error parsing Task Identity Document " + . Text.pack + + getRegion :: MonadIO m => m (Maybe Region) + getRegion = runMaybeT $ do + mr <- MaybeT . liftIO $ lookupEnv (Text.unpack envRegion) + either (const . MaybeT $ return Nothing) + return + (fromText (Text.pack mr)) + +-- | Implements the background fetching behavior used by 'fromProfileName' and +-- 'fromContainer'. Given an 'IO' action that produces an 'AuthEnv', this spawns +-- a thread that mutates the 'IORef' returned in the resulting 'Auth' to keep +-- the temporary credentials up to date. +fetchAuthInBackground :: IO AuthEnv -> IO Auth +fetchAuthInBackground menv = menv >>= \(!env) -> liftIO $ + case _authExpiry env of + Nothing -> return (Auth env) + Just x -> do + r <- newIORef env + p <- myThreadId + s <- timer menv r p x + return (Ref s r) + where + timer :: IO AuthEnv -> IORef AuthEnv -> ThreadId -> ISO8601 -> IO ThreadId + timer ma !r !p !x = forkIO $ do s <- myThreadId w <- mkWeakIORef r (killThread s) - loop w p x + loop ma w p x - loop :: Weak (IORef AuthEnv) -> ThreadId -> UTCTime -> IO () - loop w !p !x = do + loop :: IO AuthEnv -> Weak (IORef AuthEnv) -> ThreadId -> ISO8601 -> IO () + loop ma w !p !x = do diff x <$> getCurrentTime >>= threadDelay - env <- try getCredentials + env <- try ma case env of Left e -> throwTo p (RetrievalError e) Right !a -> do @@ -517,8 +616,8 @@ Nothing -> return () Just r -> do atomicWriteIORef r a - maybe (return ()) (loop w p) (_authExpiry a) + maybe (return ()) (loop ma w p) (_authExpiry a) - diff !x !y = (* 1000000) $ if n > 0 then n else 1 + diff (Time !x) !y = (* 1000000) $ if n > 0 then n else 1 where !n = truncate (diffUTCTime x y) - 60 diff --git a/src/Network/AWS/Data.hs b/src/Network/AWS/Data.hs --- a/src/Network/AWS/Data.hs +++ b/src/Network/AWS/Data.hs @@ -1,8 +1,8 @@ -- | -- Module : Network.AWS.Data --- Copyright : (c) 2013-2016 Brendan Hay +-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0. --- Maintainer : Brendan Hay +-- Maintainer : Brendan Hay -- Stability : provisional -- Portability : non-portable (GHC extensions) -- 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 @@ -7,9 +7,9 @@ -- | -- Module : Network.AWS.EC2.Metadata --- Copyright : (c) 2013-2016 Brendan Hay +-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0. --- Maintainer : Brendan Hay +-- Maintainer : Brendan Hay -- Stability : provisional -- Portability : non-portable (GHC extensions) -- 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,15 +1,15 @@ {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} -- | -- Module : Network.AWS.Env --- Copyright : (c) 2013-2016 Brendan Hay +-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0. --- Maintainer : Brendan Hay +-- Maintainer : Brendan Hay -- Stability : provisional -- Portability : non-portable (GHC extensions) -- @@ -38,21 +38,23 @@ , retryConnectionFailure ) where -import Data.Maybe (fromMaybe) -import Control.Applicative -import Control.Monad.Catch -import Control.Monad.IO.Class -import Control.Monad.Reader -import Data.Function (on) -import Data.IORef -import Data.Monoid -import Network.AWS.Auth -import Network.AWS.Internal.Logger -import Network.AWS.Lens (Getter, Lens') -import Network.AWS.Lens (lens, to) -import Network.AWS.Lens ((.~), (<>~), (?~)) -import Network.AWS.Types -import Network.HTTP.Conduit +import Control.Applicative +import Control.Monad.Catch +import Control.Monad.IO.Class +import Control.Monad.Reader + +import Data.Function (on) +import Data.IORef +import Data.Maybe (fromMaybe) +import Data.Monoid + +import Network.AWS.Auth +import Network.AWS.Internal.Logger +import Network.AWS.Lens (Getter, Lens') +import Network.AWS.Lens (lens, to) +import Network.AWS.Lens ((.~), (<>~), (?~)) +import Network.AWS.Types +import Network.HTTP.Conduit -- | The environment containing the parameters required to make AWS requests. data Env = Env diff --git a/src/Network/AWS/Internal/Body.hs b/src/Network/AWS/Internal/Body.hs --- a/src/Network/AWS/Internal/Body.hs +++ b/src/Network/AWS/Internal/Body.hs @@ -1,10 +1,11 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ViewPatterns #-} -- | -- Module : Network.AWS.Internal.Body --- Copyright : (c) 2013-2016 Brendan Hay +-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0. --- Maintainer : Brendan Hay +-- Maintainer : Brendan Hay -- Stability : provisional -- Portability : non-portable (GHC extensions) -- @@ -23,11 +24,11 @@ -- | Convenience function for obtaining the size of a file. getFileSize :: MonadIO m => FilePath -> m Integer -getFileSize f = liftIO (withBinaryFile f ReadMode hFileSize) +getFileSize path = liftIO (withBinaryFile path ReadMode hFileSize) -- | Connect a 'Sink' to a response stream. sinkBody :: MonadResource m => RsBody -> Sink ByteString m a -> m a -sinkBody (RsBody s) sink = hoist liftResourceT s $$+- sink +sinkBody (RsBody body) sink = hoist liftResourceT body $$+- sink -- | Construct a 'HashedBody' from a 'FilePath', calculating the 'SHA256' hash -- and file size. @@ -37,40 +38,81 @@ -- lastly to stream the contents to the socket during sending. -- -- /See:/ 'ToHashedBody'. -hashedFile :: MonadIO m => FilePath -> m HashedBody -hashedFile f = liftIO $ HashedStream - <$> runResourceT (Conduit.sourceFile f $$ sinkSHA256) - <*> getFileSize f - <*> pure (Conduit.sourceFile f) +hashedFile :: MonadIO m + => FilePath -- ^ The file path to read. + -> m HashedBody +hashedFile path = + liftIO $ HashedStream + <$> runResourceT (Conduit.sourceFile path $$ sinkSHA256) + <*> getFileSize path + <*> pure (Conduit.sourceFile path) --- | Construct a 'HashedBody' from a source, manually specifying the --- 'SHA256' hash and file size. +-- | Construct a 'HashedBody' from a 'FilePath', specifying the range of bytes +-- to read. This can be useful for constructing multiple requests from a single +-- file, say for S3 multipart uploads. -- +-- /See:/ 'hashedFile', 'Conduit.sourceFileRange'. +hashedFileRange :: MonadIO m + => FilePath -- ^ The file path to read. + -> Integer -- ^ The byte offset at which to start reading. + -> Integer -- ^ The maximum number of bytes to read. + -> m HashedBody +hashedFileRange path (Just -> offset) (Just -> len) = + liftIO $ HashedStream + <$> runResourceT (Conduit.sourceFileRange path offset len $$ sinkSHA256) + <*> getFileSize path + <*> pure (Conduit.sourceFileRange path offset len) + +-- | Construct a 'HashedBody' from a 'Source', manually specifying the 'SHA256' +-- hash and file size. It's left up to the caller to calculate these correctly, +-- otherwise AWS will return signing errors. +-- -- /See:/ 'ToHashedBody'. -hashedBody :: Digest SHA256 - -> Integer +hashedBody :: Digest SHA256 -- ^ A SHA256 hash of the file contents. + -> Integer -- ^ The size of the stream in bytes. -> Source (ResourceT IO) ByteString -> HashedBody -hashedBody h n = HashedStream h n +hashedBody = HashedStream --- | Something something. +-- | Construct a 'ChunkedBody' from a 'FilePath', where the contents will be +-- read and signed incrementally in chunks if the target service supports it. -- -- Will intelligently revert to 'HashedBody' if the file is smaller than the -- specified 'ChunkSize'. -- --- Add note about how it selects chunk size. --- -- /See:/ 'ToBody'. chunkedFile :: MonadIO m => ChunkSize -> FilePath -> m RqBody -chunkedFile c f = do - n <- getFileSize f - if n > toInteger c - then return $ unsafeChunkedBody c n (sourceFileChunks c f) - else Hashed `liftM` hashedFile f +chunkedFile chunk path = do + size <- getFileSize path + if size > toInteger chunk + then return $ unsafeChunkedBody chunk size (sourceFileChunks chunk path) + else Hashed `liftM` hashedFile path --- | Something something. +-- | Construct a 'ChunkedBody' from a 'FilePath', specifying the range of bytes +-- to read. This can be useful for constructing multiple requests from a single +-- file, say for S3 multipart uploads. -- --- Marked as unsafe because it does nothing to enforce the chunk size. +-- /See:/ 'chunkedFile'. +chunkedFileRange :: MonadIO m + => ChunkSize + -- ^ The idealized size of chunks that will be yielded downstream. + -> FilePath + -- ^ The file path to read. + -> Integer + -- ^ The byte offset at which to start reading. + -> Integer + -- ^ The maximum number of bytes to read. + -> m RqBody +chunkedFileRange chunk path offset len = do + size <- getFileSize path + let n = min (size - offset) len + if n > toInteger chunk + then return $ unsafeChunkedBody chunk n (sourceFileRangeChunks chunk path offset len) + else Hashed `liftM` hashedFileRange path offset len + +-- | Unsafely construct a 'ChunkedBody'. +-- +-- This function is marked unsafe because it does nothing to enforce the chunk size. -- Typically for conduit 'IO' functions, it's whatever ByteString's -- 'defaultBufferSize' is, around 32 KB. If the chunk size is less than 8 KB, -- the request will error. 64 KB or higher chunk size is recommended for @@ -81,25 +123,55 @@ -- -- /See:/ 'ToBody'. unsafeChunkedBody :: ChunkSize + -- ^ The idealized size of chunks that will be yielded downstream. -> Integer + -- ^ The size of the stream in bytes. -> Source (ResourceT IO) ByteString -> RqBody -unsafeChunkedBody c n = Chunked . ChunkedBody c n +unsafeChunkedBody chunk size = Chunked . ChunkedBody chunk size --- Uses hGet with a specific buffer size, instead of hGetSome. sourceFileChunks :: MonadResource m => ChunkSize -> FilePath -> Source m ByteString -sourceFileChunks (ChunkSize sz) f = - bracketP (openBinaryFile f ReadMode) hClose go +sourceFileChunks (ChunkSize chunk) path = + bracketP (openBinaryFile path ReadMode) hClose go where - go h = do - bs <- liftIO (BS.hGet h sz) + -- Uses hGet with a specific buffer size, instead of hGetSome. + go hd = do + bs <- liftIO (BS.hGet hd chunk) unless (BS.null bs) $ do yield bs - go h + go hd +sourceFileRangeChunks :: MonadResource m + => ChunkSize + -- ^ The idealized size of chunks that will be yielded downstream. + -> FilePath + -- ^ The file path to read. + -> Integer + -- ^ The byte offset at which to start reading. + -> Integer + -- ^ The maximum number of bytes to read. + -> Source m ByteString +sourceFileRangeChunks (ChunkSize chunk) path offset len = + bracketP acquire hClose seek + where + acquire = openBinaryFile path ReadMode + seek hd = liftIO (hSeek hd AbsoluteSeek offset) >> go (fromIntegral len) hd + + go remainder hd + | remainder <= chunk = do + bs <- liftIO (BS.hGet hd remainder) + unless (BS.null bs) $ + yield bs + + | otherwise = do + bs <- liftIO (BS.hGet hd chunk) + unless (BS.null bs) $ do + yield bs + go (remainder - chunk) hd + -- | Incrementally calculate a 'MD5' 'Digest'. sinkMD5 :: Monad m => Consumer ByteString m (Digest MD5) sinkMD5 = sinkHash @@ -113,7 +185,7 @@ sinkHash = sink hashInit where sink ctx = do - b <- await - case b of + mbs <- await + case mbs of Nothing -> return $! hashFinalize ctx Just bs -> sink $! hashUpdate ctx bs diff --git a/src/Network/AWS/Internal/HTTP.hs b/src/Network/AWS/Internal/HTTP.hs --- a/src/Network/AWS/Internal/HTTP.hs +++ b/src/Network/AWS/Internal/HTTP.hs @@ -9,9 +9,9 @@ -- | -- Module : Network.AWS.Internal.HTTP --- Copyright : (c) 2013-2016 Brendan Hay +-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0. --- Maintainer : Brendan Hay +-- Maintainer : Brendan Hay -- Stability : provisional -- Portability : non-portable (GHC extensions) -- @@ -20,23 +20,25 @@ , waiter ) where -import Control.Arrow (first) -import Control.Monad -import Control.Monad.Catch -import Control.Monad.Reader -import Control.Monad.Trans.Resource -import Control.Retry -import Data.List (intersperse) -import Data.Monoid -import Data.Proxy -import Data.Time -import Network.AWS.Env -import Network.AWS.Internal.Logger -import Network.AWS.Lens ((%~), (&), (^.), (^?)) -import Network.AWS.Lens (to, view, _Just) -import Network.AWS.Prelude -import Network.AWS.Waiter -import Network.HTTP.Conduit hiding (Proxy, Request, Response) +import Control.Arrow (first) +import Control.Monad +import Control.Monad.Catch +import Control.Monad.Reader +import Control.Monad.Trans.Resource +import Control.Retry + +import Data.List (intersperse) +import Data.Monoid +import Data.Proxy +import Data.Time + +import Network.AWS.Env +import Network.AWS.Internal.Logger +import Network.AWS.Lens ((%~), (&), (^.), (^?)) +import Network.AWS.Lens (to, view, _Just) +import Network.AWS.Prelude +import Network.AWS.Waiter +import Network.HTTP.Conduit hiding (Proxy, Request, Response) retrier :: ( MonadCatch m , MonadResource m diff --git a/src/Network/AWS/Internal/Logger.hs b/src/Network/AWS/Internal/Logger.hs --- a/src/Network/AWS/Internal/Logger.hs +++ b/src/Network/AWS/Internal/Logger.hs @@ -2,9 +2,9 @@ -- | -- Module : Network.AWS.Internal.Logger --- Copyright : (c) 2013-2016 Brendan Hay +-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0. --- Maintainer : Brendan Hay +-- Maintainer : Brendan Hay -- Stability : provisional -- Portability : non-portable (GHC extensions) -- @@ -43,7 +43,6 @@ -- should be used in production code. newLogger :: MonadIO m => LogLevel -> Handle -> m Logger newLogger x hd = liftIO $ do - hSetBinaryMode hd True hSetBuffering hd LineBuffering return $ \y b -> when (x >= y) $ diff --git a/src/Network/AWS/Presign.hs b/src/Network/AWS/Presign.hs --- a/src/Network/AWS/Presign.hs +++ b/src/Network/AWS/Presign.hs @@ -2,9 +2,9 @@ -- | -- Module : Network.AWS.Presign --- Copyright : (c) 2013-2016 Brendan Hay +-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0. --- Maintainer : Brendan Hay +-- Maintainer : Brendan Hay -- Stability : provisional -- Portability : non-portable (GHC extensions) -- diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,7 +1,7 @@ -- Module : Main --- Copyright : (c) 2013-2016 Brendan Hay +-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0. --- Maintainer : Brendan Hay +-- Maintainer : Brendan Hay -- Stability : experimental -- Portability : non-portable (GHC extensions)