amazonka-core 0.2.1 → 0.2.2

raw patch · 11 files changed

+26/−116 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• amazonka-core.cabal +1/−2
• src/Network/AWS/Data/Internal/Base64.hs +1/−1
• src/Network/AWS/Data/Internal/List.hs +2/−2
• src/Network/AWS/Data/Internal/Map.hs +2/−2
• src/Network/AWS/Data/Internal/Numeric.hs +1/−0
• src/Network/AWS/Data/Internal/Sensitive.hs +2/−0
• src/Network/AWS/Data/Internal/Time.hs +3/−2
• src/Network/AWS/Response.hs +13/−20
• src/Network/AWS/Signing.hs +0/−4
• src/Network/AWS/Signing/Internal/V3.hs +0/−82
• src/Network/AWS/Types.hs +1/−1

@@ -1,5 +1,5 @@ name:                  amazonka-core-version:               0.2.1+version:               0.2.2 synopsis:              Core functionality and data types for Amazonka libraries. homepage:              https://github.com/brendanhay/amazonka license:               OtherLicense@@ -67,7 +67,6 @@         , Network.AWS.Request.Internal         , Network.AWS.Signing.Internal         , Network.AWS.Signing.Internal.V2-        , Network.AWS.Signing.Internal.V3         , Network.AWS.Signing.Internal.V4      build-depends:

@@ -29,7 +29,7 @@  -- | Base64 encoded binary data. newtype Base64 = Base64 { unBase64 :: ByteString }-    deriving (Eq, Ord, Generic)+    deriving (Eq, Read, Ord, Generic)  instance FromText Base64 where     parser = AText.takeText >>=

@@ -43,10 +43,10 @@ import           Text.XML  newtype List (e :: Symbol) a = List { list :: [a] }-    deriving (Eq, Ord, Show, Semigroup, Monoid)+    deriving (Eq, Ord, Read, Show, Semigroup, Monoid)  newtype List1 (e :: Symbol) a = List1 { list1 :: NonEmpty a }-    deriving (Eq, Ord, Show, Semigroup)+    deriving (Eq, Ord, Read, Show, Semigroup)  deriving instance Functor     (List1 e) deriving instance Foldable    (List1 e)

@@ -59,7 +59,7 @@  newtype Map k v = Map     { fromMap :: HashMap k v-    } deriving (Eq, Show, Monoid, Semigroup)+    } deriving (Eq, Read, Show, Monoid, Semigroup)  type role Map nominal representational @@ -102,7 +102,7 @@  newtype EMap (e :: Symbol) (i :: Symbol) (j :: Symbol) k v = EMap     { fromEMap :: HashMap k v-    } deriving (Eq, Show, Monoid, Semigroup)+    } deriving (Eq, Read, Show, Monoid, Semigroup)  type role EMap phantom phantom phantom nominal representational 

