amazonka-core 1.4.5 → 1.5.0
raw patch · 48 files changed
+1192/−259 lines, 48 filesdep +data-ordlistdep ~QuickCheckdep ~bytestringdep ~conduitPVP ok
version bump matches the API change (PVP)
Dependencies added: data-ordlist
Dependency ranges changed: QuickCheck, bytestring, conduit, http-conduit, lens
API changes (from Hackage documentation)
- Network.AWS.Data.Map: instance (GHC.Classes.Eq k, Data.Data.Data k, Data.Data.Data v, Data.Hashable.Class.Hashable k) => Data.Data.Data (Network.AWS.Data.Map.Map k v)
- Network.AWS.Data.Map: instance (GHC.Classes.Eq k, Data.Hashable.Class.Hashable k) => Data.Semigroup.Semigroup (Network.AWS.Data.Map.Map k v)
- Network.AWS.Data.Map: instance (GHC.Classes.Eq k, Data.Hashable.Class.Hashable k) => GHC.Base.Monoid (Network.AWS.Data.Map.Map k v)
- Network.AWS.Data.Map: instance (GHC.Classes.Eq k, GHC.Classes.Eq v) => GHC.Classes.Eq (Network.AWS.Data.Map.Map k v)
- Network.AWS.Data.Map: instance (GHC.Classes.Eq k, GHC.Read.Read k, GHC.Read.Read v, Data.Hashable.Class.Hashable k) => GHC.Read.Read (Network.AWS.Data.Map.Map k v)
- Network.AWS.Data.Map: instance (GHC.Show.Show k, GHC.Show.Show v) => GHC.Show.Show (Network.AWS.Data.Map.Map k v)
- Network.AWS.Data.Sensitive: instance GHC.Read.Read a => GHC.Read.Read (Network.AWS.Data.Sensitive.Sensitive a)
- Network.AWS.Data.XML: toXMLNodes :: ToXML a => a -> [Node]
- Network.AWS.Data.XML: withElement :: Text -> ([Node] -> Either String a) -> [Node] -> Either String a
- Network.AWS.Pager: instance Network.AWS.Pager.AWSTruncated (GHC.Base.Maybe Data.Text.Internal.Text)
- Network.AWS.Pager: instance Network.AWS.Pager.AWSTruncated (GHC.Base.Maybe GHC.Types.Int)
- Network.AWS.Waiter: nonEmpty :: Fold a Text -> Fold a Bool
+ Network.AWS.Data.Crypto: hmacSHA1 :: (ByteArrayAccess a, ByteArray b) => a -> b -> HMAC SHA1
+ Network.AWS.Data.Map: instance (Data.Hashable.Class.Hashable k, GHC.Classes.Eq k) => Data.Semigroup.Semigroup (Network.AWS.Data.Map.Map k v)
+ Network.AWS.Data.Map: instance (Data.Hashable.Class.Hashable k, GHC.Classes.Eq k) => GHC.Base.Monoid (Network.AWS.Data.Map.Map k v)
+ Network.AWS.Data.Map: instance (Data.Hashable.Class.Hashable k, GHC.Classes.Eq k, Data.Data.Data v, Data.Data.Data k) => Data.Data.Data (Network.AWS.Data.Map.Map k v)
+ Network.AWS.Data.Map: instance (GHC.Classes.Eq v, GHC.Classes.Eq k) => GHC.Classes.Eq (Network.AWS.Data.Map.Map k v)
+ Network.AWS.Data.Map: instance (GHC.Read.Read v, GHC.Read.Read k, Data.Hashable.Class.Hashable k, GHC.Classes.Eq k) => GHC.Read.Read (Network.AWS.Data.Map.Map k v)
+ Network.AWS.Data.Map: instance (GHC.Show.Show v, GHC.Show.Show k) => GHC.Show.Show (Network.AWS.Data.Map.Map k v)
+ Network.AWS.Data.Query: parseQueryString :: ByteString -> QueryString
+ Network.AWS.Data.Sensitive: instance Network.AWS.Data.Headers.ToHeader a => Network.AWS.Data.Headers.ToHeader (Network.AWS.Data.Sensitive.Sensitive a)
+ Network.AWS.Data.Sensitive: instance Network.AWS.Data.Log.ToLog (Network.AWS.Data.Sensitive.Sensitive a)
+ Network.AWS.Data.Time: instance Network.AWS.Data.Query.ToQuery Network.AWS.Data.Time.POSIX
+ Network.AWS.Data.XML: (@@=) :: ToText a => Name -> a -> XML
+ Network.AWS.Data.XML: XAttr :: Name -> Text -> XML
+ Network.AWS.Data.XML: childrenOf :: Element -> [Node]
+ Network.AWS.Data.XML: listXMLAttributes :: XML -> [(Name, Text)]
+ Network.AWS.Error: _MatchServiceError :: AsError a => Service -> ErrorCode -> Getting (First ServiceError) a ServiceError
+ Network.AWS.Error: hasService :: (Applicative f, Choice p) => Service -> Optic' p f ServiceError ServiceError
+ Network.AWS.Pager: instance Network.AWS.Pager.AWSTruncated (GHC.Base.Maybe a)
+ Network.AWS.Sign.V2Header: instance Network.AWS.Data.Log.ToLog Network.AWS.Sign.V2Header.V2Header
+ Network.AWS.Sign.V2Header: v2Header :: Signer
+ Network.AWS.Sign.V2Header.Base: constructFullPath :: ByteString -> ByteString -> ByteString
+ Network.AWS.Sign.V2Header.Base: constructSigningHeader :: Header -> ByteString
+ Network.AWS.Sign.V2Header.Base: constructSigningQuery :: QueryString -> QueryString
+ Network.AWS.Sign.V2Header.Base: newSigner :: RequestHeaders -> ByteString -> ByteString -> QueryString -> ByteString
+ Network.AWS.Sign.V2Header.Base: toSignerQueryBS :: QueryString -> ByteString
+ Network.AWS.Sign.V2Header.Base: unionNecessaryHeaders :: [Header] -> [Header]
+ Network.AWS.Types: London :: Region
+ Network.AWS.Types: Montreal :: Region
+ Network.AWS.Types: accessKeyId :: Lens' AuthEnv AccessKey
+ Network.AWS.Types: expiration :: Lens' AuthEnv (Maybe UTCTime)
+ Network.AWS.Types: instance Control.DeepSeq.NFData Network.AWS.Types.AccessKey
+ Network.AWS.Types: instance Control.DeepSeq.NFData Network.AWS.Types.AuthEnv
+ Network.AWS.Types: instance Control.DeepSeq.NFData Network.AWS.Types.SecretKey
+ Network.AWS.Types: instance Control.DeepSeq.NFData Network.AWS.Types.SessionToken
+ Network.AWS.Types: instance Data.Aeson.Types.FromJSON.FromJSON Network.AWS.Types.AccessKey
+ Network.AWS.Types: instance Data.Aeson.Types.FromJSON.FromJSON Network.AWS.Types.SecretKey
+ Network.AWS.Types: instance Data.Aeson.Types.FromJSON.FromJSON Network.AWS.Types.SessionToken
+ Network.AWS.Types: instance Data.Aeson.Types.ToJSON.ToJSON Network.AWS.Types.AccessKey
+ Network.AWS.Types: instance Data.Aeson.Types.ToJSON.ToJSON Network.AWS.Types.SecretKey
+ Network.AWS.Types: instance Data.Aeson.Types.ToJSON.ToJSON Network.AWS.Types.SessionToken
+ Network.AWS.Types: instance Data.Data.Data Network.AWS.Types.AccessKey
+ Network.AWS.Types: instance Data.Data.Data Network.AWS.Types.AuthEnv
+ Network.AWS.Types: instance Data.Data.Data Network.AWS.Types.SecretKey
+ Network.AWS.Types: instance Data.Data.Data Network.AWS.Types.SessionToken
+ Network.AWS.Types: instance Data.Hashable.Class.Hashable Network.AWS.Types.AccessKey
+ Network.AWS.Types: instance Data.Hashable.Class.Hashable Network.AWS.Types.SecretKey
+ Network.AWS.Types: instance Data.Hashable.Class.Hashable Network.AWS.Types.SessionToken
+ Network.AWS.Types: instance GHC.Classes.Eq Network.AWS.Types.AuthEnv
+ Network.AWS.Types: instance GHC.Enum.Bounded Network.AWS.Types.Region
+ Network.AWS.Types: instance GHC.Enum.Enum Network.AWS.Types.Region
+ Network.AWS.Types: instance GHC.Generics.Generic Network.AWS.Types.AuthEnv
+ Network.AWS.Types: instance GHC.Read.Read Network.AWS.Types.AccessKey
+ Network.AWS.Types: instance GHC.Show.Show Network.AWS.Types.AuthEnv
+ Network.AWS.Types: instance Network.AWS.Data.Query.ToQuery Network.AWS.Types.AccessKey
+ Network.AWS.Types: instance Network.AWS.Data.Text.FromText Network.AWS.Types.AccessKey
+ Network.AWS.Types: instance Network.AWS.Data.Text.FromText Network.AWS.Types.SecretKey
+ Network.AWS.Types: instance Network.AWS.Data.Text.FromText Network.AWS.Types.SessionToken
+ Network.AWS.Types: instance Network.AWS.Data.XML.FromXML Network.AWS.Types.AccessKey
+ Network.AWS.Types: instance Network.AWS.Data.XML.FromXML Network.AWS.Types.AuthEnv
+ Network.AWS.Types: instance Network.AWS.Data.XML.FromXML Network.AWS.Types.SecretKey
+ Network.AWS.Types: instance Network.AWS.Data.XML.FromXML Network.AWS.Types.SessionToken
+ Network.AWS.Types: instance Network.AWS.Data.XML.ToXML Network.AWS.Types.AccessKey
+ Network.AWS.Types: instance Network.AWS.Data.XML.ToXML Network.AWS.Types.SecretKey
+ Network.AWS.Types: instance Network.AWS.Data.XML.ToXML Network.AWS.Types.SessionToken
+ Network.AWS.Types: secretAccessKey :: Lens' AuthEnv SecretKey
+ Network.AWS.Types: sessionToken :: Lens' AuthEnv (Maybe SessionToken)
+ Network.AWS.Waiter: matchNonEmpty :: Bool -> Accept -> Fold (Rs a) b -> Acceptor a
+ Network.AWS.Waiter: nonEmptyText :: Fold a Text -> Fold a Bool
- Network.AWS.Data.JSON: parseJSON :: Value -> Parser a
+ Network.AWS.Data.JSON: parseJSON :: FromJSON a => Value -> Parser a
- Network.AWS.Data.JSON: parseJSONList :: Value -> Parser [a]
+ Network.AWS.Data.JSON: parseJSONList :: FromJSON a => Value -> Parser [a]
- Network.AWS.Data.JSON: toEncoding :: a -> Encoding
+ Network.AWS.Data.JSON: toEncoding :: ToJSON a => a -> Encoding
- Network.AWS.Data.JSON: toEncodingList :: [a] -> Encoding
+ Network.AWS.Data.JSON: toEncodingList :: ToJSON a => [a] -> Encoding
- Network.AWS.Data.JSON: toJSON :: a -> Value
+ Network.AWS.Data.JSON: toJSON :: ToJSON a => a -> Value
- Network.AWS.Data.JSON: toJSONList :: [a] -> Value
+ Network.AWS.Data.JSON: toJSONList :: ToJSON a => [a] -> Value
- Network.AWS.Data.XML: XMany :: [Node] -> XML
+ Network.AWS.Data.XML: XMany :: [(Name, Text)] -> [Node] -> XML
- Network.AWS.Data.XML: infixr 7 @=
+ Network.AWS.Data.XML: infixr 7 @@=
- Network.AWS.Types: AuthEnv :: !AccessKey -> !SecretKey -> Maybe SessionToken -> Maybe UTCTime -> AuthEnv
+ Network.AWS.Types: AuthEnv :: !AccessKey -> !(Sensitive SecretKey) -> Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv
- Network.AWS.Types: [_authExpiry] :: AuthEnv -> Maybe UTCTime
+ Network.AWS.Types: [_authExpiry] :: AuthEnv -> Maybe ISO8601
- Network.AWS.Types: [_authSecret] :: AuthEnv -> !SecretKey
+ Network.AWS.Types: [_authSecret] :: AuthEnv -> !(Sensitive SecretKey)
- Network.AWS.Types: [_authToken] :: AuthEnv -> Maybe SessionToken
+ Network.AWS.Types: [_authToken] :: AuthEnv -> Maybe (Sensitive SessionToken)
Files
- amazonka-core.cabal +21/−7
- src/Network/AWS/Compat/Locale.hs +2/−2
- src/Network/AWS/Compat/Time.hs +2/−2
- src/Network/AWS/Data/Base64.hs +2/−2
- src/Network/AWS/Data/Body.hs +2/−2
- src/Network/AWS/Data/ByteString.hs +2/−2
- src/Network/AWS/Data/Crypto.hs +8/−2
- src/Network/AWS/Data/Headers.hs +2/−2
- src/Network/AWS/Data/JSON.hs +2/−2
- src/Network/AWS/Data/List1.hs +2/−2
- src/Network/AWS/Data/Log.hs +2/−2
- src/Network/AWS/Data/Map.hs +5/−5
- src/Network/AWS/Data/Numeric.hs +2/−2
- src/Network/AWS/Data/Path.hs +2/−2
- src/Network/AWS/Data/Query.hs +23/−4
- src/Network/AWS/Data/Sensitive.hs +10/−5
- src/Network/AWS/Data/Text.hs +2/−2
- src/Network/AWS/Data/Time.hs +7/−4
- src/Network/AWS/Data/XML.hs +62/−28
- src/Network/AWS/Endpoint.hs +2/−2
- src/Network/AWS/Error.hs +49/−17
- src/Network/AWS/Lens.hs +2/−2
- src/Network/AWS/Pager.hs +10/−14
- src/Network/AWS/Prelude.hs +5/−6
- src/Network/AWS/Request.hs +2/−2
- src/Network/AWS/Response.hs +2/−2
- src/Network/AWS/Sign/V2.hs +2/−2
- src/Network/AWS/Sign/V2Header.hs +87/−0
- src/Network/AWS/Sign/V2Header/Base.hs +159/−0
- src/Network/AWS/Sign/V4.hs +2/−2
- src/Network/AWS/Sign/V4/Base.hs +13/−11
- src/Network/AWS/Sign/V4/Chunked.hs +26/−20
- src/Network/AWS/Types.hs +137/−37
- src/Network/AWS/Waiter.hs +11/−6
- test/Main.hs +16/−11
- test/Test/AWS/Arbitrary.hs +49/−13
- test/Test/AWS/Data/Base64.hs +2/−2
- test/Test/AWS/Data/List.hs +2/−2
- test/Test/AWS/Data/Maybe.hs +2/−2
- test/Test/AWS/Data/Numeric.hs +2/−2
- test/Test/AWS/Data/Path.hs +2/−2
- test/Test/AWS/Data/Query.hs +51/−0
- test/Test/AWS/Data/Time.hs +2/−2
- test/Test/AWS/Error.hs +3/−3
- test/Test/AWS/Sign/V2Header/BaseSpec.hs +278/−0
- test/Test/AWS/Sign/V4.hs +11/−16
- test/Test/AWS/Sign/V4/Chunked.hs +101/−0
- test/Test/AWS/Util.hs +2/−2
amazonka-core.cabal view
@@ -1,13 +1,13 @@ name: amazonka-core-version: 1.4.5+version: 1.5.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: OtherLicense+license: MPL-2.0 license-file: LICENSE author: Brendan Hay-maintainer: Brendan Hay <brendan.g.hay@gmail.com>-copyright: Copyright (c) 2013-2016 Brendan Hay+maintainer: Brendan Hay <brendan.g.hay+amazonka@gmail.com>+copyright: Copyright (c) 2013-2017 Brendan Hay category: Network, AWS, Cloud, Distributed Computing build-type: Simple extra-source-files: README.md@@ -24,6 +24,7 @@ source-repository head type: git location: git://github.com/brendanhay/amazonka.git+ subdir: core flag old-locale description: Use old-locale and time < 1.5@@ -33,7 +34,11 @@ 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: Network.AWS.Compat.Locale@@ -61,6 +66,8 @@ , Network.AWS.Prelude , Network.AWS.Request , Network.AWS.Response+ , Network.AWS.Sign.V2Header+ , Network.AWS.Sign.V2Header.Base , Network.AWS.Sign.V2 , Network.AWS.Sign.V4 , Network.AWS.Types@@ -126,9 +133,12 @@ , Test.AWS.Data.Maybe , Test.AWS.Data.Numeric , Test.AWS.Data.Path+ , Test.AWS.Data.Query , Test.AWS.Data.Time , Test.AWS.Error+ , Test.AWS.Sign.V2Header.BaseSpec , Test.AWS.Sign.V4+ , Test.AWS.Sign.V4.Chunked , Test.AWS.Util build-depends:@@ -137,12 +147,16 @@ , base , bytestring , case-insensitive+ , conduit+ , data-ordlist+ , http-conduit , http-types+ , lens+ , QuickCheck+ , quickcheck-unicode , tasty , tasty-hunit , tasty-quickcheck , template-haskell , text , time- , QuickCheck- , quickcheck-unicode
src/Network/AWS/Compat/Locale.hs view
@@ -2,9 +2,9 @@ -- | -- Module : Network.AWS.Compat.Locale--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Compat/Time.hs view
@@ -2,9 +2,9 @@ -- | -- Module : Network.AWS.Compat.Time--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Data/Base64.hs view
@@ -4,9 +4,9 @@ -- | -- Module : Network.AWS.Data.Base64--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Data/Body.hs view
@@ -12,9 +12,9 @@ -- | -- Module : Network.AWS.Data.Body--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Data/ByteString.hs view
@@ -7,9 +7,9 @@ -- | -- Module : Network.AWS.Data.ByteString--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions)
src/Network/AWS/Data/Crypto.hs view
@@ -5,9 +5,9 @@ -- | -- Module : Network.AWS.Data.Crypto--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --@@ -18,6 +18,7 @@ , digestToBase -- * Algorithms+ , hmacSHA1 , hmacSHA256 , hashSHA256 , hashMD5@@ -49,6 +50,11 @@ digestToBase :: ByteArrayAccess a => Base -> a -> ByteString digestToBase = convertToBase+++-- | Apply an HMAC sha1 with the given secret to the given value.+hmacSHA1 :: (ByteArrayAccess a, ByteArray b) => a -> b -> HMAC SHA1+hmacSHA1 = hmac hmacSHA256 :: (ByteArrayAccess a, ByteArray b) => a -> b -> HMAC SHA256 hmacSHA256 = hmac
src/Network/AWS/Data/Headers.hs view
@@ -6,9 +6,9 @@ -- | -- Module : Network.AWS.Data.Headers--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Data/JSON.hs view
@@ -2,9 +2,9 @@ -- | -- Module : Network.AWS.Data.JSON--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Data/List1.hs view
@@ -7,9 +7,9 @@ -- | -- Module : Network.AWS.Data.List1--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Data/Log.hs view
@@ -7,9 +7,9 @@ -- | -- Module : Network.AWS.Data.Log--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Data/Map.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RoleAnnotations #-}@@ -9,9 +9,9 @@ -- | -- Module : Network.AWS.Data.Map--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --@@ -23,14 +23,14 @@ , toQueryMap ) where -import Control.DeepSeq import Control.Applicative+import Control.DeepSeq import Data.Aeson import Data.Bifunctor import qualified Data.ByteString as BS import qualified Data.CaseInsensitive as CI import Data.Coerce-import Data.Data (Data,Typeable)+import Data.Data (Data, Typeable) import Data.Foldable hiding (toList) import Data.Hashable import Data.HashMap.Strict (HashMap)
src/Network/AWS/Data/Numeric.hs view
@@ -5,9 +5,9 @@ -- | -- Module : Network.AWS.Data.Numeric--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Data/Path.hs view
@@ -8,9 +8,9 @@ -- | -- Module : Network.AWS.Data.Path--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Data/Query.hs view
@@ -11,9 +11,9 @@ -- | -- Module : Network.AWS.Data.Query--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --@@ -25,6 +25,7 @@ import qualified Data.ByteString.Lazy as LBS import Data.Data import Data.List (sort)+import Data.Maybe (fromMaybe) import Data.Monoid import Data.String import qualified Data.Text.Encoding as Text@@ -50,8 +51,26 @@ (l, r) -> QList [l, r] instance IsString QueryString where- fromString [] = mempty- fromString xs = QPair (BS8.pack xs) (QValue Nothing)+ fromString = parseQueryString . fromString+ {-# INLINE fromString #-}++parseQueryString :: ByteString -> QueryString+parseQueryString bs+ | BS8.null bs = mempty+ | otherwise =+ QList (map breakPair . filter (not . BS8.null) $ BS8.split '&' bs)+ where+ breakPair x =+ case BS8.break (== '=') x of+ ("", "") -> mempty+ ("", v) -> stripValue v+ (k, v) -> QPair k (stripValue v)++ stripValue x =+ case x of+ "" -> QValue Nothing+ "=" -> QValue Nothing+ _ -> QValue (Just (fromMaybe x (BS8.stripPrefix "=" x))) -- FIXME: use Builder instance ToByteString QueryString where
src/Network/AWS/Data/Sensitive.hs view
@@ -1,12 +1,13 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-} -- | -- Module : Network.AWS.Data.Sensitive--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --@@ -17,9 +18,13 @@ import Data.Hashable import Data.Monoid import Data.String+ import GHC.Generics (Generic)++import Network.AWS.Data.Headers import Network.AWS.Data.ByteString import Network.AWS.Data.JSON+import Network.AWS.Data.Log (ToLog (..)) import Network.AWS.Data.Query import Network.AWS.Data.Text import Network.AWS.Data.XML@@ -30,7 +35,6 @@ deriving ( Eq , Ord- , Read , IsString , Monoid , Data@@ -44,10 +48,11 @@ , ToQuery , ToJSON , FromJSON+ , ToHeader ) -instance Show (Sensitive a) where- show = const "******"+instance Show (Sensitive a) where show = const "******"+instance ToLog (Sensitive a) where build = const "******" instance Hashable a => Hashable (Sensitive a) instance NFData a => NFData (Sensitive a)
src/Network/AWS/Data/Text.hs view
@@ -6,9 +6,9 @@ -- | -- Module : Network.AWS.Data.Text--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Data/Time.hs view
@@ -13,9 +13,9 @@ -- | -- Module : Network.AWS.Data.Time--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --@@ -193,6 +193,9 @@ instance ToQuery BasicTime where toQuery = toQuery . toBS instance ToQuery AWSTime where toQuery = toQuery . toBS +instance ToQuery POSIX where+ toQuery (Time t) = toQuery (truncate (utcTimeToPOSIXSeconds t) :: Integer)+ instance ToXML RFC822 where toXML = toXMLText instance ToXML ISO8601 where toXML = toXMLText instance ToXML AWSTime where toXML = toXMLText@@ -204,5 +207,5 @@ instance ToJSON BasicTime where toJSON = toJSONText instance ToJSON POSIX where- toJSON (Time t) = Number $- scientific (truncate (utcTimeToPOSIXSeconds t) :: Integer) 0+ toJSON (Time t) =+ Number $ scientific (truncate (utcTimeToPOSIXSeconds t) :: Integer) 0
src/Network/AWS/Data/XML.hs view
@@ -4,12 +4,13 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-} -- | -- Module : Network.AWS.Data.XML--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --@@ -17,24 +18,31 @@ import Control.Applicative import Control.Monad+ import Data.Bifunctor-import qualified Data.ByteString.Lazy as LBS import Data.Conduit import Data.Conduit.Lazy (lazyConsume)-import qualified Data.Conduit.List as Conduit import Data.Maybe import Data.Monoid import Data.Traversable (traverse) import Data.XML.Types (Event (..))+ import GHC.Exts+ import Network.AWS.Data.ByteString import Network.AWS.Data.Text+ import Numeric.Natural+ import System.IO.Unsafe (unsafePerformIO)+ import Text.XML-import qualified Text.XML.Stream.Render as Stream import Text.XML.Unresolved (toEvents) +import qualified Data.ByteString.Lazy as LBS+import qualified Data.Conduit.List as Conduit+import qualified Text.XML.Stream.Render as Stream+ infixl 7 .@, .@? (.@) :: FromXML a => [Node] -> Text -> Either String a@@ -46,7 +54,7 @@ Left _ -> Right Nothing Right xs -> parseXML xs -infixr 7 @=+infixr 7 @=, @@= (@=) :: ToXML a => Name -> a -> XML n @= x =@@ -54,8 +62,13 @@ XNull -> XNull xs -> XOne . NodeElement $ mkElement n xs +(@@=) :: ToText a => Name -> a -> XML+n @@= x = XAttr n (toText x)+ decodeXML :: FromXML a => LazyByteString -> Either String a-decodeXML = first show . parseLBS def >=> parseXML . elementNodes . documentRoot+decodeXML lbs =+ bimap show documentRoot (parseLBS def lbs)+ >>= parseXML . childrenOf -- The following is taken from xml-conduit.Text.XML which uses -- unsafePerformIO anyway, with the following caveat:@@ -129,27 +142,37 @@ -- declaration be consistent WRT to single nodes or lists of nodes. data XML = XNull+ | XAttr Name Text | XOne Node- | XMany [Node]+ | XMany [(Name, Text)] [Node] deriving (Show) instance Monoid XML where mempty = XNull mappend XNull XNull = XNull- mappend a b = XMany (listXMLNodes a <> listXMLNodes b)+ mappend a XNull = a+ mappend XNull b = b+ mappend a b =+ XMany (listXMLAttributes a <> listXMLAttributes b)+ (listXMLNodes a <> listXMLNodes b) listXMLNodes :: XML -> [Node] listXMLNodes = \case- XNull -> []- XOne n -> [n]- XMany ns -> ns+ XNull -> []+ XAttr {} -> []+ XOne n -> [n]+ XMany _ ns -> ns +listXMLAttributes :: XML -> [(Name, Text)]+listXMLAttributes = \case+ XNull -> []+ XAttr n t -> [(n, t)]+ XOne {} -> []+ XMany as _ -> as+ class ToXML a where toXML :: a -> XML -toXMLNodes :: ToXML a => a -> [Node]-toXMLNodes = listXMLNodes . toXML- instance ToXML XML where toXML = id @@ -177,13 +200,14 @@ fromText toXMLList :: (IsList a, ToXML (Item a)) => Name -> a -> XML-toXMLList n = XMany . map (NodeElement . mkElement n) . toList+toXMLList n = XMany [] . map (NodeElement . mkElement n) . toList toXMLText :: ToText a => a -> XML toXMLText = XOne . NodeContent . toText mkElement :: ToXML a => Name -> a -> Element-mkElement n = Element n mempty . listXMLNodes . toXML+mkElement n (toXML -> x) =+ Element n (fromList (listXMLAttributes x)) (listXMLNodes x) withContent :: String -> [Node] -> Either String (Maybe Text) withContent k = \case@@ -191,14 +215,12 @@ [NodeContent x] -> Right (Just x) _ -> Left $ "encountered many nodes, when expecting text: " ++ k -withElement :: Text -> ([Node] -> Either String a) -> [Node] -> Either String a-withElement n f = findElement n >=> f- -- | Find a specific named NodeElement, at the current depth in the node tree. -- -- Fails if absent. findElement :: Text -> [Node] -> Either String [Node]-findElement n ns = missingElement n ns+findElement n ns =+ missingElement n ns . listToMaybe $ mapMaybe (childNodesOf n) ns @@ -206,22 +228,34 @@ -- -- Fails if absent. firstElement :: Text -> [Node] -> Either String [Node]-firstElement n ns = missingElement n ns+firstElement n ns =+ missingElement n ns . listToMaybe $ mapMaybe go ns where- go (NodeElement e)- | n == nameLocalName (elementName e)- = Just (elementNodes e)- | otherwise = listToMaybe $ mapMaybe go (elementNodes e)- go _ = Nothing+ go x = case x of+ NodeElement e+ | Just n == localName x -> Just (childrenOf e)+ | otherwise -> listToMaybe (mapMaybe go (elementNodes e))+ _ -> Nothing childNodesOf :: Text -> Node -> Maybe [Node] childNodesOf n x = case x of NodeElement e | Just n == localName x- -> Just (elementNodes e)+ -> Just (childrenOf e) _ -> Nothing++childrenOf :: Element -> [Node]+childrenOf e = elementNodes e <> map node (toList (elementAttributes e))+ where+ node (k, v) = NodeElement (Element (name k) mempty [NodeContent v])++ name k = Name+ { nameLocalName = fromMaybe "" (namePrefix k) <> ":" <> nameLocalName k+ , nameNamespace = mempty+ , namePrefix = mempty+ } localName :: Node -> Maybe Text localName = \case
src/Network/AWS/Endpoint.hs view
@@ -5,9 +5,9 @@ -- | -- Module : Network.AWS.Types--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Error.hs view
@@ -4,31 +4,58 @@ -- | -- Module : Network.AWS.Error--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) -- module Network.AWS.Error where -import Control.Applicative-import Control.Monad-import Data.Aeson-import Data.Aeson.Types (parseEither)-import Data.Maybe-import Data.Monoid-import Network.AWS.Data.ByteString-import Network.AWS.Data.Headers-import Network.AWS.Data.Text-import Network.AWS.Data.XML-import Network.AWS.Lens (Choice, Getting, Optic', filtered)-import Network.AWS.Types-import Network.HTTP.Conduit-import Network.HTTP.Types.Status (Status (..))+import Control.Applicative+import Control.Monad -import qualified Data.ByteString.Lazy as LBS+import Data.Aeson+import Data.Aeson.Types (parseEither)+import Data.Maybe+import Data.Monoid +import Network.AWS.Data.ByteString+import Network.AWS.Data.Headers+import Network.AWS.Data.Text+import Network.AWS.Data.XML+import Network.AWS.Lens (Choice, Getting, Optic', filtered)+import Network.AWS.Types+import Network.HTTP.Conduit+import Network.HTTP.Types.Status (Status (..))++import qualified Data.ByteString.Lazy as LBS++-- | Provides a generalised prism for catching a specific service error+-- identified by the opaque service abbreviation and error code.+--+-- This can be used if the generated error prisms provided by+-- @Network.AWS.<ServiceName>.Types@ do not cover all the thrown error codes.+-- For example to define a new error prism:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > import Network.AWS.S3 (ServiceError, s3)+-- >+-- > _NoSuchBucketPolicy :: AsError a => Getting (First ServiceError) a ServiceError+-- > _NoSuchBucketPolicy = _MatchServiceError s3 "NoSuchBucketPolicy"+--+-- With example usage being:+--+-- >>> import Control.Exception.Lens (trying)+-- >>> :t trying _NoSuchBucketPolicy+-- MonadCatch m => m a -> m (Either ServiceError a)+_MatchServiceError :: AsError a+ => Service+ -> ErrorCode+ -> Getting (First ServiceError) a ServiceError+_MatchServiceError s c = _ServiceError . hasService s . hasCode c+ statusSuccess :: Status -> Bool statusSuccess (statusCode -> n) = n >= 200 && n < 300 @@ -49,6 +76,11 @@ ServiceError e -> (\x -> ServiceError (e { _serviceStatus = x })) <$> g (_serviceStatus e)++hasService :: (Applicative f, Choice p)+ => Service+ -> Optic' p f ServiceError ServiceError+hasService s = filtered ((_svcAbbrev s ==) . _serviceAbbrev) hasStatus :: (Applicative f, Choice p) => Int
src/Network/AWS/Lens.hs view
@@ -1,8 +1,8 @@ -- | -- Module : Network.AWS.Lens--- Copyright : (c) 2013-2016 Brendan Hay <brendan.g.hay@gmail.com>+-- Copyright : (c) 2013-2017 Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Pager.hs view
@@ -3,9 +3,9 @@ -- | -- Module : Network.AWS.Pager--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --@@ -19,6 +19,8 @@ import Control.Applicative import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as Map+import Data.List.NonEmpty (NonEmpty)+import Data.Maybe (isJust, fromMaybe) import Data.Text (Text) import Network.AWS.Data.Text (ToText (..)) import Network.AWS.Lens (Getter, to)@@ -37,23 +39,17 @@ instance AWSTruncated Bool where truncated = id -instance AWSTruncated (Maybe Int) where- truncated (Just _) = True- truncated Nothing = False--instance AWSTruncated (Maybe Bool) where- truncated (Just x) = x- truncated Nothing = False--instance AWSTruncated (Maybe Text) where- truncated (Just _) = True- truncated Nothing = False- instance AWSTruncated [a] where truncated = not . null instance AWSTruncated (HashMap k v) where truncated = not . Map.null++instance {-# OVERLAPPABLE #-} AWSTruncated (Maybe a) where+ truncated = isJust++instance {-# OVERLAPS #-} AWSTruncated (Maybe Bool) where+ truncated = fromMaybe False stop :: AWSTruncated a => a -> Bool stop = not . truncated
src/Network/AWS/Prelude.hs view
@@ -1,8 +1,8 @@ -- | -- Module : Network.AWS.Prelude--- Copyright : (c) 2013-2016 Brendan Hay <brendan.g.hay@gmail.com>+-- Copyright : (c) 2013-2017 Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --@@ -44,10 +44,9 @@ import Network.AWS.Data.XML as Export import Network.AWS.Endpoint as Export import Network.AWS.Error as Export-import Network.AWS.Types as Export hiding (AccessKey,- Algorithm, Endpoint,- LogLevel (..), Seconds,- SecretKey, Signer,+import Network.AWS.Types as Export hiding (Algorithm,+ Endpoint, LogLevel (..),+ Seconds, Signer, serviceEndpoint) infixl 7 .!@
src/Network/AWS/Request.hs view
@@ -4,9 +4,9 @@ -- | -- Module : Network.AWS.Request--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Response.hs view
@@ -6,9 +6,9 @@ -- | -- Module : Network.AWS.Response--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Sign/V2.hs view
@@ -6,9 +6,9 @@ -- | -- Module : Network.AWS.Sign.V2--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
+ src/Network/AWS/Sign/V2Header.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module : Network.AWS.Sign.V2Header+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- This module provides an AWS compliant V2 Header request signer. It is based+-- heavily on boto (https://github.com/boto/boto), specifically boto's+-- @HmacAuthV1Handler@ AWS capable signer. AWS documentation is available+-- <http://docs.aws.amazon.com/AmazonS3/latest/dev/RESTAuthentication.html here>.+--+-- /Notice/: Limitations include an inability to sign with a security token and+-- inability to overwrite the @Date@ header with an expiry.+module Network.AWS.Sign.V2Header+ ( v2Header+ ) where++import Data.Monoid+import Data.Time+import Network.AWS.Data.Body+import Network.AWS.Data.ByteString+import Network.AWS.Data.Crypto+import Network.AWS.Data.Headers+import Network.AWS.Data.Log+import Network.AWS.Data.Path+import Network.AWS.Data.Time+import qualified Network.AWS.Sign.V2Header.Base as V2+import Network.AWS.Types+import qualified Network.HTTP.Conduit as Client+import Network.HTTP.Types++data V2Header = V2Header+ { metaTime :: !UTCTime+ , metaEndpoint :: !Endpoint+ , metaSignature :: !ByteString+ , headers :: !Network.HTTP.Types.RequestHeaders+ , signer :: !ByteString+ }++instance ToLog V2Header where+ build V2Header{..} = buildLines+ [ "[Version 2 Header Metadata] {"+ , " time = " <> build metaTime+ , " endpoint = " <> build (_endpointHost metaEndpoint)+ , " signature = " <> build metaSignature+ , " headers = " <> build headers+ , " signer = " <> build signer+ , "}"+ ]++v2Header :: Signer+v2Header = Signer sign (const sign)++sign :: Algorithm a+sign Request{..} AuthEnv{..} r t = Signed meta rq+ where+ meta = Meta (V2Header t end signature headers signer)++ signer = V2.newSigner headers meth path' _rqQuery++ rq = (clientRequest end _svcTimeout)+ { Client.method = meth+ , Client.path = path'+ , Client.queryString = toBS _rqQuery+ , Client.requestHeaders = headers+ , Client.requestBody = toRequestBody _rqBody+ }++ meth = toBS _rqMethod+ path' = toBS (escapePath _rqPath)++ end@Endpoint{..} = _svcEndpoint r++ Service{..} = _rqService++ signature = digestToBase Base64+ . hmacSHA1 (toBS _authSecret) $ signer++ headers =+ hdr hDate time+ . hdr hAuthorization ("AWS " <> toBS _authAccess <> ":" <> signature)+ $ _rqHeaders++ time = toBS (Time t :: RFC822)
+ src/Network/AWS/Sign/V2Header/Base.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module : Network.AWS.Sign.V2Header.Base+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- This module provides auxiliary functions necessary for the AWS compliant V2+-- Header request signer.+-- /See/: "Network.AWS.Sign.V2Header"+module Network.AWS.Sign.V2Header.Base+ ( newSigner++ -- * Testing+ , toSignerQueryBS++ , constructSigningHeader+ , constructSigningQuery+ , constructFullPath++ , unionNecessaryHeaders+ ) where++import Data.ByteString (ByteString)+import Data.ByteString.Builder (Builder)+import qualified Data.ByteString.Builder as Build+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as LBS+import qualified Data.CaseInsensitive as CI+import Data.Function (on)+import qualified Data.List as List+import Data.Monoid (mempty, (<>))+import qualified Network.AWS.Data.Query as Query+import qualified Network.HTTP.Types as HTTP+import Network.HTTP.Types.URI (urlEncode)++-- | Construct a full header signer following the V2 Header scheme+newSigner :: HTTP.RequestHeaders+ -> ByteString+ -> ByteString+ -> Query.QueryString+ -> ByteString+newSigner headers method path query = signer+ where+ signer =+ BS8.intercalate "\n"+ ( method+ : map constructSigningHeader (List.sort filteredHeaders)+ ++ [constructFullPath path (toSignerQueryBS filteredQuery)]+ )++ filteredHeaders = unionNecessaryHeaders (filter isInterestingHeader headers)++ filteredQuery = constructSigningQuery query++-- | The following function mostly follows the toBS in amazonka QueryString+-- except for single QValue or single QPair keys not being suffixed with+-- an equals.+toSignerQueryBS :: Query.QueryString -> ByteString+toSignerQueryBS =+ LBS.toStrict . Build.toLazyByteString . cat . List.sort . enc Nothing+ where+ enc :: Maybe ByteString -> Query.QueryString -> [ByteString]+ enc p = \case+ Query.QList xs -> concatMap (enc p) xs++ Query.QPair (urlEncode True -> k) x+ | Just n <- p -> enc (Just (n <> kdelim <> k)) x -- <prev>.key <recur>+ | otherwise -> enc (Just k) x -- key <recur>++ Query.QValue (Just (urlEncode True -> v))+ | Just n <- p -> [n <> vsep <> v] -- key=value+ | otherwise -> [v]++ _ | Just n <- p -> [n]+ | otherwise -> []++ cat :: [ByteString] -> Builder+ cat [] = mempty+ cat [x] = Build.byteString x+ cat (x:xs) = Build.byteString x <> ksep <> cat xs++ kdelim = "."+ ksep = "&"+ vsep = "="++hasAWSPrefix :: CI.CI ByteString -> Bool+hasAWSPrefix = BS8.isPrefixOf "aws-" . CI.foldedCase++-- | Filter for 'interesting' keys within a QueryString+isInterestingQueryKey :: ByteString -> Bool+isInterestingQueryKey = \case+ "acl" -> True+ "cors" -> True+ "defaultObjectAcl" -> True+ "location" -> True+ "logging" -> True+ "partNumber" -> True+ "policy" -> True+ "requestPayment" -> True+ "torrent" -> True+ "versioning" -> True+ "versionId" -> True+ "versions" -> True+ "website" -> True+ "uploads" -> True+ "uploadId" -> True+ "response-content-type" -> True+ "response-content-language" -> True+ "response-expires" -> True+ "response-cache-control" -> True+ "response-content-disposition" -> True+ "response-content-encoding" -> True+ "delete" -> True+ "lifecycle" -> True+ "tagging" -> True+ "restore" -> True+ "storageClass" -> True+ "websiteConfig" -> True+ "compose" -> True+ _ -> False++-- | Filter for 'interesting' header fields+isInterestingHeader :: HTTP.Header -> Bool+isInterestingHeader (name, _)+ | name == HTTP.hDate = True+ | name == HTTP.hContentMD5 = True+ | name == HTTP.hContentType = True+ | hasAWSPrefix name = True+ | otherwise = False++-- | Constructs a query string for signing+constructSigningQuery :: Query.QueryString -> Query.QueryString+constructSigningQuery = \case+ Query.QValue {} -> Query.QValue Nothing+ Query.QList qs -> Query.QList (map constructSigningQuery qs)+ Query.QPair k v+ | isInterestingQueryKey k -> Query.QPair k v+ | otherwise -> Query.QValue Nothing++-- | Construct a header string for signing+constructSigningHeader :: HTTP.Header -> ByteString+constructSigningHeader (name, value)+ | hasAWSPrefix name = CI.foldedCase name <> ":" <> value+ | otherwise = value++constructFullPath :: ByteString -> ByteString -> ByteString+constructFullPath path q+ | BS8.null q = path+ | otherwise = path <> "?" <> q++unionNecessaryHeaders :: [HTTP.Header] -> [HTTP.Header]+unionNecessaryHeaders =+ flip (List.unionBy (on (==) fst))+ [ (HTTP.hContentMD5, "")+ , (HTTP.hContentType, "")+ ]
src/Network/AWS/Sign/V4.hs view
@@ -11,9 +11,9 @@ -- | -- Module : Network.AWS.Sign.V4--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --
src/Network/AWS/Sign/V4/Base.hs view
@@ -11,40 +11,42 @@ -- | -- Module : Network.AWS.Sign.V4.Base--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) -- module Network.AWS.Sign.V4.Base where import Control.Applicative+ import Data.Bifunctor-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BS8-import qualified Data.CaseInsensitive as CI-import qualified Data.Foldable as Fold import Data.Function (on) import Data.List (nubBy, sortBy)-import Data.Maybe import Data.Monoid+ import GHC.TypeLits+ import Network.AWS.Data.ByteString import Network.AWS.Data.Crypto import Network.AWS.Data.Headers import Network.AWS.Data.Log import Network.AWS.Data.Path import Network.AWS.Data.Query+import Network.AWS.Data.Sensitive (_Sensitive) import Network.AWS.Data.Time-import Network.AWS.Lens ((%~), (<>~))+import Network.AWS.Lens ((%~), (<>~), (^.)) import Network.AWS.Request import Network.AWS.Types++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.CaseInsensitive as CI+import qualified Data.Foldable as Fold import qualified Network.HTTP.Conduit as Client import qualified Network.HTTP.Types.Header as H -import Prelude- default (ByteString) data V4 = V4@@ -173,7 +175,7 @@ , metaCanonicalHeaders = chs , metaSignedHeaders = shs , metaStringToSign = sts- , metaSignature = signature (_authSecret a) scope sts+ , metaSignature = signature (_authSecret a ^. _Sensitive) scope sts , metaHeaders = _rqHeaders rq , metaTimeout = _svcTimeout svc }
src/Network/AWS/Sign/V4/Chunked.hs view
@@ -14,9 +14,9 @@ -- | -- Module : Network.AWS.Sign.V4.Chunked--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --@@ -24,23 +24,29 @@ ( chunked ) where -import Control.Applicative-import qualified Data.ByteString as BS-import Data.ByteString.Builder-import qualified Data.ByteString.Char8 as BS8-import Data.Conduit-import Data.Maybe-import Data.Monoid-import Network.AWS.Data.Body-import Network.AWS.Data.ByteString-import Network.AWS.Data.Crypto-import Network.AWS.Data.Headers-import Network.AWS.Data.Time-import Network.AWS.Lens ((<>~))-import Network.AWS.Sign.V4.Base hiding (algorithm)-import Network.AWS.Types-import Network.HTTP.Types.Header+import Control.Applicative +import Data.ByteString.Builder+import Data.Conduit+import Data.Maybe+import Data.Monoid++import Network.AWS.Data.Body+import Network.AWS.Data.ByteString+import Network.AWS.Data.Crypto+import Network.AWS.Data.Headers+import Network.AWS.Data.Sensitive (_Sensitive)+import Network.AWS.Data.Time+import Network.AWS.Lens ((<>~), (^.))+import Network.AWS.Sign.V4.Base hiding (algorithm)+import Network.AWS.Types+import Network.HTTP.Types.Header++import Numeric (showHex)++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+ default (Builder, Integer) chunked :: ChunkedBody -> Algorithm a@@ -73,7 +79,7 @@ <> byteString crlf chunkSignature prev x =- signature (_authSecret a) scope (chunkStringToSign prev x)+ signature (_authSecret a ^. _Sensitive) scope (chunkStringToSign prev x) chunkStringToSign prev x = Tag $ BS8.intercalate "\n" [ algorithm@@ -104,7 +110,7 @@ where chunkLength :: Integral a => a -> Integer chunkLength (toInteger -> n) =- _chunkedLength c+ fromIntegral (length (showHex n "")) + headerLength + signatureLength + crlfLength
src/Network/AWS/Types.hs view
@@ -11,9 +11,9 @@ -- | -- Module : Network.AWS.Types--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --@@ -25,10 +25,15 @@ , SecretKey (..) , SessionToken (..) -- ** Environment- , AuthEnv (..) , Auth (..) , withAuth + , AuthEnv (..)+ , accessKeyId+ , secretAccessKey+ , sessionToken+ , expiration+ -- * Logging , LogLevel (..) , Logger@@ -126,11 +131,12 @@ import Control.Exception import Control.Monad.IO.Class import Control.Monad.Trans.Resource-import Data.Aeson hiding (Error)-import Data.ByteString.Builder (Builder)++import Data.Aeson hiding (Error)+import Data.ByteString.Builder (Builder) import Data.Coerce import Data.Conduit-import Data.Data (Data, Typeable)+import Data.Data (Data, Typeable) import Data.Hashable import Data.IORef import Data.Maybe@@ -138,25 +144,28 @@ import Data.Proxy import Data.String import Data.Time-import GHC.Generics (Generic)++import GHC.Generics (Generic)+ import Network.AWS.Data.Body import Network.AWS.Data.ByteString import Network.AWS.Data.JSON import Network.AWS.Data.Log import Network.AWS.Data.Path import Network.AWS.Data.Query+import Network.AWS.Data.Sensitive (Sensitive, _Sensitive) import Network.AWS.Data.Text+import Network.AWS.Data.Time (ISO8601, _Time) import Network.AWS.Data.XML-import Network.AWS.Lens (Iso', Lens', Prism', Setter')-import Network.AWS.Lens (exception, iso, lens, prism, sets)-import Network.HTTP.Conduit hiding (Proxy, Request, Response)+import Network.AWS.Lens (Iso', Lens', Prism', Setter')+import Network.AWS.Lens (exception, iso, lens, mapping, prism, sets,+ view)+import Network.HTTP.Conduit hiding (Proxy, Request, Response) import Network.HTTP.Types.Header import Network.HTTP.Types.Method-import Network.HTTP.Types.Status (Status)+import Network.HTTP.Types.Status (Status) -import qualified Data.ByteString as BS import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text import qualified Network.HTTP.Conduit as Client -- | A convenience alias to avoid type ambiguity.@@ -502,50 +511,135 @@ -> ClientResponse -> m (Response a) --- | Access key credential.+-- | An access key ID.+--+-- For example: @AKIAIOSFODNN7EXAMPLE@+--+-- /See:/ <http://docs.aws.amazon.com/general/latest/gr/aws-sec-cred-types.html Understanding and Getting Your Security Credentials>. newtype AccessKey = AccessKey ByteString- deriving (Eq, Show, IsString, ToText, ToByteString, ToLog)+ deriving+ ( Eq+ , Show+ , Read+ , Data+ , Typeable+ , IsString+ , ToText+ , FromText+ , ToByteString+ , ToLog+ , FromXML+ , ToXML+ , ToQuery+ , Hashable+ , NFData+ ) --- | Secret key credential.+instance ToJSON AccessKey where toJSON = toJSONText+instance FromJSON AccessKey where parseJSON = parseJSONText "AccessKey"++-- | Secret access key credential.+--+-- For example: @wJalrXUtnFEMI/K7MDENG/bPxRfiCYEXAMPLEKE@+--+-- /See:/ <http://docs.aws.amazon.com/general/latest/gr/aws-sec-cred-types.html Understanding and Getting Your Security Credentials>. newtype SecretKey = SecretKey ByteString- deriving (Eq, IsString, ToText, ToByteString)+ deriving+ ( Eq+ , Data+ , Typeable+ , IsString+ , ToText+ , FromText+ , ToByteString+ , FromXML+ , ToXML+ , Hashable+ , NFData+ ) +instance ToJSON SecretKey where toJSON = toJSONText+instance FromJSON SecretKey where parseJSON = parseJSONText "SecretKey"+ -- | A session token used by STS to temporarily authorise access to -- an AWS resource.+--+-- /See:/ <http://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_temp.html Temporary Security Credentials>. newtype SessionToken = SessionToken ByteString- deriving (Eq, IsString, ToText, ToByteString)+ deriving+ ( Eq+ , Data+ , Typeable+ , IsString+ , ToText+ , FromText+ , ToByteString+ , FromXML+ , ToXML+ , Hashable+ , NFData+ ) --- | The authorisation environment.+instance ToJSON SessionToken where toJSON = toJSONText+instance FromJSON SessionToken where parseJSON = parseJSONText "SessionToken"++-- | The AuthN/AuthZ credential environment. data AuthEnv = AuthEnv { _authAccess :: !AccessKey- , _authSecret :: !SecretKey- , _authToken :: Maybe SessionToken- , _authExpiry :: Maybe UTCTime- }+ , _authSecret :: !(Sensitive SecretKey)+ , _authToken :: Maybe (Sensitive SessionToken)+ , _authExpiry :: Maybe ISO8601+ } deriving (Eq, Show, Data, Typeable, Generic) +instance NFData AuthEnv+ instance ToLog AuthEnv where build AuthEnv{..} = buildLines [ "[Amazonka Auth] {"- , " access key = ****" <> key _authAccess- , " secret key = ****"- , " security token = " <> build (const "****" <$> _authToken :: Maybe Builder)- , " expiry = " <> build _authExpiry+ , " access key id = " <> build _authAccess+ , " secret access key = " <> build _authSecret+ , " session token = " <> build _authToken+ , " expiration = " <> build (fmap (view _Time) _authExpiry) , "}" ]- where- -- An attempt to preserve sanity when debugging which keys- -- have been loaded by the auth module.- key (AccessKey k) = build . BS.reverse . BS.take 6 $ BS.reverse k instance FromJSON AuthEnv where parseJSON = withObject "AuthEnv" $ \o -> AuthEnv- <$> f AccessKey (o .: "AccessKeyId")- <*> f SecretKey (o .: "SecretAccessKey")- <*> fmap (f SessionToken) (o .:? "Token")+ <$> o .: "AccessKeyId"+ <*> o .: "SecretAccessKey"+ <*> o .:? "Token" <*> o .:? "Expiration"- where- f g = fmap (g . Text.encodeUtf8) +instance FromXML AuthEnv where+ parseXML x = AuthEnv+ <$> x .@ "AccessKeyId"+ <*> x .@ "SecretAccessKey"+ <*> x .@? "SessionToken"+ <*> x .@? "Expiration"++-- | The access key ID that identifies the temporary security credentials.+accessKeyId :: Lens' AuthEnv AccessKey+accessKeyId = lens _authAccess (\s a -> s{ _authAccess = a })++-- | The secret access key that can be used to sign requests.+secretAccessKey :: Lens' AuthEnv SecretKey+secretAccessKey =+ lens _authSecret (\s a -> s { _authSecret = a })+ . _Sensitive++-- | The token that users must pass to the service API to use the temporary+-- credentials.+sessionToken :: Lens' AuthEnv (Maybe SessionToken)+sessionToken =+ lens _authToken (\s a -> s { _authToken = a })+ . mapping _Sensitive++-- | The date on which the current credentials expire.+expiration :: Lens' AuthEnv (Maybe UTCTime)+expiration =+ lens _authExpiry (\s a -> s { _authExpiry = a })+ . mapping _Time+ -- | An authorisation environment containing AWS credentials, and potentially -- a reference which can be refreshed out-of-band as temporary credentials expire. data Auth@@ -566,6 +660,7 @@ | Ohio -- ^ US East ('us-east-2'). | NorthCalifornia -- ^ US West ('us-west-1'). | Oregon -- ^ US West ('us-west-2').+ | Montreal -- ^ Canada ('ca-central-1'). | Tokyo -- ^ Asia Pacific ('ap-northeast-1'). | Seoul -- ^ Asia Pacific ('ap-northeast-2'). | Mumbai -- ^ Asia Pacific ('ap-south-1').@@ -573,11 +668,12 @@ | Sydney -- ^ Asia Pacific ('ap-southeast-2'). | SaoPaulo -- ^ South America ('sa-east-1'). | Ireland -- ^ EU ('eu-west-1').+ | London -- ^ EU ('eu-west-2'). | Frankfurt -- ^ EU ('eu-central-1'). | GovCloud -- ^ US GovCloud ('us-gov-west-1'). | GovCloudFIPS -- ^ US GovCloud FIPS (S3 Only, 'fips-us-gov-west-1'). | Beijing -- ^ China ('cn-north-1').- deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)+ deriving (Eq, Ord, Read, Enum, Bounded, Show, Data, Typeable, Generic) instance Hashable Region instance NFData Region@@ -588,6 +684,7 @@ "us-east-2" -> pure Ohio "us-west-1" -> pure NorthCalifornia "us-west-2" -> pure Oregon+ "ca-central-1" -> pure Montreal "ap-northeast-1" -> pure Tokyo "ap-northeast-2" -> pure Seoul "ap-south-1" -> pure Mumbai@@ -595,6 +692,7 @@ "ap-southeast-2" -> pure Sydney "sa-east-1" -> pure SaoPaulo "eu-west-1" -> pure Ireland+ "eu-west-2" -> pure London "eu-central-1" -> pure Frankfurt "us-gov-west-1" -> pure GovCloud "fips-us-gov-west-1" -> pure GovCloudFIPS@@ -608,6 +706,7 @@ Ohio -> "us-east-2" NorthCalifornia -> "us-west-1" Oregon -> "us-west-2"+ Montreal -> "ca-central-1" Tokyo -> "ap-northeast-1" Seoul -> "ap-northeast-2" Mumbai -> "ap-south-1"@@ -615,6 +714,7 @@ Sydney -> "ap-southeast-2" SaoPaulo -> "sa-east-1" Ireland -> "eu-west-1"+ London -> "eu-west-2" Frankfurt -> "eu-central-1" GovCloud -> "us-gov-west-1" GovCloudFIPS -> "fips-us-gov-west-1"
src/Network/AWS/Waiter.hs view
@@ -5,9 +5,9 @@ -- | -- Module : Network.AWS.Waiter--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : This Source Code Form is subject to the terms of--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : provisional -- Portability : non-portable (GHC extensions) --@@ -24,21 +24,23 @@ -- * Matchers , matchAll , matchAny+ , matchNonEmpty , matchError , matchStatus -- * Util- , nonEmpty+ , nonEmptyText ) where import Control.Applicative+import Control.Lens (Fold, allOf, anyOf, to, (^..),+ (^?)) import Data.Maybe import Data.Text (Text) import qualified Data.Text as Text import Network.AWS.Data.ByteString import Network.AWS.Data.Log import Network.AWS.Error-import Network.AWS.Lens (Fold, allOf, anyOf, to, (^?)) import Network.AWS.Types type Acceptor a = Request a -> Either Error (Response a) -> Maybe Accept@@ -72,6 +74,9 @@ matchAny :: Eq b => b -> Accept -> Fold (Rs a) b -> Acceptor a matchAny x a l = match (anyOf l (== x)) a +matchNonEmpty :: Bool -> Accept -> Fold (Rs a) b -> Acceptor a+matchNonEmpty x a l = match (\rs -> null (rs ^.. l) == x) a+ matchStatus :: Int -> Accept -> Acceptor a matchStatus x a _ = \case Right (s, _) | x == fromEnum s -> Just a@@ -88,5 +93,5 @@ Right (_, rs) | f rs -> Just a _ -> Nothing -nonEmpty :: Fold a Text -> Fold a Bool-nonEmpty l = l . to Text.null+nonEmptyText :: Fold a Text -> Fold a Bool+nonEmptyText f = f . to Text.null
test/Main.hs view
@@ -2,22 +2,25 @@ -- | -- Module : Main--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) -- module Main (main) where -import qualified Test.AWS.Data.Base64 as Base64-import qualified Test.AWS.Data.List as List-import qualified Test.AWS.Data.Maybe as Maybe-import qualified Test.AWS.Data.Numeric as Numeric-import qualified Test.AWS.Data.Path as Path-import qualified Test.AWS.Data.Time as Time-import qualified Test.AWS.Error as Error-import qualified Test.AWS.Sign.V4 as V4+import qualified Test.AWS.Data.Base64 as Base64+import qualified Test.AWS.Data.List as List+import qualified Test.AWS.Data.Maybe as Maybe+import qualified Test.AWS.Data.Numeric as Numeric+import qualified Test.AWS.Data.Path as Path+import qualified Test.AWS.Data.Query as Query+import qualified Test.AWS.Data.Time as Time+import qualified Test.AWS.Error as Error+import qualified Test.AWS.Sign.V2Header.BaseSpec as V2Header+import qualified Test.AWS.Sign.V4 as V4+ import Test.Tasty main :: IO ()@@ -28,6 +31,7 @@ , Time.tests , Base64.tests , Maybe.tests+ , Query.tests ] , testGroup "paths"@@ -39,7 +43,8 @@ ] , testGroup "signing"- [ V4.tests+ [ V2Header.tests+ , V4.tests ] , Error.tests
test/Test/AWS/Arbitrary.hs view
@@ -1,13 +1,14 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module : Test.AWS.Arbitrary--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -28,19 +29,30 @@ import qualified Test.QuickCheck.Unicode as Unicode import Test.Tasty.QuickCheck +instance Show (Signed a) where+ show = const "Signed { <Meta> <ClientRequest> }"+ instance Arbitrary Service where arbitrary = svc <$> arbitrary where- svc a = Service- { _svcAbbrev = a+ svc abbrev = Service+ { _svcAbbrev = abbrev , _svcSigner = v4- , _svcPrefix = Text.encodeUtf8 . Text.toLower $ toText a+ , _svcPrefix = Text.encodeUtf8 . Text.toLower $ toText abbrev , _svcVersion = "2012-01-01"- , _svcEndpoint = defaultEndpoint (svc a)+ , _svcEndpoint = defaultEndpoint (svc abbrev) , _svcTimeout = Nothing , _svcCheck = const False- , _svcError = error "_svcError not defined."- , _svcRetry = error "_svcRetry not defined."+ , _svcRetry = Exponential 1 2 3 (Just . Text.pack . show)+ , _svcError = \status hdrs _ ->+ ServiceError $ ServiceError'+ { _serviceAbbrev = abbrev+ , _serviceStatus = status+ , _serviceHeaders = hdrs+ , _serviceCode = ErrorCode "Arbitrary.Service"+ , _serviceMessage = Nothing+ , _serviceRequestId = Nothing+ } } instance Arbitrary (Request ()) where@@ -107,10 +119,16 @@ return $! rawPath (BS8.intercalate "/" xs) instance Arbitrary QueryString where- arbitrary = oneof- [ QList <$> arbitrary- , QPair <$> arbitrary <*> arbitrary- , QValue <$> arbitrary+ arbitrary = sized arbitraryQS++-- | Used to limit the recursion depth.+arbitraryQS :: Int -> Gen QueryString+arbitraryQS = \case+ 0 -> QPair <$> arbitrary <*> (QValue <$> arbitrary)+ n -> oneof+ [ QValue <$> arbitrary+ , QPair <$> arbitrary <*> arbitraryQS (n - 1)+ , QList <$> (take 4 <$> QC.listOf (arbitraryQS (n `div` 2))) ] instance (Arbitrary a, FoldCase a) => Arbitrary (CI a) where@@ -136,5 +154,23 @@ ++ [ u { utctDayTime = t } | t <- shrink dayTime ] instance Arbitrary Day where- arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary+ arbitrary = ModifiedJulianDay . (2000 +) <$> arbitrary shrink = fmap ModifiedJulianDay . shrink . toModifiedJulianDay++instance Arbitrary (Time a) where+ arbitrary = Time <$> arbitrary++instance Arbitrary AccessKey where+ arbitrary = AccessKey <$> arbitrary++instance (Arbitrary a) => Arbitrary (Sensitive a) where+ arbitrary = Sensitive <$> arbitrary++instance Arbitrary SecretKey where+ arbitrary = SecretKey . fromString <$> suchThat Unicode.string (not . null)++instance Arbitrary SessionToken where+ arbitrary = SessionToken <$> arbitrary++instance Arbitrary AuthEnv where+ arbitrary = AuthEnv <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
test/Test/AWS/Data/Base64.hs view
@@ -2,9 +2,9 @@ -- | -- Module : Test.AWS.Data.Base64--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
test/Test/AWS/Data/List.hs view
@@ -2,9 +2,9 @@ -- | -- Module : Test.AWS.Data.List--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
test/Test/AWS/Data/Maybe.hs view
@@ -2,9 +2,9 @@ -- | -- Module : Test.AWS.Data.Maybe--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
test/Test/AWS/Data/Numeric.hs view
@@ -3,9 +3,9 @@ -- | -- Module : Test.AWS.Data.Numeric--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
test/Test/AWS/Data/Path.hs view
@@ -2,9 +2,9 @@ -- | -- Module : Test.AWS.Data.Path--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
+ test/Test/AWS/Data/Query.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Test.AWS.Query.List+-- Copyright : (c) 2013-2017 Brendan Hay+-- License : Mozilla Public License, v. 2.0.+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+module Test.AWS.Data.Query (tests) where++import Network.AWS.Prelude+import Test.Tasty+import Test.Tasty.HUnit (testCase, (@?=))++tests :: TestTree+tests = testGroup "query"+ [ testGroup "fromString"+ [ testCase "key" $+ parseQueryString "foo" @?=+ QList [ QPair "foo" (QValue Nothing)+ ]++ , testCase "key=" $+ parseQueryString "foo=" @?=+ QList [ QPair "foo" (QValue Nothing)+ ]++ , testCase "key=value" $+ parseQueryString "foo=bar" @?=+ QList [ QPair "foo" (QValue (Just "bar"))+ ]++ , testCase "key&.." $+ parseQueryString "foo&bar&baz" @?=+ QList [ QPair "foo" (QValue Nothing)+ , QPair "bar" (QValue Nothing)+ , QPair "baz" (QValue Nothing)+ ]++ , testCase "key=value&.." $+ parseQueryString "foo=1&bar=2&baz&qux=3" @?=+ QList [ QPair "foo" (QValue (Just "1"))+ , QPair "bar" (QValue (Just "2"))+ , QPair "baz" (QValue Nothing)+ , QPair "qux" (QValue (Just "3"))+ ]++ ]+ ]
test/Test/AWS/Data/Time.hs view
@@ -4,9 +4,9 @@ -- | -- Module : Test.AWS.Data.Time--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
test/Test/AWS/Error.hs view
@@ -3,9 +3,9 @@ -- | -- Module : Test.AWS.Error--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -21,7 +21,7 @@ import Network.AWS.Error import Network.AWS.Prelude import Test.AWS.Arbitrary ()-import Test.QuickCheck.Property+import Test.QuickCheck.Property () import Test.Tasty import Test.Tasty.HUnit
+ test/Test/AWS/Sign/V2Header/BaseSpec.hs view
@@ -0,0 +1,278 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Test.AWS.Sign.V2Header.BaseSpec+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+module Test.AWS.Sign.V2Header.BaseSpec (tests) where++import Control.Applicative+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS8+import qualified Data.CaseInsensitive as CI+import qualified Data.List as List+import Data.List.Ordered (subset)+import Data.Maybe (isJust)+import Data.Monoid ((<>))+import qualified Data.Text as Text+import qualified Network.AWS.Data.Query as Query+import Network.AWS.Sign.V2Header.Base+import qualified Network.HTTP.Types as HTTP+import qualified Test.QuickCheck as QC+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.QuickCheck (Gen, Property, testProperty)++tests :: TestTree+tests = testGroup "v2Header.BaseSpec"+ [ testGroup "constructSigningQuery"++ [ testProperty "should always convert set QValues to Nothing"+ prop_QValueEmpty+ , testCase "should keep an unset QValue" $+ constructSigningQuery (Query.QValue (Nothing :: Maybe ByteString)) @?= (Query.QValue (Nothing :: Maybe ByteString))+ , testProperty "should discard QPairs that are not interesting to AWS"+ prop_UninterestingQPairs+ , testProperty "should keep all QPairs that are interesting to AWS"+ prop_InterestingQPairs+ , testCase "should keep an empty QList" $+ constructSigningQuery (Query.QList []) @?= Query.QList []+ , testCase "should keep a list of Nothing QValues" $+ constructSigningQuery (Query.QList [(Query.QValue Nothing)]) @?= (Query.QList [(Query.QValue Nothing)])+ , testProperty "should discard the contents of an unintersting QList"+ prop_UninterestingQLists+ , testProperty "should not discard all QC.elements in interesting QLists"+ prop_InterestingQLists+ ]++ , testGroup "constructSigningHeader"+ [ testProperty "should convert random headers to their header value"+ prop_RandomHeaders+ , testProperty "should convert interesting headers to their header value"+ prop_InterestingHeaders+ , testProperty "should convert aws headers to a canonical string"+ prop_InterestingAwsHeaders+ ]++ , testGroup "auxiliary headers functions"+ [ testProperty "should sort and preserve headers"+ prop_SortedHeaders+ , testCase "should contain empty md5 and empty content type headers if not present" $+ [(HTTP.hContentMD5, ""), (HTTP.hContentType, "")] `subset` (unionNecessaryHeaders []) @?= True+ , testCase "should preserve a set md5 and contain an empty content type header if not present" $+ [(HTTP.hContentMD5, "123"), (HTTP.hContentType, "")] `subset` (unionNecessaryHeaders [(HTTP.hContentMD5, "123")]) @?= True+ , testCase "should preserve a set content type and preserve an empty md5 header if not present" $+ [(HTTP.hContentType, "123"), (HTTP.hContentMD5, "")] `subset` (unionNecessaryHeaders [(HTTP.hContentType, "123")]) @?= True+ , testCase "should preserve md5 and content type headers if set" $+ [(HTTP.hContentType, "123"), (HTTP.hContentMD5, "456")] `subset` unionNecessaryHeaders [(HTTP.hContentType, "123"), (HTTP.hContentMD5, "456")] @?= True+ ]++ , testGroup "toSingerQBS"+ [ testCase "should convert an empty query string" $+ toSignerQueryBS (Query.QValue Nothing) @?= ""+ , testCase "should convert an empty value of QPair to just the key" $+ toSignerQueryBS (Query.QPair "key" (Query.QValue Nothing)) @?= "key"+ , testCase "should convert an empty value of QPair followed by QValue to just the key and just the value" $+ toSignerQueryBS (Query.QList [(Query.QPair "key" (Query.QValue Nothing)), (Query.QValue $+ Just "key2")]) @?= "key&key2"+ ]++ , testGroup "constructFullPath"+ [ testCase "should convert an empty queryString to just the path" $+ constructFullPath "path" "" @?= "path"+ , testCase "should convert an empty value of QPair and a path to just the path and the key" $+ constructFullPath "path" (toSignerQueryBS (Query.QPair "key" (Query.QValue Nothing))) @?= "path?key"+ ]++ , testGroup "should construct canonical headers"+ [ testCase "should construct a canonical header from a base string" $+ newSigner [] "GET" "\\" "" @?= "GET\n\n\n\\"+ ]++ ]++-- Properties for non-empty QValues++prop_QValueEmpty :: Property+prop_QValueEmpty =+ QC.forAll uninterestingQValues $ \qv ->+ constructSigningQuery qv ==+ Query.QValue (Nothing :: Maybe ByteString)++-- Generators / properties for uninteresting query pairs++prop_UninterestingQPairs :: Property+prop_UninterestingQPairs =+ QC.forAll uninterestingQPairs $ \qpair ->+ constructSigningQuery qpair == Query.QValue Nothing++uninterestingQPairs :: Gen Query.QueryString+uninterestingQPairs =+ Query.toQuery <$> ((,) <$> nonEmptyText <*> uninterestingQValues)++-- Generators / properties for interesting query pairs++prop_InterestingQPairs :: Property+prop_InterestingQPairs =+ QC.forAll interestingQPairs $ \qpair ->+ constructSigningQuery qpair /= Query.QValue Nothing++interestingQueryKey :: Gen ByteString+interestingQueryKey =+ QC.elements+ [ "acl"+ , "cors"+ , "defaultObjectAcl"+ , "location"+ , "logging"+ , "partNumber"+ , "policy"+ , "requestPayment"+ , "torrent"+ , "versioning"+ , "versionId"+ , "versions"+ , "website"+ , "uploads"+ , "uploadId"+ , "response-content-type"+ , "response-content-language"+ , "response-expires"+ , "response-cache-control"+ , "response-content-disposition"+ , "response-content-encoding"+ , "delete"+ , "lifecycle"+ , "tagging"+ , "restore"+ , "storageClass"+ , "websiteConfig"+ , "compose"+ ]++interestingQPairs :: Gen Query.QueryString+interestingQPairs =+ Query.toQuery <$> ((,) <$> interestingQueryKey <*> uninterestingQValues)++-- Generators / properties for query lists++prop_UninterestingQLists :: Property+prop_UninterestingQLists =+ QC.forAll uninterestingQLists $+ not . containsAnything . constructSigningQuery++uninterestingQLists :: Gen Query.QueryString+uninterestingQLists =+ Query.toQueryList+ <$> nonEmptyByteString+ <*> QC.listOf+ ( QC.frequency+ [ (1, uninterestingQPairs)+ , (1, uninterestingQValues)+ , (1, uninterestingQLists)+ ]+ )++containsAnything :: Query.QueryString -> Bool+containsAnything = \case+ Query.QValue v -> isJust v+ Query.QPair {} -> True+ Query.QList qs -> any containsAnything qs++interestingQLists :: Gen Query.QueryString+interestingQLists =+ Query.toQueryList+ <$> interestingQueryKey+ <*> QC.listOf+ ( QC.frequency+ [ (1, interestingQLists)+ , (1, uninterestingQPairs)+ , (1, uninterestingQValues)+ , (1, uninterestingQLists)+ ]+ )++-- this property should probably be expanded to check that all qpairs actually contain interesting query keys AND that uninteresting+-- query keys are actually preserved underneath an interesting one+prop_InterestingQLists :: Property+prop_InterestingQLists =+ QC.forAll interestingQLists $+ containsAnything . constructSigningQuery++prop_RandomHeaders :: Property+prop_RandomHeaders =+ QC.forAll randomHeaderGenerator $ \hdr ->+ constructSigningHeader hdr == snd hdr++prop_InterestingHeaders :: Property+prop_InterestingHeaders =+ QC.forAll interestingHeaderGenerator $ \hdr ->+ constructSigningHeader hdr == snd hdr++prop_InterestingAwsHeaders :: Property+prop_InterestingAwsHeaders =+ QC.forAll interestingAwsHeaderGenerator $ \hdr ->+ constructSigningHeader hdr ==+ (CI.foldedCase (fst hdr) <> ":" <> snd hdr)++-- Generator / Property for headers+randomHeaderGenerator :: Gen HTTP.Header+randomHeaderGenerator =+ (,) <$> (CI.mk <$> nonEmptyByteString) <*> nonEmptyByteString++interestingAwsHeaderName :: Gen HTTP.HeaderName+interestingAwsHeaderName =+ CI.mk <$> BS8.pack <$> fmap ("aws-" <>) nonEmptyString++interestingHeaderName :: Gen HTTP.HeaderName+interestingHeaderName =+ QC.elements [HTTP.hContentMD5, HTTP.hContentType, HTTP.hDate]++interestingHeaderGenerator :: Gen HTTP.Header+interestingHeaderGenerator =+ (,) <$> interestingHeaderName <*> nonEmptyByteString++interestingAwsHeaderGenerator :: Gen HTTP.Header+interestingAwsHeaderGenerator =+ (,) <$> interestingAwsHeaderName <*> nonEmptyByteString++-- Generators / Properties for auxiliary header functions++prop_SortedHeaders :: Property+prop_SortedHeaders =+ QC.forAll allHeadersGenerator $ \allHeaders -> testHeaders allHeaders++allHeadersGenerator :: Gen [HTTP.Header]+allHeadersGenerator =+ QC.listOf $ QC.frequency+ [ (1, interestingHeaderGenerator)+ , (1, interestingAwsHeaderGenerator)+ ]++allIncreasing :: [HTTP.Header] -> Bool+allIncreasing xs =+ and $ zipWith (<=) mapped $ drop 1 mapped+ where+ mapped = map fst xs++testHeaders :: [HTTP.Header] -> Bool+testHeaders headers =+ length sortedHeaders == length sortedHeaders && allIncreasing sortedHeaders+ where+ sortedHeaders = List.sort headers++-- Generators for Text / QueryValues++nonEmptyByteString :: Gen ByteString+nonEmptyByteString = BS8.pack <$> nonEmptyString++uninterestingQValues :: Gen Query.QueryString+uninterestingQValues = Query.toQuery <$> nonEmptyText++nonEmptyText :: Gen Text.Text+nonEmptyText = Text.pack <$> nonEmptyString++nonEmptyString :: Gen String+nonEmptyString = QC.listOf1 QC.arbitrary
test/Test/AWS/Sign/V4.hs view
@@ -3,28 +3,18 @@ -- | -- Module : Test.AWS.Sign.V$--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) -- module Test.AWS.Sign.V4 (tests) where -import qualified Data.ByteString.Char8 as BS8-import qualified Data.Foldable as Fold-import Data.List (sort)-import Data.Monoid-import Data.String-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import Network.AWS.Prelude-import Network.AWS.Sign.V4-import Test.AWS.Arbitrary ()-import Test.QuickCheck.Property-import Test.Tasty-import Test.Tasty.QuickCheck+import Test.Tasty (TestTree, testGroup) +import qualified Test.AWS.Sign.V4.Chunked as Chunked+ -- Write some V4 signing properties: -- test canonical query -- test query@@ -36,4 +26,9 @@ -- test empty query tests :: TestTree-tests = testGroup "v4" []+tests =+ testGroup "v4"+ [ testGroup "chunked"+ [ Chunked.tests+ ]+ ]
+ test/Test/AWS/Sign/V4/Chunked.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module : Test.AWS.Sign.V$+-- Copyright : (c) 2013-2017 Brendan Hay+-- License : Mozilla Public License, v. 2.0.+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+module Test.AWS.Sign.V4.Chunked (tests) where++import Prelude hiding (elem)++import Data.List (sort)+import Data.Monoid+import Data.String++import Network.AWS.Lens ((%~), (&), (.~))+import Network.AWS.Prelude+import Network.AWS.Sign.V4++import Numeric (showHex)++import Test.AWS.Arbitrary ()+import Test.QuickCheck.Property ()+import Test.Tasty+import Test.Tasty.QuickCheck++import qualified Data.ByteString.Char8 as BS8+import qualified Data.Conduit.List as Conduit+import qualified Data.Foldable as Fold+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Network.HTTP.Conduit as Client+import qualified Test.QuickCheck as QC++tests :: TestTree+tests = testGroup "headers"+ [ testProperty "empty body" testEmptyBody+ , testProperty "1 chunk body" testOneChunkBody+ , testProperty "2 chunks body" testTwoChunksBody+ ]++testEmptyBody :: Property+testEmptyBody =+ QC.forAll (mkSigned []) $ \Signed{..} ->+ let elem = (`Fold.elem` Client.requestHeaders sgRequest)+ in elem ("Content-Encoding", "aws-chunked")+ && elem ("X-Amz-Decoded-Content-Length", "0")+ && elem ("Content-Length", "86")++testOneChunkBody :: Property+testOneChunkBody =+ let n = 123+ str = BS8.pack . show+ inp = BS8.replicate n 'a'++ in QC.forAll (mkSigned [inp]) $ \Signed{..} ->+ let elem = (`Fold.elem` Client.requestHeaders sgRequest)+ in elem ("Content-Encoding", "aws-chunked")+ && elem ("X-Amz-Decoded-Content-Length", str n)+ && elem ("Content-Length", str (87 + n + 86))++testTwoChunksBody :: Property+testTwoChunksBody =+ let size = fromIntegral defaultChunkSize+ sizeLen = length (showHex size "")+ n = 123+ str = BS8.pack . show+ full = BS8.replicate size 'a' -- full-sized chunk+ final = BS8.replicate n 'b' -- final non-empty chunk++ in QC.forAll (mkSigned [full, final]) $ \Signed{..} ->+ let elem = (`Fold.elem` Client.requestHeaders sgRequest)+ in elem ("Content-Encoding", "aws-chunked")+ && elem ("X-Amz-Decoded-Content-Length", str (size + n))+ && elem ("Content-Length", str (sizeLen + 85 + size + 87 + n + 86))++mkSigned :: [BS8.ByteString] -> Gen (Signed ())+mkSigned bs = do+ aReq <- arbitrary+ aService <- arbitrary++ let svc = aService+ & serviceSigner .~ v4++ req = aReq+ & rqBody .~ Chunked (mkBody bs)+ & rqService .~ svc++ rqSign req <$> arbitrary <*> arbitrary <*> arbitrary++mkBody :: [BS8.ByteString] -> ChunkedBody+mkBody bs =+ ChunkedBody defaultChunkSize+ (fromIntegral . sum $ fmap BS8.length bs)+ (Conduit.sourceList bs)+
test/Test/AWS/Util.hs view
@@ -2,9 +2,9 @@ -- | -- Module : Test.AWS.Util--- Copyright : (c) 2013-2016 Brendan Hay+-- Copyright : (c) 2013-2017 Brendan Hay -- License : Mozilla Public License, v. 2.0.--- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Maintainer : Brendan Hay <brendan.g.hay+amazonka@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --