amazonka-core 0.0.3 → 0.0.4

raw patch · 8 files changed

+105/−58 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• amazonka-core.cabal +1/−1
• src/Network/AWS/Data/Internal/Query.hs +2/−2
• src/Network/AWS/Data/Internal/Time.hs +15/−3
• src/Network/AWS/Prelude.hs +0/−5
• src/Network/AWS/Signing/V2.hs +5/−4
• src/Network/AWS/Signing/V3.hs +3/−3
• src/Network/AWS/Signing/V4.hs +4/−7
• src/Network/AWS/Types.hs +75/−33

@@ -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

@@ -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 _

@@ -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

@@ -39,11 +39,6 @@     , Semigroup     , Whole -    -- * Endpoints-    , global-    , regional-    , custom-     -- * Shared     , Empty           (..)     , Service         (..)

@@ -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                 ]

@@ -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)

@@ -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"         ]

@@ -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