@@ -29,6 +29,7 @@     deriving         ( Eq         , Ord+        , Read         , Show         , Enum         , Num

@@ -21,10 +21,12 @@ import Network.AWS.Data.Internal.Text import Network.AWS.Data.Internal.XML +-- | read . show /= isomorphic newtype Sensitive a = Sensitive { desensitise :: a }     deriving         ( Eq         , Ord+        , Read         , IsString         , Monoid         , ToByteString

@@ -54,14 +54,15 @@     | BasicFormat     | AWSFormat     | POSIXFormat-      deriving (Eq, Show)+      deriving (Eq, Read, Show)  data Time :: Format -> * where     Time :: UTCTime -> Time a -deriving instance Show (Time a) deriving instance Eq   (Time a) deriving instance Ord  (Time a)+deriving instance Read (Time a)+deriving instance Show (Time a)  _Time :: Iso' (Time a) UTCTime _Time = iso (\(Time t) -> t) Time

@@ -48,9 +48,8 @@              -> Request a              -> Either HttpException ClientResponse              -> m (Response' a)-nullResponse rs _ = receive $ \_ _ bdy ->+nullResponse rs l = receive l $ \_ _ bdy ->     liftResourceT (bdy $$+- return (Right rs))-{-# INLINE nullResponse #-}  headerResponse :: (MonadResource m, AWSService (Sv a))                => (ResponseHeaders -> Either String (Rs a))@@ -59,7 +58,6 @@                -> Either HttpException ClientResponse                -> m (Response' a) headerResponse f = deserialise (const (Right ())) (const . f)-{-# INLINE headerResponse #-}  xmlResponse :: (MonadResource m, AWSService (Sv a), FromXML (Rs a))             => Logger@@ -67,7 +65,6 @@             -> Either HttpException ClientResponse             -> m (Response' a) xmlResponse = deserialise (decodeXML >=> parseXML) (const Right)-{-# INLINE xmlResponse #-}  xmlHeaderResponse :: (MonadResource m, AWSService (Sv a))                   => (ResponseHeaders -> [Node] -> Either String (Rs a))@@ -76,7 +73,6 @@                   -> Either HttpException ClientResponse                   -> m (Response' a) xmlHeaderResponse = deserialise decodeXML-{-# INLINE xmlHeaderResponse #-}  jsonResponse :: (MonadResource m, AWSService (Sv a), FromJSON (Rs a))              => Logger@@ -84,7 +80,6 @@              -> Either HttpException ClientResponse              -> m (Response' a) jsonResponse = deserialise eitherDecode' (const Right)-{-# INLINE jsonResponse #-}  jsonHeaderResponse :: (MonadResource m, AWSService (Sv a))                    => (ResponseHeaders -> Object -> Either String (Rs a))@@ -93,7 +88,6 @@                    -> Either HttpException ClientResponse                    -> m (Response' a) jsonHeaderResponse = deserialise eitherDecode'-{-# INLINE jsonHeaderResponse #-}  bodyResponse :: (MonadResource m, AWSService (Sv a))              => (ResponseHeaders -> ResponseBody -> Either String (Rs a))@@ -101,9 +95,8 @@              -> Request a              -> Either HttpException ClientResponse              -> m (Response' a)-bodyResponse f _ = receive $ \a hs bdy ->+bodyResponse f l = receive l $ \a hs bdy ->     return (SerializerError a `first` f hs bdy)-{-# INLINE bodyResponse #-}  deserialise :: (AWSService (Sv a), MonadResource m)             => (LazyByteString -> Either String b)@@ -112,30 +105,29 @@             -> Request a             -> Either HttpException ClientResponse             -> m (Response' a)-deserialise g f l = receive $ \a hs bdy -> do-    lbs <- sinkLbs bdy-    liftIO $ l Trace ("[Client Response Body]\n" <> build lbs)+deserialise g f l = receive l $ \a hs bdy -> do+    lbs <- sinkLbs l bdy     return $! case g lbs of         Left  e -> Left (SerializerError a e)         Right o ->             case f hs o of                 Left  e -> Left (SerializerError a e)                 Right x -> Right x-{-# INLINE deserialise #-}  receive :: forall m a. (MonadResource m, AWSService (Sv a))-        => (Abbrev -> ResponseHeaders -> ResponseBody -> m (Response a))+        => Logger+        -> (Abbrev -> ResponseHeaders -> ResponseBody -> m (Response a))         -> Request a         -> Either HttpException ClientResponse         -> m (Response' a)-receive f = const (either (return . Left . HttpError) success)+receive l f = const (either (return . Left . HttpError) success)   where     success rs = do         let s   = responseStatus  rs             bdy = responseBody    rs             hs  = responseHeaders rs         case _svcHandle svc s of-            Just g  -> Left . g <$> sinkLbs bdy+            Just g  -> Left . g <$> sinkLbs l bdy             Nothing -> do                 x <- f (_svcAbbrev svc) hs bdy                 case x of@@ -143,8 +135,9 @@                     Right y -> return (Right (s, y))      svc = service :: Service (Sv a)-{-# INLINE receive #-} -sinkLbs :: MonadResource m => ResponseBody -> m LBS.ByteString-sinkLbs bdy = liftResourceT (bdy $$+- Conduit.sinkLbs)-{-# INLINE sinkLbs #-}+sinkLbs :: MonadResource m => Logger -> ResponseBody -> m LBS.ByteString+sinkLbs l bdy = do+    lbs <- liftResourceT (bdy $$+- Conduit.sinkLbs)+    liftIO $ l Trace ("[Client Response Body] {\n" <> build lbs <> "\n}")+    return lbs

@@ -18,9 +18,6 @@     -- * Version 2       V2 -    -- * Version 3-    , V3-     -- * Version 4     , V4 @@ -31,5 +28,4 @@  import Network.AWS.Signing.Internal import Network.AWS.Signing.Internal.V2-import Network.AWS.Signing.Internal.V3 import Network.AWS.Signing.Internal.V4

@@ -1,82 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TupleSections     #-}-{-# LANGUAGE TypeFamilies      #-}---- Module      : Network.AWS.Signing.Internal.V3--- Copyright   : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>--- License     : This Source Code Form is subject to the terms of---               the Mozilla Public License, v. 2.0.---               A copy of the MPL can be found in the LICENSE file or---               you can obtain it at http://mozilla.org/MPL/2.0/.--- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : experimental--- Portability : non-portable (GHC extensions)--module Network.AWS.Signing.Internal.V3-    ( V3-    ) where--import           Control.Applicative-import           Control.Lens-import           Data.ByteString              (ByteString)-import qualified Data.ByteString.Base64       as Base64-import           Data.List                    (sortBy, intersperse)-import           Data.Maybe-import           Data.Monoid-import           Data.Ord-import           Data.Time-import           Network.AWS.Data-import           Network.AWS.Request.Internal-import           Network.AWS.Signing.Internal-import           Network.AWS.Types-import           Network.HTTP.Types.Header--data V3--data instance Meta V3 = Meta-    { _mSignature :: ByteString-    , _mTime      :: UTCTime-    }--instance ToBuilder (Meta V3) where-    build Meta{..} = mconcat $ intersperse "\n"-        [ "[Version 3 Metadata] {"-        , "  signature = " <> build _mSignature-        , "  time      = " <> build _mTime-        , "}"-        ]--instance AWSSigner V3 where-    signed AuthEnv{..} r x@Request{..} t = Signed meta rq-      where-        meta = Meta-            { _mSignature = signature-            , _mTime      = t-            }--        rq = clientRequest-            & method         .~ toBS _rqMethod-            & host           .~ _endpointHost-            & path           .~ _rqPath-            & queryString    .~ toBS _rqQuery-            & requestHeaders .~ headers-            & requestBody    .~ _bdyBody _rqBody--        Endpoint{..} = endpoint (serviceOf x) r--        headers = sortBy (comparing fst)-            . hdr hAMZAuth authorisation-            . hdr hHost _endpointHost-            . hdr hDate (toBS (Time t :: RFC822))-            $ _rqHeaders-                ++ maybeToList ((hAMZToken,) . toBS <$> _authToken)--        authorisation = "AWS3-HTTPS AWSAccessKeyId="-            <> toBS _authAccess-            <> ", Algorithm=HmacSHA256, Signature="-            <> signature--        signature = Base64.encode-            $ hmacSHA256 (toBS _authSecret) (toBS (Time t :: AWSTime))

@@ -320,7 +320,7 @@             | virginia  -> global "rds.amazonaws.com"          "route53"-            | not china -> region "route53.amazonaws.com"+            | not china -> global "route53.amazonaws.com"          "emr"             | virginia  -> global "elasticmapreduce.us-east-1.amazonaws.com"