diff --git a/amazonka-core.cabal b/amazonka-core.cabal --- a/amazonka-core.cabal +++ b/amazonka-core.cabal @@ -1,5 +1,5 @@ name: amazonka-core -version: 0.0.3 +version: 0.0.4 synopsis: Core functionality, serialisation primitives, and data types for the Amazonka Amazon Web Services SDKs. homepage: https://github.com/brendanhay/amazonka license: OtherLicense diff --git a/src/Network/AWS/Data/Internal/Query.hs b/src/Network/AWS/Data/Internal/Query.hs --- a/src/Network/AWS/Data/Internal/Query.hs +++ b/src/Network/AWS/Data/Internal/Query.hs @@ -88,10 +88,10 @@ renderQuery = intercalate . sort . enc Nothing where enc k (List xs) = concatMap (enc k) xs - enc k (Pair (urlEncode False -> k') x) + enc k (Pair (urlEncode True -> k') x) | Just n <- k = enc (Just $ n <> "." <> k') x | otherwise = enc (Just k') x - enc k (Value (Just (urlEncode False -> v))) + enc k (Value (Just (urlEncode True -> v))) | Just n <- k = [n <> vsep <> v] | otherwise = [v] enc k _ diff --git a/src/Network/AWS/Data/Internal/Time.hs b/src/Network/AWS/Data/Internal/Time.hs --- a/src/Network/AWS/Data/Internal/Time.hs +++ b/src/Network/AWS/Data/Internal/Time.hs @@ -70,13 +70,19 @@ ts (Time t) = (t, defaultTimeLocale) ts (LocaleTime l t) = (t, l) - -- | This is a poorly behaved isomorphism, due to the fact 'LocaleTime' only -- exists for testing purposes, and we wish to compose using 'mapping' -- in actual usage. +-- +-- /See:/ 'convert'. _Time :: Iso' (Time a) UTCTime _Time = iso (\case; Time a -> a; LocaleTime _ a -> a) Time +-- | Safely convert between two 'Time's, unlike the '_Time' isomorphism. +convert :: Time a -> Time b +convert (Time t) = Time t +convert (LocaleTime l t) = LocaleTime l t + type RFC822 = Time RFC822Format type ISO8601 = Time ISO8601Format type BasicTime = Time BasicFormat @@ -91,10 +97,16 @@ instance TimeFormat BasicTime where format = Tagged "%Y%m%d" instance TimeFormat AWSTime where format = Tagged "%Y%m%dT%H%M%SZ" -instance FromText RFC822 where parser = parseFormattedTime -instance FromText ISO8601 where parser = parseFormattedTime instance FromText BasicTime where parser = parseFormattedTime instance FromText AWSTime where parser = parseFormattedTime + +instance FromText RFC822 where + parser = (convert :: ISO8601 -> RFC822) <$> parseFormattedTime + <|> parseFormattedTime + +instance FromText ISO8601 where + parser = (convert :: RFC822 -> ISO8601) <$> parseFormattedTime + <|> parseFormattedTime instance FromText POSIX where parser = Time . posixSecondsToUTCTime . realToFrac diff --git a/src/Network/AWS/Prelude.hs b/src/Network/AWS/Prelude.hs --- a/src/Network/AWS/Prelude.hs +++ b/src/Network/AWS/Prelude.hs @@ -39,11 +39,6 @@ , Semigroup , Whole - -- * Endpoints - , global - , regional - , custom - -- * Shared , Empty (..) , Service (..) diff --git a/src/Network/AWS/Signing/V2.hs b/src/Network/AWS/Signing/V2.hs --- a/src/Network/AWS/Signing/V2.hs +++ b/src/Network/AWS/Signing/V2.hs @@ -61,22 +61,23 @@ rq = clientRequest & method .~ meth - & host .~ host' + & host .~ _endpointHost & path .~ _rqPath & queryString .~ toBS authorised & requestHeaders .~ headers & requestBody .~ _bdyBody _rqBody - meth = toBS _rqMethod - host' = toBS (endpoint svc r) + meth = toBS _rqMethod + Endpoint{..} = endpoint svc r + authorised = pair "Signature" (urlEncode True signature) query signature = Base64.encode . hmacSHA256 (toBS _authSecret) $ BS.intercalate "\n" [ meth - , host' + , _endpointHost , _rqPath , toBS query ] diff --git a/src/Network/AWS/Signing/V3.hs b/src/Network/AWS/Signing/V3.hs --- a/src/Network/AWS/Signing/V3.hs +++ b/src/Network/AWS/Signing/V3.hs @@ -64,17 +64,17 @@ rq = clientRequest & method .~ toBS _rqMethod - & host .~ host' + & host .~ _endpointHost & path .~ _rqPath & queryString .~ toBS _rqQuery & requestHeaders .~ headers & requestBody .~ _bdyBody _rqBody - host' = toBS (endpoint (serviceOf x) r) + Endpoint{..} = endpoint (serviceOf x) r headers = sortBy (comparing fst) . hdr hAMZAuth authorisation - . hdr hHost host' + . hdr hHost _endpointHost . hdr hDate (toBS (LocaleTime l t :: RFC822)) $ _rqHeaders ++ maybeToList ((hAMZToken,) . toBS <$> _authToken) diff --git a/src/Network/AWS/Signing/V4.hs b/src/Network/AWS/Signing/V4.hs --- a/src/Network/AWS/Signing/V4.hs +++ b/src/Network/AWS/Signing/V4.hs @@ -32,7 +32,6 @@ import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BS import qualified Data.CaseInsensitive as CI -import Data.Default.Class import qualified Data.Foldable as Fold import Data.Function import Data.List (groupBy, intersperse, sortBy, sort) @@ -137,23 +136,21 @@ rq = clientRequest & method .~ meth - & host .~ host' + & host .~ _endpointHost & path .~ _rqPath & queryString .~ toBS query & requestHeaders .~ headers & requestBody .~ _bdyBody _rqBody meth = toBS _rqMethod - host' = toBS (endpoint s r) query = qry credentialScope signedHeaders _rqQuery - region | isGlobal s = def - | otherwise = r + Endpoint{..} = endpoint s r canonicalQuery = toBS (query & valuesOf %~ Just . fromMaybe "") headers = sortBy (comparing fst) - . hdr hHost host' + . hdr hHost _endpointHost . hdr hAMZDate (toBS (LocaleTime l t :: AWSTime)) $ _rqHeaders @@ -187,7 +184,7 @@ scope = [ toBS (LocaleTime l t :: BasicTime) - , toBS region + , toBS _endpointScope , toBS _svcPrefix , "aws4_request" ] diff --git a/src/Network/AWS/Types.hs b/src/Network/AWS/Types.hs --- a/src/Network/AWS/Types.hs +++ b/src/Network/AWS/Types.hs @@ -46,12 +46,7 @@ -- * Endpoints , Endpoint (..) - , Host (..) , endpoint - , global - , regional - , custom - , isGlobal -- * Errors , ServiceError (..) @@ -110,9 +105,13 @@ import Data.Aeson hiding (Error) import qualified Data.Attoparsec.Text as AText import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.CaseInsensitive as CI import Data.Char import Data.Conduit import Data.Default.Class +import qualified Data.HashSet as Set +import Data.Hashable import Data.IORef import Data.Monoid import Data.String @@ -308,45 +307,86 @@ debug None = const (return ()) debug (Debug f) = liftIO . f -newtype Host = Host ByteString - deriving (Eq, Show) +data Endpoint = Endpoint + { _endpointHost :: ByteString + , _endpointScope :: ByteString + } deriving (Eq, Show) -instance ToByteString Host where - toBS (Host h) = h +-- | Determine the full host address and credential scope for a 'Service' within +-- the specified 'Region'. +endpoint :: Service a -> Region -> Endpoint +endpoint Service{..} r = go (CI.mk _svcPrefix) + where + go = \case + "iam" + | china -> region "iam.cn-north-1.amazonaws.com.cn" + | govcloud -> region "iam.us-gov.amazonaws.com" + | otherwise -> global "iam.amazonaws.com" --- | The scope for a service's endpoint. -data Endpoint - = Global - | Regional - | Custom ByteString - deriving (Eq) + "sdb" + | virginia -> region "sdb.amazonaws.com" -instance IsString Endpoint where - fromString = Custom . fromString + "sts" + | china -> region "sts.cn-north-1.amazonaws.com.cn" + | govcloud -> region ("sts." <> reg <> ".amazonaws.com") + | otherwise -> global "sts.amazonaws.com" --- | Determine the full host address for a 'Service within the given 'Region'. -endpoint :: Service a -> Region -> Host -endpoint Service{..} reg = - let suf = ".amazonaws.com" - in Host $ case _svcEndpoint of - Global -> _svcPrefix <> suf - Regional -> _svcPrefix <> "." <> toBS reg <> suf - Custom x -> x + "s3" + | virginia -> global "s3.amazonaws.com" + | china -> region ("s3." <> reg <> ".amazonaws.com.cn") + | s3 -> region ("s3-" <> reg <> ".amazonaws.com") -global, regional :: Endpoint -global = Global -regional = Regional + "rds" + | virginia -> global "rds.amazonaws.com" -custom :: ByteString -> Endpoint -custom = Custom + "route53" + | not china -> region "route53.amazonaws.com" -isGlobal :: Service a -> Bool -isGlobal = (== Global) . _svcEndpoint + "emr" + | virginia -> global "elasticmapreduce.us-east-1.amazonaws.com" + | otherwise -> region (reg <> ".elasticmapreduce.amazonaws.com") + "sqs" + | virginia -> global "queue.amazonaws.com" + | china -> region (reg <> ".queue.amazonaws.com.cn") + + "importexport" + | not china -> region "importexport.amazonaws.com" + + "cloudfront" + | not china -> global "cloudfront.amazonaws.com" + + _ | china -> region (_svcPrefix <> "." <> reg <> ".amazonaws.com.cn") + | otherwise -> region (_svcPrefix <> "." <> reg <> ".amazonaws.com") + + virginia = r == NorthVirginia + + s3 = r `Set.member` except + + govcloud = "us-gov" `BS.isPrefixOf` reg + china = "cn-" `BS.isPrefixOf` reg + + region h = Endpoint { _endpointHost = h, _endpointScope = reg } + global h = Endpoint { _endpointHost = h, _endpointScope = "us-east-1" } + + reg = toBS r + + except = Set.fromList + [ GovCloud + , GovCloudFIPS + , Ireland + , NorthCalifornia + , NorthVirginia + , Oregon + , SaoPaulo + , Singapore + , Sydney + , Tokyo + ] + -- | Attributes specific to an AWS service. data Service a = Service { _svcAbbrev :: !Text - , _svcEndpoint :: !Endpoint , _svcPrefix :: ByteString , _svcVersion :: ByteString , _svcTargetPrefix :: Maybe ByteString @@ -390,6 +430,8 @@ | GovCloudFIPS -- ^ AWS GovCloud (FIPS 140-2) S3 Only / fips-us-gov-west-1 | SaoPaulo -- ^ South America / sa-east-1 deriving (Eq, Ord, Read, Show, Generic) + +instance Hashable Region instance Default Region where def = NorthVirginia