diff --git a/WORKSPACE b/WORKSPACE index 0a458f86d68..d0daf1bda86 100644 --- a/WORKSPACE +++ b/WORKSPACE @@ -14,7 +14,7 @@ exports_files(glob(["**/*.json"])) """, strip_prefix = "botocore-{version}/botocore/data", url = "https://github.com/boto/botocore/archive/{version}.tar.gz", - version = "3d570196b202407e61ff3125c57ba6d94f968cf2", + version = "d60c2e45b8e36f9c90faa1666fa7258fdc8c76a7", ) # diff --git a/gen/src/Gen/AST/Data.hs b/gen/src/Gen/AST/Data.hs index 82b66ffc162..f0a6cbc0bde 100644 --- a/gen/src/Gen/AST/Data.hs +++ b/gen/src/Gen/AST/Data.hs @@ -220,11 +220,11 @@ prodData m s st = (,fields) <$> mk -- Instance declarations which are generated from the Inst data type let insts = concat - [ shapeInsts (m ^. protocol) (s ^. relMode) [] - -- Handle the two oddballs that switch from Derive to - -- Inst halfway through generation. - , [ IsNFData [] | DNFData <- derives ] - , [ IsHashable [] | DHashable <- derives] + [ shapeInsts (m ^. protocol) (s ^. relMode) [], + -- Handle the two oddballs that switch from Derive to + -- Inst halfway through generation. + [IsNFData [] | DNFData <- derives], + [IsHashable [] | DHashable <- derives] ] instInsts <- for insts $ \inst -> pp None $ instD (instToQualifiedText inst) n Nothing diff --git a/gen/src/Gen/AST/Data/Syntax.hs b/gen/src/Gen/AST/Data/Syntax.hs index d873f07dc66..d81aa269087 100644 --- a/gen/src/Gen/AST/Data/Syntax.hs +++ b/gen/src/Gen/AST/Data/Syntax.hs @@ -216,6 +216,7 @@ serviceD m r = Exts.patBindWhere (pvar n) rhs bs field (unqual "Core._serviceEndpointPrefix") (m ^. endpointPrefix . Lens.to str), field (unqual "Core._serviceSigningName") (m ^. signingName . Lens.to str), field (unqual "Core._serviceVersion") (m ^. apiVersion . Lens.to str), + field (unqual "Core._serviceS3AddressingStyle") (var "Core.S3AddressingStyleAuto"), field (unqual "Core._serviceEndpoint") (Exts.app (var "Core.defaultEndpoint") (var n)), field (unqual "Core._serviceTimeout") (Exts.app justE (Exts.intE 70)), field (unqual "Core._serviceCheck") (var "Core.statusSuccess"), @@ -374,7 +375,8 @@ requestD c m h (a, as) (b, bs) = (identifier a) $ Just [ assocD (identifier a) "AWSResponse" (typeId (identifier b)), - funD "request" (requestF c m h a as), + funArgsD "service" ["_"] (var (m ^. serviceConfig)), + funArgsD "request" ["srv"] (requestF c m h a as), funD "response" (responseE (m ^. protocol) b bs) ] @@ -813,7 +815,7 @@ requestF c meta h r is = HashMap.lookup (identifier r) (c ^. operationPlugins) <|> HashMap.lookup (mkId "*") (c ^. operationPlugins) - e = Exts.app v (var n) + e = Exts.app v (var "srv") v = var @@ -838,7 +840,6 @@ requestF c meta h r is = m = h ^. method p = meta ^. protocol - n = meta ^. serviceConfig -- FIXME: take method into account for responses, such as HEAD etc, particuarly -- when the body might be totally empty. diff --git a/lib/amazonka-core/amazonka-core.cabal b/lib/amazonka-core/amazonka-core.cabal index 7e25043c300..a3126ff44aa 100644 --- a/lib/amazonka-core/amazonka-core.cabal +++ b/lib/amazonka-core/amazonka-core.cabal @@ -1,16 +1,16 @@ -cabal-version: 2.2 -name: amazonka-core -version: 2.0 -synopsis: Core data types and functionality for Amazonka libraries. -homepage: https://github.com/brendanhay/amazonka -bug-reports: https://github.com/brendanhay/amazonka/issues -license: MPL-2.0 -license-file: LICENSE -author: Brendan Hay -maintainer: Brendan Hay -copyright: Copyright (c) 2013-2021 Brendan Hay -category: AWS -build-type: Simple +cabal-version: 2.2 +name: amazonka-core +version: 2.0 +synopsis: Core data types and functionality for Amazonka libraries. +homepage: https://github.com/brendanhay/amazonka +bug-reports: https://github.com/brendanhay/amazonka/issues +license: MPL-2.0 +license-file: LICENSE +author: Brendan Hay +maintainer: Brendan Hay +copyright: Copyright (c) 2013-2021 Brendan Hay +category: AWS +build-type: Simple description: Core data types and serialisation primitives for Amazonka related Amazon Web Service SDKs. . @@ -99,22 +99,22 @@ library Amazonka.Waiter build-depends: - , aeson ^>=1.5.0.0 || >=2.0 && <2.2 + , aeson ^>=1.5.0.0 || >=2.0 && <2.1 || ^>=2.1 , attoparsec >=0.11.3 , bytestring >=0.10.8 , case-insensitive >=1.2 , conduit >=1.3 , conduit-extra >=1.3 - , containers >=0.5 && < 0.7 + , containers >=0.5 && <0.7 , cryptonite >=0.25 , deepseq >=1.4 , hashable >=1.2 - , http-client >=0.5 && <0.8 - , http-conduit >=2.3 && <3 + , http-client >=0.5 && <0.8 + , http-conduit >=2.3 && <3 , http-types >=0.12 , lens >=4.14 , memory >=0.6 - , mtl >=2.2 && <2.4 + , mtl >=2.2 && <2.4 , regex-posix >=0.96 , resourcet >=1.1 , scientific >=0.3 diff --git a/lib/amazonka-core/src/Amazonka/Request.hs b/lib/amazonka-core/src/Amazonka/Request.hs index 0e347795f08..3c9a36b46f8 100644 --- a/lib/amazonka-core/src/Amazonka/Request.hs +++ b/lib/amazonka-core/src/Amazonka/Request.hs @@ -42,7 +42,7 @@ module Amazonka.Request where import Amazonka.Core -import Amazonka.Lens ((%~), (.~)) +import Amazonka.Lens ((%~), (.~), (^.)) import Amazonka.Prelude import qualified Data.ByteString.Char8 as B8 import qualified Network.HTTP.Client as Client @@ -167,10 +167,19 @@ glacierVersionHeader version rq = rq {_requestHeaders = hdr "x-amz-glacier-version" version (_requestHeaders rq)} -- Rewrite a request to use virtual-hosted-style buckets where --- possible. A request to endpoint "s3.region.amazonaws.com" with --- path "/foo/bar" means "object bar in bucket foo". Rewrite it to --- endpoint "foo.s3.region.amazonaws.com" and path "/bar". +-- possible and requested. -- +-- Example: A request to endpoint "s3.region.amazonaws.com" with path +-- "/foo/bar" means "object bar in bucket foo". Rewrite it to endpoint +-- "foo.s3.region.amazonaws.com" and path "/bar". +-- +-- This is basically the logic in +-- https://github.com/boto/botocore/blob/04d1fae43b657952e49b21d16daa86378ddb4253/botocore/utils.py#L1922-L1941 +-- except that we can't tell if an endpoint has been overridden, as a +-- 'Request' contains a 'Service' after all overrides have been +-- applied. +-- +-- See: https://boto3.amazonaws.com/v1/documentation/api/1.9.42/guide/s3.html#changing-the-addressing-style -- See: https://docs.aws.amazon.com/AmazonS3/latest/userguide/VirtualHosting.html s3vhost :: Request a -> Request a s3vhost rq = case _requestPath rq of @@ -186,7 +195,12 @@ s3vhost rq = case _requestPath rq of | bucketNameLen < 3 || bucketNameLen > 63 = False | not $ bucketName =~ ("^[a-z0-9][a-z0-9\\-]*[a-z0-9]$" :: ByteString) = False | otherwise = True - in if rewritePossible + + doRewrite = case rq ^. requestService . serviceS3AddressingStyle of + S3AddressingStyleAuto -> rewritePossible + S3AddressingStylePath -> False + S3AddressingStyleVirtual -> True + in if doRewrite then rq & requestService . serviceEndpoint . endpointHost %~ ((bucketName <> ".") <>) diff --git a/lib/amazonka-core/src/Amazonka/Types.hs b/lib/amazonka-core/src/Amazonka/Types.hs index 0d85e95d22d..0fb8f346343 100644 --- a/lib/amazonka-core/src/Amazonka/Types.hs +++ b/lib/amazonka-core/src/Amazonka/Types.hs @@ -36,10 +36,12 @@ module Amazonka.Types Abbrev, Service (..), serviceSigner, + serviceS3AddressingStyle, serviceEndpoint, serviceTimeout, serviceCheck, serviceRetry, + S3AddressingStyle (..), -- * Requests AWSRequest (..), @@ -147,10 +149,10 @@ import Control.Monad.Trans.Resource (ResourceT) import Data.Conduit (ConduitM) import Data.IORef (IORef, readIORef) import qualified Data.Text as Text +import Data.Time (defaultTimeLocale, formatTime, parseTimeM) import qualified Network.HTTP.Client as Client import Network.HTTP.Types.Method (StdMethod) import Network.HTTP.Types.Status (Status) -import Data.Time (defaultTimeLocale, parseTimeM, formatTime) -- | A convenience alias to avoid type ambiguity. type ClientRequest = Client.Request @@ -447,6 +449,10 @@ data Service = Service _serviceSigner :: Signer, _serviceSigningName :: ByteString, _serviceVersion :: ByteString, + -- | Only service bindings using the s3vhost request plugin + -- (configured in the generator) will care about this field. It is + -- ignored otherwise. + _serviceS3AddressingStyle :: S3AddressingStyle, _serviceEndpointPrefix :: ByteString, _serviceEndpoint :: (Region -> Endpoint), _serviceTimeout :: (Maybe Seconds), @@ -456,9 +462,37 @@ data Service = Service } deriving stock (Generic) +-- | When to rewrite S3 requests into /virtual-hosted style/. +-- +-- Requests to S3 can be rewritten to access buckets by setting the +-- @Host:@ header, which allows you to point a @CNAME@ record at an +-- Amazon S3 Bucket. +-- +-- Non-S3 object stores usually do not support this, which is usually +-- the only time you'll need to change this. +-- +-- /See:/ [Virtual hosting of buckets](https://docs.aws.amazon.com/AmazonS3/latest/userguide/VirtualHosting.html) +-- in the Amazon S3 User Guide. +-- +-- /See:/ [Changing the Addressing Style](https://boto3.amazonaws.com/v1/documentation/api/1.9.42/guide/s3.html#changing-the-addressing-style) +-- for the corresponding option in Boto 3. +data S3AddressingStyle + = -- | Rewrite S3 request paths only if they can be expressed + -- as a DNS label. This is the default. + S3AddressingStyleAuto + | -- | Do not ever rewrite S3 request paths. + S3AddressingStylePath + | -- | Force virtual hosted style rewrites without checking the + -- bucket name. + S3AddressingStyleVirtual + deriving stock (Eq, Show, Generic) + serviceSigner :: Lens' Service Signer serviceSigner = Lens.lens _serviceSigner (\s a -> s {_serviceSigner = a}) +serviceS3AddressingStyle :: Lens' Service S3AddressingStyle +serviceS3AddressingStyle = Lens.lens _serviceS3AddressingStyle (\s a -> s {_serviceS3AddressingStyle = a}) + serviceEndpoint :: Setter' Service Endpoint serviceEndpoint = Lens.sets (\f s -> s {_serviceEndpoint = \r -> f (_serviceEndpoint s r)}) @@ -525,7 +559,12 @@ class AWSRequest a where -- | The successful, expected response associated with a request. type AWSResponse a :: * - request :: a -> Request a + -- | The AWS service where requests of this type are sent. Overrides + -- in an Amazonka @Env@ are applied during before assembly into a + -- 'Request'. + service :: Proxy a -> Service + + request :: Service -> a -> Request a response :: MonadResource m => Logger -> @@ -825,15 +864,16 @@ instance Hashable Seconds where hashWithSalt salt = hashWithSalt salt . toRational . toSeconds instance FromText Seconds where - fromText t = maybe (Left err) (Right . Seconds) - $ parseTimeM False defaultTimeLocale diffTimeFormatString str - where - str = Text.unpack t - err = - "Seconds value failed to parse as expected format (" - <> diffTimeFormatString - <> "): " - <> str + fromText t = + maybe (Left err) (Right . Seconds) $ + parseTimeM False defaultTimeLocale diffTimeFormatString str + where + str = Text.unpack t + err = + "Seconds value failed to parse as expected format (" + <> diffTimeFormatString + <> "): " + <> str instance ToText Seconds where toText = @@ -846,7 +886,6 @@ instance ToText Seconds where -- number of seconds, %Es omits the decimal point unless padding is specified." -- -- We also use 'defaultTimeLocale', which means @0.1@ and not @0,1@. --- diffTimeFormatString :: String diffTimeFormatString = "%Es" diff --git a/lib/amazonka-core/test/Test/Amazonka/Arbitrary.hs b/lib/amazonka-core/test/Test/Amazonka/Arbitrary.hs index 075b127a118..5ee7c040984 100644 --- a/lib/amazonka-core/test/Test/Amazonka/Arbitrary.hs +++ b/lib/amazonka-core/test/Test/Amazonka/Arbitrary.hs @@ -35,6 +35,7 @@ instance Arbitrary Service where _serviceSigner = v4, _serviceSigningName = Text.encodeUtf8 . Text.toLower $ toText abbrev, _serviceVersion = "2012-01-01", + _serviceS3AddressingStyle = S3AddressingStyleAuto, _serviceEndpointPrefix = Text.encodeUtf8 . Text.toLower $ toText abbrev, _serviceEndpoint = defaultEndpoint (svc abbrev), _serviceTimeout = Nothing, diff --git a/lib/amazonka-s3-encryption/amazonka-s3-encryption.cabal b/lib/amazonka-s3-encryption/amazonka-s3-encryption.cabal index 1790ecd46e7..67bfc5bd46c 100644 --- a/lib/amazonka-s3-encryption/amazonka-s3-encryption.cabal +++ b/lib/amazonka-s3-encryption/amazonka-s3-encryption.cabal @@ -91,7 +91,7 @@ library Amazonka.S3.Encryption.Types build-depends: - , aeson ^>=1.5.0.0 || >=2.0 && <2.2 + , aeson ^>=1.5.0.0 || >=2.0 && <2.1 || ^>=2.1 , amazonka ^>=2.0 , amazonka-core ^>=2.0 , amazonka-kms ^>=2.0 @@ -100,7 +100,7 @@ library , case-insensitive >=1.2 , conduit >=1.3 , cryptonite >=0.25 - , http-client >=0.5 && <0.8 + , http-client >=0.5 && <0.8 , lens >=4.14 , memory >=0.6 , mtl >=2.1.3.1 diff --git a/lib/amazonka-s3-encryption/src/Amazonka/S3/Encryption/Decrypt.hs b/lib/amazonka-s3-encryption/src/Amazonka/S3/Encryption/Decrypt.hs index 42ae9e5cc0f..84a926fffb8 100644 --- a/lib/amazonka-s3-encryption/src/Amazonka/S3/Encryption/Decrypt.hs +++ b/lib/amazonka-s3-encryption/src/Amazonka/S3/Encryption/Decrypt.hs @@ -31,7 +31,9 @@ newtype Decrypted a = Decrypted instance AWSRequest (Decrypt S3.GetObject) where type AWSResponse (Decrypt S3.GetObject) = Decrypted S3.GetObjectResponse - request (Decrypt x) = coerce (request x) + service _ = service (Proxy :: Proxy S3.GetObject) + + request srv (Decrypt x) = coerce (request srv x) response l s p r = Except.runExceptT $ do diff --git a/lib/amazonka-s3-encryption/src/Amazonka/S3/Encryption/Encrypt.hs b/lib/amazonka-s3-encryption/src/Amazonka/S3/Encryption/Encrypt.hs index 9000e3ca485..9006426c212 100644 --- a/lib/amazonka-s3-encryption/src/Amazonka/S3/Encryption/Encrypt.hs +++ b/lib/amazonka-s3-encryption/src/Amazonka/S3/Encryption/Encrypt.hs @@ -58,8 +58,10 @@ envelope = _encEnvelope instance AWSRequest a => AWSRequest (Encrypted a) where type AWSResponse (Encrypted a) = AWSResponse a - request (Encrypted x xs l e) = - coerce (request x) + service _ = service (Proxy :: Proxy a) + + request srv (Encrypted x xs l e) = + coerce (request srv x) & requestBody %~ f & requestHeaders <>~ hs where diff --git a/lib/amazonka-s3-encryption/src/Amazonka/S3/Encryption/Instructions.hs b/lib/amazonka-s3-encryption/src/Amazonka/S3/Encryption/Instructions.hs index f06247b2f42..02c576ae1a3 100644 --- a/lib/amazonka-s3-encryption/src/Amazonka/S3/Encryption/Instructions.hs +++ b/lib/amazonka-s3-encryption/src/Amazonka/S3/Encryption/Instructions.hs @@ -64,8 +64,10 @@ piExtension = Lens.lens _piExt (\s a -> s {_piExt = a}) instance AWSRequest PutInstructions where type AWSResponse PutInstructions = S3.PutObjectResponse - request x = - coerce . request $ + service _ = service (Proxy :: Proxy S3.PutObject) + + request srv x = + coerce . request srv $ _piPut x & S3.putObject_key %~ appendExtension (_piExt x) response s l _ = response s l (Proxy :: Proxy S3.PutObject) @@ -88,8 +90,10 @@ giExtension = Lens.lens _giExt (\s a -> s {_giExt = a}) instance AWSRequest GetInstructions where type AWSResponse GetInstructions = Instructions - request x = - coerce . request $ + service _ = service (Proxy :: Proxy S3.GetObject) + + request srv x = + coerce . request srv $ _giGet x & S3.getObject_key %~ appendExtension (_giExt x) response = @@ -129,8 +133,10 @@ diExtension = Lens.lens _diExt (\s a -> s {_diExt = a}) instance AWSRequest DeleteInstructions where type AWSResponse DeleteInstructions = S3.DeleteObjectResponse - request x = - coerce . request $ + service _ = service (Proxy :: Proxy S3.DeleteObject) + + request srv x = + coerce . request srv $ _diDelete x & S3.deleteObject_key %~ appendExtension (_diExt x) response s l _ = response s l (Proxy :: Proxy S3.DeleteObject) diff --git a/lib/amazonka-test/src/Test/Amazonka/Fixture.hs b/lib/amazonka-test/src/Test/Amazonka/Fixture.hs index e4cc499fced..7934a1b9aeb 100644 --- a/lib/amazonka-test/src/Test/Amazonka/Fixture.hs +++ b/lib/amazonka-test/src/Test/Amazonka/Fixture.hs @@ -52,6 +52,7 @@ res n f s p e = >>= assertDiff f e req :: + forall a. (AWSRequest a, Eq a, Show a) => TestName -> FilePath -> @@ -63,7 +64,8 @@ req n f e = testCase n $ do assertDiff f e' (first show a) where expected = do - let x = signedRequest (requestSign (request e) auth NorthVirginia time) + let srv = service (Proxy :: Proxy a) + x = signedRequest (requestSign (request srv e) auth NorthVirginia time) b <- sink (Client.requestBody x) return $! mkReq diff --git a/lib/amazonka/CHANGELOG.md b/lib/amazonka/CHANGELOG.md index 0f32ca14f63..fc650d30ec5 100644 --- a/lib/amazonka/CHANGELOG.md +++ b/lib/amazonka/CHANGELOG.md @@ -105,6 +105,8 @@ Released: **?**, Compare: [2.0.0-rc1](https://github.com/brendanhay/amazonka/com ### Fixed +- `amazonka-core`: Allow customisation of S3 addressing styles like Boto 3 can (thanks @basvandijk, @ivb-supercede) +[\#832](https://github.com/brendanhay/amazonka/pull/832) - `amazonka-core`: Correctly split error-codes-in-headers at the first colon [\#830](https://github.com/brendanhay/amazonka/pull/830) - `amazonka-core`: Correctly double-url-encode request paths when computing V4 signatures diff --git a/lib/amazonka/amazonka.cabal b/lib/amazonka/amazonka.cabal index b336c808eed..23b4ffc230f 100644 --- a/lib/amazonka/amazonka.cabal +++ b/lib/amazonka/amazonka.cabal @@ -97,7 +97,7 @@ library Amazonka.Data, Amazonka.Types, Amazonka.Bytes, Amazonka.Endpoint, Amazonka.Crypto build-depends: - , aeson ^>=1.5.0.0 || >=2.0 && <2.2 + , aeson ^>=1.5.0.0 || >=2.0 && <2.1 || ^>=2.1 , amazonka-core ^>=2.0 , amazonka-sso ^>=2.0 , amazonka-sts ^>=2.0 @@ -105,8 +105,8 @@ library , conduit >=1.3 , directory >=1.2 , exceptions ^>=0.10.4 - , http-client >=0.5 && <0.8 - , http-conduit >=2.3 && <3 + , http-client >=0.5 && <0.8 + , http-conduit >=2.3 && <3 , http-types >=0.12 , ini >=0.3.5 , lens >=4 @@ -116,4 +116,4 @@ library , time >=1.9 , transformers >=0.2 , unordered-containers ^>=0.2.14.0 - , uuid >=1.2.6 && <1.4 + , uuid >=1.2.6 && <1.4 diff --git a/lib/amazonka/src/Amazonka/Auth.hs b/lib/amazonka/src/Amazonka/Auth.hs index 7592641ab3b..65d13b95d87 100644 --- a/lib/amazonka/src/Amazonka/Auth.hs +++ b/lib/amazonka/src/Amazonka/Auth.hs @@ -64,7 +64,7 @@ import Amazonka.Auth.Keys (fromKeys, fromKeysEnv, fromSession, fromTemporarySess import Amazonka.Auth.SSO (fromSSO) import Amazonka.Auth.STS (fromAssumedRole, fromWebIdentity, fromWebIdentityEnv) import Amazonka.EC2.Metadata -import Amazonka.Env (Env, EnvNoAuth, Env' (..)) +import Amazonka.Env (Env, Env' (..), EnvNoAuth) import Amazonka.Lens (catching_) import Amazonka.Prelude import Amazonka.Types diff --git a/lib/amazonka/src/Amazonka/HTTP.hs b/lib/amazonka/src/Amazonka/HTTP.hs index 0413fb3a38d..4b8aa12cf9f 100644 --- a/lib/amazonka/src/Amazonka/HTTP.hs +++ b/lib/amazonka/src/Amazonka/HTTP.hs @@ -19,7 +19,7 @@ where import Amazonka.Data.Body (isStreaming) import Amazonka.Env -import Amazonka.Lens (to, (%~), (^.), (^?), _Just) +import Amazonka.Lens (to, (^.), (^?), _Just) import Amazonka.Logger import Amazonka.Prelude import Amazonka.Types @@ -154,10 +154,11 @@ httpRequest env@Env {..} x = proxy :: Request a -> Proxy a proxy _ = Proxy -configureRequest :: AWSRequest a => Env' withAuth -> a -> Request a +configureRequest :: forall a withAuth. (AWSRequest a) => Env' withAuth -> a -> Request a configureRequest env x = let overrides = envOverride env - in request x & requestService %~ appEndo (getDual overrides) + srv = appEndo (getDual overrides) $ service (Proxy :: Proxy a) + in request srv x retryStream :: Request a -> Retry.RetryPolicy retryStream x = diff --git a/lib/amazonka/src/Amazonka/Presign.hs b/lib/amazonka/src/Amazonka/Presign.hs index 2be4404a866..a7869ae530d 100644 --- a/lib/amazonka/src/Amazonka/Presign.hs +++ b/lib/amazonka/src/Amazonka/Presign.hs @@ -84,6 +84,7 @@ defaultHeaders = filter ((/= hExpect) . fst) -- | A variant of 'presign' that allows modifying the default 'Headers' -- and the default 'Service' definition used to configure the request. presignWithHeaders :: + forall a m. (MonadIO m, AWSRequest a) => -- | Modify the default headers. ([Header] -> [Header]) -> @@ -101,4 +102,6 @@ presignWithHeaders :: presignWithHeaders f g a r ts ex x = withAuth a $ \ae -> pure $! signedRequest $ - requestPresign ex (request x & requestHeaders %~ f & requestService %~ g) ae r ts + requestPresign ex (request srv x & requestHeaders %~ f) ae r ts + where + srv = g (service (Proxy :: Proxy a))