packages feed

amazonka-core 1.5.0 → 2.0

raw patch · 95 files changed

Files

− README.md 
@@ -1,24 +0,0 @@-# Amazonka Core--* [Description](#description)-* [Contribute](#contribute)-* [Licence](#licence)--## Description--Core functionality, serialisation primitives, and data types for-Amazonka related Amazon Web Services SDKs.--The external interface of this library is stable with respect to the-downstream Amazonka libraries, only, and as such is probably not suitable-for use in non-Amazonka projects.---## Contribute--For any problems, comments, or feedback please create an issue [here on GitHub](https://github.com/brendanhay/amazonka/issues).---## Licence--`amazonka-core` is released under the [Mozilla Public License Version 2.0](http://www.mozilla.org/MPL/).
− Setup.hs 
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
amazonka-core.cabal view
@@ -1,162 +1,168 @@-name:                  amazonka-core-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:               MPL-2.0-license-file:          LICENSE-author:                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-cabal-version:         >= 1.10+cabal-version: 2.2+name:          amazonka-core+version:       2.0+synopsis:      Core data types and functionality for Amazonka libraries.+homepage:      https://github.com/brendanhay/amazonka+bug-reports:   https://github.com/brendanhay/amazonka/issues+license:       MPL-2.0+license-file:  LICENSE+author:        Brendan Hay+maintainer:+  Brendan Hay <brendan.g.hay+amazonka@gmail.com>, Jack Kelly <jack@jackkelly.name> +copyright:     Copyright (c) 2013-2023 Brendan Hay+category:      AWS+build-type:    Simple description:-    Core data types, functionality and serialisation primitives for-    Amazonka related Amazon Web Services SDKs.-    .-    The external interface of this library is stable with respect to the-    downstream Amazonka libraries, only, and as such is not suitable-    for use in non-Amazonka projects.+  Core data types and serialisation primitives for Amazonka related Amazon Web Service SDKs.+  .+  The external interface of this library is stable with respect to the downstream+  Amazonka libraries only, and is not suitable for use in non-Amazonka projects.  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-    default:           False--library-    default-language:  Haskell2010-    hs-source-dirs:    src--    ghc-options:-        -Wall-        -fwarn-incomplete-uni-patterns-        -fwarn-incomplete-record-updates-        -funbox-strict-fields+  type:     git+  location: git://github.com/brendanhay/amazonka.git+  subdir:   lib/amazonka-core -    exposed-modules:-          Network.AWS.Compat.Locale-        , Network.AWS.Compat.Time-        , Network.AWS.Data.Base64-        , Network.AWS.Data.Body-        , Network.AWS.Data.ByteString-        , Network.AWS.Data.Crypto-        , Network.AWS.Data.Headers-        , Network.AWS.Data.JSON-        , Network.AWS.Data.List1-        , Network.AWS.Data.Log-        , Network.AWS.Data.Map-        , Network.AWS.Data.Numeric-        , Network.AWS.Data.Path-        , Network.AWS.Data.Query-        , Network.AWS.Data.Sensitive-        , Network.AWS.Data.Text-        , Network.AWS.Data.Time-        , Network.AWS.Data.XML-        , Network.AWS.Endpoint-        , Network.AWS.Error-        , Network.AWS.Lens-        , Network.AWS.Pager-        , 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-        , Network.AWS.Waiter+common base+  default-language:   Haskell2010+  ghc-options:+    -Wall -funbox-strict-fields -fwarn-incomplete-uni-patterns+    -fwarn-incomplete-record-updates -fwarn-missing-deriving-strategies+    -fwarn-unused-packages -    other-modules:-          Network.AWS.Sign.V4.Base-        , Network.AWS.Sign.V4.Chunked+  default-extensions:+    NoImplicitPrelude+    ConstraintKinds+    DataKinds+    DefaultSignatures+    DeriveAnyClass+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveTraversable+    DerivingStrategies+    DerivingVia+    DuplicateRecordFields+    FlexibleContexts+    FlexibleInstances+    GADTs+    GeneralizedNewtypeDeriving+    LambdaCase+    NamedFieldPuns+    OverloadedStrings+    PackageImports+    PatternSynonyms+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    StandaloneDeriving+    StrictData+    TupleSections+    TypeApplications+    TypeFamilies+    ViewPatterns -    build-depends:-          aeson                >= 0.8-        , attoparsec           >= 0.11.3-        , base                 >= 4.7 && < 5-        , bifunctors           >= 4.1-        , bytestring           >= 0.9-        , case-insensitive     >= 1.2-        , conduit              >= 1.1-        , conduit-extra        >= 1.1-        , cryptonite           >= 0.4-        , deepseq              >= 1.4-        , exceptions           >= 0.6-        , hashable             >= 1.2-        , http-conduit         >= 2.2 && < 3-        , http-types           >= 0.8-        , lens                 >= 4.4-        , memory               >= 0.6-        , mtl                  >= 2.1.3.1-        , resourcet            >= 1.1-        , scientific           >= 0.3-        , semigroups           >= 0.12-        , tagged               >= 0.7-        , text                 >= 1.1-        , transformers         >= 0.2-        , transformers-compat  >= 0.3-        , unordered-containers >= 0.2.7-        , xml-conduit          >= 1.2-        , xml-types            >= 0.3.4+  build-depends:      base >=4.12 && <5 -    if !impl(ghc>=7.9)-        build-depends:-              nats >= 0.1.3+library+  import:          base+  hs-source-dirs:  src+  exposed-modules:+    Amazonka.Bytes+    Amazonka.Core+    Amazonka.Core.Lens+    Amazonka.Core.Lens.Internal+    Amazonka.Crypto+    Amazonka.Data+    Amazonka.Data.Base64+    Amazonka.Data.Body+    Amazonka.Data.ByteString+    Amazonka.Data.Headers+    Amazonka.Data.JSON+    Amazonka.Data.Log+    Amazonka.Data.Path+    Amazonka.Data.Query+    Amazonka.Data.Sensitive+    Amazonka.Data.Text+    Amazonka.Data.Time+    Amazonka.Data.XML+    Amazonka.Endpoint+    Amazonka.Error+    Amazonka.Pager+    Amazonka.Prelude+    Amazonka.Request+    Amazonka.Response+    Amazonka.Sign.V2+    Amazonka.Sign.V2Header+    Amazonka.Sign.V4+    Amazonka.Sign.V4.Base+    Amazonka.Sign.V4.Chunked+    Amazonka.Types+    Amazonka.Waiter -    if flag(old-locale)-        build-depends:-              old-locale == 1.*-            , time       >= 1.2 && < 1.5-    else-        build-depends:-              time       >= 1.5+  build-depends:+    , aeson                 ^>=1.5.0.0 || >=2.0 && <2.2 || ^>=2.2+    , attoparsec            >=0.11.3+    , bytestring            >=0.10.8+    , case-insensitive      >=1.2+    , conduit               >=1.3+    , conduit-extra         >=1.3+    , containers            >=0.5      && <0.7+    , crypton               >=0.32     && <0.34+    , deepseq               >=1.4+    , hashable              >=1.2+    , http-client           >=0.5      && <0.8+    , http-conduit          >=2.3      && <3+    , http-types            >=0.12+    , lens                  >=4.14+    , memory                >=0.6+    , regex-posix           >=0.96+    , resourcet             >=1.1+    , scientific            >=0.3+    , text                  >=1.1+    , time                  >=1.9+    , transformers          >=0.2+    , unordered-containers  >=0.2.7+    , xml-conduit           >=1.7.0.1+    , xml-types             >=0.3.4  test-suite tests-    type:              exitcode-stdio-1.0-    default-language:  Haskell2010-    hs-source-dirs:    test-    main-is:           Main.hs--    ghc-options:       -Wall -threaded--    other-modules:-          Test.AWS.Arbitrary-        , Test.AWS.Data.Base64-        , Test.AWS.Data.List-        , 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+  import:         base+  type:           exitcode-stdio-1.0+  hs-source-dirs: test+  main-is:        Main.hs+  ghc-options:    -Wall -threaded+  other-modules:+    Test.Amazonka.Arbitrary+    Test.Amazonka.Data.Base64+    Test.Amazonka.Data.List+    Test.Amazonka.Data.Maybe+    Test.Amazonka.Data.Numeric+    Test.Amazonka.Data.Path+    Test.Amazonka.Data.Query+    Test.Amazonka.Data.Time+    Test.Amazonka.Error+    Test.Amazonka.Sign.V2Header+    Test.Amazonka.Sign.V4+    Test.Amazonka.Sign.V4.Base+    Test.Amazonka.Sign.V4.Chunked+    Test.Amazonka.Util -    build-depends:-          aeson-        , amazonka-core-        , base-        , bytestring-        , case-insensitive-        , conduit-        , data-ordlist-        , http-conduit-        , http-types-        , lens-        , QuickCheck-        , quickcheck-unicode-        , tasty-        , tasty-hunit-        , tasty-quickcheck-        , template-haskell-        , text-        , time+  build-depends:+    , aeson+    , amazonka-core+    , bytestring+    , case-insensitive+    , conduit+    , data-ordlist+    , http-conduit+    , http-types+    , QuickCheck+    , quickcheck-unicode+    , tasty+    , tasty-hunit+    , tasty-quickcheck+    , template-haskell+    , text+    , time
+ src/Amazonka/Bytes.hs view
@@ -0,0 +1,31 @@+-- |+-- Module      : Amazonka.Bytes+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Bytes+  ( convert,+    encodeBase16,+    decodeBase16,+    encodeBase64,+    decodeBase64,+  )+where++import Amazonka.Prelude+import Data.ByteArray (ByteArrayAccess, convert)+import qualified Data.ByteArray.Encoding as ByteArray.Encoding++encodeBase16 :: ByteArrayAccess a => a -> ByteString+encodeBase16 = ByteArray.Encoding.convertToBase ByteArray.Encoding.Base16++decodeBase16 :: ByteArrayAccess a => a -> Either String ByteString+decodeBase16 = ByteArray.Encoding.convertFromBase ByteArray.Encoding.Base16++encodeBase64 :: ByteArrayAccess a => a -> ByteString+encodeBase64 = ByteArray.Encoding.convertToBase ByteArray.Encoding.Base64++decodeBase64 :: ByteArrayAccess a => a -> Either String ByteString+decodeBase64 = ByteArray.Encoding.convertFromBase ByteArray.Encoding.Base64
+ src/Amazonka/Core.hs view
@@ -0,0 +1,46 @@+-- |+-- Module      : Amazonka.Core+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- Types and values referenced by generated code.+module Amazonka.Core+  ( module Amazonka.Types,+    module Amazonka.Endpoint,+    module Amazonka.Data,+    module Amazonka.Pager,+    module Amazonka.Waiter,+    module Amazonka.Error,+    (.!@),+    may,+  )+where++-- Export Amazonka.Data submodules piecemeal and avoid exporting AWS+-- encoding/decoding modules, so we don't leak too much to library+-- clients. Service bindings import Amazonka.Data directly.+import Amazonka.Data.Base64 as Amazonka.Data+import Amazonka.Data.Body as Amazonka.Data+import Amazonka.Data.Log as Amazonka.Data+import Amazonka.Data.Sensitive as Amazonka.Data+import Amazonka.Data.Time as Amazonka.Data+import Amazonka.Endpoint+import Amazonka.Error+import Amazonka.Pager+import Amazonka.Prelude+import Amazonka.Types+import Amazonka.Waiter++-- Legacy code generation operators++infixl 7 .!@++(.!@) :: Functor f => f (Maybe a) -> a -> f a+f .!@ x = fromMaybe x <$> f++may :: Applicative f => ([a] -> f b) -> [a] -> f (Maybe b)+may _ [] = pure Nothing+may f xs = Just <$> f xs
+ src/Amazonka/Core/Lens.hs view
@@ -0,0 +1,125 @@+-- |+-- Module      : Amazonka.Core.Lens+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- Re-export lenses and other optics for types in @amazonka-core@. You+-- will probably find record updates,+-- [generic-lens](https://hackage.haskell.org/package/generic-lens),+-- [generic-optics](https://hackage.haskell.org/package/generic-optics),+-- or (GHC >=9.2) @-XOverloadedRecordDot@ more ergonomic than these.+module Amazonka.Core.Lens+  ( -- * Amazonka.Data.Body++    -- ** ResponseBody+    _ResponseBody,++    -- ** ChunkSize+    _ChunkSize,++    -- ** ChunkedBody+    chunkedBody_size,+    chunkedBody_length,+    chunkedBody_body,++    -- * Amazonka.Data.Time+    _Time,++    -- * Amazonka.Types++    -- ** Abbrev+    _Abbrev,++    -- ** AccessKey+    _AccessKey,++    -- ** AuthEnv+    authEnv_accessKeyId,+    authEnv_secretAccessKey,+    authEnv_sessionToken,+    authEnv_expiration,++    -- ** Endpoint+    endpoint_host,+    endpoint_basePath,+    endpoint_secure,+    endpoint_port,+    endpoint_scope,++    -- ** ErrorCode+    _ErrorCode,++    -- ** ErrorMessage+    _ErrorMessage,++    -- ** Request+    request_service,+    request_method,+    request_path,+    request_query,+    request_headers,+    request_body,++    -- ** RequestId+    _RequestId,++    -- ** Retry+    retry_base,+    retry_growth,+    retry_attempts,+    retry_check,++    -- ** SecretKey+    _SecretKey,++    -- ** SessionToken+    _SessionToken,++    -- ** SerializeError+    serializeError_abbrev,+    serializeError_status,+    serializeError_body,+    serializeError_message,++    -- ** Service+    service_abbrev,+    service_signer,+    service_signingName,+    service_version,+    service_s3AddressingStyle,+    service_endpointPrefix,+    service_endpoint,+    service_timeout,+    service_check,+    service_error,+    service_retry,++    -- ** ServiceError+    serviceError_abbrev,+    serviceError_status,+    serviceError_headers,+    serviceError_code,+    serviceError_message,+    serviceError_requestId,++    -- ** Signed+    signed_signedMeta,+    signed_signedRequest,++    -- * Amazonka.Waiter++    -- ** Wait+    wait_name,+    wait_attempts,+    wait_delay,+    wait_acceptors,+  )+where++import Amazonka.Data.Body+import Amazonka.Data.Time+import Amazonka.Types+import Amazonka.Waiter
+ src/Amazonka/Core/Lens/Internal.hs view
@@ -0,0 +1,65 @@+-- |+-- Module      : Amazonka.Core.Lens.Internal+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- Re-export a number of lens types and combinators for use in service+-- bindings.+module Amazonka.Core.Lens.Internal (module Export) where++import Control.Exception.Lens as Export+  ( catching,+    catching_,+    exception,+    throwingM,+    trying,+    _IOException,+  )+import Control.Lens as Export+  ( AReview,+    Choice,+    Fold,+    Getter,+    Getting,+    IndexedTraversal',+    Iso',+    Lens,+    Lens',+    Optic',+    Prism',+    Setter',+    Traversal',+    allOf,+    anyOf,+    coerced,+    concatOf,+    filtered,+    folding,+    has,+    iso,+    lens,+    mapping,+    non,+    prism,+    sets,+    to,+    traversed,+    un,+    view,+    (#),+    (%~),+    (.~),+    (<&>),+    (<>~),+    (?~),+    (^.),+    (^..),+    (^?),+    _1,+    _2,+    _Just,+    _last,+  )
+ src/Amazonka/Crypto.hs view
@@ -0,0 +1,76 @@+-- |+-- Module      : Amazonka.Crypto+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Crypto+  ( -- * HMAC+    Key,+    hmacSHA1,+    hmacSHA256,++    -- * Hashing+    hashSHA1,+    hashSHA256,+    hashMD5,+    Hash.hash,+    --- * Incremental Hashing+    sinkSHA256,+    sinkMD5,++    -- * Re-exported+    Hash.HashAlgorithm,+    Hash.Digest,+    Hash.SHA256,+    Hash.MD5,+  )+where++import Amazonka.Prelude+import qualified Crypto.Hash as Hash+import qualified Crypto.MAC.HMAC as HMAC+import Data.ByteArray (ByteArrayAccess)+import Data.Conduit (ConduitM)+import qualified Data.Conduit as Conduit++type Key = ByteString++hmacSHA1 :: ByteArrayAccess a => Key -> a -> HMAC.HMAC Hash.SHA1+hmacSHA1 = HMAC.hmac++hmacSHA256 :: ByteArrayAccess a => Key -> a -> HMAC.HMAC Hash.SHA256+hmacSHA256 = HMAC.hmac++hashSHA1 :: ByteArrayAccess a => a -> Hash.Digest Hash.SHA1+hashSHA1 = Hash.hashWith Hash.SHA1++hashSHA256 :: ByteArrayAccess a => a -> Hash.Digest Hash.SHA256+hashSHA256 = Hash.hashWith Hash.SHA256++hashMD5 :: ByteArrayAccess a => a -> Hash.Digest Hash.MD5+hashMD5 = Hash.hashWith Hash.MD5++-- | Incrementally calculate a 'MD5' 'Digest'.+sinkMD5 :: Monad m => ConduitM ByteString o m (Hash.Digest Hash.MD5)+sinkMD5 = sinkHash++-- | Incrementally calculate a 'SHA256' 'Digest'.+sinkSHA256 :: Monad m => ConduitM ByteString o m (Hash.Digest Hash.SHA256)+sinkSHA256 = sinkHash++-- | A crypton-compatible incremental hash sink.+sinkHash ::+  ( Monad m,+    Hash.HashAlgorithm a+  ) =>+  ConduitM ByteString o m (Hash.Digest a)+sinkHash = sink Hash.hashInit+  where+    sink ctx = do+      mbs <- Conduit.await++      case mbs of+        Nothing -> pure $! Hash.hashFinalize ctx+        Just bs -> sink $! Hash.hashUpdate ctx bs
+ src/Amazonka/Data.hs view
@@ -0,0 +1,24 @@+-- |+-- Module      : Amazonka.Data+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Data+  ( module Export,+  )+where++import Amazonka.Data.Base64 as Export+import Amazonka.Data.Body as Export+import Amazonka.Data.ByteString as Export+import Amazonka.Data.Headers as Export+import Amazonka.Data.JSON as Export+import Amazonka.Data.Log as Export+import Amazonka.Data.Path as Export+import Amazonka.Data.Query as Export+import Amazonka.Data.Sensitive as Export+import Amazonka.Data.Text as Export+import Amazonka.Data.Time as Export+import Amazonka.Data.XML as Export
+ src/Amazonka/Data/Base64.hs view
@@ -0,0 +1,71 @@+-- |+-- Module      : Amazonka.Data.Base64+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Data.Base64+  ( Base64 (..),+    _Base64,+  )+where++import qualified Amazonka.Bytes as Bytes+import Amazonka.Core.Lens.Internal (iso)+import Amazonka.Data.Body+import Amazonka.Data.ByteString+import Amazonka.Data.JSON+import Amazonka.Data.Query+import Amazonka.Data.Text+import Amazonka.Data.XML+import Amazonka.Prelude+import qualified Data.Text.Encoding as Text++-- | Base64 encoded binary data.+--+-- Encoding\/decoding is automatically deferred to serialisation and deserialisation+-- respectively.+newtype Base64 = Base64 {unBase64 :: ByteString}+  deriving stock (Eq, Read, Ord, Generic)++instance Hashable Base64++instance NFData Base64++_Base64 :: Iso' Base64 ByteString+_Base64 = iso unBase64 Base64++-- FIXME: a mistake to wrap a ByteString since the underlying serialisers+-- (JSON, XML) use Text internally.+instance FromText Base64 where+  fromText = fmap Base64 . Bytes.decodeBase64 . Text.encodeUtf8++instance ToByteString Base64 where+  toBS = Bytes.encodeBase64 . unBase64++instance Show Base64 where+  show = show . toBS++instance ToText Base64 where+  toText = Text.decodeUtf8 . toBS++instance ToQuery Base64 where+  toQuery = toQuery . toBS++instance FromXML Base64 where+  parseXML = parseXMLText "Base64"++instance ToXML Base64 where+  toXML = toXMLText++instance FromJSON Base64 where+  parseJSON = parseJSONText "Base64"++instance ToJSON Base64 where+  toJSON = toJSONText++instance ToHashedBody Base64 where+  toHashed = toHashed . toBS++instance ToBody Base64
+ src/Amazonka/Data/Body.hs view
@@ -0,0 +1,447 @@+{-# LANGUAGE CPP #-}++-- |+-- Module      : Amazonka.Data.Body+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Data.Body where++import qualified Amazonka.Bytes as Bytes+import Amazonka.Core.Lens.Internal (coerced)+import Amazonka.Crypto (Digest, SHA256)+import qualified Amazonka.Crypto as Crypto+import Amazonka.Data.ByteString+import Amazonka.Data.Log+import Amazonka.Data.Query (QueryString)+import Amazonka.Data.XML (encodeXML)+import Amazonka.Prelude hiding (length)+import Control.Monad.Trans.Resource (ResourceT, runResourceT)+import qualified Data.Aeson as Aeson+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy.Char8 as LBS8+import Data.Conduit (ConduitM, (.|))+import qualified Data.Conduit as Conduit+import qualified Data.Conduit.Binary as Conduit.Binary+import qualified Data.Text.Encoding as Text+import qualified Data.Text.Lazy.Encoding as LText+import qualified Network.HTTP.Client as Client+import qualified Network.HTTP.Conduit as Client.Conduit+import qualified System.IO as IO+import qualified Text.XML as XML++#if MIN_VERSION_aeson(2,0,0)+import Data.Aeson.KeyMap (KeyMap)+#endif++-- | Convenience function for obtaining the size of a file.+getFileSize :: MonadIO m => FilePath -> m Integer+getFileSize path = liftIO (IO.withBinaryFile path IO.ReadMode IO.hFileSize)++-- | A streaming, exception safe response body.+--+-- @newtype@ for show/orhpan instance purposes.+newtype ResponseBody = ResponseBody+  {body :: ConduitM () ByteString (ResourceT IO) ()}+  deriving stock (Generic)++instance Show ResponseBody where+  show = const "ResponseBody { ConduitM () ByteString (ResourceT IO) () }"++{-# INLINE _ResponseBody #-}+_ResponseBody :: Iso' ResponseBody (ConduitM () ByteString (ResourceT IO) ())+_ResponseBody = coerced++fuseStream ::+  ResponseBody ->+  ConduitM ByteString ByteString (ResourceT IO) () ->+  ResponseBody+fuseStream b@ResponseBody {body} f = b {body = body .| f}++-- | Connect a 'Sink' to a response stream.+sinkBody :: MonadIO m => ResponseBody -> ConduitM ByteString Void (ResourceT IO) a -> m a+sinkBody (ResponseBody body) sink =+  liftIO $ Conduit.runConduitRes $ body .| sink++-- | Specifies the transmitted size of the 'Transfer-Encoding' chunks.+--+-- /See:/ 'defaultChunk'.+newtype ChunkSize = ChunkSize Int+  deriving stock (Eq, Ord, Show)+  deriving newtype (Enum, Num, Real, Integral)++instance ToLog ChunkSize where+  build = build . show++_ChunkSize :: Iso' ChunkSize Int+_ChunkSize = coerced++-- | The default chunk size of 128 KB. The minimum chunk size accepted by+-- AWS is 8 KB, unless the entirety of the request is below this threshold.+--+-- A chunk size of 64 KB or higher is recommended for performance reasons.+defaultChunkSize :: ChunkSize+defaultChunkSize = 128 * 1024++-- | An opaque request body which will be transmitted via+-- @Transfer-Encoding: chunked@.+--+-- /Invariant:/ Only services that support chunked encoding can+-- accept a 'ChunkedBody'. (Currently S3.) This is enforced by the type+-- signatures emitted by the generator.+data ChunkedBody = ChunkedBody+  { size :: ChunkSize,+    length :: Integer,+    body :: ConduitM () ByteString (ResourceT IO) ()+  }++{-# INLINE chunkedBody_size #-}+chunkedBody_size :: Lens' ChunkedBody ChunkSize+chunkedBody_size f b@ChunkedBody {size} = f size <&> \size' -> b {size = size'}++{-# INLINE chunkedBody_length #-}+chunkedBody_length :: Lens' ChunkedBody Integer+chunkedBody_length f b@ChunkedBody {length} = f length <&> \length' -> b {length = length'}++{-# INLINE chunkedBody_body #-}+chunkedBody_body :: Lens' ChunkedBody (ConduitM () ByteString (ResourceT IO) ())+chunkedBody_body f b@ChunkedBody {body} = f body <&> \body' -> (b :: ChunkedBody) {body = body'}++-- Maybe revert to using Source's, and then enforce the chunk size+-- during conversion from HashedBody -> ChunkedBody++instance Show ChunkedBody where+  show c =+    BS8.unpack . toBS $+      "ChunkedBody { chunkSize = "+        <> build (size c)+        <> "<> originalLength = "+        <> build (length c)+        <> "<> fullChunks = "+        <> build (fullChunks c)+        <> "<> remainderBytes = "+        <> build (remainderBytes c)+        <> "}"++fuseChunks ::+  ChunkedBody ->+  ConduitM ByteString ByteString (ResourceT IO) () ->+  ChunkedBody+fuseChunks c@ChunkedBody {body} f = c {body = body .| f}++fullChunks :: ChunkedBody -> Integer+fullChunks c = length c `div` fromIntegral (size c)++remainderBytes :: ChunkedBody -> Maybe Integer+remainderBytes ChunkedBody {length, size} =+  case length `mod` toInteger size of+    0 -> Nothing+    n -> Just n++-- | Construct a 'ChunkedBody' from a 'FilePath', where the contents will be+-- read and signed incrementally in chunks if the target service supports it.+--+-- Will intelligently revert to 'HashedBody' if the file is smaller than the+-- specified 'ChunkSize'.+--+-- /See:/ 'ToBody'.+chunkedFile :: MonadIO m => ChunkSize -> FilePath -> m RequestBody+chunkedFile chunk path = do+  size <- getFileSize path+  if size > toInteger chunk+    then return $ unsafeChunkedBody chunk size (sourceFileChunks chunk path)+    else Hashed <$> hashedFile path++-- | Construct a 'ChunkedBody' from a 'FilePath', specifying the range of bytes+-- to read. This can be useful for constructing multiple requests from a single+-- file, say for S3 multipart uploads.+--+-- /See:/ 'chunkedFile'.+chunkedFileRange ::+  MonadIO m =>+  -- | The idealized size of chunks that will be yielded downstream.+  ChunkSize ->+  -- | The file path to read.+  FilePath ->+  -- | The byte offset at which to start reading.+  Integer ->+  -- | The maximum number of bytes to read.+  Integer ->+  m RequestBody+chunkedFileRange chunk path offset len = do+  size <- getFileSize path+  let n = min (size - offset) len+  if n > toInteger chunk+    then return $ unsafeChunkedBody chunk n (sourceFileRangeChunks chunk path offset len)+    else Hashed <$> hashedFileRange path offset len++-- | Unsafely construct a 'ChunkedBody'.+--+-- This function is marked unsafe because it does nothing to enforce the chunk size.+-- Typically for conduit 'IO' functions, it's whatever ByteString's+-- 'defaultBufferSize' is, around 32 KB. If the chunk size is less than 8 KB,+-- the request will error. 64 KB or higher chunk size is recommended for+-- performance reasons.+--+-- Note that it will always create a chunked body even if the request+-- is too small.+--+-- /See:/ 'ToBody'.+unsafeChunkedBody ::+  -- | The idealized size of chunks that will be yielded downstream.+  ChunkSize ->+  -- | The size of the stream in bytes.+  Integer ->+  ConduitM () ByteString (ResourceT IO) () ->+  RequestBody+unsafeChunkedBody chunk size = Chunked . ChunkedBody chunk size++sourceFileChunks ::+  MonadResource m =>+  ChunkSize ->+  FilePath ->+  ConduitM () ByteString m ()+sourceFileChunks (ChunkSize chunk) path =+  Conduit.bracketP (IO.openBinaryFile path IO.ReadMode) IO.hClose go+  where+    -- Uses hGet with a specific buffer size, instead of hGetSome.+    go hd = do+      bs <- liftIO (BS.hGet hd chunk)+      unless (BS.null bs) $ do+        Conduit.yield bs+        go hd++sourceFileRangeChunks ::+  MonadResource m =>+  -- | The idealized size of chunks that will be yielded downstream.+  ChunkSize ->+  -- | The file path to read.+  FilePath ->+  -- | The byte offset at which to start reading.+  Integer ->+  -- | The maximum number of bytes to read.+  Integer ->+  ConduitM () ByteString m ()+sourceFileRangeChunks (ChunkSize chunk) path offset len =+  Conduit.bracketP acquire IO.hClose seek+  where+    acquire = IO.openBinaryFile path IO.ReadMode+    seek hd = do+      liftIO (IO.hSeek hd IO.AbsoluteSeek offset)+      go (fromIntegral len) hd++    go remainder hd+      | remainder <= chunk = do+          bs <- liftIO (BS.hGet hd remainder)+          unless (BS.null bs) $+            Conduit.yield bs+      --+      | otherwise = do+          bs <- liftIO (BS.hGet hd chunk)++          unless (BS.null bs) $ do+            Conduit.yield bs+            go (remainder - chunk) hd++-- | An opaque request body containing a 'SHA256' hash.+data HashedBody+  = HashedStream (Digest SHA256) !Integer (ConduitM () ByteString (ResourceT IO) ())+  | HashedBytes (Digest SHA256) ByteString++instance Show HashedBody where+  show = \case+    HashedStream h n _ -> str "HashedStream" h n+    HashedBytes h x -> str "HashedBody" h (BS.length x)+    where+      str c h n =+        BS8.unpack . toBS $+          c+            <> " { sha256 = "+            <> build (Bytes.encodeBase16 h)+            <> ", length = "+            <> build n++instance IsString HashedBody where+  fromString = toHashed++sha256Base16 :: HashedBody -> ByteString+sha256Base16 =+  Bytes.encodeBase16 . \case+    HashedStream h _ _ -> h+    HashedBytes h _ -> h++-- | Construct a 'HashedBody' from a 'FilePath', calculating the 'SHA256' hash+-- and file size.+--+-- /Note:/ While this function will perform in constant space, it will enumerate the+-- entirety of the file contents /twice/. Firstly to calculate the SHA256 and+-- lastly to stream the contents to the socket during sending.+--+-- /See:/ 'ToHashedBody'.+hashedFile ::+  MonadIO m =>+  -- | The file path to read.+  FilePath ->+  m HashedBody+hashedFile path =+  liftIO $+    HashedStream+      <$> runResourceT (Conduit.Binary.sourceFile path `Conduit.connect` Crypto.sinkSHA256)+      <*> getFileSize path+      <*> pure (Conduit.Binary.sourceFile path)++-- | Construct a 'HashedBody' from a 'FilePath', specifying the range of bytes+-- to read. This can be useful for constructing multiple requests from a single+-- file, say for S3 multipart uploads.+--+-- /See:/ 'hashedFile', 'Conduit.sourceFileRange'.+hashedFileRange ::+  MonadIO m =>+  -- | The file path to read.+  FilePath ->+  -- | The byte offset at which to start reading.+  Integer ->+  -- | The maximum number of bytes to read.+  Integer ->+  m HashedBody+hashedFileRange path offset len = do+  size <- getFileSize path+  let bytes = min len (size - offset)+      sourceFileRange =+        Conduit.Binary.sourceFileRange path (Just offset) (Just len)+  digest <-+    liftIO . runResourceT $ Conduit.connect sourceFileRange Crypto.sinkSHA256+  pure $ HashedStream digest bytes sourceFileRange++-- | Construct a 'HashedBody' from a 'Source', manually specifying the 'SHA256'+-- hash and file size. It's left up to the caller to calculate these correctly,+-- otherwise AWS will return signing errors.+--+-- /See:/ 'ToHashedBody'.+hashedBody ::+  -- | A SHA256 hash of the file contents.+  Crypto.Digest Crypto.SHA256 ->+  -- | The size of the stream in bytes.+  Integer ->+  ConduitM () ByteString (ResourceT IO) () ->+  HashedBody+hashedBody = HashedStream++-- | Invariant: only services that support /both/ standard and+-- chunked signing expose 'RequestBody' as a parameter.+data RequestBody+  = -- | Currently S3 only, see 'ChunkedBody' for details.+    Chunked ChunkedBody+  | Hashed HashedBody+  deriving stock (Show)++instance IsString RequestBody where+  fromString = Hashed . fromString++md5Base64 :: RequestBody -> Maybe ByteString+md5Base64 = \case+  Hashed (HashedBytes _ x) -> Just (Bytes.encodeBase64 (Crypto.hashMD5 x))+  _ -> Nothing++isStreaming :: RequestBody -> Bool+isStreaming = \case+  Hashed (HashedStream {}) -> True+  _ -> False++toRequestBody :: RequestBody -> Client.RequestBody+toRequestBody = \case+  Chunked ChunkedBody {body} -> Client.Conduit.requestBodySourceChunked body+  Hashed x -> case x of+    HashedStream _ n f -> Client.Conduit.requestBodySource (fromIntegral n) f+    HashedBytes _ b -> Client.RequestBodyBS b++contentLength :: RequestBody -> Integer+contentLength = \case+  Chunked ChunkedBody {length} -> length+  Hashed x -> case x of+    HashedStream _ n _ -> n+    HashedBytes _ b -> fromIntegral (BS.length b)++-- | Anything that can be safely converted to a 'HashedBody'.+class ToHashedBody a where+  -- | Convert a value to a hashed request body.+  toHashed :: a -> HashedBody++instance ToHashedBody ByteString where+  toHashed x = HashedBytes (Crypto.hash x) x++instance ToHashedBody HashedBody where+  toHashed = id++instance ToHashedBody String where+  toHashed = toHashed . LBS8.pack++instance ToHashedBody ByteStringLazy where+  toHashed = toHashed . toBS++instance ToHashedBody Text where+  toHashed = toHashed . Text.encodeUtf8++instance ToHashedBody TextLazy where+  toHashed = toHashed . LText.encodeUtf8++instance ToHashedBody Aeson.Value where+  toHashed = toHashed . Aeson.encode++instance ToHashedBody XML.Element where+  toHashed = toHashed . encodeXML++instance ToHashedBody QueryString where+  toHashed = toHashed . toBS++#if MIN_VERSION_aeson(2,0,0)+instance ToHashedBody (KeyMap Aeson.Value) where+  toHashed = toHashed . Aeson.Object+#else+instance ToHashedBody (HashMap Text Aeson.Value) where+  toHashed = toHashed . Aeson.Object+#endif++-- | Anything that can be converted to a streaming request 'Body'.+class ToBody a where+  -- | Convert a value to a request body.+  toBody :: a -> RequestBody+  default toBody :: ToHashedBody a => a -> RequestBody+  toBody = Hashed . toHashed++instance ToBody RequestBody where+  toBody = id++instance ToBody HashedBody where+  toBody = Hashed++instance ToBody ChunkedBody where+  toBody = Chunked++instance ToHashedBody a => ToBody (Maybe a) where+  toBody = Hashed . maybe (toHashed BS.empty) toHashed++instance ToBody String++instance ToBody ByteStringLazy++instance ToBody ByteString++instance ToBody Text++instance ToBody TextLazy++#if MIN_VERSION_aeson(2,0,0)+instance ToBody (KeyMap Aeson.Value)+#else+instance ToBody (HashMap Text Aeson.Value)+#endif++instance ToBody Aeson.Value++instance ToBody XML.Element++instance ToBody QueryString
+ src/Amazonka/Data/ByteString.hs view
@@ -0,0 +1,76 @@+--++-- |+-- Module      : Amazonka.Data.ByteString+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Data.ByteString+  ( -- * ByteString+    ByteString,+    ByteStringLazy,+    ToByteString (..),+    showBS,+    stripBS,+  )+where++import Amazonka.Data.Text+import Amazonka.Prelude+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 qualified Data.Char as Char+import qualified Data.Text.Encoding as Text+import qualified Network.HTTP.Types as HTTP+import qualified Numeric++showBS :: ToByteString a => a -> String+showBS = BS8.unpack . toBS++stripBS :: ByteString -> ByteString+stripBS = BS8.dropWhile Char.isSpace . fst . BS8.spanEnd Char.isSpace++class ToByteString a where+  toBS :: a -> ByteString+  default toBS :: ToText a => a -> ByteString+  toBS = Text.encodeUtf8 . toText++instance ToByteString ByteString where+  toBS = id++instance ToByteString ByteStringBuilder where+  toBS = toBS . Build.toLazyByteString++instance ToByteString ByteStringLazy where+  toBS = LBS.toStrict++instance ToByteString Text where+  toBS = Text.encodeUtf8++instance ToByteString String where+  toBS = BS8.pack++instance ToByteString Int where+  toBS = toBS . Build.intDec++instance ToByteString Integer where+  toBS = toBS . Build.integerDec++instance ToByteString Natural where+  toBS = toBS . toInteger++instance ToByteString Double where+  toBS = toBS . ($ "") . Numeric.showFFloat Nothing++instance ToByteString HTTP.StdMethod where+  toBS = HTTP.renderStdMethod++instance ToByteString UTCTime where+  toBS = BS8.pack . show++instance ToByteString a => ToByteString (CI a) where+  toBS = toBS . CI.original
+ src/Amazonka/Data/Headers.hs view
@@ -0,0 +1,156 @@+-- |+-- Module      : Amazonka.Data.Headers+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Data.Headers+  ( module Amazonka.Data.Headers,+    HeaderName,+    Header,+    HTTP.hContentType,+  )+where++import Amazonka.Data.ByteString+import Amazonka.Data.Text+import Amazonka.Prelude+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.CaseInsensitive as CI+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import Network.HTTP.Types (Header, HeaderName, ResponseHeaders)+import qualified Network.HTTP.Types as HTTP++infixl 7 .#, .#?++-- FIXME: This whole toText/fromText shit is just stupid.+(.#) :: FromText a => ResponseHeaders -> HeaderName -> Either String a+hs .# k = hs .#? k >>= note+  where+    note Nothing = Left (BS8.unpack $ "Unable to find header: " <> CI.original k)+    note (Just x) = Right x++(.#?) :: FromText a => ResponseHeaders -> HeaderName -> Either String (Maybe a)+hs .#? k =+  maybe+    (Right Nothing)+    (fmap Just . fromText . Text.decodeUtf8)+    (k `lookup` hs)++infixr 7 =#++(=#) :: ToHeader a => HeaderName -> a -> [Header]+(=#) = toHeader++hdr :: HeaderName -> ByteString -> [Header] -> [Header]+hdr k v hs = (k, v) : filter ((/= k) . fst) hs++class ToHeaders a where+  toHeaders :: a -> [Header]++instance (ToByteString k, ToByteString v) => ToHeaders (HashMap k v) where+  toHeaders = map (bimap (CI.mk . toBS) toBS) . HashMap.toList++class ToHeader a where+  toHeader :: HeaderName -> a -> [Header]+  default toHeader :: ToText a => HeaderName -> a -> [Header]+  toHeader k = toHeader k . toText++instance ToHeader Int++instance ToHeader Integer++instance ToHeader Natural++instance ToHeader Text where+  toHeader k v = [(k, Text.encodeUtf8 v)]++instance ToHeader ByteString where+  toHeader k v = [(k, v)]++instance ToText a => ToHeader (Maybe a) where+  toHeader k = maybe [] (toHeader k . toText)++instance ToText a => ToHeader [a] where+  toHeader k vs = case vs of+    [] -> []+    _ -> toHeader k . Text.intercalate "," $ map toText vs++instance (ToByteString k, ToByteString v) => ToHeader (HashMap k v) where+  toHeader p = map (bimap k v) . HashMap.toList+    where+      k = mappend p . CI.mk . toBS+      v = toBS++parseHeadersMap ::+  FromText a =>+  ByteString ->+  ResponseHeaders ->+  Either String (HashMap Text a)+parseHeadersMap p = fmap HashMap.fromList . traverse g . filter f+  where+    f = BS.isPrefixOf p . CI.foldedCase . fst++    g (k, v) =+      (Text.decodeUtf8 . BS.drop n $ CI.original k,)+        <$> fromText (Text.decodeUtf8 v)++    n = BS.length p++hHost :: HeaderName+hHost = "Host"++hExpect :: HeaderName+hExpect = "Expect"++hAMZToken :: HeaderName+hAMZToken = "X-Amz-Security-Token"++hAMZTarget :: HeaderName+hAMZTarget = "X-Amz-Target"++hAMZAlgorithm :: HeaderName+hAMZAlgorithm = "X-Amz-Algorithm"++hAMZCredential :: HeaderName+hAMZCredential = "X-Amz-Credential"++hAMZExpires :: HeaderName+hAMZExpires = "X-Amz-Expires"++hAMZSignedHeaders :: HeaderName+hAMZSignedHeaders = "X-Amz-SignedHeaders"++hAMZContentSHA256 :: HeaderName+hAMZContentSHA256 = "X-Amz-Content-SHA256"++hAMZDate :: HeaderName+hAMZDate = "X-Amz-Date"++hMetaPrefix :: HeaderName+hMetaPrefix = "X-Amz-"++hAMZRequestId :: HeaderName+hAMZRequestId = "X-Amz-Request-Id"++hAMZNRequestId :: HeaderName+hAMZNRequestId = "X-Amzn-RequestId"++hAMZNErrorType :: HeaderName+hAMZNErrorType = "X-Amzn-ErrorType"++hAMZNAuth :: HeaderName+hAMZNAuth = "X-Amzn-Authorization"++hAMZDecodedContentLength :: HeaderName+hAMZDecodedContentLength = "X-Amz-Decoded-Content-Length"++hTransferEncoding :: HeaderName+hTransferEncoding = "Transfer-Encoding"++hFormEncoded :: ByteString+hFormEncoded = "application/x-www-form-urlencoded; charset=utf-8"
+ src/Amazonka/Data/JSON.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE CPP #-}++-- |+-- Module      : Amazonka.Data.JSON+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Data.JSON+  ( -- * FromJSON+    Aeson.FromJSON (..),+    Aeson.FromJSONKey (..),+    parseJSONText,+    Aeson.eitherDecode,+    Aeson.eitherDecode',++    -- ** Parser a+    Aeson.withObject,+    (Aeson..:),+    (Aeson..:?),+    (Aeson..!=),++    -- ** Either String a+    eitherParseJSON,+    (.:>),+    (.?>),++    -- * ToJSON+    Aeson.ToJSON (..),+    Aeson.ToJSONKey (..),+    toJSONText,+    Aeson.Value (Object),+    Aeson.object,+    (Aeson..=),+  )+where++import Amazonka.Data.Text+import Amazonka.Prelude+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson.Types++#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as KM+import Data.Aeson.Key (Key)+#else+import qualified Data.HashMap.Strict as KM+type Key = Text+#endif++parseJSONText :: FromText a => String -> Aeson.Value -> Aeson.Types.Parser a+parseJSONText n = Aeson.withText n (either fail pure . fromText)++toJSONText :: ToText a => a -> Aeson.Value+toJSONText = Aeson.String . toText++eitherParseJSON :: Aeson.FromJSON a => Aeson.Object -> Either String a+eitherParseJSON = Aeson.Types.parseEither Aeson.parseJSON . Aeson.Object++(.:>) :: Aeson.FromJSON a => Aeson.Object -> Key -> Either String a+(.:>) o k =+  case KM.lookup k o of+    Nothing -> Left $ "key " ++ show k ++ " not present"+    Just v -> Aeson.Types.parseEither Aeson.parseJSON v++(.?>) :: Aeson.FromJSON a => Aeson.Object -> Key -> Either String (Maybe a)+(.?>) o k =+  case KM.lookup k o of+    Nothing -> Right Nothing+    Just v -> Aeson.Types.parseEither Aeson.parseJSON v
+ src/Amazonka/Data/Log.hs view
@@ -0,0 +1,184 @@+-- |+-- Module      : Amazonka.Data.Log+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Data.Log where++import Amazonka.Data.ByteString+import Amazonka.Data.Headers+import Amazonka.Data.Path+import Amazonka.Data.Query+import Amazonka.Data.Text+import Amazonka.Prelude+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as Build+import qualified Data.ByteString.Lazy as LBS+import qualified Data.CaseInsensitive as CI+import qualified Data.List as List+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Data.Text.Lazy as LText+import qualified Data.Text.Lazy.Encoding as LText+import qualified Network.HTTP.Client as Client+import qualified Network.HTTP.Types as HTTP+import qualified Numeric++class ToLog a where+  -- | Convert a value to a loggable builder.+  build :: a -> ByteStringBuilder++instance ToLog ByteStringBuilder where+  build = id++instance ToLog ByteStringLazy where+  build = Build.lazyByteString++instance ToLog ByteString where+  build = Build.byteString++instance ToLog Int where+  build = Build.intDec++instance ToLog Int8 where+  build = Build.int8Dec++instance ToLog Int16 where+  build = Build.int16Dec++instance ToLog Int32 where+  build = Build.int32Dec++instance ToLog Int64 where+  build = Build.int64Dec++instance ToLog Integer where+  build = Build.integerDec++instance ToLog Word where+  build = Build.wordDec++instance ToLog Word8 where+  build = Build.word8Dec++instance ToLog Word16 where+  build = Build.word16Dec++instance ToLog Word32 where+  build = Build.word32Dec++instance ToLog Word64 where+  build = Build.word64Dec++instance ToLog UTCTime where+  build = Build.stringUtf8 . show++instance ToLog Float where+  build = build . ($ "") . Numeric.showFFloat Nothing++instance ToLog Double where+  build = build . ($ "") . Numeric.showFFloat Nothing++instance ToLog Text where+  build = build . Text.encodeUtf8++instance ToLog TextLazy where+  build = build . LText.encodeUtf8++instance ToLog Char where+  build = build . Text.singleton++instance ToLog [Char] where+  build = build . LText.pack++instance ToLog HTTP.StdMethod where+  build = build . HTTP.renderStdMethod++instance ToLog QueryString where+  build = build . toBS++instance ToLog EscapedPath where+  build = build . toBS++-- | Intercalate a list of 'ByteStringBuilder's with newlines.+buildLines :: [ByteStringBuilder] -> ByteStringBuilder+buildLines = mconcat . List.intersperse "\n"++instance ToLog a => ToLog (CI a) where+  build = build . CI.foldedCase++instance ToLog a => ToLog (Maybe a) where+  build Nothing = "Nothing"+  build (Just x) = "Just " <> build x++instance ToLog Bool where+  build True = "True"+  build False = "False"++instance ToLog HTTP.Status where+  build x = build (HTTP.statusCode x) <> " " <> build (HTTP.statusMessage x)++instance ToLog [HTTP.Header] where+  build =+    mconcat+      . List.intersperse "; "+      . map (\(k, v) -> build k <> ": " <> build v)++instance ToLog HTTP.HttpVersion where+  build HTTP.HttpVersion {httpMajor, httpMinor} =+    "HTTP/"+      <> build httpMajor+      <> build '.'+      <> build httpMinor++instance ToLog Client.RequestBody where+  build = \case+    Client.RequestBodyBuilder n _ -> " <builder:" <> build n <> ">"+    Client.RequestBodyStream n _ -> " <stream:" <> build n <> ">"+    Client.RequestBodyLBS lbs+      | n <= 4096 -> build lbs+      | otherwise -> " <lazy:" <> build n <> ">"+      where+        n = LBS.length lbs+    Client.RequestBodyBS bs+      | n <= 4096 -> build bs+      | otherwise -> " <strict:" <> build n <> ">"+      where+        n = BS.length bs+    _ -> " <chunked>"++instance ToLog Client.HttpException where+  build x = "[HttpException] {\n" <> build (show x) <> "\n}"++instance ToLog Client.HttpExceptionContent where+  build x = "[HttpExceptionContent] {\n" <> build (show x) <> "\n}"++instance ToLog Client.Request where+  build x =+    buildLines+      [ "[Client Request] {",+        "  host      = " <> build (Client.host x) <> ":" <> build (Client.port x),+        "  secure    = " <> build (Client.secure x),+        "  method    = " <> build (Client.method x),+        "  target    = " <> build target,+        "  timeout   = " <> build (show (Client.responseTimeout x)),+        "  redirects = " <> build (Client.redirectCount x),+        "  path      = " <> build (Client.path x),+        "  query     = " <> build (Client.queryString x),+        "  headers   = " <> build (Client.requestHeaders x),+        "  body      = " <> build (Client.requestBody x),+        "}"+      ]+    where+      target = hAMZTarget `lookup` Client.requestHeaders x++instance ToLog (Client.Response a) where+  build x =+    buildLines+      [ "[Client Response] {",+        "  status  = " <> build (Client.responseStatus x),+        "  headers = " <> build (Client.responseHeaders x),+        "}"+      ]
+ src/Amazonka/Data/Path.hs view
@@ -0,0 +1,111 @@+-- |+-- Module      : Amazonka.Data.Path+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Data.Path+  ( -- * Path Types+    Path (..),+    RawPath,+    EscapedPath,+    TwiceEscapedPath,++    -- * Constructing Paths+    ToPath (..),+    rawPath,++    -- * Manipulating Paths+    escapePath,+    escapePathTwice,+    collapsePath,+  )+where++import Amazonka.Data.ByteString+import Amazonka.Data.Text+import Amazonka.Prelude+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Network.HTTP.Types.URI as URI++class ToPath a where+  toPath :: a -> ByteString++instance ToPath ByteString where+  toPath = id++instance ToPath Text where+  toPath = toBS++rawPath :: ToPath a => a -> Path 'NoEncoding+rawPath = Raw . strip . BS8.split sep . toPath+  where+    strip (x : xs)+      | BS.null x = xs+    strip xs = xs++data Encoding = NoEncoding | Percent+  deriving stock (Eq, Show)++data Path :: Encoding -> Type where+  Raw :: [ByteString] -> Path 'NoEncoding+  Encoded :: [ByteString] -> Path 'Percent++deriving stock instance Show (Path a)++deriving stock instance Eq (Path a)++type RawPath = Path 'NoEncoding++type EscapedPath = Path 'Percent++-- | Used in SigV4+newtype TwiceEscapedPath = TwiceEscapedPath (Path 'Percent)+  deriving newtype (Eq, Show, ToByteString)++instance Semigroup RawPath where+  Raw xs <> Raw ys = Raw (xs ++ ys)++instance Monoid RawPath where+  mempty = Raw []+  mappend = (<>)++instance ToByteString EscapedPath where+  toBS (Encoded []) = slash+  toBS (Encoded xs) = slash <> BS8.intercalate slash xs++escapePath :: Path a -> EscapedPath+escapePath (Raw xs) = Encoded (map (URI.urlEncode True) xs)+escapePath (Encoded xs) = Encoded xs++-- | Escape a path twice. Used when computing the SigV4 canonical path.+escapePathTwice :: Path a -> TwiceEscapedPath+escapePathTwice p = TwiceEscapedPath $+  Encoded $ case p of+    Raw xs -> map (URI.urlEncode True . URI.urlEncode True) xs+    Encoded xs -> map (URI.urlEncode True) xs++collapsePath :: Path a -> Path a+collapsePath = \case+  Raw xs -> Raw (go xs)+  Encoded xs -> Encoded (go xs)+  where+    go = reverse . f . reverse++    f :: [ByteString] -> [ByteString]+    f [] = []+    f (x : xs)+      | x == dot = f xs+      | x == dots = drop 1 (f xs)+      | otherwise = x : f xs++    dot = "."+    dots = ".."++slash :: ByteString+slash = BS8.singleton sep++sep :: Char+sep = '/'
+ src/Amazonka/Data/Query.hs view
@@ -0,0 +1,158 @@+-- |+-- Module      : Amazonka.Data.Query+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Data.Query where++import Amazonka.Data.ByteString+import Amazonka.Data.Text+import Amazonka.Prelude+import qualified Data.ByteString.Builder as Build+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as LBS+import qualified Data.HashMap.Strict as HashMap+import qualified Data.List as List+import qualified Data.Text.Encoding as Text+import qualified Network.HTTP.Types.URI as URI++-- | Structured representation of a query string.+--+-- Some operations (e.g., [sqs:CreateQueue](https://docs.aws.amazon.com/AWSSimpleQueueService/latest/APIReference/API_CreateQueue.html))+-- use query parameters to pass structured data like lists and maps,+-- which is why this type is more complicatated than the+-- @[(ByteString, Maybe ByteString)]@ from @http-types@ that you may+-- have expected here.+data QueryString+  = QList [QueryString]+  | QPair ByteString QueryString+  | QValue (Maybe ByteString)+  deriving stock (Eq, Show)++instance Semigroup QueryString where+  a <> b = case (a, b) of+    (QList l, QList r) -> QList (l ++ r)+    (QList l, r) -> QList (r : l)+    (l, QList r) -> QList (l : r)+    (l, r) -> QList [l, r]++instance Monoid QueryString where+  mempty = QList []+  mappend = (<>)++instance IsString QueryString where+  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 (URI.urlDecode True k) (stripValue v)++    stripValue :: ByteString -> QueryString+    stripValue x =+      case x of+        "" -> QValue Nothing+        "=" -> QValue Nothing+        _ -> QValue (Just (URI.urlDecode True $ BS8.drop 1 x))++-- FIXME: use Builder+instance ToByteString QueryString where+  toBS = LBS.toStrict . Build.toLazyByteString . cat . List.sort . enc Nothing+    where+      enc :: Maybe ByteString -> QueryString -> [ByteString]+      enc p = \case+        QList xs -> concatMap (enc p) xs+        QPair (URI.urlEncode True -> k) x+          | Just n <- p -> enc (Just (n <> kdelim <> k)) x -- <prev>.key <recur>+          | otherwise -> enc (Just k) x -- key <recur>+        QValue (Just (URI.urlEncode True -> v))+          | Just n <- p -> [n <> vsep <> v] -- key=value+          | otherwise -> [v <> vsep] -- value= -- note: required for signing.+        _+          | Just n <- p -> [n <> vsep] -- key=+          -- note: this case required for request signing+          | otherwise -> []++      cat :: [ByteString] -> ByteStringBuilder+      cat [] = mempty+      cat [x] = Build.byteString x+      cat (x : xs) = Build.byteString x <> ksep <> cat xs++      kdelim = "."+      ksep = "&"+      vsep = "="++pair :: ToQuery a => ByteString -> a -> QueryString -> QueryString+pair k v = mappend (QPair k (toQuery v))++infixr 7 =:++(=:) :: ToQuery a => ByteString -> a -> QueryString+k =: v = QPair k (toQuery v)++toQueryList ::+  (IsList a, ToQuery (Item a)) =>+  ByteString ->+  a ->+  QueryString+toQueryList k = QPair k . QList . zipWith f [1 ..] . toList+  where+    f :: ToQuery a => Int -> a -> QueryString+    f n v = toBS n =: toQuery v++toQueryMap ::+  (ToQuery k, ToQuery v) =>+  ByteString ->+  ByteString ->+  ByteString ->+  HashMap k v ->+  QueryString+toQueryMap e k v = toQueryList e . map f . HashMap.toList+  where+    f (x, y) = QList [k =: toQuery x, v =: toQuery y]++class ToQuery a where+  toQuery :: a -> QueryString+  default toQuery :: ToText a => a -> QueryString+  toQuery = toQuery . toText++instance ToQuery QueryString where+  toQuery = id++instance (ToByteString k, ToQuery v) => ToQuery (k, v) where+  toQuery (k, v) = QPair (toBS k) (toQuery v)++instance ToQuery Char where+  toQuery = toQuery . BS8.singleton++instance ToQuery ByteString where+  toQuery "" = QValue Nothing+  toQuery bs = QValue (Just bs)++instance ToQuery Text where toQuery = toQuery . Text.encodeUtf8++instance ToQuery Int where toQuery = toQuery . toBS++instance ToQuery Integer where toQuery = toQuery . toBS++instance ToQuery Double where toQuery = toQuery . toBS++instance ToQuery Natural where toQuery = toQuery . toBS++instance ToQuery a => ToQuery (Maybe a) where+  toQuery (Just x) = toQuery x+  toQuery Nothing = mempty++instance ToQuery Bool where+  toQuery True = toQuery ("true" :: ByteString)+  toQuery False = toQuery ("false" :: ByteString)
+ src/Amazonka/Data/Sensitive.hs view
@@ -0,0 +1,50 @@+-- |+-- Module      : Amazonka.Data.Sensitive+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Data.Sensitive where++import Amazonka.Core.Lens.Internal (iso)+import Amazonka.Data.Body+import Amazonka.Data.ByteString+import Amazonka.Data.Headers+import Amazonka.Data.JSON+import Amazonka.Data.Log+import Amazonka.Data.Query+import Amazonka.Data.Text+import Amazonka.Data.XML+import Amazonka.Prelude++-- | /Note/: read . show /= isomorphic+newtype Sensitive a = Sensitive {fromSensitive :: a}+  deriving stock (Eq, Ord, Generic, Functor)+  deriving newtype+    ( IsString,+      Semigroup,+      Monoid,+      ToByteString,+      FromText,+      ToText,+      FromXML,+      ToXML,+      ToQuery,+      ToJSON,+      FromJSON,+      ToHeader,+      ToBody,+      Hashable,+      NFData,+      IsList+    )++instance Show (Sensitive a) where+  show = const "******"++instance ToLog (Sensitive a) where+  build = const "******"++_Sensitive :: Iso' (Sensitive a) a+_Sensitive = iso fromSensitive Sensitive
+ src/Amazonka/Data/Text.hs view
@@ -0,0 +1,138 @@+-- |+-- Module      : Amazonka.Data.Text+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Data.Text+  ( Text,++    -- * Deserialisation+    FromText (..),++    -- * Serialisation+    ToText (..),+    toTextCI,+    showText,+  )+where++import qualified Amazonka.Bytes as Bytes+import qualified Amazonka.Crypto as Crypto+import Amazonka.Prelude+import qualified Data.Attoparsec.Text as A+import qualified Data.ByteString.Char8 as BS8+import qualified Data.CaseInsensitive as CI+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Data.Text.Lazy as LText+import qualified Data.Text.Lazy.Builder as Build+import qualified Data.Text.Lazy.Builder.Int as Build+import qualified Data.Text.Lazy.Builder.Scientific as Build+import qualified Network.HTTP.Types as HTTP+import qualified Numeric++class FromText a where+  fromText :: Text -> Either String a++instance FromText Text where+  fromText = pure++instance FromText String where+  fromText = pure . Text.unpack++instance FromText ByteString where+  fromText = pure . Text.encodeUtf8++instance (CI.FoldCase a, FromText a) => FromText (CI a) where+  fromText = fmap CI.mk . fromText++instance FromText Char where+  fromText = A.parseOnly (A.anyChar <* A.endOfInput)++instance FromText Int where+  fromText = A.parseOnly (A.signed A.decimal <* A.endOfInput)++instance FromText Int64 where+  fromText = A.parseOnly (A.signed A.decimal <* A.endOfInput)++instance FromText Integer where+  fromText = A.parseOnly (A.signed A.decimal <* A.endOfInput)++instance FromText Scientific where+  fromText = A.parseOnly (A.signed A.scientific <* A.endOfInput)++instance FromText Natural where+  fromText = A.parseOnly (A.decimal <* A.endOfInput)++instance FromText Double where+  fromText = A.parseOnly (A.signed A.rational <* A.endOfInput)++instance FromText Bool where+  fromText text =+    case CI.mk text of+      "true" -> pure True+      "false" -> pure False+      other -> Left ("Failure parsing Bool from " ++ show other ++ ".")++instance FromText HTTP.StdMethod where+  fromText text =+    case HTTP.parseMethod (Text.encodeUtf8 text) of+      Left err -> Left (BS8.unpack err)+      Right ok -> pure ok++showText :: ToText a => a -> String+showText = Text.unpack . toText++class ToText a where+  toText :: a -> Text++instance ToText a => ToText (CI a) where+  toText = toText . CI.original++instance ToText Text where+  toText = id++instance ToText ByteString where+  toText = Text.decodeUtf8++instance ToText Char where+  toText = Text.singleton++instance ToText String where+  toText = Text.pack++instance ToText Int where+  toText = shortText . Build.decimal++instance ToText Int64 where+  toText = shortText . Build.decimal++instance ToText Integer where+  toText = shortText . Build.decimal++instance ToText Natural where+  toText = shortText . Build.decimal++instance ToText Scientific where+  toText = shortText . Build.scientificBuilder++instance ToText Double where+  toText = toText . ($ "") . Numeric.showFFloat Nothing++instance ToText HTTP.StdMethod where+  toText = toText . HTTP.renderStdMethod++instance ToText (Crypto.Digest a) where+  toText = toText . Bytes.encodeBase16++instance ToText Bool where+  toText True = "true"+  toText False = "false"++shortText :: TextBuilder -> Text+shortText = LText.toStrict . Build.toLazyTextWith 32++toTextCI :: ToText a => a -> CI Text+toTextCI = CI.mk . toText
+ src/Amazonka/Data/Time.hs view
@@ -0,0 +1,251 @@+-- |+-- Module      : Amazonka.Data.Time+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Data.Time+  ( -- * Time+    Format (..),+    Time (..),+    _Time,++    -- ** Formats+    UTCTime,+    RFC822,+    ISO8601,+    BasicTime,+    AWSTime,+    POSIX,+  )+where++import Amazonka.Core.Lens.Internal (iso)+import Amazonka.Data.ByteString+import Amazonka.Data.JSON+import Amazonka.Data.Query+import Amazonka.Data.Text+import Amazonka.Data.XML+import Amazonka.Prelude+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import qualified Data.Attoparsec.Text as A+import qualified Data.Attoparsec.Text as AText+import qualified Data.ByteString.Char8 as BS+import qualified Data.Scientific as Scientific+import qualified Data.Text as Text+import qualified Data.Time as Time+import Data.Time.Clock.POSIX+import Data.Time.Format (defaultTimeLocale, formatTime)++data Format+  = RFC822Format+  | ISO8601Format+  | BasicFormat+  | AWSFormat+  | POSIXFormat+  deriving stock (Eq, Read, Show, Generic)++newtype Time (a :: Format) = Time {fromTime :: UTCTime}+  deriving stock (Show, Read, Eq, Ord, Generic)+  deriving newtype (NFData)++instance Hashable (Time a) where+  hashWithSalt salt (Time (Time.UTCTime (Time.ModifiedJulianDay d) t)) =+    salt+      `hashWithSalt` d+      `hashWithSalt` toRational t++_Time :: Iso' (Time a) UTCTime+_Time = iso fromTime Time++convert :: Time a -> Time b+convert = coerce++type RFC822 = Time 'RFC822Format++type ISO8601 = Time 'ISO8601Format++type BasicTime = Time 'BasicFormat++type AWSTime = Time 'AWSFormat++type POSIX = Time 'POSIXFormat++class TimeFormat a where+  format :: proxy a -> String++instance TimeFormat RFC822 where+  format _ = "%a, %d %b %Y %H:%M:%S %Z"++instance TimeFormat ISO8601 where+  format _ = "%FT%XZ"++instance TimeFormat BasicTime where+  format _ = "%Y%m%d"++instance TimeFormat AWSTime where+  format _ = "%Y%m%dT%H%M%SZ"++instance FromText (Time fmt) where+  fromText = A.parseOnly ((parseUnixTimestamp <|> parseFormattedTime) <* A.endOfInput)++parseFormattedTime :: A.Parser (Time a)+parseFormattedTime = do+  s <- Text.unpack <$> AText.takeText++  let parse :: String -> A.Parser (Time a)+      parse fmt =+        case Time.parseTimeM True defaultTimeLocale fmt s of+          Just x -> pure (Time x)+          Nothing ->+            fail+              ( "Unable to parse Time format "+                  ++ show fmt+                  ++ " from "+                  ++ show s+              )++  parse (format (Proxy @RFC822))+    <|> parse (format (Proxy @ISO8601))+    <|> parse (format (Proxy @BasicTime))+    <|> parse (format (Proxy @AWSTime))+    -- Deprecated ISO8601 format exhibited in the AWS-supplied examples.+    <|> parse "%FT%X%Q%Z"+    -- Exhaustive Failure+    <|> fail ("Failure parsing Time from value: " ++ show s)++parseUnixTimestamp :: A.Parser (Time a)+parseUnixTimestamp =+  Time . posixSecondsToUTCTime . realToFrac+    <$> AText.double+    <* AText.endOfInput+    <|> fail "Failure parsing Unix Timestamp"++instance ToText RFC822 where+  toText = Text.pack . renderFormattedTime++instance ToText ISO8601 where+  toText = Text.pack . renderFormattedTime++instance ToText BasicTime where+  toText = Text.pack . renderFormattedTime++instance ToText AWSTime where+  toText = Text.pack . renderFormattedTime++instance ToText POSIX where+  toText (Time t) = toText (truncate (utcTimeToPOSIXSeconds t) :: Integer)++renderFormattedTime :: forall a. TimeFormat (Time a) => Time a -> String+renderFormattedTime (Time t) =+  formatTime+    defaultTimeLocale+    (format (Proxy @(Time a)))+    -- Convert `t` to a GMT `ZonedTime`, because otherwise the+    -- `FormatTime` instance for `UTCTime` converts to UTC `ZonedTime`+    -- for us. While they are the same offset, a UTC `ZonedTime` emits+    -- `UTC` instead of `GMT` when formatted by `RFC822`'s+    -- `TimeFormat`, which is not a valid `zone` in RFC 822's grammar.+    (Time.utcToZonedTime (read "GMT") t)++instance FromXML RFC822 where+  parseXML = parseXMLText "RFC822"++instance FromXML ISO8601 where+  parseXML = parseXMLText "ISO8601"++instance FromXML AWSTime where+  parseXML = parseXMLText "AWSTime"++instance FromXML BasicTime where+  parseXML = parseXMLText "BasicTime"++instance FromJSON RFC822 where+  parseJSON = parseJSONText "RFC822"++instance FromJSON ISO8601 where+  parseJSON = parseJSONText "ISO8601"++instance FromJSON AWSTime where+  parseJSON = parseJSONText "AWSTime"++instance FromJSON BasicTime where+  parseJSON = parseJSONText "BasicTime"++-- This is a somewhat unfortunate hack to support the bizzare apigateway+-- occurence of returning ISO8601 or POSIX timestamps in unknown scenarios.+--+-- See: https://github.com/brendanhay/amazonka/issues/291+instance FromJSON POSIX where+  parseJSON o = fmap convert (str o) <|> num o+    where+      str :: Value -> Aeson.Parser ISO8601+      str = parseJSON++      num :: Value -> Aeson.Parser POSIX+      num =+        Aeson.withScientific+          "POSIX"+          ( pure+              . Time+              . posixSecondsToUTCTime+              . realToFrac+          )++instance ToByteString RFC822 where+  toBS = BS.pack . renderFormattedTime++instance ToByteString ISO8601 where+  toBS = BS.pack . renderFormattedTime++instance ToByteString BasicTime where+  toBS = BS.pack . renderFormattedTime++instance ToByteString AWSTime where+  toBS = BS.pack . renderFormattedTime++instance ToQuery RFC822 where+  toQuery = toQuery . toBS++instance ToQuery ISO8601 where+  toQuery = toQuery . toBS++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++instance ToXML BasicTime where+  toXML = toXMLText++instance ToJSON RFC822 where+  toJSON = toJSONText++instance ToJSON ISO8601 where+  toJSON = toJSONText++instance ToJSON AWSTime where+  toJSON = toJSONText++instance ToJSON BasicTime where+  toJSON = toJSONText++instance ToJSON POSIX where+  toJSON (Time t) =+    Aeson.Number $+      Scientific.scientific (truncate (utcTimeToPOSIXSeconds t) :: Integer) 0
+ src/Amazonka/Data/XML.hs view
@@ -0,0 +1,312 @@+-- |+-- Module      : Amazonka.Data.XML+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Data.XML where++import Amazonka.Data.ByteString+import Amazonka.Data.Text+import Amazonka.Prelude+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Conduit as Conduit+import qualified Data.Conduit.Lazy as Conduit.Lazy+import qualified Data.Conduit.List as Conduit.List+import qualified Data.HashMap.Strict as HashMap+import qualified Data.List.NonEmpty as NonEmpty+import Data.XML.Types (Event (..))+import System.IO.Unsafe (unsafePerformIO)+import Text.XML+import qualified Text.XML.Stream.Render as XML.Stream+import qualified Text.XML.Unresolved as XML.Unresolved++infixl 7 .@, .@?++(.@) :: FromXML a => [Node] -> Text -> Either String a+ns .@ n = findElement n ns >>= parseXML++(.@?) :: FromXML a => [Node] -> Text -> Either String (Maybe a)+ns .@? n =+  case findElement n ns of+    Left _ -> Right Nothing+    Right xs -> parseXML xs++infixr 7 @=, @@=++(@=) :: ToXML a => Name -> a -> XML+n @= x =+  case toXML x of+    XNull -> XNull+    xs -> XOne . NodeElement $ mkElement n xs++(@@=) :: ToText a => Name -> a -> XML+n @@= x = XAttr n (toText x)++decodeXML :: FromXML a => ByteStringLazy -> Either String a+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:+--   'not generally safe, but we know that runResourceT+--    will not deallocate any of the resources being used+--    by the process.'+encodeXML :: ToElement a => a -> ByteStringLazy+encodeXML x =+  LBS.fromChunks . unsafePerformIO . Conduit.Lazy.lazyConsume $+    Conduit.List.sourceList (XML.Unresolved.toEvents doc)+      Conduit..| Conduit.List.map rename+      Conduit..| XML.Stream.renderBytes def+  where+    doc =+      toXMLDocument $+        Document+          { documentRoot = root,+            documentEpilogue = [],+            documentPrologue =+              Prologue+                { prologueBefore = [],+                  prologueDoctype = Nothing,+                  prologueAfter = []+                }+          }++    rename = \case+      EventBeginElement n xs -> EventBeginElement (f n) (map (first f) xs)+      EventEndElement n -> EventEndElement (f n)+      evt -> evt+      where+        f n+          | isNothing (nameNamespace n) = n {nameNamespace = ns}+          | otherwise = n++    ns = nameNamespace (elementName root)+    root = toElement x++class FromXML a where+  parseXML :: [Node] -> Either String a++instance FromXML [Node] where+  parseXML = pure++instance FromXML a => FromXML (Maybe a) where+  parseXML [] = pure Nothing+  parseXML ns = Just <$> parseXML ns++instance FromXML Text where+  parseXML = fmap (fromMaybe mempty) . withContent "Text"++instance FromXML Char where parseXML = parseXMLText "Char"++instance FromXML ByteString where parseXML = parseXMLText "ByteString"++instance FromXML Int where parseXML = parseXMLText "Int"++instance FromXML Integer where parseXML = parseXMLText "Integer"++instance FromXML Natural where parseXML = parseXMLText "Natural"++instance FromXML Double where parseXML = parseXMLText "Double"++instance FromXML Bool where parseXML = parseXMLText "Bool"++class ToElement a where+  toElement :: a -> Element++instance ToElement Element where+  toElement = id++-- | Convert to an 'Element', only if the resulting element contains @> 0@ nodes.+maybeElement :: ToElement a => a -> Maybe Element+maybeElement x =+  case toElement x of+    e@(Element _ _ ns)+      | null ns -> Nothing+      | otherwise -> Just e++-- | Provides a way to make the operators for ToXML instance+-- declaration be consistent WRT to single nodes or lists of nodes.+data XML+  = XNull+  | XAttr Name Text+  | XOne Node+  | XMany [(Name, Text)] [Node]+  deriving stock (Show)++instance Semigroup XML where+  XNull <> XNull = XNull+  a <> XNull = a+  XNull <> b = b+  a <> b =+    XMany+      (listXMLAttributes a <> listXMLAttributes b)+      (listXMLNodes a <> listXMLNodes b)++instance Monoid XML where+  mempty = XNull+  mappend = (<>)++listXMLNodes :: XML -> [Node]+listXMLNodes = \case+  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++instance ToXML XML where+  toXML = id++instance ToXML a => ToXML (Maybe a) where+  toXML (Just x) = toXML x+  toXML Nothing = XNull++instance ToXML Text where toXML = toXMLText++instance ToXML ByteString where toXML = toXMLText++instance ToXML Int where toXML = toXMLText++instance ToXML Integer where toXML = toXMLText++instance ToXML Natural where toXML = toXMLText++instance ToXML Double where toXML = toXMLText++instance ToXML Bool where toXML = toXMLText++parseXMLMap ::+  (Eq k, Hashable k, FromText k, FromXML v) =>+  Text ->+  Text ->+  Text ->+  [Node] ->+  Either String (HashMap k v)+parseXMLMap e k v =+  fmap HashMap.fromList . traverse f . mapMaybe (childNodesOf e)+  where+    f ns =+      (,)+        <$> (ns .@ k >>= fromText)+        <*> ns .@ v++parseXMLList1 ::+  FromXML a =>+  Text ->+  [Node] ->+  Either String (NonEmpty a)+parseXMLList1 n = parseXMLList n >=> parse+  where+    parse xs =+      maybe+        (Left $ "Error parsing empty List1 when expecting at least one element: " ++ show n)+        Right+        (NonEmpty.nonEmpty xs)++parseXMLList ::+  FromXML a =>+  Text ->+  [Node] ->+  Either String [a]+parseXMLList n = traverse parseXML . mapMaybe (childNodesOf n)++parseXMLText :: FromText a => String -> [Node] -> Either String a+parseXMLText n =+  withContent n+    >=> maybe+      (Left $ "empty node list, when expecting single node " ++ n)+      fromText++toXMLList :: (IsList a, ToXML (Item a)) => Name -> a -> XML+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 (toXML -> x) =+  Element n (fromList (listXMLAttributes x)) (listXMLNodes x)++withContent :: String -> [Node] -> Either String (Maybe Text)+withContent k = \case+  [] -> Right Nothing+  [NodeContent x] -> Right (Just x)+  _ -> Left $ "encountered many nodes, when expecting text: " ++ k++-- | 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+    . listToMaybe+    $ mapMaybe (childNodesOf n) ns++-- | Find the first specific named NodeElement, at any depth in the node tree.+--+-- Fails if absent.+firstElement :: Text -> [Node] -> Either String [Node]+firstElement n ns =+  missingElement n ns+    . listToMaybe+    $ mapMaybe go ns+  where+    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 (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+  NodeElement e -> Just (nameLocalName (elementName e))+  _ -> Nothing++-- | An inefficient mechanism for retreiving the root+-- element name of an XML document.+rootElementName :: ByteStringLazy -> Maybe Text+rootElementName bs =+  either+    (const Nothing)+    (Just . nameLocalName . elementName . documentRoot)+    (parseLBS def bs)++missingElement :: Text -> [Node] -> Maybe a -> Either String a+missingElement n ns = maybe (Left err) Right+  where+    err =+      "unable to find element "+        ++ show n+        ++ " in nodes "+        ++ show (mapMaybe localName ns)
+ src/Amazonka/Endpoint.hs view
@@ -0,0 +1,97 @@+-- |+-- Module      : Amazonka.Endpoint+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Endpoint+  ( -- * Endpoint+    setEndpoint,+    defaultEndpoint,+  )+where++import Amazonka.Data.ByteString+import Amazonka.Prelude+import Amazonka.Types+import qualified Data.CaseInsensitive as CI++-- | A convenience function for overriding the 'Service' 'Endpoint'.+--+-- /See:/ 'endpoint'.+setEndpoint ::+  -- | Whether to use HTTPS (ie. SSL).+  Bool ->+  -- | The hostname to connect to.+  ByteString ->+  -- | The port number to connect to.+  Int ->+  -- | The service configuration to override.+  Service ->+  Service+setEndpoint secure host port s@Service {endpoint} =+  s {endpoint = \r -> (endpoint r) {secure, host, port}}++-- | Determine the full host address and credential scope+-- within the specified 'Region'.+defaultEndpoint :: Service -> Region -> Endpoint+defaultEndpoint Service {endpointPrefix = p} r = go (CI.mk p)+  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"+      "sdb"+        | virginia -> region "sdb.amazonaws.com"+      "sts"+        | china -> region "sts.cn-north-1.amazonaws.com.cn"+        | govcloud -> region ("sts." <> reg <> ".amazonaws.com")+        | otherwise -> global "sts.amazonaws.com"+      "rds"+        | virginia -> global "rds.amazonaws.com"+      "route53"+        | not china -> global "route53.amazonaws.com"+      "emr"+        | virginia -> global "elasticmapreduce.us-east-1.amazonaws.com"+        | china -> region "elasticmapreduce.cn-north-1.amazonaws.com.cn"+        | frankfurt -> region "elasticmapreduce.eu-central-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"+      "waf"+        | not china -> global "waf.amazonaws.com"+      _other+        | china -> region (p <> "." <> reg <> ".amazonaws.com.cn")+        | otherwise -> region (p <> "." <> reg <> ".amazonaws.com")++    virginia = r == NorthVirginia+    frankfurt = r == Frankfurt+    china = r == Beijing+    govcloud = r == GovCloudEast || r == GovCloudWest++    region host =+      Endpoint+        { host,+          basePath = mempty,+          secure = True,+          port = 443,+          scope = reg+        }++    global host =+      Endpoint+        { host,+          basePath = mempty,+          secure = True,+          port = 443,+          scope = "us-east-1"+        }++    reg = toBS r
+ src/Amazonka/Error.hs view
@@ -0,0 +1,186 @@+-- |+-- Module      : Amazonka.Error+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Error where++import Amazonka.Core.Lens.Internal (Choice, Fold, Optic', filtered)+import Amazonka.Data+import Amazonka.Prelude+import Amazonka.Types+import qualified Amazonka.Types as ServiceError (ServiceError (..))+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson.Types+import qualified Data.ByteString.Lazy as LBS+import Data.Either (fromRight)+import qualified Data.Text as Text+import qualified Network.HTTP.Client as Client+import Network.HTTP.Types.Status (Status (..))++-- | 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+-- @Amazonka.<ServiceName>.Types@ do not cover all the thrown error codes.+-- For example to define a new error prism:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > import Amazonka.S3 (ServiceError, s3)+-- >+-- > _NoSuchBucketPolicy :: AsError a => Fold 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 ->+  Fold a ServiceError+_MatchServiceError s c = _ServiceError . hasService s . hasCode c++statusSuccess :: Status -> Bool+statusSuccess (statusCode -> n) = n >= 200 && n < 300 || n == 304++_HttpStatus :: AsError a => Traversal' a Status+_HttpStatus = _Error . f+  where+    f g = \case+      TransportError (Client.HttpExceptionRequest rq (Client.StatusCodeException rs b)) ->+        (\x -> TransportError (Client.HttpExceptionRequest rq (Client.StatusCodeException (rs {Client.responseStatus = x}) b)))+          <$> g (Client.responseStatus rs)+      --+      TransportError e ->+        pure (TransportError e)+      --+      SerializeError (SerializeError' a s b e) ->+        (\x -> SerializeError (SerializeError' a x b e)) <$> g s+      --+      ServiceError e@ServiceError' {status} ->+        (\x -> ServiceError (e {status = x})) <$> g status++hasService ::+  (Applicative f, Choice p) =>+  Service ->+  Optic' p f ServiceError ServiceError+hasService Service {abbrev} = filtered ((abbrev ==) . ServiceError.abbrev)++hasStatus ::+  (Applicative f, Choice p) =>+  Int ->+  Optic' p f ServiceError ServiceError+hasStatus n = filtered ((n ==) . fromEnum . ServiceError.status)++hasCode ::+  (Applicative f, Choice p) =>+  ErrorCode ->+  Optic' p f ServiceError ServiceError+hasCode c = filtered ((c ==) . ServiceError.code)++serviceError ::+  Abbrev ->+  Status ->+  [Header] ->+  Maybe ErrorCode ->+  Maybe ErrorMessage ->+  Maybe RequestId ->+  ServiceError+serviceError a s h c m r =+  ServiceError' a s h (fromMaybe (getErrorCode s h) c) m (r <|> getRequestId h)++getRequestId :: [Header] -> Maybe RequestId+getRequestId h+  | Right hAMZ <- h .# hAMZRequestId = Just hAMZ+  | Right hAMZN <- h .# hAMZNRequestId = Just hAMZN+  | otherwise = Nothing++getErrorCode :: Status -> [Header] -> ErrorCode+getErrorCode s h =+  case h .# hAMZNErrorType of+    Left _ -> newErrorCode (toText (statusMessage s))+    Right x -> newErrorCode code+      where+        -- For headers only, botocore takes everything in the header+        -- value before a colon:+        -- https://github.com/boto/botocore/blob/fec0e5bd5e4a9d7dcadb36198423e61437294fe6/botocore/parsers.py#L1006-L1015+        (code, _) = Text.break (== ':') x++parseJSONError ::+  Abbrev ->+  Status ->+  [Header] ->+  ByteStringLazy ->+  Error+parseJSONError a s h bs =+  decodeError a s h bs (parse bs)+  where+    parse =+      eitherDecode'+        >=> Aeson.Types.parseEither (Aeson.withObject "JSONError" go)++    go o = do+      e <- (Just <$> o .: "__type") <|> o .:? "code"+      m <- msg e o++      pure (serviceError a s h e m Nothing)++    msg c o =+      if c == Just "RequestEntityTooLarge"+        then pure (Just "Request body must be less than 1 MB")+        else+          Just <$> o .: "message"+            <|> o .:? "Message"++parseXMLError ::+  Abbrev ->+  Status ->+  [Header] ->+  ByteStringLazy ->+  Error+parseXMLError a s h bs = decodeError a s h bs (go <$> decodeXML bs)+  where+    go x =+      serviceError+        a+        s+        h+        (code x)+        (may' (firstElement "Message" x))+        (may' (firstElement "RequestId" x) <|> may' (firstElement "RequestID" x))++    code x = fromRight root $ parseXML =<< firstElement "Code" x++    root = newErrorCode <$> rootElementName bs++    may' x = either (const Nothing) Just $ parseXML =<< x++parseRESTError ::+  Abbrev ->+  Status ->+  [Header] ->+  a ->+  Error+parseRESTError a s h _ =+  ServiceError (serviceError a s h Nothing Nothing Nothing)++decodeError ::+  Abbrev ->+  Status ->+  [Header] ->+  ByteStringLazy ->+  Either String ServiceError ->+  Error+decodeError a s h bs e+  | LBS.null bs = parseRESTError a s h bs+  | otherwise =+      either+        (SerializeError . SerializeError' a s (Just bs))+        ServiceError+        e
+ src/Amazonka/Pager.hs view
@@ -0,0 +1,55 @@+-- |+-- Module      : Amazonka.Pager+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Pager+  ( AWSPager (..),+    AWSTruncated (..),+    stop,+    choice,+  )+where++import Amazonka.Core.Lens.Internal (Getter, to)+import Amazonka.Data (ToText (..))+import Amazonka.Prelude+import Amazonka.Types+import qualified Data.HashMap.Strict as HashMap++-- | Specify how an 'AWSRequest' and it's associated 'Rs' response can+-- generate a subsequent request, if available.+class AWSRequest a => AWSPager a where+  page :: a -> AWSResponse a -> Maybe a++-- | Generalise IsTruncated and other optional/required+-- response pagination fields.+class AWSTruncated a where+  truncated :: a -> Bool++instance AWSTruncated Bool where+  truncated = id++instance AWSTruncated [a] where+  truncated = not . null++instance AWSTruncated (HashMap k v) where+  truncated = not . HashMap.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++choice ::+  (Alternative f, ToText a, ToText b) =>+  (s -> f a) ->+  (s -> f b) ->+  Getter s (f Text)+choice f g = to $ \x -> (toText <$> f x) <|> (toText <$> g x)
+ src/Amazonka/Prelude.hs view
@@ -0,0 +1,82 @@+-- |+-- Module      : Amazonka.Prelude+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- An intentionally limited set of prelude exports to control backward+-- compatibility and simplify code generation.+--+-- Please consider long and hard before adding any addtional types exports to+-- this module - they should either be in pervasive use throughout the project+-- or have zero ambiguity. If you ever are forced to disambiguate at any point,+-- it's a bad export.+--+-- Try and avoid any value, operator, or symbol exports, if possible. Most of+-- the ones here exist to ease legacy code-migration.+module Amazonka.Prelude+  ( module Export,+    TextLazy,+    TextBuilder,+    ByteStringLazy,+    ByteStringBuilder,+  )+where++import Control.Applicative as Export (Alternative ((<|>)))+import Control.DeepSeq as Export (NFData (rnf))+import Control.Exception as Export (Exception, SomeException)+import Control.Lens as Export+  ( Iso',+    Lens',+    Prism',+    Setter',+    Traversal',+  )+import Control.Monad as Export+import Control.Monad.IO.Class as Export (MonadIO (liftIO))+import Control.Monad.Trans.Class as Export (MonadTrans (lift))+import Control.Monad.Trans.Resource as Export (MonadResource)+import Data.Bifoldable as Export+import Data.Bifunctor as Export+import Data.Bitraversable as Export+import Data.ByteString as Export (ByteString)+import qualified Data.ByteString.Builder as ByteString.Builder+import qualified Data.ByteString.Lazy as ByteString.Lazy+import Data.CaseInsensitive as Export (CI)+import Data.Coerce as Export (Coercible, coerce)+import Data.Function as Export ((&))+import Data.Functor as Export ((<&>))+import Data.Functor.Identity as Export (Identity (..))+import Data.HashMap.Strict as Export (HashMap)+import Data.HashSet as Export (HashSet)+import Data.Hashable as Export (Hashable (hash, hashWithSalt))+import Data.Int as Export (Int16, Int32, Int64, Int8)+import Data.Kind as Export (Type)+import Data.List.NonEmpty as Export (NonEmpty ((:|)))+import Data.Maybe as Export+import Data.Monoid as Export (First)+import Data.Proxy as Export (Proxy (Proxy))+import Data.Scientific as Export (Scientific)+import Data.String as Export (IsString (fromString))+import Data.Text as Export (Text)+import qualified Data.Text.Lazy as Text.Lazy+import qualified Data.Text.Lazy.Builder as Text.Lazy.Builder+import Data.Time as Export (Day, DiffTime, NominalDiffTime, UTCTime)+import Data.Void as Export (Void)+import Data.Word as Export (Word16, Word32, Word64, Word8)+import GHC.Exts as Export (IsList (..))+import GHC.Generics as Export (Generic)+import GHC.TypeLits as Export (KnownNat, KnownSymbol, Nat, Symbol)+import Numeric.Natural as Export (Natural)+import Prelude as Export++type TextLazy = Text.Lazy.Text++type TextBuilder = Text.Lazy.Builder.Builder++type ByteStringLazy = ByteString.Lazy.ByteString++type ByteStringBuilder = ByteString.Builder.Builder
+ src/Amazonka/Request.hs view
@@ -0,0 +1,207 @@+-- |+-- Module      : Amazonka.Request+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Request+  ( -- * Requests+    head',+    delete,+    get,++    -- ** Empty body+    post,+    put,++    -- ** Specialised body+    patchBody,+    patchJSON,+    postXML,+    postJSON,+    postQuery,+    postBody,+    putXML,+    putJSON,+    putBody,++    -- ** Constructors+    defaultRequest,++    -- ** Operation Plugins+    contentMD5Header,+    expectHeader,+    glacierVersionHeader,+    s3vhost,++    -- ** Lenses+    clientRequestHeaders,+    clientRequestQuery,+    clientRequestURL,+  )+where++import Amazonka.Core+import Amazonka.Data+import Amazonka.Prelude+import qualified Data.ByteString.Char8 as B8+import qualified Network.HTTP.Client as Client+import Network.HTTP.Types (StdMethod (..))+import qualified Network.HTTP.Types as HTTP+import Text.Regex.Posix++type ToRequest a = (ToPath a, ToQuery a, ToHeaders a)++head' :: ToRequest a => Service -> a -> Request a+head' s x = (get s x) {method = HEAD}++delete :: ToRequest a => Service -> a -> Request a+delete s x = (get s x) {method = DELETE}++get :: ToRequest a => Service -> a -> Request a+get = defaultRequest++post :: ToRequest a => Service -> a -> Request a+post s x = (get s x) {method = POST}++put :: ToRequest a => Service -> a -> Request a+put s x = (get s x) {method = PUT}++patchBody :: (ToRequest a, ToBody a) => Service -> a -> Request a+patchBody s x = (putBody s x) {method = PATCH}++patchJSON :: (ToRequest a, ToJSON a) => Service -> a -> Request a+patchJSON s x = (putJSON s x) {method = PATCH}++postXML :: (ToRequest a, ToElement a) => Service -> a -> Request a+postXML s x = (putXML s x) {method = POST}++postJSON :: (ToRequest a, ToJSON a) => Service -> a -> Request a+postJSON s x = (putJSON s x) {method = POST}++postQuery :: ToRequest a => Service -> a -> Request a+postQuery service x =+  Request+    { service,+      method = POST,+      path = rawPath x,+      query = mempty,+      body = toBody (toQuery x),+      headers = hdr hContentType hFormEncoded (toHeaders x)+    }++postBody :: (ToRequest a, ToBody a) => Service -> a -> Request a+postBody s x = (post s x) {body = toBody x}++putXML :: (ToRequest a, ToElement a) => Service -> a -> Request a+putXML s x = (put s x) {body = maybe "" toBody (maybeElement x)}++putJSON :: (ToRequest a, ToJSON a) => Service -> a -> Request a+putJSON s x = (put s x) {body = toBody (toJSON x)}++putBody :: (ToRequest a, ToBody a) => Service -> a -> Request a+putBody s x = (put s x) {body = toBody x}++defaultRequest :: ToRequest a => Service -> a -> Request a+defaultRequest service x =+  Request+    { service,+      method = GET,+      path = rawPath x,+      query = toQuery x,+      headers = toHeaders x,+      body = ""+    }++clientRequestQuery :: Lens' ClientRequest ByteString+clientRequestQuery f x =+  f (Client.queryString x) <&> \y -> x {Client.queryString = y}++clientRequestHeaders :: Lens' ClientRequest HTTP.RequestHeaders+clientRequestHeaders f x =+  f (Client.requestHeaders x) <&> \y -> x {Client.requestHeaders = y}++clientRequestURL :: ClientRequest -> ByteString+clientRequestURL x =+  scheme+    <> toBS (Client.host x)+    <> port (Client.port x)+    <> toBS (Client.path x)+    <> toBS (Client.queryString x)+  where+    scheme+      | secure = "https://"+      | otherwise = "http://"++    port = \case+      80 -> ""+      443 | secure -> ""+      n -> ":" <> toBS n++    secure = Client.secure x++contentMD5Header :: Request a -> Request a+contentMD5Header rq@Request {headers, body}+  | isMissing, Just x <- maybeMD5 = rq {headers = hdr HTTP.hContentMD5 x headers}+  | otherwise = rq+  where+    maybeMD5 = md5Base64 body+    isMissing = isNothing (lookup HTTP.hContentMD5 headers)++expectHeader :: Request a -> Request a+expectHeader rq@Request {headers} =+  rq {headers = hdr hExpect "100-continue" headers}++glacierVersionHeader :: ByteString -> Request a -> Request a+glacierVersionHeader version rq@Request {headers} =+  rq {headers = hdr "x-amz-glacier-version" version headers}++-- Rewrite a request to use virtual-hosted-style buckets where+-- possible and requested.+--+-- Example: A request to endpoint "s3.region.amazonaws.com" with path+-- "/foo/bar" means "object bar in bucket foo". Rewrite it to endpoint+-- "foo.s3.region.amazonaws.com" and path "/bar".+--+-- This is basically the logic in+-- https://github.com/boto/botocore/blob/04d1fae43b657952e49b21d16daa86378ddb4253/botocore/utils.py#L1922-L1941+-- except that we can't tell if an endpoint has been overridden, as a+-- 'Request' contains a 'Service' after all overrides have been+-- applied.+--+-- See: https://boto3.amazonaws.com/v1/documentation/api/1.9.42/guide/s3.html#changing-the-addressing-style+-- See: https://docs.aws.amazon.com/AmazonS3/latest/userguide/VirtualHosting.html+s3vhost :: Request a -> Request a+s3vhost+  rq@Request+    { path = path,+      service = service@Service {endpoint, s3AddressingStyle}+    } = case path of+    Raw [] -> rq -- Impossible?+    Raw (bucketName : p) ->+      let bucketNameLen = B8.length bucketName++          -- Inspired by:+          -- https://github.com/boto/botocore/blob/04d1fae43b657952e49b21d16daa86378ddb4253/botocore/utils.py#L1067+          rewritePossible+            | '.' `B8.elem` bucketName = False+            | bucketNameLen < 3 || bucketNameLen > 63 = False+            | not $ bucketName =~ ("^[a-z0-9][a-z0-9\\-]*[a-z0-9]$" :: ByteString) = False+            | otherwise = True++          doRewrite = case s3AddressingStyle of+            S3AddressingStyleAuto -> rewritePossible+            S3AddressingStylePath -> False+            S3AddressingStyleVirtual -> True++          path' = Raw p+          service' =+            service+              { endpoint = \r ->+                  let e@Endpoint {host} = endpoint r+                   in e {host = mconcat [bucketName, ".", host]}+              }+       in if doRewrite+            then rq {path = path', service = service'}+            else rq
+ src/Amazonka/Response.hs view
@@ -0,0 +1,177 @@+-- |+-- Module      : Amazonka.Response+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- Functions contained in this module fully consume the body and thus close+-- the connection. This is needed to avoid hitting this issue:+-- <https://github.com/brendanhay/amazonka/issues/490>.+--+-- The only exception is 'receiveBody', which passes a streaming response+-- body to a callback and thus is not allowed to close the connection. Users+-- of streaming functions are advised to be careful and consume the response+-- body manually if they want the connection to be closed promptly.+--+-- Note that using 'runResourceT' will always close the connection.+module Amazonka.Response+  ( receiveNull,+    receiveEmpty,+    receiveXMLWrapper,+    receiveXML,+    receiveJSON,+    receiveBytes,+    receiveBody,+  )+where++import Amazonka.Data+import Amazonka.Prelude hiding (error)+import Amazonka.Types+import qualified Control.Monad.Trans.Except as Except+import Control.Monad.Trans.Resource (liftResourceT)+import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Lazy as LBS+import Data.Conduit ()+import qualified Data.Conduit as Conduit+import qualified Data.Conduit.Binary as Conduit.Binary+import Data.Functor (($>))+import qualified Network.HTTP.Client as Client+import Network.HTTP.Types (ResponseHeaders)+import qualified Text.XML as XML++receiveNull ::+  MonadResource m =>+  AWSResponse a ->+  (ByteStringLazy -> IO ByteStringLazy) ->+  Service ->+  Proxy a ->+  ClientResponse ClientBody ->+  m (Either Error (ClientResponse (AWSResponse a)))+receiveNull rs _ =+  stream $ \r _ _ _ ->+    liftIO (Client.responseClose r) $> Right rs++receiveEmpty ::+  MonadResource m =>+  (Int -> ResponseHeaders -> () -> Either String (AWSResponse a)) ->+  (ByteStringLazy -> IO ByteStringLazy) ->+  Service ->+  Proxy a ->+  ClientResponse ClientBody ->+  m (Either Error (ClientResponse (AWSResponse a)))+receiveEmpty f _ =+  stream $ \r s h _ ->+    liftIO (Client.responseClose r) $> f s h ()++receiveXMLWrapper ::+  MonadResource m =>+  Text ->+  (Int -> ResponseHeaders -> [XML.Node] -> Either String (AWSResponse a)) ->+  (ByteStringLazy -> IO ByteStringLazy) ->+  Service ->+  Proxy a ->+  ClientResponse ClientBody ->+  m (Either Error (ClientResponse (AWSResponse a)))+receiveXMLWrapper n f = receiveXML (\s h x -> x .@ n >>= f s h)++receiveXML ::+  MonadResource m =>+  (Int -> ResponseHeaders -> [XML.Node] -> Either String (AWSResponse a)) ->+  (ByteStringLazy -> IO ByteStringLazy) ->+  Service ->+  Proxy a ->+  ClientResponse ClientBody ->+  m (Either Error (ClientResponse (AWSResponse a)))+receiveXML = deserialise decodeXML++receiveJSON ::+  MonadResource m =>+  (Int -> ResponseHeaders -> Aeson.Object -> Either String (AWSResponse a)) ->+  (ByteStringLazy -> IO ByteStringLazy) ->+  Service ->+  Proxy a ->+  ClientResponse ClientBody ->+  m (Either Error (ClientResponse (AWSResponse a)))+receiveJSON = deserialise Aeson.eitherDecode'++receiveBytes ::+  MonadResource m =>+  (Int -> ResponseHeaders -> ByteString -> Either String (AWSResponse a)) ->+  (ByteStringLazy -> IO ByteStringLazy) ->+  Service ->+  Proxy a ->+  ClientResponse ClientBody ->+  m (Either Error (ClientResponse (AWSResponse a)))+receiveBytes = deserialise (Right . LBS.toStrict)++receiveBody ::+  MonadResource m =>+  (Int -> ResponseHeaders -> ResponseBody -> Either String (AWSResponse a)) ->+  (ByteStringLazy -> IO ByteStringLazy) ->+  Service ->+  Proxy a ->+  ClientResponse ClientBody ->+  m (Either Error (ClientResponse (AWSResponse a)))+receiveBody f _ =+  stream $ \_ s h x ->+    pure (f s h (ResponseBody x))++-- | Deserialise an entire response body, such as an XML or JSON payload.+deserialise ::+  MonadResource m =>+  (ByteStringLazy -> Either String b) ->+  (Int -> ResponseHeaders -> b -> Either String (AWSResponse a)) ->+  (ByteStringLazy -> IO ByteStringLazy) ->+  Service ->+  Proxy a ->+  ClientResponse ClientBody ->+  m (Either Error (ClientResponse (AWSResponse a)))+deserialise reader parser responseBodyHook Service {..} _ rs =+  Except.runExceptT $ do+    let status = Client.responseStatus rs+        headers = Client.responseHeaders rs++    body <- sinkLBS (Client.responseBody rs) >>= liftIO . responseBodyHook++    unless (check status) $ Except.throwE (error status headers body)++    case reader body >>= parser (fromEnum status) headers of+      Right ok -> pure (ok <$ rs)+      Left err ->+        Except.throwE $+          SerializeError (SerializeError' abbrev status (Just body) err)++-- | Stream a raw response body, such as an S3 object payload.+stream ::+  MonadResource m =>+  ( ClientResponse () ->+    Int ->+    ResponseHeaders ->+    ClientBody ->+    m (Either String (AWSResponse a))+  ) ->+  Service ->+  Proxy a ->+  ClientResponse ClientBody ->+  m (Either Error (ClientResponse (AWSResponse a)))+stream parser Service {..} _ rs =+  Except.runExceptT $ do+    let status = Client.responseStatus rs+        headers = Client.responseHeaders rs+        body = Client.responseBody rs++    unless (check status) $ do+      lazy <- sinkLBS body+      Except.throwE (error status headers lazy)++    lift (parser (void rs) (fromEnum status) headers body) >>= \case+      Right ok -> pure (ok <$ rs)+      Left err ->+        Except.throwE $+          SerializeError (SerializeError' abbrev status Nothing err)++sinkLBS :: MonadResource m => ClientBody -> m ByteStringLazy+sinkLBS bdy = liftResourceT (bdy `Conduit.connect` Conduit.Binary.sinkLbs)
+ src/Amazonka/Sign/V2.hs view
@@ -0,0 +1,86 @@+-- |+-- Module      : Amazonka.Sign.V2+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Sign.V2+  ( v2,+  )+where++import qualified Amazonka.Bytes as Bytes+import qualified Amazonka.Crypto as Crypto+import Amazonka.Data+import Amazonka.Prelude hiding (error)+import Amazonka.Types hiding (presign, sign)+import qualified Data.ByteString.Char8 as BS8+import qualified Network.HTTP.Client as Client+import qualified Network.HTTP.Types as HTTP+import qualified Network.HTTP.Types.URI as URI++data V2 = V2+  { metaTime :: UTCTime,+    metaEndpoint :: Endpoint,+    metaSignature :: ByteString+  }++instance ToLog V2 where+  build V2 {..} =+    buildLines+      [ "[Version 2 Metadata] {",+        "  time      = " <> build metaTime,+        "  endpoint  = " <> build (host metaEndpoint),+        "  signature = " <> build metaSignature,+        "}"+      ]++v2 :: Signer+v2 = Signer sign (const sign) -- FIXME: revisit v2 presigning.++sign :: Algorithm a+sign Request {service = Service {..}, ..} AuthEnv {..} r t = Signed meta rq+  where+    meta = Meta (V2 t end signature)++    rq =+      (newClientRequest end timeout)+        { Client.method = meth,+          Client.path = path',+          Client.queryString = toBS authorised,+          Client.requestHeaders = headers',+          Client.requestBody = toRequestBody body+        }++    meth = toBS method+    path' = toBS (escapePath $ basePath <> path)++    end@Endpoint {..} = endpoint r++    authorised = pair "Signature" (URI.urlEncode True signature) query++    signature =+      Bytes.encodeBase64+        . Crypto.hmacSHA256 (toBS secretAccessKey)+        $ BS8.intercalate+          "\n"+          [ meth,+            host,+            path',+            toBS query'+          ]++    query' =+      pair "Version" version+        . pair "SignatureVersion" ("2" :: ByteString)+        . pair "SignatureMethod" ("HmacSHA256" :: ByteString)+        . pair "Timestamp" time+        . pair "AWSAccessKeyId" (toBS accessKeyId)+        $ query <> maybe mempty toQuery token++    token = ("SecurityToken" :: ByteString,) . toBS <$> sessionToken++    headers' = hdr HTTP.hDate time headers++    time = toBS (Time t :: ISO8601)
+ src/Amazonka/Sign/V2Header.hs view
@@ -0,0 +1,219 @@+-- |+-- Module      : Amazonka.Sign.V2Header+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+--+-- This module provides an AWS compliant V2 Header request signer. It is based+-- heavily on <https://github.com/boto/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 Amazonka.Sign.V2Header+  ( v2Header,+    newSigner,+    toSignerQueryBS,+    constructSigningHeader,+    constructSigningQuery,+    constructFullPath,+    unionNecessaryHeaders,+  )+where++import qualified Amazonka.Bytes as Bytes+import qualified Amazonka.Crypto as Crypto+import Amazonka.Data+import qualified Amazonka.Data.Query as Query+import Amazonka.Prelude+import Amazonka.Types hiding (presign, sign)+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 qualified Data.Function as Function+import qualified Data.List as List+import qualified Network.HTTP.Client as Client+import qualified Network.HTTP.Types as HTTP+import qualified Network.HTTP.Types.URI as URI++data V2Header = V2Header+  { metaTime :: UTCTime,+    metaEndpoint :: Endpoint,+    metaSignature :: ByteString,+    headers :: HTTP.RequestHeaders,+    signer :: ByteString+  }++instance ToLog V2Header where+  build V2Header {..} =+    buildLines+      [ "[Version 2 Header Metadata] {",+        "  time      = " <> build metaTime,+        "  endpoint  = " <> build (host 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 = newSigner headers' meth path' query++    rq =+      (newClientRequest end timeout)+        { Client.method = meth,+          Client.path = path',+          Client.queryString = toBS query,+          Client.requestHeaders = headers',+          Client.requestBody = toRequestBody body+        }++    meth = toBS method+    path' = toBS (escapePath $ basePath <> path)++    end@Endpoint {basePath} = endpoint r++    Service {timeout, endpoint} = service++    signature =+      Bytes.encodeBase64+        . Crypto.hmacSHA1 (toBS secretAccessKey)+        $ signer++    headers' =+      headers+        & hdr HTTP.hAuthorization ("AWS " <> toBS accessKeyId <> ":" <> signature)+        & hdr HTTP.hDate time++    time = toBS (Time t :: RFC822)++-- | 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 (URI.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 (URI.urlEncode True -> v))+        | Just n <- p -> [n <> vsep <> v] -- key=value+        | otherwise -> [v]+      _+        | Just n <- p -> [n]+        | otherwise -> []++    cat :: [ByteString] -> ByteStringBuilder+    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 (Function.on (==) fst))+    [ (HTTP.hContentMD5, ""),+      (HTTP.hContentType, "")+    ]
+ src/Amazonka/Sign/V4.hs view
@@ -0,0 +1,84 @@+-- |+-- Module      : Amazonka.Sign.V4+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Sign.V4+  ( Base.V4 (..),+    v4,+  )+where++import Amazonka.Bytes+import Amazonka.Core.Lens.Internal ((<>~))+import Amazonka.Data.Body+import Amazonka.Data.ByteString+import Amazonka.Data.Headers+import Amazonka.Data.Query+import Amazonka.Data.Time+import Amazonka.Prelude+import Amazonka.Request+import qualified Amazonka.Sign.V4.Base as Base+import qualified Amazonka.Sign.V4.Chunked as Chunked+import Amazonka.Types hiding (presign, sign)+import qualified Data.ByteString as BS+import qualified Data.CaseInsensitive as CI++v4 :: Signer+v4 = Signer sign presign++-- |+-- Presigns a URL according to the AWS Request Signature V4 spec <https://docs.aws.amazon.com/general/latest/gr/sigv4_signing.html>.+-- In the case that the URL contains a payload that is not signed when sending requests to Amazon S3, a literal `UNSIGNED-PAYLOAD`+-- must be included when constructing the cannonical request. See <https://docs.aws.amazon.com/AmazonS3/latest/API/sig-v4-header-based-auth.html>+-- In the edge case that the request body is a @Amazonka.Data.Body.ChunkedBody@ we will also use the `UNSIGNED-PAYLOAD` literal as we won't consume the stream+-- to hash it.+presign :: Seconds -> Algorithm a+presign ex rq@Request {body, service} a region ts =+  Base.signRequest meta mempty auth+  where+    auth = clientRequestQuery <>~ ("&X-Amz-Signature=" <> toBS (Base.metaSignature meta))++    meta = Base.signMetadata a region ts presigner digest (prepare rq)++    presigner c shs =+      pair (CI.original hAMZAlgorithm) Base.algorithm+        . pair (CI.original hAMZCredential) (toBS c)+        . pair (CI.original hAMZDate) (Time ts :: AWSTime)+        . pair (CI.original hAMZExpires) ex+        . pair (CI.original hAMZSignedHeaders) (toBS shs)+        . pair (CI.original hAMZToken) (toBS <$> sessionToken a)++    digest =+      case body of+        Chunked _ -> unsignedPayload+        Hashed (HashedStream h _ _) -> Base.Tag $ encodeBase16 h+        Hashed (HashedBytes h b)+          | BS.null b && signingName service == "s3" -> unsignedPayload+          | otherwise -> Base.Tag $ encodeBase16 h++    unsignedPayload = Base.Tag "UNSIGNED-PAYLOAD"++    prepare :: Request a -> Request a+    prepare r@Request {headers} = r {headers = hdr hHost realHost headers}++    realHost =+      case (secure, port) of+        (False, 80) -> host+        (True, 443) -> host+        _ -> mconcat [host, ":", toBS port]++    Endpoint {host, port, secure} = endpoint service region++sign :: Algorithm a+sign rq@Request {body} a r ts =+  case body of+    Chunked x -> Chunked.chunked x rq a r ts+    Hashed x -> hashed x rq a r ts++hashed :: HashedBody -> Algorithm a+hashed x rq a r ts =+  let (meta, auth) = Base.base (Base.Tag (sha256Base16 x)) rq a r ts+   in Base.signRequest meta (toRequestBody (Hashed x)) auth
+ src/Amazonka/Sign/V4/Base.hs view
@@ -0,0 +1,311 @@+-- |+-- Module      : Amazonka.Sign.V4.Base+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Sign.V4.Base where++import qualified Amazonka.Bytes as Bytes+import Amazonka.Core.Lens.Internal ((<>~), (^.))+import qualified Amazonka.Crypto as Crypto+import Amazonka.Data hiding (Path)+import Amazonka.Prelude+import Amazonka.Request+import Amazonka.Types+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as BSB+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as BSL+import qualified Data.CaseInsensitive as CI+import qualified Data.Foldable as Foldable+import qualified Data.Map.Strict as Map+import qualified Network.HTTP.Client as Client+import qualified Network.HTTP.Types as HTTP++data V4 = V4+  { metaTime :: UTCTime,+    metaMethod :: Method,+    metaPath :: Path,+    metaEndpoint :: Endpoint,+    metaCredential :: Credential,+    metaCanonicalQuery :: CanonicalQuery,+    metaCanonicalRequest :: CanonicalRequest,+    metaCanonicalHeaders :: CanonicalHeaders,+    metaSignedHeaders :: SignedHeaders,+    metaStringToSign :: StringToSign,+    metaSignature :: Signature,+    metaHeaders :: [Header],+    metaTimeout :: Maybe Seconds+  }++instance ToLog V4 where+  build V4 {metaEndpoint = Endpoint {host}, ..} =+    buildLines+      [ "[Version 4 Metadata] {",+        "  time              = " <> build metaTime,+        "  endpoint          = " <> build host,+        "  credential        = " <> build metaCredential,+        "  signed headers    = " <> build metaSignedHeaders,+        "  signature         = " <> build metaSignature,+        "  string to sign    = {",+        build metaStringToSign,+        "  }",+        "  canonical request = {",+        build metaCanonicalRequest,+        "  }",+        "}"+      ]++base ::+  Hash ->+  Request a ->+  AuthEnv ->+  Region ->+  UTCTime ->+  (V4, ClientRequest -> ClientRequest)+base h rq a region ts = (meta, auth)+  where+    auth = clientRequestHeaders <>~ [(HTTP.hAuthorization, authorisation meta)]++    meta = signMetadata a region ts presigner h (prepare rq)++    presigner _ _ = id++    prepare :: Request a -> Request a+    prepare r@Request {headers} =+      r+        { headers =+            headers+              & hdr hHost realHost+              & hdr hAMZDate (toBS (Time ts :: AWSTime))+              & hdr hAMZContentSHA256 (toBS h)+              & maybe id (hdr hAMZToken . toBS) (sessionToken a)+        }++    realHost =+      case (secure, port) of+        (False, 80) -> host+        (True, 443) -> host+        _ -> mconcat [host, ":", toBS port]++    Endpoint {host, port, secure} = endpoint (service rq) region++-- | Used to tag provenance. This allows keeping the same layout as+-- the signing documentation, passing 'ByteString's everywhere, with+-- some type guarantees.+--+-- Data.Tagged is not used for no reason other than the dependency, syntactic length,+-- and the ToByteString instance.+newtype Tag (s :: Symbol) a = Tag {untag :: a}+  deriving stock (Show)++instance ToByteString (Tag s ByteString) where toBS = untag++instance ToLog (Tag s ByteString) where build = build . untag++instance ToByteString CredentialScope where+  toBS = BS8.intercalate "/" . untag++type Hash = Tag "body-digest" ByteString++type StringToSign = Tag "string-to-sign" ByteString++type Credential = Tag "credential" ByteString++type CredentialScope = Tag "credential-scope" [ByteString]++type CanonicalRequest = Tag "canonical-request" ByteString++type CanonicalHeaders = Tag "canonical-headers" ByteString++type CanonicalQuery = Tag "canonical-query" ByteString++type SignedHeaders = Tag "signed-headers" ByteString++type NormalisedHeaders = Tag "normalised-headers" [(ByteString, ByteString)]++type Method = Tag "method" ByteString++type CanonicalPath = Tag "canonical-path" ByteString++type Path = Tag "path" ByteString++type Signature = Tag "signature" ByteString++authorisation :: V4 -> ByteString+authorisation V4 {..} =+  mconcat+    [ algorithm,+      " Credential=",+      toBS metaCredential,+      ", SignedHeaders=",+      toBS metaSignedHeaders,+      ", Signature=",+      toBS metaSignature+    ]++signRequest ::+  -- | Pre-signRequestd signing metadata.+  V4 ->+  -- | The request body.+  Client.RequestBody ->+  -- | Insert authentication information.+  (ClientRequest -> ClientRequest) ->+  Signed a+signRequest m@V4 {..} b auth = Signed (Meta m) (auth rq)+  where+    rq =+      (newClientRequest metaEndpoint metaTimeout)+        { Client.method = toBS metaMethod,+          Client.path = toBS metaPath,+          Client.queryString = qry,+          Client.requestHeaders = metaHeaders,+          Client.requestBody = b+        }++    qry+      | BS.null x = x+      | otherwise = '?' `BS8.cons` x+      where+        x = toBS metaCanonicalQuery++signMetadata ::+  AuthEnv ->+  Region ->+  UTCTime ->+  (Credential -> SignedHeaders -> QueryString -> QueryString) ->+  Hash ->+  Request a ->+  V4+signMetadata a r ts presign digest rq@Request {headers, method, query, service} =+  V4+    { metaTime = ts,+      metaMethod = method',+      metaPath = path,+      metaEndpoint = end,+      metaCredential = cred,+      metaCanonicalQuery = query',+      metaCanonicalRequest = crq,+      metaCanonicalHeaders = chs,+      metaSignedHeaders = shs,+      metaStringToSign = sts,+      metaSignature = signature (secretAccessKey a ^. _Sensitive) scope sts,+      metaHeaders = headers,+      metaTimeout = timeout service+    }+  where+    query' = canonicalQuery $ presign cred shs query++    sts = stringToSign ts scope crq+    cred = credential (accessKeyId a) scope+    scope = credentialScope service end ts+    crq = canonicalRequest method' cpath digest query' chs shs++    chs = canonicalHeaders normalisedHeaders+    shs = signedHeaders normalisedHeaders+    normalisedHeaders = normaliseHeaders headers++    end = endpoint service r+    method' = Tag $ toBS method+    path = escapedPath r rq+    cpath = canonicalPath r rq++algorithm :: ByteString+algorithm = "AWS4-HMAC-SHA256"++signature :: SecretKey -> CredentialScope -> StringToSign -> Signature+signature k c = Tag . Bytes.encodeBase16 . Crypto.hmacSHA256 signingKey . untag+  where+    signingKey = Foldable.foldl' hmac ("AWS4" <> toBS k) (untag c)++    hmac x y = Bytes.convert (Crypto.hmacSHA256 x y)++stringToSign :: UTCTime -> CredentialScope -> CanonicalRequest -> StringToSign+stringToSign t c r =+  Tag $+    BS8.intercalate+      "\n"+      [ algorithm,+        toBS (Time t :: AWSTime),+        toBS c,+        Bytes.encodeBase16 . Crypto.hashSHA256 $ toBS r+      ]++credential :: AccessKey -> CredentialScope -> Credential+credential k c = Tag (toBS k <> "/" <> toBS c)++credentialScope :: Service -> Endpoint -> UTCTime -> CredentialScope+credentialScope Service {signingName} Endpoint {scope} t =+  Tag+    [ toBS (Time t :: BasicTime),+      toBS scope,+      toBS signingName,+      "aws4_request"+    ]++canonicalRequest ::+  Method ->+  CanonicalPath ->+  Hash ->+  CanonicalQuery ->+  CanonicalHeaders ->+  SignedHeaders ->+  CanonicalRequest+canonicalRequest meth path digest query chs shs =+  Tag $+    BS8.intercalate+      "\n"+      [ toBS meth,+        toBS path,+        toBS query,+        toBS chs,+        toBS shs,+        toBS digest+      ]++escapedPath :: Region -> Request a -> Path+escapedPath r rq@Request {service = Service {abbrev}} =+  Tag $ case abbrev of+    "S3" -> toBS $ escapePath p+    _ -> toBS $ escapePath $ collapsePath p+  where+    p = fullRawPath r rq++canonicalPath :: Region -> Request a -> CanonicalPath+canonicalPath r rq@Request {service = Service {abbrev}} =+  Tag $ case abbrev of+    "S3" -> toBS $ escapePath p+    _ -> toBS $ escapePathTwice $ collapsePath p+  where+    p = fullRawPath r rq++-- | The complete raw path for a request, including any 'basePath' on+-- the endpoint.+fullRawPath :: Region -> Request a -> RawPath+fullRawPath r Request {path, service = Service {endpoint}} =+  basePath (endpoint r) <> path++canonicalQuery :: QueryString -> CanonicalQuery+canonicalQuery = Tag . toBS++-- FIXME: the following use of stripBS is too naive, should remove+-- all internal whitespace, replacing with a single space char,+-- unless quoted with \"...\"+canonicalHeaders :: NormalisedHeaders -> CanonicalHeaders+canonicalHeaders = Tag . BSL.toStrict . BSB.toLazyByteString . Foldable.foldMap (uncurry f) . untag+  where+    f k v = BSB.byteString k <> BSB.char7 ':' <> BSB.byteString (stripBS v) <> BSB.char7 '\n'++signedHeaders :: NormalisedHeaders -> SignedHeaders+signedHeaders = Tag . BS8.intercalate ";" . map fst . untag++normaliseHeaders :: [Header] -> NormalisedHeaders+normaliseHeaders =+  Tag+    . map (first CI.foldedCase)+    . Map.toAscList+    . Map.delete "authorization"+    . Map.delete "content-length"+    . Map.fromListWith const
+ src/Amazonka/Sign/V4/Chunked.hs view
@@ -0,0 +1,136 @@+-- |+-- Module      : Amazonka.Sign.V4.Chunked+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Sign.V4.Chunked where++import qualified Amazonka.Bytes as Bytes+import Amazonka.Core.Lens.Internal ((^.))+import qualified Amazonka.Crypto as Crypto+import Amazonka.Data+import Amazonka.Prelude as Prelude+import Amazonka.Sign.V4.Base as V4 hiding (algorithm)+import Amazonka.Types+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as Build+import qualified Data.ByteString.Char8 as BS8+import Data.Conduit (ConduitM)+import qualified Data.Conduit as Conduit+import qualified Network.HTTP.Types as HTTP+import qualified Numeric++chunked :: ChunkedBody -> Algorithm a+chunked+  c@ChunkedBody {length = len}+  rq@Request {service = service@Service {endpoint}}+  a+  region+  ts =+    signRequest meta (toRequestBody body) auth+    where+      (meta, auth) = V4.base (Tag digest) (prepare rq) a region ts++      -- Although https://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-streaming.html says to include+      -- `Content-Encoding: aws-chunked`, we don't. If it's the only header, S3 will remove+      -- `aws-chunked` leaving a blank header, and store `"ContentEncoding": ""` in the object's metadata.+      -- This breaks some CDNs and HTTP clients.+      --+      -- According to https://github.com/fog/fog-aws/pull/147 , AWS support have confirmed that the+      -- header is not strictly necessary, and S3 will figure out that it's a chunked body.+      prepare :: Request a -> Request a+      prepare r@Request {headers} =+        r+          { headers =+              headers+                <> [ (hAMZDecodedContentLength, toBS len),+                     (HTTP.hContentLength, toBS (metadataLength c))+                   ]+          }++      body = Chunked (c `fuseChunks` sign (metaSignature meta))++      sign :: Monad m => Signature -> ConduitM ByteString ByteString m ()+      sign prev = do+        mx <- Conduit.await++        let next = chunkSignature prev (fromMaybe mempty mx)++        case mx of+          Nothing -> Conduit.yield (chunkData next mempty)+          Just x -> Conduit.yield (chunkData next x) >> sign next++      chunkData next x =+        toBS $+          Build.word64Hex (fromIntegral (BS.length x))+            <> Build.byteString chunkSignatureHeader+            <> Build.byteString (toBS next)+            <> Build.byteString crlf+            <> Build.byteString x+            <> Build.byteString crlf++      chunkSignature prev x =+        signature (secretAccessKey a ^. _Sensitive) scope (chunkStringToSign prev x)++      chunkStringToSign prev x =+        Tag $+          BS8.intercalate+            "\n"+            [ algorithm,+              time,+              toBS scope,+              toBS prev,+              sha256Empty,+              sha256 x+            ]++      time :: ByteString+      time = toBS (Time ts :: AWSTime)++      scope :: CredentialScope+      scope = credentialScope service end ts++      end :: Endpoint+      end = endpoint region++metadataLength :: ChunkedBody -> Integer+metadataLength c =+  -- Number of full sized chunks.+  fullChunks c * chunkLength (size c)+    -- Non-full chunk preceeding the final chunk.+    + maybe 0 chunkLength (remainderBytes c)+    -- The final empty chunk.+    + chunkLength (0 :: Integer)+  where+    chunkLength :: Integral a => a -> Integer+    chunkLength (toInteger -> n) =+      fromIntegral (Prelude.length (Numeric.showHex n ""))+        + headerLength+        + signatureLength+        + crlfLength+        + n+        + crlfLength++    headerLength = toInteger (BS.length chunkSignatureHeader)+    crlfLength = toInteger (BS.length crlf)+    signatureLength = 64++sha256 :: ByteString -> ByteString+sha256 = Bytes.encodeBase16 . Crypto.hashSHA256++sha256Empty :: ByteString+sha256Empty = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"++algorithm :: ByteString+algorithm = "AWS4-HMAC-SHA256-PAYLOAD"++digest :: ByteString+digest = "STREAMING-AWS4-HMAC-SHA256-PAYLOAD"++chunkSignatureHeader :: ByteString+chunkSignatureHeader = ";chunk-signature="++crlf :: ByteString+crlf = "\r\n"
+ src/Amazonka/Types.hs view
@@ -0,0 +1,1043 @@+-- |+-- Module      : Amazonka.Types+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Types+  ( -- * Authentication++    -- ** Credentials+    AccessKey (..),+    SecretKey (..),+    SessionToken (..),++    -- *** Optics+    _AccessKey,+    _SecretKey,+    _SessionToken,++    -- ** Environment+    Auth (..),+    withAuth,+    AuthEnv (..),++    -- *** Lenses+    authEnv_accessKeyId,+    authEnv_secretAccessKey,+    authEnv_sessionToken,+    authEnv_expiration,++    -- * Signing+    Algorithm,+    Meta (..),+    Signer (..),+    Signed (..),++    -- ** Lenses+    signed_signedMeta,+    signed_signedRequest,++    -- * Service+    Abbrev,+    Service (..),+    S3AddressingStyle (..),++    -- ** Optics+    _Abbrev,+    service_abbrev,+    service_signer,+    service_signingName,+    service_version,+    service_s3AddressingStyle,+    service_endpointPrefix,+    service_endpoint,+    service_timeout,+    service_check,+    service_error,+    service_retry,++    -- * Requests+    AWSRequest (..),+    Request (..),+    requestSign,+    requestPresign,+    requestUnsigned,++    -- ** Lenses+    request_service,+    request_method,+    request_path,+    request_query,+    request_headers,+    request_body,++    -- * Retries+    Retry (..),++    -- ** Lenses+    retry_base,+    retry_growth,+    retry_attempts,+    retry_check,++    -- * Errors+    AsError (..),+    Error (..),++    -- ** HTTP Errors+    Client.HttpException,++    -- ** Serialize Errors+    SerializeError (..),++    -- *** Lenses+    serializeError_abbrev,+    serializeError_status,+    serializeError_body,+    serializeError_message,++    -- ** Service Errors+    ServiceError (..),++    -- *** Lenses+    serviceError_abbrev,+    serviceError_status,+    serviceError_headers,+    serviceError_code,+    serviceError_message,+    serviceError_requestId,++    -- ** Error Types+    ErrorCode (..),+    newErrorCode,+    ErrorMessage (..),+    RequestId (..),++    -- *** Optics+    _ErrorCode,+    _ErrorMessage,+    _RequestId,++    -- * Regions+    Region+      ( Ohio,+        NorthVirginia,+        NorthCalifornia,+        Oregon,+        CapeTown,+        HongKong,+        Hyderabad,+        Jakarta,+        Melbourne,+        Mumbai,+        Osaka,+        Seoul,+        Singapore,+        Sydney,+        Tokyo,+        Montreal,+        Frankfurt,+        Ireland,+        London,+        Milan,+        Paris,+        Spain,+        Stockholm,+        Zurich,+        Bahrain,+        UAE,+        SaoPaulo,+        GovCloudEast,+        GovCloudWest,+        Beijing,+        Ningxia,+        ..+      ),++    -- * Endpoints+    Endpoint (..),++    -- ** Lenses+    endpoint_host,+    endpoint_basePath,+    endpoint_secure,+    endpoint_port,+    endpoint_scope,++    -- * HTTP+    ClientRequest,+    ClientResponse,+    ClientBody,+    newClientRequest,++    -- ** Seconds+    Seconds (..),+    toSeconds,+    toMicroseconds,+  )+where++import qualified Amazonka.Core.Lens.Internal as Lens+import Amazonka.Data+import Amazonka.Prelude hiding (error)+import Control.Concurrent (ThreadId)+import Control.Monad.Trans.Resource (ResourceT)+import Data.Conduit (ConduitM)+import Data.IORef (IORef, readIORef)+import qualified Data.Text as Text+import Data.Time (defaultTimeLocale, formatTime, parseTimeM)+import qualified Network.HTTP.Client as Client+import Network.HTTP.Types.Method (StdMethod)+import Network.HTTP.Types.Status (Status)++-- | A convenience alias to avoid type ambiguity.+type ClientRequest = Client.Request++-- | Construct a 'ClientRequest' using common parameters such as TLS and prevent+-- throwing errors when receiving erroneous status codes in respones.+newClientRequest :: Endpoint -> Maybe Seconds -> ClientRequest+newClientRequest Endpoint {host, secure, port} timeout =+  Client.defaultRequest+    { Client.secure = secure,+      Client.host = host,+      Client.port = port,+      Client.redirectCount = 0,+      Client.responseTimeout =+        case timeout of+          Nothing -> Client.responseTimeoutNone+          Just n -> Client.responseTimeoutMicro (toMicroseconds n)+    }++-- | A convenience alias encapsulating the common 'Response'.+type ClientResponse = Client.Response++-- | A convenience alias encapsulating the common 'Response' body.+type ClientBody = ConduitM () ByteString (ResourceT IO) ()++-- | Abbreviated service name.+newtype Abbrev = Abbrev {fromAbbrev :: Text}+  deriving stock (Eq, Ord, Show, Generic)+  deriving newtype (IsString, FromXML, FromJSON, FromText, ToText, ToLog)++{-# INLINE _Abbrev #-}+_Abbrev :: Iso' Abbrev Text+_Abbrev = Lens.coerced++newtype ErrorCode = ErrorCode Text+  deriving stock (Eq, Ord, Show)+  deriving newtype (ToText, ToLog)++{-# INLINE _ErrorCode #-}+_ErrorCode :: Iso' ErrorCode Text+_ErrorCode = Lens.coerced++instance IsString ErrorCode where+  fromString = newErrorCode . fromString++instance FromJSON ErrorCode where+  parseJSON = parseJSONText "ErrorCode"++instance FromXML ErrorCode where+  parseXML = parseXMLText "ErrorCode"++instance FromText ErrorCode where+  fromText = pure . newErrorCode++-- | Construct an 'ErrorCode'.+newErrorCode :: Text -> ErrorCode+newErrorCode = ErrorCode . strip . unnamespace+  where+    -- Common suffixes are stripped since the service definitions are ambigiuous+    -- as to whether the error shape's name, or the error code is present+    -- in the response.+    strip x =+      fromMaybe x $+        Text.stripSuffix "Exception" x <|> Text.stripSuffix "Fault" x++    -- Removing the (potential) leading ...# namespace.+    unnamespace x =+      case Text.break (== '#') x of+        (ns, e)+          | Text.null e -> ns+          | otherwise -> Text.drop 1 e++newtype ErrorMessage = ErrorMessage {fromErrorMessage :: Text}+  deriving stock (Eq, Ord, Show, Generic)+  deriving newtype (IsString, FromXML, FromJSON, FromText, ToText, ToLog)++{-# INLINE _ErrorMessage #-}+_ErrorMessage :: Iso' ErrorMessage Text+_ErrorMessage = Lens.coerced++newtype RequestId = RequestId {fromRequestId :: Text}+  deriving stock (Eq, Ord, Show, Generic)+  deriving newtype (IsString, FromXML, FromJSON, FromText, ToText, ToLog)++{-# INLINE _RequestId #-}+_RequestId :: Iso' RequestId Text+_RequestId = Lens.coerced++-- | An error type representing errors that can be attributed to this library.+data Error+  = TransportError Client.HttpException+  | SerializeError SerializeError+  | ServiceError ServiceError+  deriving stock (Show, Generic)++instance Exception Error++instance ToLog Error where+  build = \case+    TransportError e -> build e+    SerializeError e -> build e+    ServiceError e -> build e++data SerializeError = SerializeError'+  { abbrev :: Abbrev,+    status :: Status,+    -- | The response body, if the response was not streaming.+    body :: Maybe ByteStringLazy,+    message :: String+  }+  deriving stock (Eq, Show, Generic)++instance ToLog SerializeError where+  build SerializeError' {..} =+    buildLines+      [ "[SerializeError] {",+        "  service = " <> build abbrev,+        "  status  = " <> build status,+        "  message = " <> build message,+        "  body    = " <> build body,+        "}"+      ]++{-# INLINE serializeError_abbrev #-}+serializeError_abbrev :: Lens' SerializeError Abbrev+serializeError_abbrev f e@SerializeError' {abbrev} = f abbrev <&> \abbrev' -> (e :: SerializeError) {abbrev = abbrev'}++{-# INLINE serializeError_status #-}+serializeError_status :: Lens' SerializeError Status+serializeError_status f e@SerializeError' {status} = f status <&> \status' -> (e :: SerializeError) {status = status'}++{-# INLINE serializeError_body #-}+serializeError_body :: Lens' SerializeError (Maybe ByteStringLazy)+serializeError_body f e@SerializeError' {body} = f body <&> \body' -> (e :: SerializeError) {body = body'}++{-# INLINE serializeError_message #-}+serializeError_message :: Lens' SerializeError String+serializeError_message f e@SerializeError' {message} = f message <&> \message' -> (e :: SerializeError) {message = message'}++data ServiceError = ServiceError'+  { abbrev :: Abbrev,+    status :: Status,+    headers :: [Header],+    code :: ErrorCode,+    message :: Maybe ErrorMessage,+    requestId :: Maybe RequestId+  }+  deriving stock (Eq, Show, Generic)++instance ToLog ServiceError where+  build ServiceError' {..} =+    buildLines+      [ "[ServiceError] {",+        "  service    = " <> build abbrev,+        "  status     = " <> build status,+        "  code       = " <> build code,+        "  message    = " <> build message,+        "  request-id = " <> build requestId,+        "}"+      ]++{-# INLINE serviceError_abbrev #-}+serviceError_abbrev :: Lens' ServiceError Abbrev+serviceError_abbrev f e@ServiceError' {abbrev} = f abbrev <&> \abbrev' -> (e :: ServiceError) {abbrev = abbrev'}++{-# INLINE serviceError_status #-}+serviceError_status :: Lens' ServiceError Status+serviceError_status f e@ServiceError' {status} = f status <&> \status' -> (e :: ServiceError) {status = status'}++{-# INLINE serviceError_headers #-}+serviceError_headers :: Lens' ServiceError [Header]+serviceError_headers f e@ServiceError' {headers} = f headers <&> \headers' -> (e :: ServiceError) {headers = headers'}++{-# INLINE serviceError_code #-}+serviceError_code :: Lens' ServiceError ErrorCode+serviceError_code f e@ServiceError' {code} = f code <&> \code' -> e {code = code'}++{-# INLINE serviceError_message #-}+serviceError_message :: Lens' ServiceError (Maybe ErrorMessage)+serviceError_message f e@ServiceError' {message} = f message <&> \message' -> (e :: ServiceError) {message = message'}++{-# INLINE serviceError_requestId #-}+serviceError_requestId :: Lens' ServiceError (Maybe RequestId)+serviceError_requestId f e@ServiceError' {requestId} = f requestId <&> \requestId' -> (e :: ServiceError) {requestId = requestId'}++class AsError a where+  -- | A general Amazonka error.+  _Error :: Prism' a Error++  {-# MINIMAL _Error #-}++  -- | An error occured while communicating over HTTP with a remote service.+  _TransportError :: Prism' a Client.HttpException++  -- | A serialisation error occured when attempting to deserialise a response.+  _SerializeError :: Prism' a SerializeError++  -- | A service specific error returned by the remote service.+  _ServiceError :: Prism' a ServiceError++  _TransportError = _Error . _TransportError+  _SerializeError = _Error . _SerializeError+  _ServiceError = _Error . _ServiceError++instance AsError SomeException where+  _Error = Lens.exception++instance AsError Error where+  _Error = id++  _TransportError = Lens.prism TransportError $ \case+    TransportError e -> Right e+    x -> Left x++  _SerializeError = Lens.prism SerializeError $ \case+    SerializeError e -> Right e+    x -> Left x++  _ServiceError = Lens.prism ServiceError $ \case+    ServiceError e -> Right e+    x -> Left x++data Endpoint = Endpoint+  { -- | The host to make requests to. Usually something like+    -- @s3.us-east-1.amazonaws.com@.+    host :: ByteString,+    -- | Path segment prepended to the request path of any request+    -- made to this endpoint. This is useful if you want to use the+    -- AWS API Gateway Management API, which requires you to override+    -- the client endpoint including a leading path segment (either+    -- the stage or, on a custom domain, the mapped base path).+    basePath :: RawPath,+    secure :: Bool,+    port :: Int,+    -- | Signing scope, usually a region like @us-east-1@.+    scope :: ByteString+  }+  deriving stock (Eq, Show, Generic)++{-# INLINE endpoint_host #-}+endpoint_host :: Lens' Endpoint ByteString+endpoint_host f e@Endpoint {host} = f host <&> \host' -> e {host = host'}++{-# INLINE endpoint_basePath #-}+endpoint_basePath :: Lens' Endpoint RawPath+endpoint_basePath f e@Endpoint {basePath} = f basePath <&> \basePath' -> e {basePath = basePath'}++{-# INLINE endpoint_secure #-}+endpoint_secure :: Lens' Endpoint Bool+endpoint_secure f e@Endpoint {secure} = f secure <&> \secure' -> e {secure = secure'}++{-# INLINE endpoint_port #-}+endpoint_port :: Lens' Endpoint Int+endpoint_port f e@Endpoint {port} = f port <&> \port' -> e {port = port'}++{-# INLINE endpoint_scope #-}+endpoint_scope :: Lens' Endpoint ByteString+endpoint_scope f e@Endpoint {scope} = f scope <&> \scope' -> e {scope = scope'}++-- | Constants and predicates used to create a 'RetryPolicy'.+data Retry = Exponential+  { base :: Double,+    growth :: Int,+    attempts :: Int,+    -- | Returns a descriptive name for logging+    -- if the request should be retried.+    check :: ServiceError -> Maybe Text+  }+  deriving stock (Generic)++{-# INLINE retry_base #-}+retry_base :: Lens' Retry Double+retry_base f r@Exponential {base} = f base <&> \base' -> r {base = base'}++{-# INLINE retry_growth #-}+retry_growth :: Lens' Retry Int+retry_growth f r@Exponential {growth} = f growth <&> \growth' -> r {growth = growth'}++{-# INLINE retry_attempts #-}+retry_attempts :: Lens' Retry Int+retry_attempts f r@Exponential {attempts} = f attempts <&> \attempts' -> r {attempts = attempts'}++{-# INLINE retry_check #-}+retry_check :: Lens' Retry (ServiceError -> Maybe Text)+retry_check f r@Exponential {check} = f check <&> \check' -> (r :: Retry) {check = check'}++-- | Signing algorithm specific metadata.+data Meta where+  Meta :: ToLog a => a -> Meta++instance ToLog Meta where+  build (Meta m) = build m++-- | A signed 'ClientRequest' and associated metadata specific+-- to the signing algorithm, tagged with the initial request type+-- to be able to obtain the associated response, @'AWSResponse' a@.+data Signed a = Signed+  { signedMeta :: Meta,+    signedRequest :: ClientRequest+  }++{-# INLINE signed_signedMeta #-}+signed_signedMeta :: Lens' (Signed a) Meta+signed_signedMeta f s@Signed {signedMeta} = f signedMeta <&> \signedMeta' -> s {signedMeta = signedMeta'}++{-# INLINE signed_signedRequest #-}+signed_signedRequest :: Lens' (Signed a) ClientRequest+signed_signedRequest f s@Signed {signedRequest} = f signedRequest <&> \signedRequest' -> s {signedRequest = signedRequest'}++type Algorithm a = Request a -> AuthEnv -> Region -> UTCTime -> Signed a++data Signer = Signer+  { sign :: forall a. Algorithm a,+    presign :: forall a. Seconds -> Algorithm a+  }++-- | Attributes and functions specific to an AWS service.+data Service = Service+  { abbrev :: Abbrev,+    signer :: Signer,+    signingName :: ByteString,+    version :: ByteString,+    -- | Only service bindings using the s3vhost request plugin+    -- (configured in the generator) will care about this field. It is+    -- ignored otherwise.+    s3AddressingStyle :: S3AddressingStyle,+    endpointPrefix :: ByteString,+    endpoint :: Region -> Endpoint,+    timeout :: Maybe Seconds,+    check :: Status -> Bool,+    error :: Status -> [Header] -> ByteStringLazy -> Error,+    retry :: Retry+  }+  deriving stock (Generic)++{-# INLINE service_abbrev #-}+service_abbrev :: Lens' Service Abbrev+service_abbrev f s@Service {abbrev} = f abbrev <&> \abbrev' -> (s :: Service) {abbrev = abbrev'}++{-# INLINE service_signer #-}+service_signer :: Lens' Service Signer+service_signer f s@Service {signer} = f signer <&> \signer' -> (s :: Service) {signer = signer'}++{-# INLINE service_signingName #-}+service_signingName :: Lens' Service ByteString+service_signingName f s@Service {signingName} = f signingName <&> \signingName' -> s {signingName = signingName'}++{-# INLINE service_version #-}+service_version :: Lens' Service ByteString+service_version f s@Service {version} = f version <&> \version' -> s {version = version'}++{-# INLINE service_s3AddressingStyle #-}+service_s3AddressingStyle :: Lens' Service S3AddressingStyle+service_s3AddressingStyle f s@Service {s3AddressingStyle} = f s3AddressingStyle <&> \s3AddressingStyle' -> s {s3AddressingStyle = s3AddressingStyle'}++{-# INLINE service_endpointPrefix #-}+service_endpointPrefix :: Lens' Service ByteString+service_endpointPrefix f s@Service {endpointPrefix} = f endpointPrefix <&> \endpointPrefix' -> s {endpointPrefix = endpointPrefix'}++{-# INLINE service_endpoint #-}+service_endpoint :: Lens' Service (Region -> Endpoint)+service_endpoint f s@Service {endpoint} = f endpoint <&> \endpoint' -> s {endpoint = endpoint'}++{-# INLINE service_timeout #-}+service_timeout :: Lens' Service (Maybe Seconds)+service_timeout f s@Service {timeout} = f timeout <&> \timeout' -> s {timeout = timeout'}++{-# INLINE service_check #-}+service_check :: Lens' Service (Status -> Bool)+service_check f s@Service {check} = f check <&> \check' -> (s :: Service) {check = check'}++{-# INLINE service_error #-}+service_error :: Lens' Service (Status -> [Header] -> ByteStringLazy -> Error)+service_error f s@Service {error} = f error <&> \error' -> (s :: Service) {error = error'}++{-# INLINE service_retry #-}+service_retry :: Lens' Service Retry+service_retry f s@Service {retry} = f retry <&> \retry' -> (s :: Service) {retry = retry'}++-- | When to rewrite S3 requests into /virtual-hosted style/.+--+-- Requests to S3 can be rewritten to access buckets by setting the+-- @Host:@ header, which allows you to point a @CNAME@ record at an+-- Amazon S3 Bucket.+--+-- Non-S3 object stores usually do not support this, which is usually+-- the only time you'll need to change this.+--+-- /See:/ [Virtual hosting of buckets](https://docs.aws.amazon.com/AmazonS3/latest/userguide/VirtualHosting.html)+-- in the Amazon S3 User Guide.+--+-- /See:/ [Changing the Addressing Style](https://boto3.amazonaws.com/v1/documentation/api/1.9.42/guide/s3.html#changing-the-addressing-style)+-- for the corresponding option in Boto 3.+data S3AddressingStyle+  = -- | Rewrite S3 request paths only if they can be expressed+    -- as a DNS label. This is the default.+    S3AddressingStyleAuto+  | -- | Do not ever rewrite S3 request paths.+    S3AddressingStylePath+  | -- | Force virtual hosted style rewrites without checking the+    -- bucket name.+    S3AddressingStyleVirtual+  deriving stock (Eq, Show, Generic)++-- | An unsigned request.+data Request a = Request+  { service :: Service,+    method :: StdMethod,+    path :: RawPath,+    query :: QueryString,+    headers :: [Header],+    body :: RequestBody+  }+  deriving stock (Generic)++{-# INLINE request_service #-}+request_service :: Lens' (Request a) Service+request_service f rq@Request {service} = f service <&> \service' -> rq {service = service'}++{-# INLINE request_method #-}+request_method :: Lens' (Request a) StdMethod+request_method f rq@Request {method} = f method <&> \method' -> rq {method = method'}++{-# INLINE request_path #-}+request_path :: Lens' (Request a) RawPath+request_path f rq@Request {path} = f path <&> \path' -> rq {path = path'}++{-# INLINE request_query #-}+request_query :: Lens' (Request a) QueryString+request_query f rq@Request {query} = f query <&> \query' -> rq {query = query'}++{-# INLINE request_headers #-}+request_headers :: forall a. Lens' (Request a) [Header]+request_headers f rq@Request {headers} = f headers <&> \headers' -> (rq :: Request a) {headers = headers'}++{-# INLINE request_body #-}+request_body :: forall a. Lens' (Request a) RequestBody+request_body f rq@Request {body} = f body <&> \body' -> (rq :: Request a) {body = body'}++requestSign :: Algorithm a+requestSign rq@Request {service = Service {signer = Signer {sign}}} = sign rq++requestPresign :: Seconds -> Algorithm a+requestPresign ex rq@Request {service = Service {signer = Signer {presign}}} =+  presign ex rq++-- | Create an unsigned 'ClientRequest'. You will almost never need to do this.+requestUnsigned :: Request a -> Region -> ClientRequest+requestUnsigned Request {service = Service {..}, ..} r =+  (newClientRequest end timeout)+    { Client.method = toBS method,+      Client.path = toBS (escapePath path),+      Client.queryString = toBS query,+      Client.requestHeaders = headers,+      Client.requestBody = toRequestBody body+    }+  where+    end = endpoint r++-- | Specify how a request can be de/serialised.+class AWSRequest a where+  -- | The successful, expected response associated with a request.+  type AWSResponse a :: Type++  request ::+    -- | Overrides applied to the default 'Service'.+    (Service -> Service) ->+    a ->+    Request a++  response ::+    MonadResource m =>+    -- | Raw response body hook.+    (ByteStringLazy -> IO ByteStringLazy) ->+    Service ->+    Proxy a ->+    ClientResponse ClientBody ->+    m (Either Error (ClientResponse (AWSResponse a)))++-- | 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 stock (Eq, Show, Read, Generic)+  deriving newtype+    ( IsString,+      ToText,+      FromText,+      ToLog,+      ToByteString,+      ToQuery,+      FromXML,+      ToXML,+      Hashable,+      NFData+    )++instance ToJSON AccessKey where+  toJSON = toJSONText++instance FromJSON AccessKey where+  parseJSON = parseJSONText "AccessKey"++_AccessKey :: Iso' AccessKey ByteString+_AccessKey = Lens.coerced++-- | 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 stock (Eq, Generic)+  deriving newtype+    ( IsString,+      ToText,+      FromText,+      ToByteString,+      FromXML,+      ToXML,+      Hashable,+      NFData+    )++instance ToJSON SecretKey where+  toJSON = toJSONText++instance FromJSON SecretKey where+  parseJSON = parseJSONText "SecretKey"++_SecretKey :: Iso' SecretKey ByteString+_SecretKey = Lens.coerced++-- | 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 stock (Eq, Generic)+  deriving newtype+    ( IsString,+      ToText,+      FromText,+      ToByteString,+      FromXML,+      ToXML,+      Hashable,+      NFData+    )++instance ToJSON SessionToken where+  toJSON = toJSONText++instance FromJSON SessionToken where+  parseJSON = parseJSONText "SessionToken"++_SessionToken :: Iso' SessionToken ByteString+_SessionToken = Lens.coerced++-- | The AuthN/AuthZ credential environment.+data AuthEnv = AuthEnv+  { accessKeyId :: AccessKey,+    secretAccessKey :: Sensitive SecretKey,+    sessionToken :: Maybe (Sensitive SessionToken),+    expiration :: Maybe ISO8601+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (NFData)++instance ToLog AuthEnv where+  build AuthEnv {..} =+    buildLines+      [ "[Amazonka Auth] {",+        "  access key id     = " <> build accessKeyId,+        "  secret access key = " <> build secretAccessKey,+        "  session token     = " <> build sessionToken,+        "  expiration        = " <> build (fmap (Lens.view _Time) expiration),+        "}"+      ]++instance FromJSON AuthEnv where+  parseJSON = withObject "AuthEnv" $ \o ->+    AuthEnv+      <$> o .: "AccessKeyId"+      <*> o .: "SecretAccessKey"+      <*> o .:? "Token"+      <*> o .:? "Expiration"++instance FromXML AuthEnv where+  parseXML x =+    AuthEnv+      <$> x .@ "AccessKeyId"+      <*> x .@ "SecretAccessKey"+      <*> x .@? "SessionToken"+      <*> x .@? "Expiration"++{-# INLINE authEnv_accessKeyId #-}+authEnv_accessKeyId :: Lens' AuthEnv AccessKey+authEnv_accessKeyId f a@AuthEnv {accessKeyId} = f accessKeyId <&> \accessKeyId' -> a {accessKeyId = accessKeyId'}++{-# INLINE authEnv_secretAccessKey #-}+authEnv_secretAccessKey :: Lens' AuthEnv (Sensitive SecretKey)+authEnv_secretAccessKey f a@AuthEnv {secretAccessKey} = f secretAccessKey <&> \secretAccessKey' -> a {secretAccessKey = secretAccessKey'}++{-# INLINE authEnv_sessionToken #-}+authEnv_sessionToken :: Lens' AuthEnv (Maybe (Sensitive SessionToken))+authEnv_sessionToken f a@AuthEnv {sessionToken} = f sessionToken <&> \sessionToken' -> a {sessionToken = sessionToken'}++{-# INLINE authEnv_expiration #-}+authEnv_expiration :: Lens' AuthEnv (Maybe ISO8601)+authEnv_expiration f a@AuthEnv {expiration} = f expiration <&> \expiration' -> a {expiration = expiration'}++-- | An authorisation environment containing AWS credentials, and potentially+-- a reference which can be refreshed out-of-band as temporary credentials expire.+data Auth+  = Ref ThreadId (IORef AuthEnv)+  | Auth AuthEnv++instance ToLog Auth where+  build (Ref t _) = "[Amazonka Auth] { <thread:" <> build (show t) <> "> }"+  build (Auth e) = build e++withAuth :: MonadIO m => Auth -> (AuthEnv -> m a) -> m a+withAuth (Ref _ r) f = liftIO (readIORef r) >>= f+withAuth (Auth e) f = f e++-- | The available AWS regions.+newtype Region = Region' {fromRegion :: Text}+  deriving stock (Show, Read, Eq, Ord, Generic)+  deriving newtype+    ( IsString,+      Hashable,+      NFData,+      ToText,+      FromText,+      ToQuery,+      ToXML,+      FromXML,+      ToJSON,+      FromJSON,+      ToByteString,+      ToLog+    )++{-# INLINE _Region #-}+_Region :: Iso' Region Text+_Region = Lens.coerced++-- Patterns for Regions - keep in sync with+-- https://docs.aws.amazon.com/general/latest/gr/rande.html#regional-endpoints++-- United States++pattern Ohio :: Region+pattern Ohio = Region' "us-east-2"++pattern NorthVirginia :: Region+pattern NorthVirginia = Region' "us-east-1"++pattern NorthCalifornia :: Region+pattern NorthCalifornia = Region' "us-west-1"++pattern Oregon :: Region+pattern Oregon = Region' "us-west-2"++-- Africa++pattern CapeTown :: Region+pattern CapeTown = Region' "af-south-1"++-- Asia Pacific++pattern HongKong :: Region+pattern HongKong = Region' "ap-east-1"++pattern Hyderabad :: Region+pattern Hyderabad = Region' "ap-south-2"++pattern Jakarta :: Region+pattern Jakarta = Region' "ap-southeast-3"++pattern Melbourne :: Region+pattern Melbourne = Region' "ap-southeast-4"++pattern Mumbai :: Region+pattern Mumbai = Region' "ap-south-1"++pattern Osaka :: Region+pattern Osaka = Region' "ap-northeast-3"++pattern Seoul :: Region+pattern Seoul = Region' "ap-northeast-2"++pattern Singapore :: Region+pattern Singapore = Region' "ap-southeast-1"++pattern Sydney :: Region+pattern Sydney = Region' "ap-southeast-2"++pattern Tokyo :: Region+pattern Tokyo = Region' "ap-northeast-1"++-- Canada++pattern Montreal :: Region+pattern Montreal = Region' "ca-central-1"++-- Europe++pattern Frankfurt :: Region+pattern Frankfurt = Region' "eu-central-1"++pattern Ireland :: Region+pattern Ireland = Region' "eu-west-1"++pattern London :: Region+pattern London = Region' "eu-west-2"++pattern Milan :: Region+pattern Milan = Region' "eu-south-1"++pattern Paris :: Region+pattern Paris = Region' "eu-west-3"++pattern Spain :: Region+pattern Spain = Region' "eu-south-2"++pattern Stockholm :: Region+pattern Stockholm = Region' "eu-north-1"++pattern Zurich :: Region+pattern Zurich = Region' "eu-central-2"++-- Middle East++pattern Bahrain :: Region+pattern Bahrain = Region' "me-south-1"++pattern UAE :: Region+pattern UAE = Region' "me-central-1"++-- South America++pattern SaoPaulo :: Region+pattern SaoPaulo = Region' "sa-east-1"++-- GovCloud++pattern GovCloudEast :: Region+pattern GovCloudEast = Region' "us-gov-east-1"++pattern GovCloudWest :: Region+pattern GovCloudWest = Region' "us-gov-west-1"++-- China++pattern Beijing :: Region+pattern Beijing = Region' "cn-north-1"++pattern Ningxia :: Region+pattern Ningxia = Region' "cn-northwest-1"++{-# COMPLETE+  Ohio,+  NorthVirginia,+  NorthCalifornia,+  Oregon,+  CapeTown,+  HongKong,+  Hyderabad,+  Jakarta,+  Melbourne,+  Mumbai,+  Osaka,+  Seoul,+  Singapore,+  Sydney,+  Tokyo,+  Montreal,+  Frankfurt,+  Ireland,+  London,+  Milan,+  Paris,+  Spain,+  Stockholm,+  Zurich,+  Bahrain,+  UAE,+  SaoPaulo,+  GovCloudEast,+  GovCloudWest,+  Beijing,+  Ningxia,+  Region'+  #-}++-- | A numeric value representing seconds.+newtype Seconds = Seconds DiffTime+  deriving stock (Eq, Ord, Read, Show, Generic)+  deriving newtype (Enum, Num, Real, NFData)++instance Hashable Seconds where+  hashWithSalt salt = hashWithSalt salt . toRational . toSeconds++instance FromText Seconds where+  fromText t =+    maybe (Left err) (Right . Seconds) $+      parseTimeM False defaultTimeLocale diffTimeFormatString str+    where+      str = Text.unpack t+      err =+        "Seconds value failed to parse as expected format ("+          <> diffTimeFormatString+          <> "): "+          <> str++instance ToText Seconds where+  toText =+    Text.pack . formatTime defaultTimeLocale diffTimeFormatString . toSeconds++_Seconds :: Iso' Seconds DiffTime+_Seconds = Lens.coerced++-- | Format string used in parse/format options+--+-- Currently @%Es@, which is "total seconds, with decimal point and up to+-- <width> (default 12) decimal places, without trailing zeros. For a whole+-- number of seconds, %Es omits the decimal point unless padding is specified."+--+-- We also use 'defaultTimeLocale', which means @0.1@ and not @0,1@.+diffTimeFormatString :: String+diffTimeFormatString = "%Es"++instance ToByteString Seconds++instance ToQuery Seconds++instance ToLog Seconds where+  build s = build (toText s) <> "s"++toSeconds :: Seconds -> DiffTime+toSeconds (Seconds n)+  | n < 0 = 0+  | otherwise = n++toMicroseconds :: Seconds -> Int+toMicroseconds = round . (1000000 *) . toSeconds
+ src/Amazonka/Waiter.hs view
@@ -0,0 +1,118 @@+-- |+-- Module      : Amazonka.Waiter+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Amazonka.Waiter+  ( -- * Types+    Acceptor,+    Accept (..),+    Wait (..),++    -- ** Lenses+    wait_name,+    wait_attempts,+    wait_delay,+    wait_acceptors,++    -- * Acceptors+    accept,++    -- * Matchers+    matchAll,+    matchAny,+    matchNonEmpty,+    matchError,+    matchStatus,++    -- * Util+    nonEmptyText,+  )+where++import Amazonka.Core.Lens.Internal+  ( Fold,+    Lens,+    allOf,+    anyOf,+    to,+    (^..),+    (^?),+  )+import Amazonka.Data+import Amazonka.Error (_HttpStatus)+import Amazonka.Prelude+import Amazonka.Types+import qualified Data.Text as Text+import qualified Network.HTTP.Client as Client++type Acceptor a = Request a -> Either Error (ClientResponse (AWSResponse a)) -> Maybe Accept++data Accept+  = AcceptSuccess+  | AcceptFailure+  | AcceptRetry+  deriving stock (Eq, Show)++instance ToLog Accept where+  build = \case+    AcceptSuccess -> "Success"+    AcceptFailure -> "Failure"+    AcceptRetry -> "Retry"++-- | Timing and acceptance criteria to check fulfillment of a remote operation.+data Wait a = Wait+  { name :: ByteString,+    attempts :: Int,+    delay :: Seconds,+    acceptors :: [Acceptor a]+  }++{-# INLINE wait_name #-}+wait_name :: Lens' (Wait a) ByteString+wait_name f w@Wait {name} = f name <&> \name' -> w {name = name'}++{-# INLINE wait_attempts #-}+wait_attempts :: forall a. Lens' (Wait a) Int+wait_attempts f w@Wait {attempts} = f attempts <&> \attempts' -> (w :: Wait a) {attempts = attempts'}++{-# INLINE wait_delay #-}+wait_delay :: Lens' (Wait a) Seconds+wait_delay f w@Wait {delay} = f delay <&> \delay' -> w {delay = delay'}++{-# INLINE wait_acceptors #-}+wait_acceptors :: Lens (Wait a) (Wait b) [Acceptor a] [Acceptor b]+wait_acceptors f w@Wait {acceptors} = f acceptors <&> \acceptors' -> w {acceptors = acceptors'}++accept :: Wait a -> Acceptor a+accept w rq rs = listToMaybe . mapMaybe (\f -> f rq rs) $ acceptors w++matchAll :: Eq b => b -> Accept -> Fold (AWSResponse a) b -> Acceptor a+matchAll x a l = match (allOf l (== x)) a++matchAny :: Eq b => b -> Accept -> Fold (AWSResponse a) b -> Acceptor a+matchAny x a l = match (anyOf l (== x)) a++matchNonEmpty :: Bool -> Accept -> Fold (AWSResponse 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 rs | x == fromEnum (Client.responseStatus rs) -> Just a+  Left e | Just x == (fromEnum <$> e ^? _HttpStatus) -> Just a+  _ -> Nothing++matchError :: ErrorCode -> Accept -> Acceptor a+matchError c a _ = \case+  Left e | Just c == e ^? _ServiceError . to code -> Just a+  _ -> Nothing++match :: (AWSResponse a -> Bool) -> Accept -> Acceptor a+match f a _ = \case+  Right rs | f (Client.responseBody rs) -> Just a+  _ -> Nothing++nonEmptyText :: Fold a Text -> Fold a Bool+nonEmptyText f = f . to Text.null
− src/Network/AWS/Compat/Locale.hs 
@@ -1,20 +0,0 @@-{-# LANGUAGE CPP #-}---- |--- Module      : Network.AWS.Compat.Locale--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Compat.Locale-    ( defaultTimeLocale-    , iso8601DateFormat-    ) where--#if MIN_VERSION_time(1,5,0)-import           Data.Time.Format (defaultTimeLocale, iso8601DateFormat)-#else-import           System.Locale    (defaultTimeLocale, iso8601DateFormat)-#endif
− src/Network/AWS/Compat/Time.hs 
@@ -1,22 +0,0 @@-{-# LANGUAGE CPP #-}---- |--- Module      : Network.AWS.Compat.Time--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Compat.Time-    ( parseTime-    ) where--#if MIN_VERSION_time(1,5,0)-import           Data.Time.Format (ParseTime, TimeLocale, parseTimeM)--parseTime :: ParseTime a => TimeLocale -> String -> String -> Maybe a-parseTime = parseTimeM True-#else-import           Data.Time.Format (parseTime)-#endif
− src/Network/AWS/Data/Base64.hs 
@@ -1,67 +0,0 @@-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- |--- Module      : Network.AWS.Data.Base64--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.Base64-    ( Base64 (..)-    , _Base64-    ) where--import           Control.Applicative         (pure)-import           Control.DeepSeq-import           Data.Aeson.Types-import qualified Data.Attoparsec.Text        as AText-import qualified Data.ByteArray.Encoding     as BA-import           Data.Data                   (Data, Typeable)-import           Data.Hashable-import qualified Data.Text.Encoding          as Text-import           GHC.Generics                (Generic)-import           Network.AWS.Data.Body-import           Network.AWS.Data.ByteString-import           Network.AWS.Data.JSON-import           Network.AWS.Data.Query-import           Network.AWS.Data.Text-import           Network.AWS.Data.XML-import           Network.AWS.Lens            (Iso', iso)---- | Base64 encoded binary data.------ Encoding\/decoding is automatically deferred to serialisation and deserialisation--- respectively.-newtype Base64 = Base64 { unBase64 :: ByteString }-    deriving (Eq, Read, Ord, Data, Typeable, Generic)--instance Hashable Base64-instance NFData   Base64--_Base64 :: Iso' Base64 ByteString-_Base64 = iso unBase64 Base64---- FIXME: probably a mistake to wrap a ByteString since--- the underlying serialisers (JSON, XML) use Text internally.-instance FromText Base64 where-    parser = AText.takeText >>=-        either fail (pure . Base64)-            . BA.convertFromBase BA.Base64-            . Text.encodeUtf8--instance ToByteString Base64 where-    toBS = BA.convertToBase BA.Base64 . unBase64--instance Show         Base64 where show      = show . toBS-instance ToText       Base64 where toText    = Text.decodeUtf8 . toBS-instance ToQuery      Base64 where toQuery   = toQuery . toBS-instance FromXML      Base64 where parseXML  = parseXMLText "Base64"-instance ToXML        Base64 where toXML     = toXMLText-instance FromJSON     Base64 where parseJSON = parseJSONText "Base64"-instance ToJSON       Base64 where toJSON    = toJSONText-instance ToHashedBody Base64 where toHashed  = toHashed . toBS-instance ToBody       Base64
− src/Network/AWS/Data/Body.hs 
@@ -1,226 +0,0 @@-{-# LANGUAGE DefaultSignatures          #-}-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE ExtendedDefaultRules       #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE PackageImports             #-}--{-# OPTIONS_GHC -fno-warn-type-defaults #-}---- |--- Module      : Network.AWS.Data.Body--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.Body where--import           Control.Monad.Trans.Resource-import           Data.Aeson-import qualified Data.ByteString              as BS-import           Data.ByteString.Builder      (Builder)-import qualified Data.ByteString.Char8        as BS8-import qualified Data.ByteString.Lazy         as LBS-import qualified Data.ByteString.Lazy.Char8   as LBS8-import           Data.Conduit-import           Data.HashMap.Strict          (HashMap)-import           Data.Monoid-import           Data.String-import           Data.Text                    (Text)-import qualified Data.Text.Encoding           as Text-import qualified Data.Text.Lazy               as LText-import qualified Data.Text.Lazy.Encoding      as LText-import           Network.AWS.Data.ByteString-import           Network.AWS.Data.Crypto-import           Network.AWS.Data.Log-import           Network.AWS.Data.Query       (QueryString)-import           Network.AWS.Data.XML         (encodeXML)-import           Network.AWS.Lens             (AReview, Lens', lens, to, un)-import           Network.HTTP.Conduit-import           Text.XML                     (Element)--default (Builder)---- | A streaming, exception safe response body.-newtype RsBody = RsBody-    { _streamBody :: ResumableSource (ResourceT IO) ByteString-    } -- newtype for show/orhpan instance purposes.--instance Show RsBody where-    show = const "RsBody { ResumableSource (ResourceT IO) ByteString }"--fuseStream :: RsBody-           -> Conduit ByteString (ResourceT IO) ByteString-           -> RsBody-fuseStream b f = b { _streamBody = _streamBody b $=+ f }---- | Specifies the transmitted size of the 'Transfer-Encoding' chunks.------ /See:/ 'defaultChunk'.-newtype ChunkSize = ChunkSize Int-    deriving (Eq, Ord, Show, Enum, Num, Real, Integral)--instance ToLog ChunkSize where-    build = build . show---- | The default chunk size of 128 KB. The minimum chunk size accepted by--- AWS is 8 KB, unless the entirety of the request is below this threshold.------ A chunk size of 64 KB or higher is recommended for performance reasons.-defaultChunkSize :: ChunkSize-defaultChunkSize = 128 * 1024---- | An opaque request body which will be transmitted via--- @Transfer-Encoding: chunked@.------ /Invariant:/ Only services that support chunked encoding can--- accept a 'ChunkedBody'. (Currently S3.) This is enforced by the type--- signatures emitted by the generator.-data ChunkedBody = ChunkedBody-    { _chunkedSize   :: !ChunkSize-    , _chunkedLength :: !Integer-    , _chunkedBody   :: Source (ResourceT IO) ByteString-    }--chunkedLength :: Lens' ChunkedBody Integer-chunkedLength = lens _chunkedLength (\s a -> s { _chunkedLength = a })---- Maybe revert to using Source's, and then enforce the chunk size--- during conversion from HashedBody -> ChunkedBody--instance Show ChunkedBody where-    show c = BS8.unpack . toBS $ build-          "ChunkedBody { chunkSize = "-        <> build (_chunkedSize c)-        <> "<> originalLength = "-        <> build (_chunkedLength c)-        <> "<> fullChunks = "-        <> build (fullChunks c)-        <> "<> remainderBytes = "-        <> build (remainderBytes c)-        <> "}"--fuseChunks :: ChunkedBody-           -> Conduit ByteString (ResourceT IO) ByteString-           -> ChunkedBody-fuseChunks c f = c { _chunkedBody = _chunkedBody c =$= f }--fullChunks :: ChunkedBody -> Integer-fullChunks c = _chunkedLength c `div` fromIntegral (_chunkedSize c)--remainderBytes :: ChunkedBody -> Maybe Integer-remainderBytes c =-    case _chunkedLength c `mod` toInteger (_chunkedSize c) of-         0 -> Nothing-         n -> Just n---- | An opaque request body containing a 'SHA256' hash.-data HashedBody-    = HashedStream (Digest SHA256) !Integer (Source (ResourceT IO) ByteString)-    | HashedBytes  (Digest SHA256) ByteString--instance Show HashedBody where-    show = \case-        HashedStream h n _ -> str "HashedStream" h n-        HashedBytes  h x   -> str "HashedBody"   h (BS.length x)-      where-        str c h n = BS8.unpack . toBS $-            c <> " { sha256 = "-              <> build (digestToBase Base16 h)-              <> ", length = "-              <> build n--instance IsString HashedBody where-    fromString = toHashed--sha256Base16 :: HashedBody -> ByteString-sha256Base16 = digestToBase Base16 . \case-    HashedStream h _ _ -> h-    HashedBytes  h _   -> h---- | Invariant: only services that support _both_ standard and--- chunked signing expose 'RqBody' as a parameter.-data RqBody-    = Chunked ChunkedBody-    | Hashed  HashedBody-      deriving (Show)--instance IsString RqBody where-    fromString = Hashed . fromString--md5Base64 :: RqBody -> Maybe ByteString-md5Base64 = \case-    Hashed (HashedBytes _ x) -> Just . digestToBase Base64 $ hashMD5 x-    _                        -> Nothing--isStreaming :: RqBody -> Bool-isStreaming = \case-    Hashed (HashedStream {}) -> True-    _                        -> False--toRequestBody :: RqBody -> RequestBody-toRequestBody = \case-    Chunked x -> requestBodySourceChunked (_chunkedBody x)-    Hashed  x -> case x of-         HashedStream _ n f -> requestBodySource (fromIntegral n) f-         HashedBytes  _ b   -> RequestBodyBS b--contentLength :: RqBody -> Integer-contentLength = \case-    Chunked x -> _chunkedLength x-    Hashed  x -> case x of-        HashedStream _ n _ -> n-        HashedBytes  _ b   -> fromIntegral (BS.length b)---- | Anything that can be safely converted to a 'HashedBody'.-class ToHashedBody a where-    -- | Convert a value to a hashed request body.-    toHashed :: a -> HashedBody--instance ToHashedBody ByteString where-    toHashed x = HashedBytes (hash x) x--instance ToHashedBody HashedBody     where toHashed = id-instance ToHashedBody String         where toHashed = toHashed . LBS8.pack-instance ToHashedBody LBS.ByteString where toHashed = toHashed . toBS-instance ToHashedBody Text           where toHashed = toHashed . Text.encodeUtf8-instance ToHashedBody LText.Text     where toHashed = toHashed . LText.encodeUtf8-instance ToHashedBody Value          where toHashed = toHashed . encode-instance ToHashedBody Element        where toHashed = toHashed . encodeXML-instance ToHashedBody QueryString    where toHashed = toHashed . toBS--instance ToHashedBody (HashMap Text Value) where-    toHashed = toHashed . Object---- | Anything that can be converted to a streaming request 'Body'.-class ToBody a where-    -- | Convert a value to a request body.-    toBody :: a -> RqBody--    default toBody :: ToHashedBody a => a -> RqBody-    toBody = Hashed . toHashed--instance ToBody RqBody      where toBody = id-instance ToBody HashedBody  where toBody = Hashed-instance ToBody ChunkedBody where toBody = Chunked--instance ToHashedBody a => ToBody (Maybe a) where-    toBody = Hashed . maybe (toHashed BS.empty) toHashed--instance ToBody String-instance ToBody LBS.ByteString-instance ToBody ByteString-instance ToBody Text-instance ToBody LText.Text-instance ToBody (HashMap Text Value)-instance ToBody Value-instance ToBody Element-instance ToBody QueryString--_Body :: ToBody a => AReview RqBody a-_Body = un (to toBody)
− src/Network/AWS/Data/ByteString.hs 
@@ -1,69 +0,0 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports    #-}-{-# LANGUAGE RecordWildCards   #-}---- |--- Module      : Network.AWS.Data.ByteString--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)-----module Network.AWS.Data.ByteString-    (-    -- * ByteString-      ByteString-    , LazyByteString-    , ToByteString (..)-    , showBS-    , stripBS-    ) where--import           Data.ByteString              (ByteString)-import           Data.ByteString.Builder      (Builder)-import qualified Data.ByteString.Char8        as BS8-import qualified Data.ByteString.Lazy         as LBS-import qualified Data.ByteString.Lazy.Builder as Build-import           Data.CaseInsensitive         (CI)-import qualified Data.CaseInsensitive         as CI-import           Data.Char-import qualified Data.Text.Encoding           as Text-import           Data.Time                    (UTCTime)-import           Network.AWS.Data.Text-import           Network.HTTP.Types-import           Numeric-import           Numeric.Natural--type LazyByteString = LBS.ByteString--showBS :: ToByteString a => a -> String-showBS = BS8.unpack . toBS--stripBS :: ByteString -> ByteString-stripBS = BS8.dropWhile isSpace . fst . BS8.spanEnd isSpace--class ToByteString a where-    toBS :: a -> ByteString--    default toBS :: ToText a => a -> ByteString-    toBS = Text.encodeUtf8 . toText--instance ToByteString ByteString     where toBS = id-instance ToByteString Builder        where toBS = toBS . Build.toLazyByteString-instance ToByteString LazyByteString where toBS = LBS.toStrict-instance ToByteString Text           where toBS = Text.encodeUtf8-instance ToByteString String         where toBS = BS8.pack-instance ToByteString Int            where toBS = toBS . Build.intDec-instance ToByteString Integer        where toBS = toBS . Build.integerDec-instance ToByteString Natural        where toBS = toBS . toInteger-instance ToByteString Double         where toBS = toBS . ($ "") . showFFloat Nothing-instance ToByteString StdMethod      where toBS = renderStdMethod-instance ToByteString UTCTime        where toBS = BS8.pack . show--instance ToByteString a => ToByteString (CI a) where-    toBS = toBS . CI.original
− src/Network/AWS/Data/Crypto.hs 
@@ -1,66 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE OverloadedStrings  #-}-{-# LANGUAGE PackageImports     #-}---- |--- Module      : Network.AWS.Data.Crypto--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.Crypto-    (-    -- * Conversion-      digestToBS-    , digestToBase--    -- * Algorithms-    , hmacSHA1-    , hmacSHA256-    , hashSHA256-    , hashMD5--    -- * Contexts-    , hash-    , hashlazy-    , hashInit-    , hashUpdate-    , hashFinalize--    -- * Re-exported-    , HMAC-    , Digest-    , HashAlgorithm-    , SHA256 (..)-    , MD5    (..)-    , Base   (..)-    ) where--import           "cryptonite" Crypto.Hash-import           "cryptonite" Crypto.MAC.HMAC-import           Data.ByteArray-import           Data.ByteArray.Encoding-import           Data.ByteString         (ByteString)--digestToBS :: ByteArrayAccess a => a -> ByteString-digestToBS = convert--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--hashSHA256 :: ByteArrayAccess a => a -> Digest SHA256-hashSHA256 = hashWith SHA256--hashMD5 :: ByteArrayAccess a => a -> Digest MD5-hashMD5 = hashWith MD5
− src/Network/AWS/Data/Headers.hs 
@@ -1,124 +0,0 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections     #-}---- |--- Module      : Network.AWS.Data.Headers--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.Headers-    ( module Network.AWS.Data.Headers-    , HeaderName-    , Header-    , hContentType-    ) where--import qualified Data.ByteString.Char8       as BS8-import qualified Data.CaseInsensitive        as CI-import           Data.Monoid-import qualified Data.Text.Encoding          as Text-import           Network.AWS.Data.ByteString-import           Network.AWS.Data.Text-import           Network.HTTP.Types--infixl 7 .#, .#?---- FIXME: This whole toText/fromText shit is just stupid.-(.#) :: FromText a => ResponseHeaders -> HeaderName -> Either String a-hs .# k = hs .#? k >>= note-  where-    note Nothing  = Left (BS8.unpack $ "Unable to find header: " <> CI.original k)-    note (Just x) = Right x--(.#?) :: FromText a => ResponseHeaders -> HeaderName -> Either String (Maybe a)-hs .#? k =-    maybe (Right Nothing)-          (fmap Just . fromText . Text.decodeUtf8)-          (k `lookup` hs)--infixr 7 =#--(=#) :: ToHeader a => HeaderName -> a -> [Header]-(=#) = toHeader--hdr :: HeaderName -> ByteString -> [Header] -> [Header]-hdr k v hs = (k, v) : filter ((/= k) . fst) hs--class ToHeaders a where-    toHeaders :: a -> [Header]-    toHeaders = const mempty--class ToHeader a where-    toHeader :: HeaderName -> a -> [Header]--    default toHeader :: ToText a => HeaderName -> a -> [Header]-    toHeader k = toHeader k . toText--instance ToHeader Text where-    toHeader k v = [(k, Text.encodeUtf8 v)]--instance ToHeader ByteString where-    toHeader k v = [(k, v)]--instance ToText a => ToHeader (Maybe a) where-    toHeader k = maybe [] (toHeader k . toText)--hHost :: HeaderName-hHost = "Host"--hExpect :: HeaderName-hExpect = "Expect"--hAMZToken :: HeaderName-hAMZToken = "X-Amz-Security-Token"--hAMZTarget :: HeaderName-hAMZTarget = "X-Amz-Target"--hAMZAlgorithm :: HeaderName-hAMZAlgorithm = "X-Amz-Algorithm"--hAMZCredential :: HeaderName-hAMZCredential = "X-Amz-Credential"--hAMZExpires :: HeaderName-hAMZExpires = "X-Amz-Expires"--hAMZSignedHeaders :: HeaderName-hAMZSignedHeaders = "X-Amz-SignedHeaders"--hAMZContentSHA256 :: HeaderName-hAMZContentSHA256 = "X-Amz-Content-SHA256"--hAMZDate :: HeaderName-hAMZDate = "X-Amz-Date"--hMetaPrefix :: HeaderName-hMetaPrefix = "X-Amz-"--hAMZRequestId :: HeaderName-hAMZRequestId = "X-Amz-Request-Id"--hAMZNRequestId :: HeaderName-hAMZNRequestId = "X-Amzn-RequestId"--hAMZNErrorType :: HeaderName-hAMZNErrorType = "X-Amzn-ErrorType"--hAMZNAuth :: HeaderName-hAMZNAuth = "X-Amzn-Authorization"--hAMZDecodedContentLength :: HeaderName-hAMZDecodedContentLength = "X-Amz-Decoded-Content-Length"--hTransferEncoding :: HeaderName-hTransferEncoding = "Transfer-Encoding"--hFormEncoded :: ByteString-hFormEncoded = "application/x-www-form-urlencoded; charset=utf-8"
− src/Network/AWS/Data/JSON.hs 
@@ -1,62 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- |--- Module      : Network.AWS.Data.JSON--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.JSON-    (-    -- * FromJSON-      FromJSON (..)-    , parseJSONText-    , eitherDecode-    , eitherDecode'--    -- ** Parser a-    , withObject-    , (.:)-    , (.:?)-    , (.!=)--    -- ** Either String a-    , eitherParseJSON-    , (.:>)-    , (.?>)--    -- * ToJSON-    , ToJSON   (..)-    , toJSONText-    , Value    (Object)-    , object-    , (.=)-    ) where--import           Data.Aeson            (eitherDecode, eitherDecode')-import           Data.Aeson.Types-import qualified Data.HashMap.Strict   as Map-import           Network.AWS.Data.Text--parseJSONText :: FromText a => String -> Value -> Parser a-parseJSONText n = withText n (either fail return . fromText)--toJSONText :: ToText a => a -> Value-toJSONText = String . toText--eitherParseJSON :: FromJSON a => Object -> Either String a-eitherParseJSON = parseEither parseJSON . Object--(.:>) :: FromJSON a => Object -> Text -> Either String a-(.:>) o k =-    case Map.lookup k o of-        Nothing -> Left $ "key " ++ show k ++ " not present"-        Just v  -> parseEither parseJSON v--(.?>) :: FromJSON a => Object -> Text -> Either String (Maybe a)-(.?>) o k =-    case Map.lookup k o of-        Nothing -> Right Nothing-        Just v  -> parseEither parseJSON v
− src/Network/AWS/Data/List1.hs 
@@ -1,88 +0,0 @@-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFoldable             #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE DeriveTraversable          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TypeFamilies               #-}---- |--- Module      : Network.AWS.Data.List1--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.List1 where--import           Control.Applicative-import           Control.DeepSeq-import           Control.Monad-import           Data.Aeson-import           Data.Coerce-import           Data.Data            (Data, Typeable)-import           Data.Foldable        (Foldable)-import qualified Data.Foldable        as Fold-import           Data.Hashable-import           Data.List.NonEmpty   (NonEmpty (..))-import qualified Data.List.NonEmpty   as NonEmpty-import           Data.Semigroup-import           Data.Text            (Text)-import           Data.Traversable     (Traversable, traverse)-import           GHC.Exts-import           GHC.Generics         (Generic)-import           Network.AWS.Data.XML-import           Network.AWS.Lens     (Iso', iso)-import           Text.XML             (Node)--newtype List1 a = List1 { toNonEmpty :: NonEmpty a }-    deriving-        ( Functor-        , Monad-        , Applicative-        , Foldable-        , Traversable-        , Semigroup-        , Eq-        , Ord-        , Read-        , Show-        , Data-        , Typeable-        , Generic-        )--instance NFData a => NFData (List1 a)--_List1 :: (Coercible a b, Coercible b a) => Iso' (List1 a) (NonEmpty b)-_List1 = iso (coerce . toNonEmpty) (List1 . coerce)--instance IsList (List1 a) where-   type Item (List1 a) = a--   fromList = List1 . NonEmpty.fromList-   toList   = NonEmpty.toList . toNonEmpty--instance FromJSON a => FromJSON (List1 a) where-    parseJSON = withArray "List1" (go >=> traverse parseJSON)-      where-        go = maybe (fail "Error parsing empty List1 when expecting at least one element.")-                   (pure . List1)-           . NonEmpty.nonEmpty-           . Fold.toList--instance ToJSON a => ToJSON (List1 a) where-    toJSON = toJSON . toList--instance Hashable a => Hashable (List1 a)--parseXMLList1 :: FromXML a-              => Text-              -> [Node]-              -> Either String (List1 a)-parseXMLList1 n = parseXMLList n >=> parse-  where-    parse xs =-       maybe (Left $ "Error parsing empty List1 when expecting at least one element: " ++ show n)-             (Right . List1)-             (NonEmpty.nonEmpty xs)
− src/Network/AWS/Data/Log.hs 
@@ -1,150 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}--{-# OPTIONS_GHC -fsimpl-tick-factor=110 #-}---- |--- Module      : Network.AWS.Data.Log--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.Log where--import qualified Data.ByteString              as BS-import           Data.ByteString.Builder      (Builder)-import qualified Data.ByteString.Lazy         as LBS-import qualified Data.ByteString.Lazy.Builder as Build-import           Data.CaseInsensitive         (CI)-import qualified Data.CaseInsensitive         as CI-import           Data.Int-import           Data.List                    (intersperse)-import           Data.Monoid-import qualified Data.Text                    as Text-import qualified Data.Text.Encoding           as Text-import qualified Data.Text.Lazy               as LText-import qualified Data.Text.Lazy.Encoding      as LText-import           Data.Time                    (UTCTime)-import           Data.Word-import           Network.AWS.Data.ByteString-import           Network.AWS.Data.Headers-import           Network.AWS.Data.Path-import           Network.AWS.Data.Query-import           Network.AWS.Data.Text-import           Network.HTTP.Conduit-import           Network.HTTP.Types-import           Numeric--class ToLog a where-    -- | Convert a value to a loggable builder.-    build :: a -> Builder--instance ToLog Builder        where build = id-instance ToLog LBS.ByteString where build = Build.lazyByteString-instance ToLog ByteString     where build = Build.byteString-instance ToLog Int            where build = Build.intDec-instance ToLog Int8           where build = Build.int8Dec-instance ToLog Int16          where build = Build.int16Dec-instance ToLog Int32          where build = Build.int32Dec-instance ToLog Int64          where build = Build.int64Dec-instance ToLog Integer        where build = Build.integerDec-instance ToLog Word           where build = Build.wordDec-instance ToLog Word8          where build = Build.word8Dec-instance ToLog Word16         where build = Build.word16Dec-instance ToLog Word32         where build = Build.word32Dec-instance ToLog Word64         where build = Build.word64Dec-instance ToLog UTCTime        where build = Build.stringUtf8 . show-instance ToLog Float          where build = build . ($ "") . showFFloat Nothing-instance ToLog Double         where build = build . ($ "") . showFFloat Nothing-instance ToLog Text           where build = build . Text.encodeUtf8-instance ToLog LText.Text     where build = build . LText.encodeUtf8-instance ToLog Char           where build = build . Text.singleton-instance ToLog [Char]         where build = build . LText.pack-instance ToLog StdMethod      where build = build . renderStdMethod-instance ToLog QueryString    where build = build . toBS-instance ToLog EscapedPath    where build = build . toBS---- | Intercalate a list of 'Builder's with newlines.-buildLines :: [Builder] -> Builder-buildLines = mconcat . intersperse "\n"--instance ToLog a => ToLog (CI a) where-    build = build . CI.foldedCase--instance ToLog a => ToLog (Maybe a) where-    build Nothing  = "Nothing"-    build (Just x) = "Just " <> build x--instance ToLog Bool where-    build True  = "True"-    build False = "False"--instance ToLog Status where-    build x = build (statusCode x) <> " " <> build (statusMessage x)--instance ToLog [Header] where-    build = mconcat-        . intersperse "; "-        . map (\(k, v) -> build k <> ": " <> build v)--instance ToLog HttpVersion where-    build HttpVersion{..} =-           "HTTP/"-        <> build httpMajor-        <> build '.'-        <> build httpMinor--instance ToLog RequestBody where-    build = \case-        RequestBodyBuilder     n _ -> " <builder:" <> build n <> ">"-        RequestBodyStream      n _ -> " <stream:"  <> build n <> ">"--        RequestBodyLBS lbs-            | n <= 4096            -> build lbs-            | otherwise            -> " <lazy:" <> build n <> ">"-          where-            n = LBS.length lbs--        RequestBodyBS bs-            | n <= 4096            -> build bs-            | otherwise            -> " <strict:" <> build n <> ">"-          where-            n = BS.length bs--        _                          -> " <chunked>"--instance ToLog HttpException where-    build x = "[HttpException] {\n" <> build (show x) <> "\n}"--instance ToLog HttpExceptionContent where-    build x = "[HttpExceptionContent] {\n" <> build (show x) <> "\n}"--instance ToLog Request where-    build x = buildLines-        [  "[Client Request] {"-        ,  "  host      = " <> build (host x) <> ":" <> build (port x)-        ,  "  secure    = " <> build (secure x)-        ,  "  method    = " <> build (method x)-        ,  "  target    = " <> build target-        ,  "  timeout   = " <> build (show (responseTimeout x))-        ,  "  redirects = " <> build (redirectCount x)-        ,  "  path      = " <> build (path            x)-        ,  "  query     = " <> build (queryString     x)-        ,  "  headers   = " <> build (requestHeaders  x)-        ,  "  body      = " <> build (requestBody     x)-        ,  "}"-        ]-      where-        target = hAMZTarget `lookup` requestHeaders x--instance ToLog (Response a) where-    build x = buildLines-        [ "[Client Response] {"-        , "  status  = " <> build (responseStatus  x)-        , "  headers = " <> build (responseHeaders x)-        , "}"-        ]
− src/Network/AWS/Data/Map.hs 
@@ -1,131 +0,0 @@-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFoldable             #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE DeriveTraversable          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE RoleAnnotations            #-}-{-# LANGUAGE TupleSections              #-}-{-# LANGUAGE TypeFamilies               #-}---- |--- Module      : Network.AWS.Data.Map--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.Map-    ( Map (..)-    , _Map-    , parseXMLMap-    , parseHeadersMap-    , toQueryMap-    ) where--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.Foldable               hiding (toList)-import           Data.Hashable-import           Data.HashMap.Strict         (HashMap)-import qualified Data.HashMap.Strict         as Map-import           Data.Maybe-import           Data.Semigroup-import qualified Data.Text.Encoding          as Text-import           Data.Traversable-import           GHC.Exts-import           GHC.Generics                (Generic)-import           Network.AWS.Data.ByteString-import           Network.AWS.Data.Headers-import           Network.AWS.Data.Query-import           Network.AWS.Data.Text-import           Network.AWS.Data.XML-import           Network.AWS.Lens            (Iso', iso)-import           Network.HTTP.Types          (ResponseHeaders)-import           Text.XML                    (Node)--newtype Map k v = Map { toMap :: HashMap k v }-    deriving-        ( Functor-        , Foldable-        , Traversable-        , Monoid-        , Semigroup-        , Eq-        , Read-        , Show-        , Data-        , Typeable-        , Generic-        )--type role Map nominal representational--_Map :: (Coercible a b, Coercible b a) => Iso' (Map k a) (HashMap k b)-_Map = iso (coerce . toMap) (Map . coerce)--instance (Hashable k, Hashable v) => Hashable (Map k v)-instance (NFData k,   NFData   v) => NFData   (Map k v)--instance (Hashable k, Eq k) => IsList (Map k v) where-   type Item (Map k v) = (k, v)--   fromList = Map . Map.fromList-   toList   = Map.toList . toMap--instance (Eq k, Hashable k, FromText k, FromJSON v) => FromJSON (Map k v) where-    parseJSON = withObject "HashMap" (fmap fromList . traverse f . toList)-      where-        f (k, v) = (,)-            <$> either fail return (fromText k)-            <*> parseJSON v--instance (Eq k, Hashable k, ToText k, ToJSON v) => ToJSON (Map k v) where-    toJSON = Object . fromList . map (bimap toText toJSON) . toList--instance (Eq k, Hashable k, ToByteString k, ToText v) => ToHeader (Map k v) where-    toHeader p = map (bimap k v) . toList-      where-        k = mappend p . CI.mk . toBS-        v = Text.encodeUtf8 . toText--parseXMLMap :: (Eq k, Hashable k, FromText k, FromXML v)-            => Text-            -> Text-            -> Text-            -> [Node]-            -> Either String (Map k v)-parseXMLMap e k v = fmap fromList . traverse f . mapMaybe (childNodesOf e)-  where-    f ns = (,)-       <$> (ns .@ k >>= fromText)-       <*>  ns .@ v--parseHeadersMap :: FromText a-                => ByteString-                -> ResponseHeaders-                -> Either String (Map Text a)-parseHeadersMap p = fmap fromList . traverse g . filter f-  where-    f = BS.isPrefixOf p . CI.foldedCase . fst--    g (k, v) = (Text.decodeUtf8 . BS.drop n $ CI.original k,) <$>-        fromText (Text.decodeUtf8 v)--    n = BS.length p--toQueryMap :: (Hashable k, Eq k, ToQuery k, ToQuery v)-           => ByteString-           -> ByteString-           -> ByteString-           -> Map k v-           -> QueryString-toQueryMap e k v = toQueryList e . map f . toList-  where-    f (x, y) = QList [k =: toQuery x, v =: toQuery y]
− src/Network/AWS/Data/Numeric.hs 
@@ -1,74 +0,0 @@-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables        #-}---- |--- Module      : Network.AWS.Data.Numeric--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.Numeric where--import           Control.DeepSeq-import           Control.Monad-import           Data.Aeson.Types-import           Data.Data                   (Data, Typeable)-import           Data.Hashable-import           Data.Monoid-import           Data.Scientific-import           GHC.Generics                (Generic)-import           Network.AWS.Data.ByteString-import           Network.AWS.Data.Query-import           Network.AWS.Data.Text-import           Network.AWS.Data.XML-import           Network.AWS.Lens            (Iso', iso)-import           Numeric.Natural--newtype Nat = Nat { unNat :: Natural }-    deriving-        ( Eq-        , Ord-        , Read-        , Show-        , Enum-        , Num-        , Real-        , Integral-        , Data-        , Typeable-        , Generic-        , ToByteString-        , FromText-        , ToText-        , FromXML-        , ToXML-        , ToQuery-        )--_Nat :: Iso' Nat Natural-_Nat = iso unNat Nat--instance Hashable Nat where-    hashWithSalt salt (Nat n) = hashWithSalt salt (toInteger n)--instance NFData Nat where-    rnf = rnf . toInteger . unNat--instance FromJSON Nat where-    parseJSON = parseJSON >=> go-      where-        go n = case floatingOrInteger n of-            Left  (_ :: Double) -> fail (floatErr n)-            Right i-                | n < 0         -> fail (negateErr n)-                | otherwise     -> return . Nat $ fromInteger i--        floatErr  = mappend "Cannot convert float to Natural: " . show-        negateErr = mappend "Cannot convert negative number to Natural: " . show--instance ToJSON Nat where-    toJSON = Number . flip scientific 0 . toInteger . unNat
− src/Network/AWS/Data/Path.hs 
@@ -1,101 +0,0 @@-{-# LANGUAGE DataKinds          #-}-{-# LANGUAGE FlexibleInstances  #-}-{-# LANGUAGE GADTs              #-}-{-# LANGUAGE KindSignatures     #-}-{-# LANGUAGE LambdaCase         #-}-{-# LANGUAGE OverloadedStrings  #-}-{-# LANGUAGE StandaloneDeriving #-}---- |--- Module      : Network.AWS.Data.Path--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.Path-    (-    -- * Path Types-      RawPath-    , EscapedPath--    -- * Constructing Paths-    , ToPath (..)-    , rawPath--    -- * Manipulating Paths-    , escapePath-    , collapsePath-    ) where--import qualified Data.ByteString             as BS-import qualified Data.ByteString.Char8       as BS8-import           Data.Monoid-import           Network.AWS.Data.ByteString-import           Network.AWS.Data.Text-import           Network.HTTP.Types.URI--class ToPath a where-    toPath :: a -> ByteString--instance ToPath ByteString where-    toPath = id--instance ToPath Text where-    toPath = toBS--rawPath :: ToPath a => a -> Path 'NoEncoding-rawPath = Raw . strip . BS8.split sep . toPath-  where-    strip (x:xs)-        | BS.null x = xs-    strip xs        = xs--data Encoding = NoEncoding | Percent-    deriving (Eq, Show)--data Path :: Encoding -> * where-    Raw     :: [ByteString] -> Path 'NoEncoding-    Encoded :: [ByteString] -> Path 'Percent--deriving instance Show (Path a)-deriving instance Eq   (Path a)--type RawPath     = Path 'NoEncoding-type EscapedPath = Path 'Percent--instance Monoid RawPath where-    mempty                    = Raw []-    mappend (Raw xs) (Raw ys) = Raw (xs ++ ys)--instance ToByteString EscapedPath where-    toBS (Encoded []) = slash-    toBS (Encoded xs) = slash <> BS8.intercalate slash xs--escapePath :: Path a -> EscapedPath-escapePath (Raw     xs) = Encoded (map (urlEncode True) xs)-escapePath (Encoded xs) = Encoded xs--collapsePath :: Path a -> Path a-collapsePath = \case-    Raw     xs -> Raw     (go xs)-    Encoded xs -> Encoded (go xs)-  where-    go = reverse . f . reverse--    f :: [ByteString] -> [ByteString]-    f []            = []-    f (x:xs)-        | x == dot  = f xs-        | x == dots = drop 1 (f xs)-        | otherwise = x : f xs--    dot  = "."-    dots = ".."--slash :: ByteString-slash = BS8.singleton sep--sep :: Char-sep = '/'
− src/Network/AWS/Data/Query.hs 
@@ -1,152 +0,0 @@-{-# LANGUAGE DefaultSignatures   #-}-{-# LANGUAGE DeriveDataTypeable  #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE LambdaCase          #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies        #-}-{-# LANGUAGE TypeOperators       #-}-{-# LANGUAGE ViewPatterns        #-}---- |--- Module      : Network.AWS.Data.Query--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.Query where--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           Data.Data-import           Data.List                   (sort)-import           Data.Maybe                  (fromMaybe)-import           Data.Monoid-import           Data.String-import qualified Data.Text.Encoding          as Text-import           GHC.Exts-import           Network.AWS.Data.ByteString-import           Network.AWS.Data.Text-import           Network.HTTP.Types.URI      (urlEncode)-import           Numeric.Natural--data QueryString-    = QList  [QueryString]-    | QPair  ByteString QueryString-    | QValue (Maybe ByteString)-      deriving (Eq, Show, Data, Typeable)--instance Monoid QueryString where-    mempty = QList []--    mappend a b = case (a, b) of-        (QList l, QList r) -> QList (l ++ r)-        (QList l, r)       -> QList (r : l)-        (l,       QList r) -> QList (l : r)-        (l,       r)       -> QList [l, r]--instance IsString QueryString where-    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-    toBS = LBS.toStrict . Build.toLazyByteString . cat . sort . enc Nothing-      where-        enc :: Maybe ByteString -> QueryString -> [ByteString]-        enc p = \case-            QList xs          -> concatMap (enc p) xs--            QPair (urlEncode True -> k) x-                | Just n <- p -> enc (Just (n <> kdelim <> k)) x -- <prev>.key <recur>-                | otherwise   -> enc (Just k)                  x -- key <recur>--            QValue (Just (urlEncode True -> v))-                | Just n <- p -> [n <> vsep <> v] -- key=value-                | otherwise   -> [v <> vsep]      -- value= -- note: required for signing.--            _   | Just n <- p -> [n <> vsep]      -- key=-                                                  -- note: this case required for request signing-                | otherwise   -> []--        cat :: [ByteString] -> Builder-        cat []     = mempty-        cat [x]    = Build.byteString x-        cat (x:xs) = Build.byteString x <> ksep <> cat xs--        kdelim = "."-        ksep   = "&"-        vsep   = "="--pair :: ToQuery a => ByteString -> a -> QueryString -> QueryString-pair k v = mappend (QPair k (toQuery v))--infixr 7 =:--(=:) :: ToQuery a => ByteString -> a -> QueryString-k =: v = QPair k (toQuery v)--toQueryList :: (IsList a, ToQuery (Item a))-            => ByteString-            -> a-            -> QueryString-toQueryList k = QPair k . QList . zipWith f [1..] . toList-  where-    f :: ToQuery a => Int -> a -> QueryString-    f n v = toBS n =: toQuery v--class ToQuery a where-    toQuery :: a -> QueryString--    default toQuery :: ToText a => a -> QueryString-    toQuery = toQuery . toText--instance ToQuery QueryString where-    toQuery = id--instance (ToByteString k, ToQuery v) => ToQuery (k, v) where-    toQuery (k, v) = QPair (toBS k) (toQuery v)--instance ToQuery Char where-    toQuery = toQuery . BS8.singleton--instance ToQuery ByteString where-    toQuery "" = QValue Nothing-    toQuery bs = QValue (Just bs)--instance ToQuery Text    where toQuery = toQuery . Text.encodeUtf8-instance ToQuery Int     where toQuery = toQuery . toBS-instance ToQuery Integer where toQuery = toQuery . toBS-instance ToQuery Double  where toQuery = toQuery . toBS-instance ToQuery Natural where toQuery = toQuery . toBS--instance ToQuery a => ToQuery (Maybe a) where-    toQuery (Just x) = toQuery x-    toQuery Nothing  = mempty--instance ToQuery Bool where-    toQuery True  = toQuery ("true"  :: ByteString)-    toQuery False = toQuery ("false" :: ByteString)
− src/Network/AWS/Data/Sensitive.hs 
@@ -1,61 +0,0 @@-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings          #-}---- |--- Module      : Network.AWS.Data.Sensitive--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.Sensitive where--import           Control.DeepSeq-import           Data.Data                   (Data, Typeable)-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-import           Network.AWS.Lens            (Iso', iso)---- | /Note/: read . show /= isomorphic-newtype Sensitive a = Sensitive { desensitise :: a }-    deriving-        ( Eq-        , Ord-        , IsString-        , Monoid-        , Data-        , Typeable-        , Generic-        , ToByteString-        , FromText-        , ToText-        , FromXML-        , ToXML-        , ToQuery-        , ToJSON-        , FromJSON-        , ToHeader-        )--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)--_Sensitive :: Iso' (Sensitive a) a-_Sensitive = iso desensitise Sensitive
− src/Network/AWS/Data/Text.hs 
@@ -1,141 +0,0 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports    #-}---- |--- Module      : Network.AWS.Data.Text--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.Text-    ( Text--    -- * Deserialisation-    , FromText (..)-    , fromText-    , fromTextError-    , takeLowerText-    , takeText--    -- * Serialisation-    , ToText   (..)-    , toTextCI-    , showText-    ) where--import           Control.Applicative-import           Data.Attoparsec.Text              (Parser)-import qualified Data.Attoparsec.Text              as A-import           Data.ByteString                   (ByteString)-import qualified Data.ByteString.Char8             as BS8-import           Data.CaseInsensitive              (CI)-import qualified Data.CaseInsensitive              as CI-import           Data.Int-import           Data.Monoid-import           Data.Scientific-import           Data.Text                         (Text)-import qualified Data.Text                         as Text-import qualified Data.Text.Encoding                as Text-import qualified Data.Text.Lazy                    as LText-import           Data.Text.Lazy.Builder            (Builder)-import qualified Data.Text.Lazy.Builder            as Build-import qualified Data.Text.Lazy.Builder.Int        as Build-import qualified Data.Text.Lazy.Builder.Scientific as Build-import           Network.AWS.Data.Crypto-import           Network.HTTP.Types-import           Numeric-import           Numeric.Natural---- | Fail parsing with a 'Text' error.------ Constrained to the actual attoparsec monad to avoid--- exposing 'fail' usage directly.-fromTextError :: Text -> Parser a-fromTextError = fail . Text.unpack--fromText :: FromText a => Text -> Either String a-fromText = A.parseOnly parser--takeLowerText :: Parser Text-takeLowerText = Text.toLower <$> A.takeText--takeText :: Parser Text-takeText = A.takeText--class FromText a where-    parser :: Parser a--instance FromText Text where-    parser = A.takeText--instance FromText ByteString where-    parser = Text.encodeUtf8 <$> A.takeText--instance (CI.FoldCase a, FromText a) => FromText (CI a) where-    parser = CI.mk <$> parser--instance FromText Char where-    parser = A.anyChar <* A.endOfInput--instance FromText Int where-    parser = A.signed A.decimal <* A.endOfInput--instance FromText Integer where-    parser = A.signed A.decimal <* A.endOfInput--instance FromText Scientific where-    parser = A.signed A.scientific <* A.endOfInput--instance FromText Natural where-    parser = A.decimal <* A.endOfInput--instance FromText Double where-    parser = A.signed A.rational <* A.endOfInput--instance FromText Bool where-    parser = takeLowerText >>= \case-        "true"  -> pure True-        "false" -> pure False-        e       -> fromTextError $ "Failure parsing Bool from '" <> e <> "'."--instance FromText StdMethod where-    parser = do-        bs <- Text.encodeUtf8 <$> A.takeText-        either (fail . BS8.unpack) pure (parseMethod bs)--showText :: ToText a => a -> String-showText = Text.unpack . toText--class ToText a where-    toText :: a -> Text--instance ToText a => ToText (CI a) where-    toText = toText . CI.original--instance ToText Text       where toText = id-instance ToText ByteString where toText = Text.decodeUtf8-instance ToText Char       where toText = Text.singleton-instance ToText String     where toText = Text.pack-instance ToText Int        where toText = shortText . Build.decimal-instance ToText Int64      where toText = shortText . Build.decimal-instance ToText Integer    where toText = shortText . Build.decimal-instance ToText Natural    where toText = shortText . Build.decimal-instance ToText Scientific where toText = shortText . Build.scientificBuilder-instance ToText Double     where toText = toText . ($ "") . showFFloat Nothing-instance ToText StdMethod  where toText = toText . renderStdMethod-instance ToText (Digest a) where toText = toText . digestToBase Base16--instance ToText Bool where-    toText True  = "true"-    toText False = "false"--shortText :: Builder -> Text-shortText = LText.toStrict . Build.toLazyTextWith 32--toTextCI :: ToText a => a -> CI Text-toTextCI = CI.mk . toText
− src/Network/AWS/Data/Time.hs 
@@ -1,211 +0,0 @@-{-# LANGUAGE DataKinds                  #-}-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GADTs                      #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures             #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE StandaloneDeriving         #-}---- |--- Module      : Network.AWS.Data.Time--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.Time-    (-    -- * Time-      Format (..)-    , Time   (..)-    , _Time-    -- ** Formats-    , UTCTime-    , RFC822-    , ISO8601-    , BasicTime-    , AWSTime-    , POSIX-    ) where--import           Control.Applicative-import           Control.DeepSeq-import           Data.Aeson-import qualified Data.Aeson.Types            as Aeson-import           Data.Attoparsec.Text        (Parser)-import qualified Data.Attoparsec.Text        as AText-import qualified Data.ByteString.Char8       as BS-import           Data.Data                   (Data, Typeable)-import           Data.Hashable-import           Data.Monoid-import           Data.Scientific-import           Data.Tagged-import qualified Data.Text                   as Text-import           Data.Time                   (Day (..), UTCTime (..))-import           Data.Time.Clock.POSIX-import           Data.Time.Format            (formatTime)-import           GHC.Generics                (Generic)-import           Network.AWS.Compat.Locale-import           Network.AWS.Compat.Time-import           Network.AWS.Data.ByteString-import           Network.AWS.Data.JSON-import           Network.AWS.Data.Query-import           Network.AWS.Data.Text-import           Network.AWS.Data.XML-import           Network.AWS.Lens            (Iso', iso)--data Format-    = RFC822Format-    | ISO8601Format-    | BasicFormat-    | AWSFormat-    | POSIXFormat-      deriving (Eq, Read, Show, Data, Typeable, Generic)--deriving instance Typeable 'RFC822Format-deriving instance Typeable 'ISO8601Format-deriving instance Typeable 'BasicFormat-deriving instance Typeable 'AWSFormat-deriving instance Typeable 'POSIXFormat--data Time :: Format -> * where-    Time :: UTCTime -> Time a-      deriving (Data, Typeable, Generic)--deriving instance Eq   (Time a)-deriving instance Ord  (Time a)-deriving instance Read (Time a)-deriving instance Show (Time a)--instance NFData (Time a)--instance Hashable (Time a) where-    hashWithSalt salt (Time (UTCTime (ModifiedJulianDay d) t)) =-        salt `hashWithSalt` d-             `hashWithSalt` toRational t--_Time :: Iso' (Time a) UTCTime-_Time = iso (\(Time t) -> t) Time--convert :: Time a -> Time b-convert (Time t) = Time t--type RFC822    = Time 'RFC822Format-type ISO8601   = Time 'ISO8601Format-type BasicTime = Time 'BasicFormat-type AWSTime   = Time 'AWSFormat-type POSIX     = Time 'POSIXFormat--class TimeFormat a where-    format :: Tagged a String--instance TimeFormat RFC822    where format = Tagged "%a, %d %b %Y %H:%M:%S GMT"-instance TimeFormat ISO8601   where format = Tagged (iso8601DateFormat (Just "%X%QZ"))-instance TimeFormat BasicTime where format = Tagged "%Y%m%d"-instance TimeFormat AWSTime   where format = Tagged "%Y%m%dT%H%M%SZ"--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-         -- Deprecated, but ensure compatibility with examples until further investigation can be done-         <|> parseFormattedTime' (Tagged $ iso8601DateFormat (Just "%X%Q%Z"))--parseFormattedTime :: forall a. TimeFormat (Time a) => Parser (Time a)-parseFormattedTime = parseFormattedTime' format--parseFormattedTime' :: Tagged (Time a) String -> Parser (Time a)-parseFormattedTime' f = do-    x <- Text.unpack <$> AText.takeText-    p (parseTime defaultTimeLocale (untag f) x) x-  where-    p :: Maybe UTCTime -> String -> Parser (Time a)-    p (Just x) _ = return (Time x)-    p Nothing  s = fail $ mconcat-        [ "Failure parsing Date format "-        , untag f-        , " from value: '"-        , s-        , "'"-        ]--instance ToText RFC822    where toText = Text.pack . renderFormattedTime-instance ToText ISO8601   where toText = Text.pack . renderFormattedTime-instance ToText BasicTime where toText = Text.pack . renderFormattedTime-instance ToText AWSTime   where toText = Text.pack . renderFormattedTime--instance ToText POSIX where-    toText (Time t) = toText (truncate (utcTimeToPOSIXSeconds t) :: Integer)--renderFormattedTime :: forall a. TimeFormat (Time a) => Time a -> String-renderFormattedTime (Time t) = formatTime defaultTimeLocale (untag f) t-  where-    f :: Tagged (Time a) String-    f = format--instance FromXML RFC822    where parseXML = parseXMLText "RFC822"-instance FromXML ISO8601   where parseXML = parseXMLText "ISO8601"-instance FromXML AWSTime   where parseXML = parseXMLText "AWSTime"-instance FromXML BasicTime where parseXML = parseXMLText "BasicTime"--instance FromJSON RFC822    where parseJSON = parseJSONText "RFC822"-instance FromJSON ISO8601   where parseJSON = parseJSONText "ISO8601"-instance FromJSON AWSTime   where parseJSON = parseJSONText "AWSTime"-instance FromJSON BasicTime where parseJSON = parseJSONText "BasicTime"---- This is a somewhat unfortunate hack to support the bizzare apigateway--- occurence of returning ISO8601 or POSIX timestamps in unknown scenarios.------ See: https://github.com/brendanhay/amazonka/issues/291-instance FromJSON POSIX where-    parseJSON o = fmap convert (str o) <|> num o-      where-        str :: Value -> Aeson.Parser ISO8601-        str = parseJSON--        num :: Value -> Aeson.Parser POSIX-        num = withScientific "POSIX"-            ( pure-            . Time-            . posixSecondsToUTCTime-            . realToFrac-            )--instance ToByteString RFC822    where toBS = BS.pack . renderFormattedTime-instance ToByteString ISO8601   where toBS = BS.pack . renderFormattedTime-instance ToByteString BasicTime where toBS = BS.pack . renderFormattedTime-instance ToByteString AWSTime   where toBS = BS.pack . renderFormattedTime--instance ToQuery RFC822    where toQuery = toQuery . toBS-instance ToQuery ISO8601   where toQuery = toQuery . toBS-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-instance ToXML BasicTime where toXML = toXMLText--instance ToJSON RFC822    where toJSON = toJSONText-instance ToJSON ISO8601   where toJSON = toJSONText-instance ToJSON AWSTime   where toJSON = toJSONText-instance ToJSON BasicTime where toJSON = toJSONText--instance ToJSON POSIX where-    toJSON (Time t) =-        Number $ scientific (truncate (utcTimeToPOSIXSeconds t) :: Integer) 0
− src/Network/AWS/Data/XML.hs 
@@ -1,279 +0,0 @@-{-# LANGUAGE DefaultSignatures   #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE LambdaCase          #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns        #-}---- |--- Module      : Network.AWS.Data.XML--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Data.XML where--import           Control.Applicative-import           Control.Monad--import           Data.Bifunctor-import           Data.Conduit-import           Data.Conduit.Lazy           (lazyConsume)-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           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-ns .@ n = findElement n ns >>= parseXML--(.@?) :: FromXML a => [Node] -> Text -> Either String (Maybe a)-ns .@? n =-    case findElement n ns of-        Left _   -> Right Nothing-        Right xs -> parseXML xs--infixr 7 @=, @@=--(@=) :: ToXML a => Name -> a -> XML-n @= x =-    case toXML x of-        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 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:---   'not generally safe, but we know that runResourceT---    will not deallocate any of the resources being used---    by the process.'-encodeXML :: ToElement a => a -> LazyByteString-encodeXML x = LBS.fromChunks . unsafePerformIO . lazyConsume-     $  Conduit.sourceList (toEvents doc)-    =$= Conduit.map rename-    =$= Stream.renderBytes def-  where-    doc = toXMLDocument $ Document-        { documentRoot     = root-        , documentEpilogue = []-        , documentPrologue =-            Prologue-                { prologueBefore  = []-                , prologueDoctype = Nothing-                , prologueAfter   = []-                }-        }--    rename = \case-        EventBeginElement n xs -> EventBeginElement (f n) (map (first f) xs)-        EventEndElement   n    -> EventEndElement   (f n)-        evt                    -> evt-      where-        f n | isNothing (nameNamespace n) = n { nameNamespace = ns }-            | otherwise                   = n--    ns   = nameNamespace (elementName root)-    root = toElement x--class FromXML a where-    parseXML :: [Node] -> Either String a--instance FromXML [Node] where-    parseXML = pure--instance FromXML a => FromXML (Maybe a) where-    parseXML [] = pure Nothing-    parseXML ns = Just <$> parseXML ns--instance FromXML Text where-    parseXML = fmap (fromMaybe mempty) . withContent "Text"--instance FromXML Char       where parseXML = parseXMLText "Char"-instance FromXML ByteString where parseXML = parseXMLText "ByteString"-instance FromXML Int        where parseXML = parseXMLText "Int"-instance FromXML Integer    where parseXML = parseXMLText "Integer"-instance FromXML Natural    where parseXML = parseXMLText "Natural"-instance FromXML Double     where parseXML = parseXMLText "Double"-instance FromXML Bool       where parseXML = parseXMLText "Bool"--class ToElement a where-    toElement :: a -> Element--instance ToElement Element where-    toElement = id---- | Convert to an 'Element', only if the resulting element contains @> 0@ nodes.-maybeElement :: ToElement a => a -> Maybe Element-maybeElement x =-    case toElement x of-        e@(Element _ _ ns)-            | null ns   -> Nothing-            | otherwise -> Just e---- | Provides a way to make the operators for ToXML instance--- declaration be consistent WRT to single nodes or lists of nodes.-data XML-    = XNull-    | XAttr Name Text-    | XOne  Node-    | XMany [(Name, Text)] [Node]-      deriving (Show)--instance Monoid XML where-    mempty              = XNull-    mappend XNull XNull = XNull-    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      -> []-    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--instance ToXML XML where-    toXML = id--instance ToXML a => ToXML (Maybe a) where-    toXML (Just x) = toXML x-    toXML Nothing  = XNull--instance ToXML Text       where toXML = toXMLText-instance ToXML ByteString where toXML = toXMLText-instance ToXML Int        where toXML = toXMLText-instance ToXML Integer    where toXML = toXMLText-instance ToXML Natural    where toXML = toXMLText-instance ToXML Double     where toXML = toXMLText-instance ToXML Bool       where toXML = toXMLText--parseXMLList :: FromXML a-             => Text-             -> [Node]-             -> Either String [a]-parseXMLList n = traverse parseXML . mapMaybe (childNodesOf n)--parseXMLText :: FromText a => String -> [Node] -> Either String a-parseXMLText n = withContent n >=>-    maybe (Left $ "empty node list, when expecting single node " ++ n)-        fromText--toXMLList :: (IsList a, ToXML (Item a)) => Name -> a -> XML-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 (toXML -> x) =-    Element n (fromList (listXMLAttributes x)) (listXMLNodes x)--withContent :: String -> [Node] -> Either String (Maybe Text)-withContent k = \case-    []              -> Right Nothing-    [NodeContent x] -> Right (Just x)-    _               -> Left $ "encountered many nodes, when expecting text: " ++ k---- | 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-   . listToMaybe-   $ mapMaybe (childNodesOf n) ns---- | Find the first specific named NodeElement, at any depth in the node tree.------ Fails if absent.-firstElement :: Text -> [Node] -> Either String [Node]-firstElement n ns =-      missingElement n ns-    . listToMaybe-    $ mapMaybe go ns-  where-    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 (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-    NodeElement e -> Just (nameLocalName (elementName e))-    _             -> Nothing---- | An inefficient mechanism for retreiving the root--- element name of an XML document.-rootElementName :: LazyByteString -> Maybe Text-rootElementName bs =-    either (const Nothing)-           (Just . nameLocalName . elementName . documentRoot)-           (parseLBS def bs)--missingElement :: Text -> [Node] -> Maybe a -> Either String a-missingElement n ns = maybe (Left err) Right-  where-    err = "unable to find element "-        ++ show n-        ++ " in nodes "-        ++ show (mapMaybe localName ns)
− src/Network/AWS/Endpoint.hs 
@@ -1,123 +0,0 @@-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE ViewPatterns      #-}---- |--- Module      : Network.AWS.Types--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Endpoint where--import qualified Data.CaseInsensitive        as CI-import qualified Data.HashSet                as Set-import           Data.Monoid-import           Network.AWS.Data.ByteString-import           Network.AWS.Lens            ((%~), (.~))-import           Network.AWS.Types---- | A convenience function for overriding the 'Service' 'Endpoint'.------ /See:/ 'serviceEndpoint'.-setEndpoint :: Bool       -- ^ Whether to use HTTPS (ie. SSL).-            -> ByteString -- ^ The hostname to connect to.-            -> Int        -- ^ The port number to connect to.-            -> Service    -- ^ The service configuration to override.-            -> Service-setEndpoint s h p = serviceEndpoint %~ addr-  where-    addr = (endpointSecure .~ s)-         . (endpointHost   .~ h)-         . (endpointPort   .~ p)---- | Determine the full host address and credential scope--- within the specified 'Region'.-defaultEndpoint :: Service -> Region -> Endpoint-defaultEndpoint (_svcPrefix -> p) r = go (CI.mk p)-  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"--        "sdb"-            | virginia  -> region "sdb.amazonaws.com"--        "sts"-            | china     -> region "sts.cn-north-1.amazonaws.com.cn"-            | govcloud  -> region ("sts." <> reg <> ".amazonaws.com")-            | otherwise -> global "sts.amazonaws.com"--        "s3"-            | virginia  -> global "s3.amazonaws.com"-            | china     -> region ("s3." <> reg <> ".amazonaws.com.cn")-            | s3        -> region ("s3-" <> reg <> ".amazonaws.com")--        "rds"-            | virginia  -> global "rds.amazonaws.com"--        "route53"-            | not china -> global "route53.amazonaws.com"--        "emr"-            | virginia  -> global "elasticmapreduce.us-east-1.amazonaws.com"-            | china     -> region "elasticmapreduce.cn-north-1.amazonaws.com.cn"-            | frankfurt -> region "elasticmapreduce.eu-central-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"--        "waf"-            | not china -> global "waf.amazonaws.com"--        _   | china     -> region (p <> "." <> reg <> ".amazonaws.com.cn")-            | otherwise -> region (p <> "." <> reg <> ".amazonaws.com")--    virginia  = r == NorthVirginia-    frankfurt = r == Frankfurt-    china     = r == Beijing-    govcloud  = r == GovCloud || r == GovCloudFIPS--    s3 = r `Set.member` except--    region h = Endpoint-         { _endpointHost   = h-         , _endpointSecure = True-         , _endpointPort   = 443-         , _endpointScope  = reg-         }--    global h = Endpoint-         { _endpointHost   = h-         , _endpointSecure = True-         , _endpointPort   = 443-         , _endpointScope  = "us-east-1"-         }--    reg = toBS r--    except = Set.fromList-        [ GovCloud-        , GovCloudFIPS-        , Ireland-        , NorthCalifornia-        , NorthVirginia-        , Oregon-        , SaoPaulo-        , Singapore-        , Sydney-        , Tokyo-        ]
− src/Network/AWS/Error.hs 
@@ -1,174 +0,0 @@-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns      #-}---- |--- Module      : Network.AWS.Error--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- 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 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--httpStatus :: AsError a => Getting (First Status) a Status-httpStatus = _Error . f-  where-    f g = \case-        TransportError (HttpExceptionRequest rq (StatusCodeException rs b))-            -> (\x -> TransportError (HttpExceptionRequest rq (StatusCodeException (rs { responseStatus = x }) b)))-               <$> g (responseStatus rs)--        TransportError e-            -> pure (TransportError e)--        SerializeError (SerializeError' a s b e)-            -> (\x -> SerializeError (SerializeError' a x b e)) <$> g s--        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-          -> Optic' p f ServiceError ServiceError-hasStatus n = filtered ((n ==) . fromEnum . _serviceStatus)--hasCode :: (Applicative f, Choice p)-        => ErrorCode-        -> Optic' p f ServiceError ServiceError-hasCode c = filtered ((c ==) . _serviceCode)--serviceError :: Abbrev-             -> Status-             -> [Header]-             -> Maybe ErrorCode-             -> Maybe ErrorMessage-             -> Maybe RequestId-             -> ServiceError-serviceError a s h c m r =-    ServiceError' a s h (fromMaybe (getErrorCode s h) c) m (r <|> getRequestId h)--getRequestId :: [Header] -> Maybe RequestId-getRequestId h =-    either (const Nothing) Just (h .# hAMZRequestId <|> h .# hAMZNRequestId)--getErrorCode :: Status -> [Header] -> ErrorCode-getErrorCode s h =-    case h .# hAMZNErrorType of-        Left  _ -> errorCode (toText (statusMessage s))-        Right x -> errorCode x--parseJSONError :: Abbrev-               -> Status-               -> [Header]-               -> LazyByteString-               -> Error-parseJSONError a s h bs = decodeError a s h bs (parse bs)-  where-    parse = eitherDecode' >=> parseEither (withObject "JSONError" go)--    go o = do-        e <- (Just <$> o .: "__type") <|> o .:? "code"-        m <- msg e o-        return $! serviceError a s h e m Nothing--    msg c o =-        if c == Just "RequestEntityTooLarge"-            then pure (Just "Request body must be less than 1 MB")-            else Just <$> o .:  "message"-                      <|> o .:? "Message"--parseXMLError :: Abbrev-              -> Status-              -> [Header]-              -> LazyByteString-              -> Error-parseXMLError a s h bs = decodeError a s h bs (decodeXML bs >>= go)-  where-    go x = serviceError a s h-        <$> code x-        <*> may (firstElement "Message"   x)-        <*> may (firstElement "RequestId" x  <|> firstElement "RequestID" x)--    code x = Just <$> (firstElement "Code" x >>= parseXML)-         <|> return root--    root = errorCode <$> rootElementName bs--    may (Left  _) = pure Nothing-    may (Right x) = Just <$> parseXML x--parseRESTError :: Abbrev-               -> Status-               -> [Header]-               -> a-               -> Error-parseRESTError a s h _ =-    ServiceError (serviceError a s h Nothing Nothing Nothing)--decodeError :: Abbrev-            -> Status-            -> [Header]-            -> LazyByteString-            -> Either String ServiceError-            -> Error-decodeError a s h bs e-    | LBS.null bs = parseRESTError a s h bs-    | otherwise   =-        either (SerializeError . SerializeError' a s (Just bs))-               ServiceError-               e
− src/Network/AWS/Lens.hs 
@@ -1,27 +0,0 @@--- |--- Module      : Network.AWS.Lens--- 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+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Lens-    ( module Ex-    , module Ty-    , module Fn-    , module Op-    ) where--import           Control.Exception.Lens as Ex (catching, catching_, exception,-                                               throwingM, trying, _IOException)-import           Control.Lens           as Ty (AReview, Choice, Fold, Getter,-                                               Getting, IndexedTraversal', Iso',-                                               Lens', Optic', Prism', Setter',-                                               Traversal')-import           Control.Lens           as Fn (allOf, anyOf, concatOf, filtered,-                                               folding, has, iso, lens, mapping,-                                               prism, sets, to, traversed, un,-                                               view, _1, _2, _Just, _last)-import           Control.Lens           as Op (( # ), (%~), (&), (.~), (<&>),-                                               (<>~), (?~), (^.), (^?))
− src/Network/AWS/Pager.hs 
@@ -1,61 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE RankNTypes        #-}---- |--- Module      : Network.AWS.Pager--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Pager-    ( AWSPager     (..)-    , AWSTruncated (..)-    , stop-    , choice-    ) where--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)-import           Network.AWS.Types---- | Specify how an 'AWSRequest' and it's associated 'Rs' response can--- generate a subsequent request, if available.-class AWSRequest a => AWSPager a where-    page :: a -> Rs a -> Maybe a---- | Generalise IsTruncated and other optional/required--- response pagination fields.-class AWSTruncated a where-    truncated :: a -> Bool--instance AWSTruncated Bool where-    truncated = id--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--choice :: (Alternative f, ToText a, ToText b)-       => (s -> f a)-       -> (s -> f b)-       -> Getter s (f Text)-choice f g = to $ \x -> (toText <$> f x) <|> (toText <$> g x)
− src/Network/AWS/Prelude.hs 
@@ -1,59 +0,0 @@--- |--- Module      : Network.AWS.Prelude--- 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+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Prelude-    ( module Network.AWS.Prelude-    , module Export-    ) where--import           Control.Applicative         as Export (Applicative, pure)-import           Control.Applicative         as Export ((<$>), (<*>), (<|>))-import           Control.DeepSeq             as Export (NFData)-import           Data.Data                   as Export (Data, Typeable)-import           Data.Foldable               as Export (Foldable)-import           Data.Hashable               as Export (Hashable)-import           Data.HashMap.Strict         as Export (HashMap)-import           Data.List.NonEmpty          as Export (NonEmpty (..))-import           Data.Maybe                  as Export-import           Data.Monoid                 as Export (First, mconcat, mempty)-import           Data.Monoid                 as Export ((<>))-import           GHC.Generics                as Export (Generic)-import           Network.HTTP.Types.Status   as Export (Status (..))-import           Network.HTTP.Types.URI      as Export (urlDecode, urlEncode)-import           Numeric.Natural             as Export (Natural)--import           Network.AWS.Data.Base64     as Export-import           Network.AWS.Data.Body       as Export-import           Network.AWS.Data.ByteString as Export-import           Network.AWS.Data.Crypto     as Export hiding (Base (..))-import           Network.AWS.Data.Headers    as Export-import           Network.AWS.Data.JSON       as Export-import           Network.AWS.Data.List1      as Export-import           Network.AWS.Data.Map        as Export-import           Network.AWS.Data.Numeric    as Export-import           Network.AWS.Data.Path       as Export-import           Network.AWS.Data.Query      as Export-import           Network.AWS.Data.Sensitive  as Export-import           Network.AWS.Data.Text       as Export-import           Network.AWS.Data.Time       as Export-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 (Algorithm,-                                                        Endpoint, LogLevel (..),-                                                        Seconds, Signer,-                                                        serviceEndpoint)--infixl 7 .!@--(.!@) :: Functor f => f (Maybe a) -> a -> f a-f .!@ x = fromMaybe x <$> f--may :: Applicative f => ([a] -> f b) -> [a] -> f (Maybe b)-may _ [] = pure Nothing-may f xs = Just <$> f xs
− src/Network/AWS/Request.hs 
@@ -1,166 +0,0 @@-{-# LANGUAGE ConstraintKinds   #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}---- |--- Module      : Network.AWS.Request--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Request-    (-    -- * Requests-      head'-    , delete-    , get--    -- ** Empty body-    , post-    , put--    -- ** Specialised body-    , patchJSON--    , postXML-    , postJSON-    , postQuery-    , postBody--    , putXML-    , putJSON-    , putBody--    -- ** Constructors-    , defaultRequest--    -- ** Operation Plugins-    , contentMD5Header-    , expectHeader--    -- ** Lenses-    , requestHeaders-    , queryString-    , requestURL-    ) where--import           Data.Maybe-import           Data.Monoid-import           Network.AWS.Data.Body-import           Network.AWS.Data.ByteString-import           Network.AWS.Data.Headers-import           Network.AWS.Data.JSON-import           Network.AWS.Data.Path-import           Network.AWS.Data.Query-import           Network.AWS.Data.XML-import           Network.AWS.Lens            (Lens')-import           Network.AWS.Lens            ((%~), (&), (.~), (<&>))-import           Network.AWS.Types-import qualified Network.HTTP.Conduit        as Client-import           Network.HTTP.Types          (StdMethod (..))-import qualified Network.HTTP.Types          as HTTP--type ToRequest a = (ToPath a, ToQuery a, ToHeaders a)--head' :: ToRequest a => Service -> a -> Request a-head' s x = get s x & rqMethod .~ HEAD--delete :: ToRequest a => Service -> a -> Request a-delete s x = get s x & rqMethod .~ DELETE--get :: ToRequest a => Service -> a -> Request a-get s = defaultRequest s--post :: ToRequest a => Service -> a -> Request a-post s x = get s x & rqMethod .~ POST--put :: ToRequest a => Service -> a -> Request a-put s x = get s x & rqMethod .~ PUT--patchJSON :: (ToRequest a, ToJSON a) => Service -> a -> Request a-patchJSON s x = putJSON s x & rqMethod .~ PATCH--postXML :: (ToRequest a, ToElement a) => Service -> a -> Request a-postXML s x = putXML s x & rqMethod .~ POST--postJSON :: (ToRequest a, ToJSON a) => Service -> a -> Request a-postJSON s x = putJSON s x & rqMethod .~ POST--postQuery :: ToRequest a => Service -> a -> Request a-postQuery s x = Request-    { _rqService = s-    , _rqMethod  = POST-    , _rqPath    = rawPath x-    , _rqQuery   = mempty-    , _rqBody    = toBody (toQuery x)-    , _rqHeaders = hdr hContentType hFormEncoded (toHeaders x)-    }--postBody :: (ToRequest a, ToBody a) => Service -> a -> Request a-postBody s x = defaultRequest s x-    & rqMethod .~ POST-    & rqBody   .~ toBody x--putXML :: (ToRequest a, ToElement a) => Service -> a -> Request a-putXML s x = defaultRequest s x-    & rqMethod .~ PUT-    & rqBody   .~ maybe "" toBody (maybeElement x)--putJSON :: (ToRequest a, ToJSON a) => Service -> a -> Request a-putJSON s x = defaultRequest s x-    & rqMethod .~ PUT-    & rqBody   .~ toBody (toJSON x)--putBody :: (ToRequest a, ToBody a) => Service -> a -> Request a-putBody s x = defaultRequest s x-    & rqMethod .~ PUT-    & rqBody   .~ toBody x--defaultRequest :: ToRequest a => Service -> a -> Request a-defaultRequest s x = Request-    { _rqService = s-    , _rqMethod  = GET-    , _rqPath    = rawPath x-    , _rqQuery   = toQuery x-    , _rqHeaders = toHeaders x-    , _rqBody    = ""-    }--queryString :: Lens' Client.Request ByteString-queryString f x =-    f (Client.queryString x) <&> \y -> x { Client.queryString = y }--requestHeaders :: Lens' Client.Request HTTP.RequestHeaders-requestHeaders f x =-    f (Client.requestHeaders x) <&> \y -> x { Client.requestHeaders = y }--requestURL :: ClientRequest -> ByteString-requestURL x = scheme-    <> toBS (Client.host        x)-    <> port (Client.port        x)-    <> toBS (Client.path        x)-    <> toBS (Client.queryString x)-  where-    scheme-        | secure    = "https://"-        | otherwise = "http://"--    port = \case-        80           -> ""-        443 | secure -> ""-        n            -> ":" <> toBS n--    secure = Client.secure x--contentMD5Header :: Request a -> Request a-contentMD5Header rq-    | missing, Just x <- md5 = rq & rqHeaders %~ hdr HTTP.hContentMD5 x-    | otherwise              = rq-  where-    missing = isNothing $ lookup HTTP.hContentMD5 (_rqHeaders rq)-    md5     = md5Base64 (_rqBody rq)--expectHeader :: Request a -> Request a-expectHeader = rqHeaders %~ hdr hExpect "100-continue"
− src/Network/AWS/Response.hs 
@@ -1,136 +0,0 @@-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TupleSections     #-}-{-# LANGUAGE TypeFamilies      #-}---- |--- Module      : Network.AWS.Response--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Response where--import           Control.Applicative          (pure)-import           Control.Monad.Catch-import           Control.Monad.IO.Class-import           Control.Monad.Trans.Resource-import           Data.Aeson-import           Data.Conduit-import qualified Data.Conduit.Binary          as Conduit-import           Data.Monoid-import           Data.Proxy-import           Data.Text                    (Text)-import           Network.AWS.Data.Body-import           Network.AWS.Data.ByteString-import           Network.AWS.Data.Log-import           Network.AWS.Data.XML-import           Network.AWS.Types-import           Network.HTTP.Conduit         hiding (Proxy, Request, Response)-import           Network.HTTP.Types-import           Text.XML                     (Node)--receiveNull :: MonadResource m-            => Rs a-            -> Logger-            -> Service-            -> Proxy a-            -> ClientResponse-            -> m (Response a)-receiveNull rs _ = stream $ \_ _ x ->-    liftResourceT (x $$+- pure (Right rs))--receiveEmpty :: MonadResource m-             => (Int -> ResponseHeaders -> () -> Either String (Rs a))-             -> Logger-             -> Service-             -> Proxy a-             -> ClientResponse-             -> m (Response a)-receiveEmpty f _ = stream $ \s h x ->-    liftResourceT (x $$+- pure (f s h ()))--receiveXMLWrapper :: MonadResource m-                  => Text-                  -> (Int -> ResponseHeaders -> [Node] -> Either String (Rs a))-                  -> Logger-                  -> Service-                  -> Proxy a-                  -> ClientResponse-                  -> m (Response a)-receiveXMLWrapper n f = receiveXML (\s h x -> x .@ n >>= f s h)--receiveXML :: MonadResource m-           => (Int -> ResponseHeaders -> [Node] -> Either String (Rs a))-           -> Logger-           -> Service-           -> Proxy a-           -> ClientResponse-           -> m (Response a)-receiveXML = deserialise decodeXML--receiveJSON :: MonadResource m-            => (Int -> ResponseHeaders -> Object -> Either String (Rs a))-            -> Logger-            -> Service-            -> Proxy a-            -> ClientResponse-            -> m (Response a)-receiveJSON = deserialise eitherDecode'--receiveBody :: MonadResource m-            => (Int -> ResponseHeaders -> RsBody -> Either String (Rs a))-            -> Logger-            -> Service-            -> Proxy a-            -> ClientResponse-            -> m (Response a)-receiveBody f _ = stream $ \s h x -> pure (f s h (RsBody x))---- | Deserialise an entire response body, such as an XML or JSON payload.-deserialise :: MonadResource m-            => (LazyByteString -> Either String b)-            -> (Int -> ResponseHeaders -> b -> Either String (Rs a))-            -> Logger-            -> Service-            -> Proxy a-            -> ClientResponse-            -> m (Response a)-deserialise g f l Service{..} _ rs = do-    let s = responseStatus  rs-        h = responseHeaders rs-        x = responseBody    rs-    b <- sinkLBS x-    if not (_svcCheck s)-        then throwM (_svcError s h b)-        else do-            liftIO . l Debug . build $ "[Raw Response Body] {\n" <> b <> "\n}"-            case g b >>= f (fromEnum s) h of-                Right r -> pure (s, r)-                Left  e -> throwM . SerializeError $-                    SerializeError' _svcAbbrev s (Just b) e---- | Stream a raw response body, such as an S3 object payload.-stream :: MonadResource m-       => (Int -> ResponseHeaders -> ResponseBody -> m (Either String (Rs a)))-       -> Service-       -> Proxy a-       -> ClientResponse-       -> m (Response a)-stream f Service{..} _ rs = do-    let s = responseStatus  rs-        h = responseHeaders rs-        x = responseBody    rs-    if not (_svcCheck s)-        then sinkLBS x >>= throwM . _svcError s h-        else do-            e <- f (fromEnum s) h x-            either (throwM . SerializeError . SerializeError' _svcAbbrev s Nothing)-                   (pure . (s,))-                   e--sinkLBS :: MonadResource m => ResponseBody -> m LazyByteString-sinkLBS bdy = liftResourceT (bdy $$+- Conduit.sinkLbs)
− src/Network/AWS/Sign/V2.hs 
@@ -1,96 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TupleSections     #-}-{-# LANGUAGE TypeFamilies      #-}---- |--- Module      : Network.AWS.Sign.V2--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Sign.V2-    ( v2-    ) where--import           Control.Applicative-import qualified Data.ByteString.Char8       as BS8-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.Query-import           Network.AWS.Data.Time-import           Network.AWS.Types-import qualified Network.HTTP.Conduit        as Client-import           Network.HTTP.Types          hiding (toQuery)--data V2 = V2-    { metaTime      :: !UTCTime-    , metaEndpoint  :: !Endpoint-    , metaSignature :: !ByteString-    }--instance ToLog V2 where-    build V2{..} = buildLines-        [ "[Version 2 Metadata] {"-        , "  time      = " <> build metaTime-        , "  endpoint  = " <> build (_endpointHost metaEndpoint)-        , "  signature = " <> build metaSignature-        , "}"-        ]--v2 :: Signer-v2 = Signer sign (const sign) -- FIXME: revisit v2 presigning.--sign :: Algorithm a-sign Request{..} AuthEnv{..} r t = Signed meta rq-  where-    meta = Meta (V2 t end signature)--    rq = (clientRequest end _svcTimeout)-        { Client.method         = meth-        , Client.path           = path'-        , Client.queryString    = toBS authorised-        , Client.requestHeaders = headers-        , Client.requestBody    = toRequestBody _rqBody-        }--    meth  = toBS _rqMethod-    path' = toBS (escapePath _rqPath)--    end@Endpoint{..} = _svcEndpoint r--    Service{..} = _rqService--    authorised = pair "Signature" (urlEncode True signature) query--    signature = digestToBase Base64-        . hmacSHA256 (toBS _authSecret)-        $ BS8.intercalate "\n"-            [ meth-            , _endpointHost-            , path'-            , toBS query-            ]--    query =-         pair "Version"          _svcVersion-       . pair "SignatureVersion" ("2"          :: ByteString)-       . pair "SignatureMethod"  ("HmacSHA256" :: ByteString)-       . pair "Timestamp"        time-       . pair "AWSAccessKeyId"   (toBS _authAccess)-       $ _rqQuery <> maybe mempty toQuery token--    token = ("SecurityToken" :: ByteString,) . toBS <$> _authToken--    headers = hdr hDate time _rqHeaders--    time = toBS (Time t :: ISO8601)
− src/Network/AWS/Sign/V2Header.hs 
@@ -1,87 +0,0 @@-{-# 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 
@@ -1,159 +0,0 @@-{-# 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 
@@ -1,73 +0,0 @@-{-# LANGUAGE DataKinds            #-}-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE LambdaCase           #-}-{-# LANGUAGE OverloadedStrings    #-}-{-# LANGUAGE PackageImports       #-}-{-# LANGUAGE RankNTypes           #-}-{-# LANGUAGE RecordWildCards      #-}-{-# LANGUAGE TupleSections        #-}-{-# LANGUAGE TypeFamilies         #-}---- |--- Module      : Network.AWS.Sign.V4--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Sign.V4-    ( V4 (..)-    , v4-    ) where--import           Control.Applicative-import qualified Data.CaseInsensitive        as CI-import           Data.Monoid-import           Network.AWS.Data.Body-import           Network.AWS.Data.ByteString-import           Network.AWS.Data.Headers-import           Network.AWS.Data.Query-import           Network.AWS.Data.Time-import           Network.AWS.Lens            ((%~), (<>~))-import           Network.AWS.Request-import           Network.AWS.Sign.V4.Base-import           Network.AWS.Sign.V4.Chunked-import           Network.AWS.Types--default (ByteString)--v4 :: Signer-v4 = Signer sign presign--presign :: Seconds -> Algorithm a-presign ex rq a r ts = signRequest meta mempty auth-  where-    auth = queryString <>~ ("&X-Amz-Signature=" <> toBS (metaSignature meta))--    meta = signMetadata a r ts presigner digest (prepare rq)--    presigner c shs =-          pair (CI.original hAMZAlgorithm)     algorithm-        . pair (CI.original hAMZCredential)    (toBS c)-        . pair (CI.original hAMZDate)          (Time ts :: AWSTime)-        . pair (CI.original hAMZExpires)       ex-        . pair (CI.original hAMZSignedHeaders) (toBS shs)-        . pair (CI.original hAMZToken)         (toBS <$> _authToken a)--    digest = Tag "UNSIGNED-PAYLOAD"--    prepare = rqHeaders %~ ( hdr hHost (_endpointHost end) )-    end     = _svcEndpoint (_rqService rq) r--sign :: Algorithm a-sign rq a r ts =-    case _rqBody rq of-        Chunked x -> chunked x rq a r ts-        Hashed  x -> hashed  x rq a r ts--hashed :: HashedBody -> Algorithm a-hashed x rq a r ts =-    let (meta, auth) = base (Tag (sha256Base16 x)) rq a r ts-     in signRequest meta (toRequestBody (Hashed x)) auth
− src/Network/AWS/Sign/V4/Base.hs 
@@ -1,271 +0,0 @@-{-# LANGUAGE DataKinds            #-}-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE LambdaCase           #-}-{-# LANGUAGE OverloadedStrings    #-}-{-# LANGUAGE PackageImports       #-}-{-# LANGUAGE RankNTypes           #-}-{-# LANGUAGE RecordWildCards      #-}-{-# LANGUAGE TupleSections        #-}-{-# LANGUAGE TypeFamilies         #-}---- |--- Module      : Network.AWS.Sign.V4.Base--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- 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           Data.Function               (on)-import           Data.List                   (nubBy, sortBy)-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.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--default (ByteString)--data V4 = V4-    { metaTime             :: !UTCTime-    , metaMethod           :: !Method-    , metaPath             :: !Path-    , metaEndpoint         :: !Endpoint-    , metaCredential       :: !Credential-    , metaCanonicalQuery   :: !CanonicalQuery-    , metaCanonicalRequest :: !CanonicalRequest-    , metaCanonicalHeaders :: !CanonicalHeaders-    , metaSignedHeaders    :: !SignedHeaders-    , metaStringToSign     :: !StringToSign-    , metaSignature        :: !Signature-    , metaHeaders          :: ![Header]-    , metaTimeout          :: !(Maybe Seconds)-    }--instance ToLog V4 where-    build V4{..} = buildLines-        [ "[Version 4 Metadata] {"-        , "  time              = " <> build metaTime-        , "  endpoint          = " <> build (_endpointHost metaEndpoint)-        , "  credential        = " <> build metaCredential-        , "  signed headers    = " <> build metaSignedHeaders-        , "  signature         = " <> build metaSignature-        , "  string to sign    = {"-        , build metaStringToSign-        , "}"-        , "  canonical request = {"-        , build metaCanonicalRequest-        , "  }"-        , "}"-        ]--base :: Hash-     -> Request a-     -> AuthEnv-     -> Region-     -> UTCTime-     -> (V4, ClientRequest -> ClientRequest)-base h rq a r ts = (meta, auth)-  where-    auth = requestHeaders <>~ [(H.hAuthorization, authorisation meta)]--    meta = signMetadata a r ts presigner h (prepare rq)--    presigner _ _ = id--    prepare = rqHeaders %~-        ( hdr hHost             (_endpointHost end)-        . hdr hAMZDate          (toBS (Time ts :: AWSTime))-        . hdr hAMZContentSHA256 (toBS h)-        . maybe id (hdr hAMZToken . toBS) (_authToken a)-        )--    end = _svcEndpoint (_rqService rq) r---- | Used to tag provenance. This allows keeping the same layout as--- the signing documentation, passing 'ByteString's everywhere, with--- some type guarantees.------ Data.Tagged is not used for no reason other than syntactic length and--- the ToByteString instance.-newtype Tag (s :: Symbol) a = Tag { unTag :: a } deriving (Show)--instance ToByteString (Tag s ByteString) where toBS  = unTag-instance ToLog        (Tag s ByteString) where build = build . unTag--instance ToByteString CredentialScope where-    toBS = BS8.intercalate "/" . unTag--type Hash              = Tag "body-digest"        ByteString-type StringToSign      = Tag "string-to-sign"     ByteString-type Credential        = Tag "credential"         ByteString-type CredentialScope   = Tag "credential-scope"   [ByteString]-type CanonicalRequest  = Tag "canonical-request"  ByteString-type CanonicalHeaders  = Tag "canonical-headers"  ByteString-type CanonicalQuery    = Tag "canonical-query"    ByteString-type SignedHeaders     = Tag "signed-headers"     ByteString-type NormalisedHeaders = Tag "normalised-headers" [(ByteString, ByteString)]-type Method            = Tag "method"             ByteString-type Path              = Tag "path"               ByteString-type Signature         = Tag "signature"          ByteString--authorisation :: V4 -> ByteString-authorisation V4{..} = algorithm-    <> " Credential="     <> toBS metaCredential-    <> ", SignedHeaders=" <> toBS metaSignedHeaders-    <> ", Signature="     <> toBS metaSignature--signRequest :: V4                               -- ^ Pre-signRequestd signing metadata.-            -> Client.RequestBody               -- ^ The request body.-            -> (ClientRequest -> ClientRequest) -- ^ Insert authentication information.-            -> Signed a-signRequest m@V4{..} b auth = Signed (Meta m) (auth rq)-  where-    rq = (clientRequest metaEndpoint metaTimeout)-        { Client.method         = toBS metaMethod-        , Client.path           = toBS metaPath-        , Client.queryString    = qry-        , Client.requestHeaders = metaHeaders-        , Client.requestBody    = b-        }--    qry | BS.null x = x-        | otherwise = '?' `BS8.cons` x-      where-        x = toBS metaCanonicalQuery--signMetadata :: AuthEnv-             -> Region-             -> UTCTime-             -> (Credential -> SignedHeaders -> QueryString -> QueryString)-             -> Hash-             -> Request a-             -> V4-signMetadata a r ts presign digest rq = V4-    { metaTime             = ts-    , metaMethod           = method-    , metaPath             = path-    , metaEndpoint         = end-    , metaCredential       = cred-    , metaCanonicalQuery   = query-    , metaCanonicalRequest = crq-    , metaCanonicalHeaders = chs-    , metaSignedHeaders    = shs-    , metaStringToSign     = sts-    , metaSignature        = signature (_authSecret a ^. _Sensitive) scope sts-    , metaHeaders          = _rqHeaders rq-    , metaTimeout          = _svcTimeout svc-    }-  where-    query = canonicalQuery . presign cred shs $ _rqQuery rq--    sts   = stringToSign ts scope crq-    cred  = credential (_authAccess a) scope-    scope = credentialScope svc end ts-    crq   = canonicalRequest method path digest query chs shs--    chs     = canonicalHeaders headers-    shs     = signedHeaders    headers-    headers = normaliseHeaders (_rqHeaders rq)--    end    = _svcEndpoint svc r-    method = Tag . toBS $ _rqMethod rq-    path   = escapedPath rq--    svc    = _rqService rq--algorithm :: ByteString-algorithm = "AWS4-HMAC-SHA256"--signature :: SecretKey -> CredentialScope -> StringToSign -> Signature-signature k c = Tag . digestToBase Base16 . hmacSHA256 signingKey . unTag-  where-    signingKey = Fold.foldl' hmac ("AWS4" <> toBS k) (unTag c)--    hmac x y = digestToBS (hmacSHA256 x y)--stringToSign :: UTCTime -> CredentialScope -> CanonicalRequest -> StringToSign-stringToSign t c r = Tag $ BS8.intercalate "\n"-    [ algorithm-    , toBS (Time t :: AWSTime)-    , toBS c-    , digestToBase Base16 . hashSHA256 $ toBS r-    ]--credential :: AccessKey -> CredentialScope -> Credential-credential k c = Tag (toBS k <> "/" <> toBS c)--credentialScope :: Service -> Endpoint -> UTCTime -> CredentialScope-credentialScope s e t = Tag-    [ toBS (Time t :: BasicTime)-    , toBS (_endpointScope e)-    , toBS (_svcPrefix     s)-    , "aws4_request"-    ]--canonicalRequest :: Method-                 -> Path-                 -> Hash-                 -> CanonicalQuery-                 -> CanonicalHeaders-                 -> SignedHeaders-                 -> CanonicalRequest-canonicalRequest meth path digest query chs shs = Tag $-   BS8.intercalate "\n"-       [ toBS meth-       , toBS path-       , toBS query-       , toBS chs-       , toBS shs-       , toBS digest-       ]--escapedPath :: Request a -> Path-escapedPath r = Tag . toBS . escapePath $-    case _svcAbbrev (_rqService r) of-        "S3" -> _rqPath r-        _    -> collapsePath (_rqPath r)--canonicalQuery :: QueryString -> CanonicalQuery-canonicalQuery = Tag . toBS---- FIXME: the following use of stripBS is too naive, should remove--- all internal whitespace, replacing with a single space char,--- unless quoted with \"...\"-canonicalHeaders :: NormalisedHeaders -> CanonicalHeaders-canonicalHeaders = Tag . Fold.foldMap (uncurry f) . unTag-  where-    f k v = k <> ":" <> stripBS v <> "\n"--signedHeaders :: NormalisedHeaders -> SignedHeaders-signedHeaders = Tag . BS8.intercalate ";" . map fst . unTag--normaliseHeaders :: [Header] -> NormalisedHeaders-normaliseHeaders = Tag-    . map    (first CI.foldedCase)-    . nubBy  ((==)    `on` fst)-    . sortBy (compare `on` fst)-    . filter ((/= "authorization") . fst)
− src/Network/AWS/Sign/V4/Chunked.hs 
@@ -1,140 +0,0 @@-{-# LANGUAGE DataKinds            #-}-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE LambdaCase           #-}-{-# LANGUAGE OverloadedStrings    #-}-{-# LANGUAGE PackageImports       #-}-{-# LANGUAGE RankNTypes           #-}-{-# LANGUAGE RecordWildCards      #-}-{-# LANGUAGE TupleSections        #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE ViewPatterns         #-}--{-# OPTIONS_GHC -fno-warn-type-defaults #-}---- |--- Module      : Network.AWS.Sign.V4.Chunked--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Sign.V4.Chunked-    ( chunked-    ) where--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-chunked c rq a r ts = signRequest meta (toRequestBody body) auth-  where-    (meta, auth) = base (Tag digest) (prepare rq) a r ts--    prepare = rqHeaders <>~-        [ (hContentEncoding,         "aws-chunked")-        , (hAMZDecodedContentLength, toBS (_chunkedLength c))-        , (hContentLength,           toBS (metadataLength   c))-        ]--    body = Chunked (c `fuseChunks` sign (metaSignature meta))--    sign :: Monad m => Signature -> Conduit ByteString m ByteString-    sign prev = do-        mx <- await-        let next = chunkSignature prev (fromMaybe mempty mx)-        case mx of-            Nothing -> yield (chunkData next mempty)-            Just x  -> yield (chunkData next x) >> sign next--    chunkData next x = toBS-         $ word64Hex  (fromIntegral (BS.length x))-        <> byteString chunkSignatureHeader-        <> byteString (toBS next)-        <> byteString crlf-        <> byteString x-        <> byteString crlf--    chunkSignature prev x =-        signature (_authSecret a ^. _Sensitive) scope (chunkStringToSign prev x)--    chunkStringToSign prev x = Tag $ BS8.intercalate "\n"-        [ algorithm-        , time-        , toBS scope-        , toBS prev-        , sha256Empty-        , sha256 x-        ]--    time :: ByteString-    time = toBS (Time ts :: AWSTime)--    scope :: CredentialScope-    scope = credentialScope (_rqService rq) end ts--    end :: Endpoint-    end = _svcEndpoint (_rqService rq) r--metadataLength :: ChunkedBody -> Integer-metadataLength c =-      -- Number of full sized chunks.-      fullChunks c * chunkLength (_chunkedSize c)-      -- Non-full chunk preceeding the final chunk.-    + maybe 0 chunkLength (remainderBytes c)-      -- The final empty chunk.-    + chunkLength 0-  where-    chunkLength :: Integral a => a -> Integer-    chunkLength (toInteger -> n) =-          fromIntegral (length (showHex n ""))-        + headerLength-        + signatureLength-        + crlfLength-        + n-        + crlfLength--    headerLength    = toInteger (BS.length chunkSignatureHeader)-    crlfLength      = toInteger (BS.length crlf)-    signatureLength = 64--sha256 :: ByteString -> ByteString-sha256 = digestToBase Base16 . hashSHA256--sha256Empty :: ByteString-sha256Empty = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"--algorithm :: ByteString-algorithm = "AWS4-HMAC-SHA256-PAYLOAD"--digest :: ByteString-digest = "STREAMING-AWS4-HMAC-SHA256-PAYLOAD"--chunkSignatureHeader :: ByteString-chunkSignatureHeader = ";chunk-signature="--crlf :: ByteString-crlf = "\r\n"
− src/Network/AWS/Types.hs 
@@ -1,776 +0,0 @@-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE GADTs                      #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE RankNTypes                 #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE TypeFamilies               #-}---- |--- Module      : Network.AWS.Types--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Types-    (-    -- * Authentication-    -- ** Credentials-      AccessKey      (..)-    , SecretKey      (..)-    , SessionToken   (..)-    -- ** Environment-    , Auth           (..)-    , withAuth--    , AuthEnv        (..)-    , accessKeyId-    , secretAccessKey-    , sessionToken-    , expiration--    -- * Logging-    , LogLevel       (..)-    , Logger--    -- * Signing-    , Algorithm-    , Meta           (..)-    , Signer         (..)-    , Signed         (..)--    -- * Service-    , Abbrev-    , Service        (..)-    , serviceSigner-    , serviceEndpoint-    , serviceTimeout-    , serviceCheck-    , serviceRetry--    -- * Requests-    , AWSRequest     (..)-    , Request        (..)-    , rqService-    , rqMethod-    , rqHeaders-    , rqPath-    , rqQuery-    , rqBody-    , rqSign-    , rqPresign--    -- * Responses-    , Response--    -- * Retries-    , Retry          (..)-    , exponentBase-    , exponentGrowth-    , retryAttempts-    , retryCheck--    -- * Errors-    , AsError        (..)-    , Error          (..)-    -- ** HTTP Errors-    , HttpException-    -- ** Serialize Errors-    , SerializeError (..)-    , serializeAbbrev-    , serializeStatus-    , serializeMessage-    -- ** Service Errors-    , ServiceError   (..)-    , serviceAbbrev-    , serviceStatus-    , serviceHeaders-    , serviceCode-    , serviceMessage-    , serviceRequestId-    -- ** Error Types-    , ErrorCode      (..)-    , errorCode-    , ErrorMessage   (..)-    , RequestId      (..)--    -- * Regions-    , Region         (..)--    -- * Endpoints-    , Endpoint       (..)-    , endpointHost-    , endpointPort-    , endpointSecure-    , endpointScope--    -- * HTTP-    , ClientRequest-    , ClientResponse-    , ResponseBody-    , clientRequest--    -- ** Seconds-    , Seconds         (..)-    , seconds-    , microseconds--    -- * Isomorphisms-    , _Coerce-    , _Default-    ) where--import Control.Applicative-import Control.Concurrent           (ThreadId)-import Control.DeepSeq-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.Coerce-import Data.Conduit-import Data.Data               (Data, Typeable)-import Data.Hashable-import Data.IORef-import Data.Maybe-import Data.Monoid-import Data.Proxy-import Data.String-import Data.Time--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, 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 qualified Data.Text            as Text-import qualified Network.HTTP.Conduit as Client---- | A convenience alias to avoid type ambiguity.-type ClientRequest = Client.Request---- | A convenience alias encapsulating the common 'Response'.-type ClientResponse = Client.Response ResponseBody---- | A convenience alias encapsulating the common 'Response' body.-type ResponseBody = ResumableSource (ResourceT IO) ByteString---- | Abbreviated service name.-newtype Abbrev = Abbrev Text-    deriving (Eq, Ord, Show, IsString, FromXML, FromJSON, FromText, ToText, ToLog)--newtype ErrorCode = ErrorCode Text-    deriving (Eq, Ord, Show, ToText, ToLog)--instance IsString ErrorCode where fromString = errorCode . fromString-instance FromJSON ErrorCode where parseJSON  = parseJSONText "ErrorCode"-instance FromXML  ErrorCode where parseXML   = parseXMLText  "ErrorCode"--instance FromText ErrorCode where-    parser = errorCode <$> parser---- | Construct an 'ErrorCode'.-errorCode :: Text -> ErrorCode-errorCode = ErrorCode . strip . unnamespace-  where-    -- Common suffixes are stripped since the service definitions are ambigiuous-    -- as to whether the error shape's name, or the error code is present-    -- in the response.-    strip x = fromMaybe x $-        Text.stripSuffix "Exception" x <|> Text.stripSuffix "Fault" x--    -- Removing the (potential) leading ...# namespace.-    unnamespace x =-        case Text.break (== '#') x of-            (ns, e) | Text.null e -> ns-                    | otherwise   -> Text.drop 1 e--newtype ErrorMessage = ErrorMessage Text-    deriving (Eq, Ord, Show, IsString, FromXML, FromJSON, FromText, ToText, ToLog)--newtype RequestId = RequestId Text-    deriving (Eq, Ord, Show, IsString, FromXML, FromJSON, FromText, ToText, ToLog)---- | An error type representing errors that can be attributed to this library.-data Error-    = TransportError HttpException-    | SerializeError SerializeError-    | ServiceError   ServiceError-      deriving (Show, Typeable)--instance Exception Error--instance ToLog Error where-    build = \case-        TransportError e -> build e-        SerializeError e -> build e-        ServiceError   e -> build e--data SerializeError = SerializeError'-    { _serializeAbbrev  :: !Abbrev-    , _serializeStatus  :: !Status-    , _serializeBody    :: Maybe LazyByteString-      -- ^ The response body, if the response was not streaming.-    , _serializeMessage :: String-    } deriving (Eq, Show, Typeable)--instance ToLog SerializeError where-    build SerializeError'{..} = buildLines-        [ "[SerializeError] {"-        , "  service = " <> build _serializeAbbrev-        , "  status  = " <> build _serializeStatus-        , "  message = " <> build _serializeMessage-        , "  body    = " <> build _serializeBody-        , "}"-        ]--serializeAbbrev :: Lens' SerializeError Abbrev-serializeAbbrev = lens _serializeAbbrev (\s a -> s { _serializeAbbrev = a })--serializeStatus :: Lens' SerializeError Status-serializeStatus = lens _serializeStatus (\s a -> s { _serializeStatus = a })--serializeMessage :: Lens' SerializeError String-serializeMessage = lens _serializeMessage (\s a -> s { _serializeMessage = a })--data ServiceError = ServiceError'-    { _serviceAbbrev    :: !Abbrev-    , _serviceStatus    :: !Status-    , _serviceHeaders   :: [Header]-    , _serviceCode      :: !ErrorCode-    , _serviceMessage   :: Maybe ErrorMessage-    , _serviceRequestId :: Maybe RequestId-    } deriving (Eq, Show, Typeable)--instance ToLog ServiceError where-    build ServiceError'{..} = buildLines-        [ "[ServiceError] {"-        , "  service    = " <> build _serviceAbbrev-        , "  status     = " <> build _serviceStatus-        , "  code       = " <> build _serviceCode-        , "  message    = " <> build _serviceMessage-        , "  request-id = " <> build _serviceRequestId-        , "}"-        ]--serviceAbbrev :: Lens' ServiceError Abbrev-serviceAbbrev = lens _serviceAbbrev (\s a -> s { _serviceAbbrev = a })--serviceStatus :: Lens' ServiceError Status-serviceStatus = lens _serviceStatus (\s a -> s { _serviceStatus = a })--serviceHeaders :: Lens' ServiceError [Header]-serviceHeaders = lens _serviceHeaders (\s a -> s { _serviceHeaders = a })--serviceCode :: Lens' ServiceError ErrorCode-serviceCode = lens _serviceCode (\s a -> s { _serviceCode = a })--serviceMessage :: Lens' ServiceError (Maybe ErrorMessage)-serviceMessage = lens _serviceMessage (\s a -> s { _serviceMessage = a })--serviceRequestId :: Lens' ServiceError (Maybe RequestId)-serviceRequestId = lens _serviceRequestId (\s a -> s { _serviceRequestId = a })--class AsError a where-    -- | A general Amazonka error.-    _Error          :: Prism' a Error-    {-# MINIMAL _Error #-}--    -- | An error occured while communicating over HTTP with a remote service.-    _TransportError :: Prism' a HttpException--    -- | A serialisation error occured when attempting to deserialise a response.-    _SerializeError :: Prism' a SerializeError--    -- | A service specific error returned by the remote service.-    _ServiceError   :: Prism' a ServiceError--    _TransportError = _Error . _TransportError-    _SerializeError = _Error . _SerializeError-    _ServiceError   = _Error . _ServiceError--instance AsError SomeException where-    _Error = exception--instance AsError Error where-    _Error = id--    _TransportError = prism TransportError $ \case-        TransportError e -> Right e-        x                -> Left x--    _SerializeError = prism SerializeError $ \case-        SerializeError e -> Right e-        x                -> Left  x--    _ServiceError = prism ServiceError $ \case-        ServiceError e -> Right e-        x              -> Left  x--data Endpoint = Endpoint-    { _endpointHost   :: ByteString-    , _endpointSecure :: !Bool-    , _endpointPort   :: !Int-    , _endpointScope  :: ByteString-    } deriving (Eq, Show, Data, Typeable)--endpointHost :: Lens' Endpoint ByteString-endpointHost = lens _endpointHost (\s a -> s { _endpointHost = a })--endpointSecure :: Lens' Endpoint Bool-endpointSecure = lens _endpointSecure (\s a -> s { _endpointSecure = a })--endpointPort :: Lens' Endpoint Int-endpointPort = lens _endpointPort (\s a -> s { _endpointPort = a })--endpointScope :: Lens' Endpoint ByteString-endpointScope = lens _endpointScope (\s a -> s { _endpointScope = a })--data LogLevel-    = Info  -- ^ Info messages supplied by the user - this level is not emitted by the library.-    | Error -- ^ Error messages only.-    | Debug -- ^ Useful debug information + info + error levels.-    | Trace -- ^ Includes potentially sensitive signing metadata, and non-streaming response bodies.-      deriving (Eq, Ord, Enum, Show, Data, Typeable)--instance FromText LogLevel where-    parser = takeLowerText >>= \case-        "info"  -> pure Info-        "error" -> pure Error-        "debug" -> pure Debug-        "trace" -> pure Trace-        e       -> fromTextError $ "Failure parsing LogLevel from " <> e--instance ToText LogLevel where-    toText = \case-        Info  -> "info"-        Error -> "error"-        Debug -> "debug"-        Trace -> "trace"--instance ToByteString LogLevel---- | A function threaded through various request and serialisation routines--- to log informational and debug messages.-type Logger = LogLevel -> Builder -> IO ()---- | Constants and predicates used to create a 'RetryPolicy'.-data Retry = Exponential-    { _retryBase     :: !Double-    , _retryGrowth   :: !Int-    , _retryAttempts :: !Int-    , _retryCheck    :: ServiceError -> Maybe Text-      -- ^ Returns a descriptive name for logging-      -- if the request should be retried.-    }--exponentBase :: Lens' Retry Double-exponentBase = lens _retryBase (\s a -> s { _retryBase = a })--exponentGrowth :: Lens' Retry Int-exponentGrowth = lens _retryGrowth (\s a -> s { _retryGrowth = a })--retryAttempts :: Lens' Retry Int-retryAttempts = lens _retryAttempts (\s a -> s { _retryAttempts = a })--retryCheck :: Lens' Retry (ServiceError -> Maybe Text)-retryCheck = lens _retryCheck (\s a -> s { _retryCheck = a })---- | Signing algorithm specific metadata.-data Meta where-    Meta :: ToLog a => a -> Meta--instance ToLog Meta where-   build (Meta m) = build m---- | A signed 'ClientRequest' and associated metadata specific--- to the signing algorithm, tagged with the initial request type--- to be able to obtain the associated response, 'Rs a'.-data Signed a = Signed-    { sgMeta    :: !Meta-    , sgRequest :: !ClientRequest-    }--type Algorithm a = Request a -> AuthEnv -> Region -> UTCTime -> Signed a--data Signer = Signer-    { sgSign    :: forall a. Algorithm a-    , sgPresign :: forall a. Seconds -> Algorithm a-    }---- | Attributes and functions specific to an AWS service.-data Service = Service-    { _svcAbbrev   :: !Abbrev-    , _svcSigner   :: !Signer-    , _svcPrefix   :: !ByteString-    , _svcVersion  :: !ByteString-    , _svcEndpoint :: !(Region -> Endpoint)-    , _svcTimeout  :: !(Maybe Seconds)-    , _svcCheck    :: !(Status -> Bool)-    , _svcError    :: !(Status -> [Header] -> LazyByteString -> Error)-    , _svcRetry    :: !Retry-    }--serviceSigner :: Lens' Service Signer-serviceSigner = lens _svcSigner (\s a -> s { _svcSigner = a })--serviceEndpoint :: Setter' Service Endpoint-serviceEndpoint = sets (\f s -> s { _svcEndpoint = \r -> f (_svcEndpoint s r) })--serviceTimeout :: Lens' Service (Maybe Seconds)-serviceTimeout = lens _svcTimeout (\s a -> s { _svcTimeout = a })--serviceCheck :: Lens' Service (Status -> Bool)-serviceCheck = lens _svcCheck (\s a -> s { _svcCheck = a })--serviceRetry :: Lens' Service Retry-serviceRetry = lens _svcRetry (\s a -> s { _svcRetry = a })---- | Construct a 'ClientRequest' using common parameters such as TLS and prevent--- throwing errors when receiving erroneous status codes in respones.-clientRequest :: Endpoint -> Maybe Seconds -> ClientRequest-clientRequest e t = Client.defaultRequest-    { Client.secure          = _endpointSecure e-    , Client.host            = _endpointHost   e-    , Client.port            = _endpointPort   e-    , Client.redirectCount   = 0-    , Client.responseTimeout =-        case t of-            Nothing -> Client.responseTimeoutNone-            Just x  -> Client.responseTimeoutMicro (microseconds x)-    }---- | An unsigned request.-data Request a = Request-    { _rqService :: !Service-    , _rqMethod  :: !StdMethod-    , _rqPath    :: !RawPath-    , _rqQuery   :: !QueryString-    , _rqHeaders :: ![Header]-    , _rqBody    :: !RqBody-    }--rqService :: Lens' (Request a) Service-rqService = lens _rqService (\s a -> s { _rqService = a })--rqBody :: Lens' (Request a) RqBody-rqBody = lens _rqBody (\s a -> s { _rqBody = a })--rqHeaders :: Lens' (Request a) [Header]-rqHeaders = lens _rqHeaders (\s a -> s { _rqHeaders = a })--rqMethod :: Lens' (Request a) StdMethod-rqMethod = lens _rqMethod (\s a -> s { _rqMethod = a })--rqPath :: Lens' (Request a) RawPath-rqPath = lens _rqPath (\s a -> s { _rqPath = a })--rqQuery :: Lens' (Request a) QueryString-rqQuery = lens _rqQuery (\s a -> s { _rqQuery = a })--rqSign :: Algorithm a-rqSign x = sgSign (_svcSigner (_rqService x)) x--rqPresign :: Seconds -> Algorithm a-rqPresign ex x = sgPresign (_svcSigner (_rqService x)) ex x--type Response a = (Status, Rs a)---- | Specify how a request can be de/serialised.-class AWSRequest a where-    -- | The successful, expected response associated with a request.-    type Rs a :: *--    request  :: a -> Request a-    response :: MonadResource m-             => Logger-             -> Service-             -> Proxy a -- For injectivity reasons.-             -> ClientResponse-             -> m (Response a)---- | 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-        , Read-        , Data-        , Typeable-        , IsString-        , ToText-        , FromText-        , ToByteString-        , ToLog-        , FromXML-        , ToXML-        , ToQuery-        , Hashable-        , NFData-        )--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-        , 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-        , Data-        , Typeable-        , IsString-        , ToText-        , FromText-        , ToByteString-        , FromXML-        , ToXML-        , Hashable-        , NFData-        )--instance ToJSON   SessionToken where toJSON    = toJSONText-instance FromJSON SessionToken where parseJSON = parseJSONText "SessionToken"---- | The AuthN/AuthZ credential environment.-data AuthEnv = AuthEnv-    { _authAccess :: !AccessKey-    , _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 id     = " <> build _authAccess-        , "  secret access key = " <> build _authSecret-        , "  session token     = " <> build _authToken-        , "  expiration        = " <> build (fmap (view _Time) _authExpiry)-        , "}"-        ]--instance FromJSON AuthEnv where-    parseJSON = withObject "AuthEnv" $ \o -> AuthEnv-        <$> o .:  "AccessKeyId"-        <*> o .:  "SecretAccessKey"-        <*> o .:? "Token"-        <*> o .:? "Expiration"--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-    = Ref  ThreadId (IORef AuthEnv)-    | Auth AuthEnv--instance ToLog Auth where-    build (Ref t _) = "[Amazonka Auth] { <thread:" <> build (show t) <> "> }"-    build (Auth  e) = build e--withAuth :: MonadIO m => Auth -> (AuthEnv -> m a) -> m a-withAuth (Ref _ r) f = liftIO (readIORef r) >>= f-withAuth (Auth  e) f = f e---- | The available AWS regions.-data Region-    = NorthVirginia   -- ^ US East ('us-east-1').-    | 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').-    | Singapore       -- ^ Asia Pacific ('ap-southeast-1').-    | 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, Enum, Bounded, Show, Data, Typeable, Generic)--instance Hashable Region-instance NFData   Region--instance FromText Region where-    parser = takeLowerText >>= \case-        "us-east-1"          -> pure NorthVirginia-        "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-        "ap-southeast-1"     -> pure Singapore-        "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-        "cn-north-1"         -> pure Beijing-        e                    ->-            fromTextError $ "Failure parsing Region from " <> e--instance ToText Region where-    toText = \case-        NorthVirginia   -> "us-east-1"-        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"-        Singapore       -> "ap-southeast-1"-        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"-        Beijing         -> "cn-north-1"--instance ToByteString Region--instance ToLog Region where-    build = build . toBS--instance FromXML  Region where parseXML  = parseXMLText "Region"-instance ToXML    Region where toXML     = toXMLText-instance FromJSON Region where parseJSON = parseJSONText "Region"-instance ToJSON   Region where toJSON    = toJSONText---- | An integral value representing seconds.-newtype Seconds = Seconds Int-    deriving-        ( Eq-        , Ord-        , Read-        , Show-        , Enum-        , Num-        , Bounded-        , Integral-        , Real-        , Data-        , Typeable-        , Generic-        , ToQuery-        , ToByteString-        , ToText-        )--instance Hashable Seconds-instance NFData   Seconds--instance ToLog Seconds where-    build s = build (seconds s) <> "s"--seconds :: Seconds -> Int-seconds (Seconds n)-    | n < 0     = 0-    | otherwise = n--microseconds :: Seconds -> Int-microseconds =  (1000000 *) . seconds--_Coerce :: (Coercible a b, Coercible b a) => Iso' a b-_Coerce = iso coerce coerce---- | Invalid Iso, should be a Prism but exists for ease of composition--- with the current 'Lens . Iso' chaining to hide internal types from the user.-_Default :: Monoid a => Iso' (Maybe a) a-_Default = iso f Just-  where-    f (Just x) = x-    f Nothing  = mempty
− src/Network/AWS/Waiter.hs 
@@ -1,97 +0,0 @@-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes        #-}---- |--- Module      : Network.AWS.Waiter--- Copyright   : (c) 2013-2017 Brendan Hay--- License     : This Source Code Form is subject to the terms of--- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.AWS.Waiter-    (-    -- * Types-      Acceptor-    , Accept (..)-    , Wait   (..)--    -- * Acceptors-    , accept--    -- * Matchers-    , matchAll-    , matchAny-    , matchNonEmpty-    , matchError-    , matchStatus--    -- * Util-    , 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.Types--type Acceptor a = Request a -> Either Error (Response a) -> Maybe Accept--data Accept-    = AcceptSuccess-    | AcceptFailure-    | AcceptRetry-      deriving (Eq, Show)--instance ToLog Accept where-    build = \case-        AcceptSuccess -> "Success"-        AcceptFailure -> "Failure"-        AcceptRetry   -> "Retry"---- | Timing and acceptance criteria to check fulfillment of a remote operation.-data Wait a = Wait-    { _waitName      :: ByteString-    , _waitAttempts  :: !Int-    , _waitDelay     :: !Seconds-    , _waitAcceptors :: [Acceptor a]-    }--accept :: Wait a -> Acceptor a-accept w rq rs = listToMaybe . mapMaybe (\f -> f rq rs) $ _waitAcceptors w--matchAll :: Eq b => b -> Accept -> Fold (Rs a) b -> Acceptor a-matchAll x a l = match (allOf l (== x)) a--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-    Left  e      | Just x == (fromEnum <$> e ^? httpStatus) -> Just a-    _                                                       -> Nothing--matchError :: ErrorCode -> Accept -> Acceptor a-matchError c a _ = \case-    Left e | Just c == e ^? _ServiceError . serviceCode -> Just a-    _                                                   -> Nothing--match :: (Rs a -> Bool) -> Accept -> Acceptor a-match f a _ = \case-    Right (_, rs) | f rs -> Just a-    _                    -> Nothing--nonEmptyText :: Fold a Text -> Fold a Bool-nonEmptyText f = f . to Text.null
test/Main.hs view
@@ -1,51 +1,50 @@-{-# LANGUAGE TemplateHaskell #-}- -- | -- Module      : Main--- Copyright   : (c) 2013-2017 Brendan Hay+-- Copyright   : (c) 2013-2023 Brendan Hay -- License     : Mozilla Public License, v. 2.0. -- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>--- Stability   : experimental+-- Stability   : provisional -- 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.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+import qualified Test.Amazonka.Data.Base64 as Base64+import qualified Test.Amazonka.Data.List as List+import qualified Test.Amazonka.Data.Maybe as Maybe+import qualified Test.Amazonka.Data.Numeric as Numeric+import qualified Test.Amazonka.Data.Path as Path+import qualified Test.Amazonka.Data.Query as Query+import qualified Test.Amazonka.Data.Time as Time+import qualified Test.Amazonka.Error as Error+import qualified Test.Amazonka.Sign.V2Header as V2Header+import qualified Test.Amazonka.Sign.V4 as V4+import Test.Tasty+import Prelude  main :: IO ()-main = defaultMain $-    testGroup "amazonka-core"-        [ testGroup "primitives"-            [ Numeric.tests-            , Time.tests-            , Base64.tests-            , Maybe.tests-            , Query.tests-            ]--        , testGroup "paths"-            [ Path.tests-            ]--        , testGroup "collections"-            [ List.tests-            ]--        , testGroup "signing"-            [ V2Header.tests-            , V4.tests-            ]--        , Error.tests-        ]+main =+  defaultMain $+    testGroup+      "amazonka-core"+      [ testGroup+          "primitives"+          [ Numeric.tests,+            Time.tests,+            Base64.tests,+            Maybe.tests,+            Query.tests+          ],+        testGroup+          "paths"+          [ Path.tests+          ],+        testGroup+          "collections"+          [ List.tests+          ],+        testGroup+          "signing"+          [ V2Header.tests,+            V4.tests+          ],+        Error.tests+      ]
− test/Test/AWS/Arbitrary.hs 
@@ -1,176 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}--{-# OPTIONS_GHC -fno-warn-orphans #-}---- |--- Module      : Test.AWS.Arbitrary--- 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.Arbitrary where--import qualified Data.ByteString.Char8   as BS8-import           Data.CaseInsensitive    (CI, FoldCase)-import qualified Data.CaseInsensitive    as CI-import           Data.String-import qualified Data.Text               as Text-import qualified Data.Text.Encoding      as Text-import           Data.Time-import           Network.AWS.Data.Query-import           Network.AWS.Prelude-import           Network.AWS.Sign.V4-import           Network.HTTP.Types-import           Test.QuickCheck.Gen     as QC-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 abbrev = Service-        { _svcAbbrev   = abbrev-        , _svcSigner   = v4-        , _svcPrefix   = Text.encodeUtf8 . Text.toLower $ toText abbrev-        , _svcVersion  = "2012-01-01"-        , _svcEndpoint = defaultEndpoint (svc abbrev)-        , _svcTimeout  = Nothing-        , _svcCheck    = const False-        , _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-    arbitrary = Request-        <$> arbitrary-        <*> arbitrary-        <*> arbitrary-        <*> arbitrary-        <*> arbitrary-        <*> arbitrary--instance Arbitrary Abbrev where-    arbitrary = fromString <$> QC.elements-        [ "IAM"-        , "SDB"-        , "STS"-        , "S3"-        , "EC2"-        , "RDS"-        , "EMR"-        , "SQS"-        , "SNS"-        , "ImportExport"-        , "CloudFront"-        , "SES"-        , "Route53"-        ]--instance Arbitrary StdMethod where-    arbitrary = QC.elements-        [ GET-        , POST-        , HEAD-        , PUT-        , DELETE-        , TRACE-        , CONNECT-        , OPTIONS-        , PATCH-        ]--instance Arbitrary Region where-    arbitrary = QC.elements-        [ Ireland-        , Frankfurt-        , Tokyo-        , Singapore-        , Sydney-        , Beijing-        , NorthVirginia-        , NorthCalifornia-        , Oregon-        , GovCloud-        , GovCloudFIPS-        , SaoPaulo-        ]--instance Arbitrary RqBody where-    arbitrary = toBody <$> (arbitrary :: Gen ByteString)--instance Arbitrary RawPath where-    arbitrary = do-        xs <- listOf (BS8.pack . getNonEmpty <$> arbitrary)-        return $! rawPath (BS8.intercalate "/" xs)--instance Arbitrary QueryString where-    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-    arbitrary = CI.mk <$> arbitrary--instance Arbitrary Text where-    arbitrary = Text.pack <$> suchThat Unicode.string (not . null)--instance Arbitrary ByteString where-    arbitrary = BS8.pack <$> suchThat Unicode.string (not . null)--instance Arbitrary DiffTime where-    arbitrary = arbitrarySizedFractional-    shrink    = shrinkRealFrac--instance Arbitrary UTCTime where-    arbitrary = UTCTime-        <$> arbitrary-        <*> (fromRational . toRational <$> choose (0 :: Double, 86400))--    shrink u@(UTCTime day dayTime) =-           [ u { utctDay     = d } | d <- shrink day     ]-        ++ [ u { utctDayTime = t } | t <- shrink dayTime ]--instance Arbitrary Day where-    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 
@@ -1,46 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- |--- Module      : Test.AWS.Data.Base64--- 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.Base64 (tests) where--import           Data.Monoid-import           Data.String-import           Network.AWS.Prelude-import           Network.HTTP.Types-import           Test.AWS.Util-import           Test.Tasty--tests :: TestTree-tests = testGroup "base64"-    [ testGroup "text"-        [ testFromText "deserialise" encoded decoded-        , testToText   "serialise"   encoded decoded-        ]--    , testGroup "query"-        [ testToQuery "serialise" ("x=" <> urlEncode True encoded) decoded-        ]--    , testGroup "xml"-        [ testFromXML "deserialise" encoded decoded-        , testToXML   "serialise"   encoded decoded-        ]--    , testGroup "json"-        [ testFromJSON "deserialise" (str encoded) decoded-        , testToJSON   "serialise"   (str encoded) decoded-        ]-    ]--encoded :: IsString a => a-encoded = "U2VkIHV0IHBlcnNwaWNpYXRpcyB1bmRlIG9tbmlzIGlzdGUgbmF0dXMgZXJyb3Igc2l0IHZvbHVwdGF0ZW0="--decoded :: Base64-decoded = Base64 "Sed ut perspiciatis unde omnis iste natus error sit voluptatem"
− test/Test/AWS/Data/List.hs 
@@ -1,176 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- |--- Module      : Test.AWS.Data.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.List (tests) where--import           Network.AWS.Prelude-import           Test.AWS.Util-import           Test.Tasty--tests :: TestTree-tests = testGroup "list"-    [ testGroup "query"-        [ testGroup "serialise"-            [ testGroup "non-flattened"-                [ testToQuery "absent"-                    "x.name=absent"-                    (NonFlat "absent" absent)--                , testToQuery "primitive"-                    "x.itemSet.item.1=1&x.itemSet.item.2=2&x.itemSet.item.3=3&x.name=primitive"-                    (NonFlat "primitive" (Just ([1, 2, 3] :: [Int])))--                , testToQuery "complex"-                    "x.itemSet.item.1.value=1&x.itemSet.item.2.value=2&x.name=complex"-                    (NonFlat "complex" (Just [Item 1, Item 2]))-                ]--            , testGroup "flattened"-                [ testToQuery "absent/empty"-                    "x.name=empty"-                    (Flat "empty" empty)--                , testToQuery "primitive"-                    "x.item.1=4&x.item.2=5&x.item.3=6&x.name=primitive"-                    (Flat "primitive" (Just ([4, 5, 6] :: [Int])))--                , testToQuery "complex"-                    "x.item.1.value=9&x.item.2.value=10&x.name=complex"-                    (Flat "complex" (Just [Item 9, Item 10]))-                ]-            ]-        ]--    , testGroup "xml"-        [ testGroup "deserialise"-            [ testGroup "non-flattened"-                [ testFromXML "absent"-                    "<name>absent</name>"-                    (NonFlat "absent" absent)--                , testFromXML "empty"-                    "<name>empty</name><itemSet/>"-                    (NonFlat "empty" absent)--                , testFromXML "primitive"-                    "<name>primitive</name><itemSet><item>1</item><item>2</item><item>3</item></itemSet>"-                    (NonFlat "primitive" (Just ([1, 2, 3] :: [Int])))--                , testFromXML "complex"-                    "<name>complex</name><itemSet><item><value>1</value></item><item><value>2</value></item></itemSet>"-                    (NonFlat "complex" (Just [Item 1, Item 2]))-                ]--            , testGroup "flattened"-                [ testFromXML "absent/empty"-                    "<name>empty</name>"-                    (Flat "empty" empty)--                , testFromXML "primitive"-                    "<name>primitive</name><item>4</item><item>5</item><item>6</item>"-                    (Flat "primitive" (Just ([4, 5, 6] :: [Int])))--                , testFromXML "complex"-                    "<name>complex</name><item><value>9</value></item><item><value>10</value></item>"-                    (Flat "complex" (Just [Item 9, Item 10]))-                ]-            ]--        , testGroup "serialise"-            [ testGroup "non-flattened"-                [ testToXML "absent"-                    "<name>absent</name>"-                    (NonFlat "absent" absent)--                , testToXML "primitive"-                    "<name>primitive</name><itemSet><item>1</item><item>2</item><item>3</item></itemSet>"-                    (NonFlat "primitive" (Just ([1, 2, 3] :: [Int])))--                , testToXML "complex"-                    "<name>complex</name><itemSet><item><value>1</value></item><item><value>2</value></item></itemSet>"-                    (NonFlat "complex" (Just [Item 1, Item 2]))-                ]--            , testGroup "flattened"-                [ testToXML "absent/empty"-                    "<name>empty</name>"-                    (Flat "empty" empty)--                , testToXML "primitive"-                    "<name>primitive</name><item>4</item><item>5</item><item>6</item>"-                    (Flat "primitive" (Just ([4, 5, 6] :: [Int])))--                , testToXML "complex"-                    "<name>complex</name><item><value>9</value></item><item><value>10</value></item>"-                    (Flat "complex" (Just [Item 9, Item 10]))-                ]-            ]-        ]-    ]--empty :: Maybe [Int]-empty = Just []--absent :: Maybe [Int]-absent = Nothing--data NonFlat a = NonFlat Text (Maybe [a])-    deriving (Eq, Show)--instance ToQuery a => ToQuery (NonFlat a) where-    toQuery (NonFlat n x) = mconcat-        [ "name"    =: n-        , "itemSet" =: toQuery (toQueryList "item" <$> x)-        ]--instance FromXML a => FromXML (NonFlat a) where-    parseXML x = NonFlat-         <$>  x .@  "name"-         <*> (x .@? "itemSet"-                .!@ mempty-                >>= may (parseXMLList "item"))--instance ToXML a => ToXML (NonFlat a) where-    toXML (NonFlat n x) = mconcat-        [ "name"    @= n-        , "itemSet" @= toXML (toXMLList "item" <$> x)-        ]--data Flat a = Flat Text (Maybe [a])-    deriving (Eq, Show)--instance ToQuery a => ToQuery (Flat a) where-    toQuery (Flat n x) = mconcat-        [ "name" =: n-        , toQuery (toQueryList "item" <$> x)-        ]--instance FromXML a => FromXML (Flat a) where-    parseXML x = Flat-         <$> x .@  "name"-         <*> may (parseXMLList "item") x--instance ToXML a => ToXML (Flat a) where-    toXML (Flat n x) = mconcat-        [ "name" @= n-        , toXML (toXMLList "item" <$> x)-        ]--newtype Item = Item Int-    deriving (Eq, Show)--instance ToQuery Item where-    toQuery (Item n) = "value" =: n--instance FromXML Item where-    parseXML x = Item <$> x .@ "value"--instance ToXML Item where-    toXML (Item n) = "value" @= n
− test/Test/AWS/Data/Maybe.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- |--- Module      : Test.AWS.Data.Maybe--- 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.Maybe (tests) where--import           Network.AWS.Prelude-import           Test.AWS.Util-import           Test.Tasty-import           Test.Tasty.HUnit--tests :: TestTree-tests = testGroup "maybe"-    [ testGroup "xml"-        [ testGroup "serialise"-            [ testCase "nothing" $-                wrapXML "<Key>foo</Key>"-                    @?= encodeXML (X (Item "foo" Nothing))--            , testCase "just" $-                wrapXML "<Key>bar</Key><Num>23</Num>"-                    @?= encodeXML (X (Item "bar" (Just 23)))-            ]-        ]-    ]--data Item = Item Text (Maybe Int)-    deriving (Eq, Show)--instance ToXML Item where-    toXML (Item x y) = mconcat-        [ "Key" @= x-        , "Num" @= y-        ]
− test/Test/AWS/Data/Numeric.hs 
@@ -1,128 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}---- |--- Module      : Test.AWS.Data.Numeric--- 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.Numeric (tests) where--import           Control.Applicative-import           Network.AWS.Prelude-import           Test.AWS.Util-import           Test.Tasty--tests :: TestTree-tests = testGroup "numeric"-    [ testGroup "json"-        [ testGroup "deserialisation"-            [ testFromJSON "natural"-                "123" (Nat 123)--            , testFromJSON "int"-                (toLazyBS maxInt) maxInt--            , testFromJSON "negative int"-                (toLazyBS minInt) minInt--            , testFromJSON "integer"-                "891324" (891324 :: Integer)--            , testFromJSON "negative integer"-                "-998" (-998 :: Integer)--            , testFromJSON "double"-                "46.39212" (46.39212 :: Double)--            , testFromJSON "negative double"-                "-1.09231" (-1.09231 :: Double)--            , testFromJSON "numeric text"-                "\"22\"" ("22" :: Text)-            ]--        , testGroup "serialisation"-            [ testToJSON "natural"-                "123" (Nat 123)--            , testToJSON "int"-                (toLazyBS maxInt) maxInt--            , testToJSON "negative int"-                (toLazyBS minInt) minInt--            , testToJSON "integer"-                "891324" (891324 :: Integer)--            , testToJSON "negative integer"-                "-998" (-998 :: Integer)--            , testToJSON "double"-                "46.39212" (46.39212 :: Double)--            , testToJSON "negative double"-                "-1.09231" (-1.09231 :: Double)--            , testToJSON "numeric string"-                "\"22\"" ("22" :: String)-            ]-        ]--    , testGroup "xml"-        [ testGroup "deserialisation"-            [ testFromXML "natural"-                "123" (Nat 123)--            , testFromXML "int"-                (toLazyBS maxInt) maxInt--            , testFromXML "negative int"-                (toLazyBS minInt) minInt--            , testFromXML "integer"-                "891324" (891324 :: Integer)--            , testFromXML "negative integer"-                "-998" (-998 :: Integer)--            , testFromXML "double"-                "46.39212" (46.39212 :: Double)--            , testFromXML "negative double"-                "-1.09231" (-1.09231 :: Double)--            , testFromXML "numeric string"-                "22" ("22" :: Text)-            ]--        , testGroup "serialisation"-            [ testToXML "natural"-                "123" (Nat 123)--            ,  testToXML "int"-                (toLazyBS maxInt) maxInt--            , testToXML "negative int"-                (toLazyBS minInt) minInt--            , testToXML "integer"-                "891324" (891324 :: Integer)--            , testToXML "negative integer"-                "-998" (-998 :: Integer)--            , testToXML "double"-                "46.39212" (46.39212 :: Double)--            , testToXML "negative double"-                "-1.09231" (-1.09231 :: Double)--            , testToXML "numeric text"-                "22" ("22" :: Text)-            ]-        ]-    ]
− test/Test/AWS/Data/Path.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- |--- Module      : Test.AWS.Data.Path--- 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.Path (tests) where--import           Network.AWS.Prelude-import           Test.Tasty-import           Test.Tasty.HUnit--tests :: TestTree-tests = testGroup "path"-    [ testGroup "encode"-        [ testCase "doesn't append trailing slash" $-            let x = "/path/without/trailing/slash" in encode x @?= x--        , testCase "preserves trailing slash" $-            let x = "/some/path/with/trailing/slash/" in encode x @?= x--        , testCase "preserves adjacent slashes" $-            let x = "/path//with/adjacent///slahes/" in encode x @?= x-        ]-    ]--encode :: ByteString -> ByteString-encode = toBS . escapePath . rawPath
− test/Test/AWS/Data/Query.hs 
@@ -1,51 +0,0 @@-{-# 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 
@@ -1,128 +0,0 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}---- |--- Module      : Test.AWS.Data.Time--- 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.Time (tests) where--import           Network.AWS.Compat.Locale-import           Network.AWS.Compat.Time-import           Network.AWS.Prelude-import           Test.AWS.Util-import           Test.Tasty--tests :: TestTree-tests = testGroup "time"-    [ testGroup "text"-        [ testGroup "deserialise"-            [ testFromText "rfc822"-                "Fri, 07 Nov 2014 04:42:13 GMT" (time :: RFC822)--            , testFromText "iso8601"-                "2014-11-07T04:42:13.000Z" (time :: ISO8601)--            , testFromText "aws"-                "20141107T044213Z" (time :: AWSTime)-            ]--        , testGroup "serialise"-            [ testToText "rfc822"-                "Fri, 07 Nov 2014 04:42:13 GMT" (time :: RFC822)--            , testToText "iso8601"-                "2014-11-07T04:42:13Z" (time :: ISO8601)--            , testToText "aws"-                "20141107T044213Z" (time :: AWSTime)-            ]-        ]--    , testGroup "query"-        [ testGroup "serialise"-            [ testToQuery "rfc822"-                "x=Fri%2C%2007%20Nov%202014%2004%3A42%3A13%20GMT" (time :: RFC822)--            , testToQuery "iso8601"-                "x=2014-11-07T04%3A42%3A13Z" (time :: ISO8601)--            , testToQuery "aws"-                "x=20141107T044213Z" (time :: AWSTime)-            ]-        ]--    , testGroup "xml"-        [ testGroup "deserialise"-            [ testFromXML "rfc822"-                "Fri, 07 Nov 2014 04:42:13 GMT" (time :: RFC822)--            , testFromXML "iso8601"-                "2014-11-07T04:42:13.000Z" (time :: ISO8601)--            , testFromXML "aws"-                "20141107T044213Z" (time :: AWSTime)-            ]--        , testGroup "serialise"-            [ testToXML "rfc822"-                "Fri, 07 Nov 2014 04:42:13 GMT" (time :: RFC822)--            , testToXML "iso8601"-                "2014-11-07T04:42:13Z" (time :: ISO8601)--            , testToXML "aws"-                "20141107T044213Z" (time :: AWSTime)-            ]-        ]--    , testGroup "json"-        [ testGroup "deserialise"-            [ testFromJSON "rfc822"-                (str "Fri, 07 Nov 2014 04:42:13 GMT") (time :: RFC822)--            , testFromJSON "iso8601"-                (str "2014-11-07T04:42:13.000Z") (time :: ISO8601)--            , testFromJSON "aws"-                (str "20141107T044213Z") (time :: AWSTime)--            , testGroup "posix"-                [ testFromJSON "integer"-                    "1415335333" (time :: POSIX)--                , testFromJSON "double"-                    "1415335333.000" (time :: POSIX)--                , testFromJSON "scientific"-                    "1.415335333E9" (time :: POSIX)-                ]-            ]--        , testGroup "serialise"-            [ testToJSON "rfc822"-                (str "Fri, 07 Nov 2014 04:42:13 GMT") (time :: RFC822)--            , testToJSON "iso8601"-                (str "2014-11-07T04:42:13Z") (time :: ISO8601)--            , testToJSON "aws"-                (str "20141107T044213Z") (time :: AWSTime)--            , testToJSON "posix"-                "1415335333" (time :: POSIX)-            ]-        ]-    ]--time :: Time a-time = Time . fromMaybe (error msg) $ parseTime defaultTimeLocale fmt ts-  where-    msg = "Unable to parse time: " ++ ts-    fmt = (iso8601DateFormat (Just "%H:%M:%S"))-    ts  = "2014-11-07T04:42:13"
− test/Test/AWS/Error.hs 
@@ -1,74 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies      #-}---- |--- Module      : Test.AWS.Error--- 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.Error (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.Error-import           Network.AWS.Prelude-import           Test.AWS.Arbitrary       ()-import           Test.QuickCheck.Property ()-import           Test.Tasty-import           Test.Tasty.HUnit--tests :: TestTree-tests = testGroup "errors"-    [ testGroup "xml"-        [ testCase "ec2" $ xmlError ec2-            "VolumeInUse"-            "vol-8c8cea98 is already attached to an instance"-            "c0ca7700-c515-4653-87e3-f1a9ce6416e8"--        , testCase "route53" $ xmlError route53-            "InvalidChangeBatch"-            "Tried to delete resource record set noexist.example.com. type A,but it was not found"-            "default_rid"--        , testCase "sqs" $ xmlError sqs-            "InvalidParameterValue"-            "Value (quename_nonalpha) for parameter QueueName is invalid. Must be an alphanumeric String of 1 to 80 in length"-            "42d59b56-7407-4c4a-be0f-4c88daeea257"-        ]-    ]--xmlError :: LazyByteString-         -> ErrorCode-         -> ErrorMessage-         -> RequestId-         -> Assertion-xmlError bs c m r = actual @?= Right expect-  where-    expect = serviceError a s h (Just c) (Just m) (Just r)-    actual =-        case parseXMLError a s h bs of-            ServiceError e -> Right e-            e              -> Left $ "unexpected error: " ++ show e--    a = "Test"-    s = toEnum 400-    h = [(hAMZRequestId, "default_rid")]---- Samples representative of differing xml errors.--ec2 :: LazyByteString-ec2 = "<?xml version=\"1.0\" encoding=\"UTF-8\"?><Response><Errors><Error><Code>VolumeInUse</Code><Message>vol-8c8cea98 is already attached to an instance</Message></Error></Errors><RequestID>c0ca7700-c515-4653-87e3-f1a9ce6416e8</RequestID></Response>"--route53 :: LazyByteString-route53 = "<InvalidChangeBatch xmlns=\"https://route53.amazonaws.com/doc/2013-04-01/\"><Messages><Message>Tried to delete resource record set noexist.example.com. type A,but it was not found</Message></Messages></InvalidChangeBatch>"--sqs :: LazyByteString-sqs = "<ErrorResponse><Error><Type>Sender</Type><Code>InvalidParameterValue</Code><Message>Value (quename_nonalpha) for parameter QueueName is invalid. Must be an alphanumeric String of 1 to 80 in length</Message></Error><RequestId>42d59b56-7407-4c4a-be0f-4c88daeea257</RequestId></ErrorResponse>"
− test/Test/AWS/Sign/V2Header/BaseSpec.hs 
@@ -1,278 +0,0 @@-{-# 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 
@@ -1,34 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# 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 (tests) where--import Test.Tasty (TestTree, testGroup)--import qualified Test.AWS.Sign.V4.Chunked as Chunked---- Write some V4 signing properties:---  test canonical query---  test query---  test canonical headers---  test signed headers---  test time format---  test host, x-amz-date, content-sha256 headers exist---  test empty path---  test empty query--tests :: TestTree-tests =-    testGroup "v4"-        [ testGroup "chunked"-            [ Chunked.tests-            ]-        ]
− test/Test/AWS/Sign/V4/Chunked.hs 
@@ -1,101 +0,0 @@-{-# 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 
@@ -1,113 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- |--- Module      : Test.AWS.Util--- 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.Util where--import           Data.Aeson-import qualified Data.ByteString.Lazy      as LBS-import           Language.Haskell.TH-import           Language.Haskell.TH.Quote-import           Network.AWS.Prelude-import           Test.Tasty-import           Test.Tasty.HUnit--doc :: QuasiQuoter-doc = QuasiQuoter-    { quoteExp  = stringE-    , quotePat  = const $ error "No quotePat  defined."-    , quoteType = const $ error "No quoteType defined."-    , quoteDec  = const $ error "No quoteDec  defined."-    }---- | Dummy root element for testing nested structures.-newtype X a = X a-    deriving (Eq, Show)--instance ToQuery a => ToQuery (X a) where-    toQuery (X x) = "x" =: x--instance FromXML a => FromXML (X a) where-    parseXML = fmap X . parseXML--instance ToXML a => ToElement (X a) where-    toElement (X x) = mkElement "x" x--instance FromJSON a => FromJSON (X a) where-    parseJSON = withObject "X" (fmap X . (.: "x"))--instance ToJSON a => ToJSON (X a) where-    toJSON (X x) = object ["x" .= x]--testFromText :: (FromText a, Show a, Eq a)-             => TestName-             -> Text-             -> a-             -> TestTree-testFromText n t x = testCase n (Right x @?= fromText t)--testToText :: (ToText a, Show a, Eq a)-           => TestName-           -> Text-           -> a-           -> TestTree-testToText n t x = testCase n (t @?= toText x)--testToQuery :: (ToQuery a, Show a, Eq a)-            => TestName-            -> ByteString-            -> a-            -> TestTree-testToQuery n bs x = testCase n (bs @=? toBS (toQuery (X x)))--testFromXML :: (FromXML a, Show a, Eq a)-            => TestName-            -> LazyByteString-            -> a-            -> TestTree-testFromXML n bs x = testCase n $-     Right (X x) @?= (decodeXML (wrapXML bs) >>= parseXML)--testToXML :: (ToXML a, Show a, Eq a)-          => TestName-          -> LazyByteString-          -> a-          -> TestTree-testToXML n bs x = testCase n $ wrapXML bs @?= encodeXML (X x)--testFromJSON :: (FromJSON a, Show a, Eq a)-             => TestName-             -> LazyByteString-             -> a-             -> TestTree-testFromJSON n bs x = testCase n $-    Right (X x) @?= eitherDecode' ("{\"x\":" <> bs <> "}")--testToJSON :: (ToJSON a, Show a, Eq a)-           => TestName-           -> LazyByteString-           -> a-           -> TestTree-testToJSON n bs x = testCase n (bs @?= encode x)--str :: LazyByteString -> LazyByteString-str bs = "\"" <> bs <> "\""--wrapXML :: LazyByteString -> LazyByteString-wrapXML bs =-    "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" <> "<x>" <> bs <> "</x>"--maxInt :: Int-maxInt = maxBound--minInt :: Int-minInt = minBound--toLazyBS :: ToByteString a => a -> LazyByteString-toLazyBS = LBS.fromStrict . toBS
+ test/Test/Amazonka/Arbitrary.hs view
@@ -0,0 +1,182 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module      : Test.Amazonka.Arbitrary+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Test.Amazonka.Arbitrary where++import Amazonka.Core+import Amazonka.Data+import Amazonka.Prelude+import Amazonka.Sign.V4+import qualified Data.ByteString.Char8 as BS8+import Data.CaseInsensitive (FoldCase)+import qualified Data.CaseInsensitive as CI+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import Data.Time (Day (..), UTCTime (..))+import Network.HTTP.Types (StdMethod (..))+import Test.QuickCheck.Gen as QC+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 abbrev =+        Service+          { abbrev = abbrev,+            signer = v4,+            signingName = Text.encodeUtf8 . Text.toLower $ toText abbrev,+            version = "2012-01-01",+            s3AddressingStyle = S3AddressingStyleAuto,+            endpointPrefix = Text.encodeUtf8 . Text.toLower $ toText abbrev,+            endpoint = defaultEndpoint (svc abbrev),+            timeout = Nothing,+            check = const False,+            retry = Exponential 1 2 3 (Just . Text.pack . show),+            error = \status hdrs _ ->+              ServiceError $+                ServiceError'+                  { abbrev = abbrev,+                    status = status,+                    headers = hdrs,+                    code = ErrorCode "Arbitrary.Service",+                    message = Nothing,+                    requestId = Nothing+                  }+          }++instance Arbitrary (Request ()) where+  arbitrary =+    Request+      <$> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary++instance Arbitrary Abbrev where+  arbitrary =+    fromString+      <$> QC.elements+        [ "IAM",+          "SDB",+          "STS",+          "S3",+          "EC2",+          "RDS",+          "EMR",+          "SQS",+          "SNS",+          "ImportExport",+          "CloudFront",+          "SES",+          "Route53"+        ]++instance Arbitrary StdMethod where+  arbitrary =+    QC.elements+      [ GET,+        POST,+        HEAD,+        PUT,+        DELETE,+        TRACE,+        CONNECT,+        OPTIONS,+        PATCH+      ]++instance Arbitrary Region where+  arbitrary =+    QC.elements+      [ Ireland,+        Frankfurt,+        Tokyo,+        Singapore,+        Sydney,+        Beijing,+        NorthVirginia,+        NorthCalifornia,+        Oregon,+        GovCloudEast,+        GovCloudWest,+        SaoPaulo+      ]++instance Arbitrary RequestBody where+  arbitrary = toBody <$> (arbitrary :: Gen ByteString)++instance Arbitrary RawPath where+  arbitrary = do+    xs <- listOf (BS8.pack . getNonEmpty <$> arbitrary)+    return $! rawPath (BS8.intercalate "/" xs)++instance Arbitrary QueryString where+  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+  arbitrary = CI.mk <$> arbitrary++instance Arbitrary Text where+  arbitrary = Text.pack <$> suchThat Unicode.string (not . null)++instance Arbitrary ByteString where+  arbitrary = BS8.pack <$> suchThat Unicode.string (not . null)++instance Arbitrary DiffTime where+  arbitrary = arbitrarySizedFractional+  shrink = shrinkRealFrac++instance Arbitrary UTCTime where+  arbitrary =+    UTCTime+      <$> arbitrary+      <*> (fromRational . toRational <$> choose (0 :: Double, 86400))++  shrink u@(UTCTime day dayTime) =+    [u {utctDay = d} | d <- shrink day]+      ++ [u {utctDayTime = t} | t <- shrink dayTime]++instance Arbitrary Day where+  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/Amazonka/Data/Base64.hs view
@@ -0,0 +1,45 @@+-- |+-- Module      : Test.Amazonka.Data.Base64+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Test.Amazonka.Data.Base64 (tests) where++import Amazonka.Core+import Amazonka.Prelude+import Network.HTTP.Types.URI (urlEncode)+import Test.Amazonka.Util+import Test.Tasty++tests :: TestTree+tests =+  testGroup+    "base64"+    [ testGroup+        "text"+        [ testFromText "deserialise" encoded decoded,+          testToText "serialise" encoded decoded+        ],+      testGroup+        "query"+        [ testToQuery "serialise" ("x=" <> urlEncode True encoded) decoded+        ],+      testGroup+        "xml"+        [ testFromXML "deserialise" encoded decoded,+          testToXML "serialise" encoded decoded+        ],+      testGroup+        "json"+        [ testFromJSON "deserialise" (str encoded) decoded,+          testToJSON "serialise" (str encoded) decoded+        ]+    ]++encoded :: IsString a => a+encoded = "U2VkIHV0IHBlcnNwaWNpYXRpcyB1bmRlIG9tbmlzIGlzdGUgbmF0dXMgZXJyb3Igc2l0IHZvbHVwdGF0ZW0="++decoded :: Base64+decoded = Base64 "Sed ut perspiciatis unde omnis iste natus error sit voluptatem"
+ test/Test/Amazonka/Data/List.hs view
@@ -0,0 +1,197 @@+-- |+-- Module      : Test.Amazonka.Data.List+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Test.Amazonka.Data.List (tests) where++import Amazonka.Core+import Amazonka.Data+import Amazonka.Prelude hiding (Item)+import Test.Amazonka.Util+import Test.Tasty++tests :: TestTree+tests =+  testGroup+    "list"+    [ testGroup+        "query"+        [ testGroup+            "serialise"+            [ testGroup+                "non-flattened"+                [ testToQuery+                    "absent"+                    "x.name=absent"+                    (NonFlat "absent" absent),+                  testToQuery+                    "primitive"+                    "x.itemSet.item.1=1&x.itemSet.item.2=2&x.itemSet.item.3=3&x.name=primitive"+                    (NonFlat "primitive" (Just ([1, 2, 3] :: [Int]))),+                  testToQuery+                    "complex"+                    "x.itemSet.item.1.value=1&x.itemSet.item.2.value=2&x.name=complex"+                    (NonFlat "complex" (Just [Item 1, Item 2]))+                ],+              testGroup+                "flattened"+                [ testToQuery+                    "absent/empty"+                    "x.name=empty"+                    (Flat "empty" empty),+                  testToQuery+                    "primitive"+                    "x.item.1=4&x.item.2=5&x.item.3=6&x.name=primitive"+                    (Flat "primitive" (Just ([4, 5, 6] :: [Int]))),+                  testToQuery+                    "complex"+                    "x.item.1.value=9&x.item.2.value=10&x.name=complex"+                    (Flat "complex" (Just [Item 9, Item 10]))+                ]+            ]+        ],+      testGroup+        "xml"+        [ testGroup+            "deserialise"+            [ testGroup+                "non-flattened"+                [ testFromXML+                    "absent"+                    "<name>absent</name>"+                    (NonFlat "absent" absent),+                  testFromXML+                    "empty"+                    "<name>empty</name><itemSet/>"+                    (NonFlat "empty" absent),+                  testFromXML+                    "primitive"+                    "<name>primitive</name><itemSet><item>1</item><item>2</item><item>3</item></itemSet>"+                    (NonFlat "primitive" (Just ([1, 2, 3] :: [Int]))),+                  testFromXML+                    "complex"+                    "<name>complex</name><itemSet><item><value>1</value></item><item><value>2</value></item></itemSet>"+                    (NonFlat "complex" (Just [Item 1, Item 2]))+                ],+              testGroup+                "flattened"+                [ testFromXML+                    "absent/empty"+                    "<name>empty</name>"+                    (Flat "empty" empty),+                  testFromXML+                    "primitive"+                    "<name>primitive</name><item>4</item><item>5</item><item>6</item>"+                    (Flat "primitive" (Just ([4, 5, 6] :: [Int]))),+                  testFromXML+                    "complex"+                    "<name>complex</name><item><value>9</value></item><item><value>10</value></item>"+                    (Flat "complex" (Just [Item 9, Item 10]))+                ]+            ],+          testGroup+            "serialise"+            [ testGroup+                "non-flattened"+                [ testToXML+                    "absent"+                    "<name>absent</name>"+                    (NonFlat "absent" absent),+                  testToXML+                    "primitive"+                    "<name>primitive</name><itemSet><item>1</item><item>2</item><item>3</item></itemSet>"+                    (NonFlat "primitive" (Just ([1, 2, 3] :: [Int]))),+                  testToXML+                    "complex"+                    "<name>complex</name><itemSet><item><value>1</value></item><item><value>2</value></item></itemSet>"+                    (NonFlat "complex" (Just [Item 1, Item 2]))+                ],+              testGroup+                "flattened"+                [ testToXML+                    "absent/empty"+                    "<name>empty</name>"+                    (Flat "empty" empty),+                  testToXML+                    "primitive"+                    "<name>primitive</name><item>4</item><item>5</item><item>6</item>"+                    (Flat "primitive" (Just ([4, 5, 6] :: [Int]))),+                  testToXML+                    "complex"+                    "<name>complex</name><item><value>9</value></item><item><value>10</value></item>"+                    (Flat "complex" (Just [Item 9, Item 10]))+                ]+            ]+        ]+    ]++empty :: Maybe [Int]+empty = Just []++absent :: Maybe [Int]+absent = Nothing++data NonFlat a = NonFlat Text (Maybe [a])+  deriving stock (Eq, Show)++instance ToQuery a => ToQuery (NonFlat a) where+  toQuery (NonFlat n x) =+    mconcat+      [ "name" =: n,+        "itemSet" =: toQuery (toQueryList "item" <$> x)+      ]++instance FromXML a => FromXML (NonFlat a) where+  parseXML x =+    NonFlat+      <$> x .@ "name"+      <*> ( x+              .@? "itemSet"+              .!@ mempty+              >>= may (parseXMLList "item")+          )++instance ToXML a => ToXML (NonFlat a) where+  toXML (NonFlat n x) =+    mconcat+      [ "name" @= n,+        "itemSet" @= toXML (toXMLList "item" <$> x)+      ]++data Flat a = Flat Text (Maybe [a])+  deriving stock (Eq, Show)++instance ToQuery a => ToQuery (Flat a) where+  toQuery (Flat n x) =+    mconcat+      [ "name" =: n,+        toQuery (toQueryList "item" <$> x)+      ]++instance FromXML a => FromXML (Flat a) where+  parseXML x =+    Flat+      <$> x .@ "name"+      <*> may (parseXMLList "item") x++instance ToXML a => ToXML (Flat a) where+  toXML (Flat n x) =+    mconcat+      [ "name" @= n,+        toXML (toXMLList "item" <$> x)+      ]++newtype Item = Item Int+  deriving stock (Eq, Show)++instance ToQuery Item where+  toQuery (Item n) = "value" =: n++instance FromXML Item where+  parseXML x = Item <$> x .@ "value"++instance ToXML Item where+  toXML (Item n) = "value" @= n
+ test/Test/Amazonka/Data/Maybe.hs view
@@ -0,0 +1,42 @@+-- |+-- Module      : Test.Amazonka.Data.Maybe+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Test.Amazonka.Data.Maybe (tests) where++import Amazonka.Data+import Amazonka.Prelude hiding (Item)+import Test.Amazonka.Util+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "maybe"+    [ testGroup+        "xml"+        [ testGroup+            "serialise"+            [ testCase "nothing" $+                wrapXML "<Key>foo</Key>"+                  @?= encodeXML (X (Item "foo" Nothing)),+              testCase "just" $+                wrapXML "<Key>bar</Key><Num>23</Num>"+                  @?= encodeXML (X (Item "bar" (Just 23)))+            ]+        ]+    ]++data Item = Item Text (Maybe Int)+  deriving stock (Eq, Show)++instance ToXML Item where+  toXML (Item x y) =+    mconcat+      [ "Key" @= x,+        "Num" @= y+      ]
+ test/Test/Amazonka/Data/Numeric.hs view
@@ -0,0 +1,164 @@+-- |+-- Module      : Test.Amazonka.Data.Numeric+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Test.Amazonka.Data.Numeric (tests) where++import Amazonka.Prelude+import Test.Amazonka.Util+import Test.Tasty++tests :: TestTree+tests =+  testGroup+    "numeric"+    [ testGroup+        "json"+        [ testGroup+            "deserialisation"+            [ testFromJSON+                "natural"+                "123"+                (123 :: Natural),+              testFromJSON+                "int"+                (toLazyBS maxInt)+                maxInt,+              testFromJSON+                "negative int"+                (toLazyBS minInt)+                minInt,+              testFromJSON+                "integer"+                "891324"+                (891324 :: Integer),+              testFromJSON+                "negative integer"+                "-998"+                (-998 :: Integer),+              testFromJSON+                "double"+                "46.39212"+                (46.39212 :: Double),+              testFromJSON+                "negative double"+                "-1.09231"+                (-1.09231 :: Double),+              testFromJSON+                "numeric text"+                "\"22\""+                ("22" :: Text)+            ],+          testGroup+            "serialisation"+            [ testToJSON+                "natural"+                "123"+                (123 :: Natural),+              testToJSON+                "int"+                (toLazyBS maxInt)+                maxInt,+              testToJSON+                "negative int"+                (toLazyBS minInt)+                minInt,+              testToJSON+                "integer"+                "891324"+                (891324 :: Integer),+              testToJSON+                "negative integer"+                "-998"+                (-998 :: Integer),+              testToJSON+                "double"+                "46.39212"+                (46.39212 :: Double),+              testToJSON+                "negative double"+                "-1.09231"+                (-1.09231 :: Double),+              testToJSON+                "numeric string"+                "\"22\""+                ("22" :: String)+            ]+        ],+      testGroup+        "xml"+        [ testGroup+            "deserialisation"+            [ testFromXML+                "natural"+                "123"+                (123 :: Natural),+              testFromXML+                "int"+                (toLazyBS maxInt)+                maxInt,+              testFromXML+                "negative int"+                (toLazyBS minInt)+                minInt,+              testFromXML+                "integer"+                "891324"+                (891324 :: Integer),+              testFromXML+                "negative integer"+                "-998"+                (-998 :: Integer),+              testFromXML+                "double"+                "46.39212"+                (46.39212 :: Double),+              testFromXML+                "negative double"+                "-1.09231"+                (-1.09231 :: Double),+              testFromXML+                "numeric string"+                "22"+                ("22" :: Text)+            ],+          testGroup+            "serialisation"+            [ testToXML+                "natural"+                "123"+                (123 :: Natural),+              testToXML+                "int"+                (toLazyBS maxInt)+                maxInt,+              testToXML+                "negative int"+                (toLazyBS minInt)+                minInt,+              testToXML+                "integer"+                "891324"+                (891324 :: Integer),+              testToXML+                "negative integer"+                "-998"+                (-998 :: Integer),+              testToXML+                "double"+                "46.39212"+                (46.39212 :: Double),+              testToXML+                "negative double"+                "-1.09231"+                (-1.09231 :: Double),+              testToXML+                "numeric text"+                "22"+                ("22" :: Text)+            ]+        ]+    ]
+ test/Test/Amazonka/Data/Path.hs view
@@ -0,0 +1,31 @@+-- |+-- Module      : Test.Amazonka.Data.Path+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Test.Amazonka.Data.Path (tests) where++import Amazonka.Data+import Amazonka.Prelude+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "path"+    [ testGroup+        "encode"+        [ testCase "doesn't append trailing slash" $+            let x = "/path/without/trailing/slash" in encode x @?= x,+          testCase "preserves trailing slash" $+            let x = "/some/path/with/trailing/slash/" in encode x @?= x,+          testCase "preserves adjacent slashes" $+            let x = "/path//with/adjacent///slahes/" in encode x @?= x+        ]+    ]++encode :: ByteString -> ByteString+encode = toBS . escapePath . rawPath
+ test/Test/Amazonka/Data/Query.hs view
@@ -0,0 +1,52 @@+-- |+-- Module      : Test.Amazonka.Query.List+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Test.Amazonka.Data.Query (tests) where++import Amazonka.Data+import Amazonka.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/Amazonka/Data/Time.hs view
@@ -0,0 +1,173 @@+-- |+-- Module      : Test.Amazonka.Data.Time+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Test.Amazonka.Data.Time (tests) where++import Amazonka.Data+import Amazonka.Prelude+import qualified Data.Time as Time+import Test.Amazonka.Util+import Test.Tasty++tests :: TestTree+tests =+  testGroup+    "time"+    [ testGroup+        "text"+        [ testGroup+            "deserialise"+            [ testFromText+                "rfc822 - UTC"+                "Fri, 07 Nov 2014 04:42:13 UTC"+                (time :: RFC822),+              testFromText+                "rfc822 - GMT"+                "Fri, 07 Nov 2014 04:42:13 GMT"+                (time :: RFC822),+              testFromText+                "rfc822 - PST"+                "Fri, 06 Nov 2014 20:42:13 PST"+                (time :: RFC822),+              testFromText+                "iso8601"+                "2014-11-07T04:42:13.000Z"+                (time :: ISO8601),+              testFromText+                "aws"+                "20141107T044213Z"+                (time :: AWSTime)+            ],+          testGroup+            "serialise"+            [ testToText+                "rfc822"+                "Fri, 07 Nov 2014 04:42:13 GMT"+                (time :: RFC822),+              testToText+                "iso8601"+                "2014-11-07T04:42:13Z"+                (time :: ISO8601),+              testToText+                "aws"+                "20141107T044213Z"+                (time :: AWSTime)+            ]+        ],+      testGroup+        "query"+        [ testGroup+            "serialise"+            [ testToQuery+                "rfc822"+                "x=Fri%2C%2007%20Nov%202014%2004%3A42%3A13%20GMT"+                (time :: RFC822),+              testToQuery+                "iso8601"+                "x=2014-11-07T04%3A42%3A13Z"+                (time :: ISO8601),+              testToQuery+                "aws"+                "x=20141107T044213Z"+                (time :: AWSTime)+            ]+        ],+      testGroup+        "xml"+        [ testGroup+            "deserialise"+            [ testFromXML+                "rfc822"+                "Fri, 07 Nov 2014 04:42:13 GMT"+                (time :: RFC822),+              testFromXML+                "iso8601"+                "2014-11-07T04:42:13.000Z"+                (time :: ISO8601),+              testFromXML+                "aws"+                "20141107T044213Z"+                (time :: AWSTime)+            ],+          testGroup+            "serialise"+            [ testToXML+                "rfc822"+                "Fri, 07 Nov 2014 04:42:13 GMT"+                (time :: RFC822),+              testToXML+                "iso8601"+                "2014-11-07T04:42:13Z"+                (time :: ISO8601),+              testToXML+                "aws"+                "20141107T044213Z"+                (time :: AWSTime)+            ]+        ],+      testGroup+        "json"+        [ testGroup+            "deserialise"+            [ testFromJSON+                "rfc822"+                (str "Fri, 07 Nov 2014 04:42:13 GMT")+                (time :: RFC822),+              testFromJSON+                "iso8601"+                (str "2014-11-07T04:42:13.000Z")+                (time :: ISO8601),+              testFromJSON+                "aws"+                (str "20141107T044213Z")+                (time :: AWSTime),+              testGroup+                "posix"+                [ testFromJSON+                    "integer"+                    "1415335333"+                    (time :: POSIX),+                  testFromJSON+                    "double"+                    "1415335333.000"+                    (time :: POSIX),+                  testFromJSON+                    "scientific"+                    "1.415335333E9"+                    (time :: POSIX)+                ]+            ],+          testGroup+            "serialise"+            [ testToJSON+                "rfc822"+                (str "Fri, 07 Nov 2014 04:42:13 GMT")+                (time :: RFC822),+              testToJSON+                "iso8601"+                (str "2014-11-07T04:42:13Z")+                (time :: ISO8601),+              testToJSON+                "aws"+                (str "20141107T044213Z")+                (time :: AWSTime),+              testToJSON+                "posix"+                "1415335333"+                (time :: POSIX)+            ]+        ]+    ]++time :: Time a+time =+  Time . fromMaybe (error msg) $+    Time.parseTimeM True Time.defaultTimeLocale fmt ts+  where+    msg = "Unable to parse time: " ++ ts+    fmt = "%FT%H:%M:%S"+    ts = "2014-11-07T04:42:13"
+ test/Test/Amazonka/Error.hs view
@@ -0,0 +1,85 @@+-- |+-- Module      : Test.Amazonka.Error+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Test.Amazonka.Error (tests) where++import Amazonka.Core+import Amazonka.Data+import Amazonka.Prelude+import Network.HTTP.Types.Status (status400, status404)+import Test.Amazonka.Arbitrary ()+import Test.QuickCheck.Property ()+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "errors"+    [ testGroup+        "getErrorCode"+        [ testCase "with header, colon" $+            getErrorCode status404 [(hAMZNErrorType, "ResourceNotFoundException")]+              @?= ErrorCode "ResourceNotFound",+          testCase "with header, no colon" $+            getErrorCode status404 [(hAMZNErrorType, "ResourceNotFoundException:http://iot.amazonaws.com/doc/2015-10-02/")]+              @?= ErrorCode "ResourceNotFound",+          testCase "no header" $+            getErrorCode status400 []+              @?= ErrorCode "Bad Request"+        ],+      testGroup+        "xml"+        [ testCase "ec2" $+            xmlError+              ec2+              "VolumeInUse"+              "vol-8c8cea98 is already attached to an instance"+              "c0ca7700-c515-4653-87e3-f1a9ce6416e8",+          testCase "route53" $+            xmlError+              route53+              "InvalidChangeBatch"+              "Tried to delete resource record set noexist.example.com. type A,but it was not found"+              "default_rid",+          testCase "sqs" $+            xmlError+              sqs+              "InvalidParameterValue"+              "Value (quename_nonalpha) for parameter QueueName is invalid. Must be an alphanumeric String of 1 to 80 in length"+              "42d59b56-7407-4c4a-be0f-4c88daeea257"+        ]+    ]++xmlError ::+  ByteStringLazy ->+  ErrorCode ->+  ErrorMessage ->+  RequestId ->+  Assertion+xmlError bs c m r = actual @?= Right expect+  where+    expect = serviceError a s h (Just c) (Just m) (Just r)+    actual =+      case parseXMLError a s h bs of+        ServiceError e -> Right e+        e -> Left $ "unexpected error: " ++ show e++    a = "Test"+    s = toEnum 400+    h = [(hAMZRequestId, "default_rid")]++-- Samples representative of differing xml errors.++ec2 :: ByteStringLazy+ec2 = "<?xml version=\"1.0\" encoding=\"UTF-8\"?><Response><Errors><Error><Code>VolumeInUse</Code><Message>vol-8c8cea98 is already attached to an instance</Message></Error></Errors><RequestID>c0ca7700-c515-4653-87e3-f1a9ce6416e8</RequestID></Response>"++route53 :: ByteStringLazy+route53 = "<InvalidChangeBatch xmlns=\"https://route53.amazonaws.com/doc/2013-04-01/\"><Messages><Message>Tried to delete resource record set noexist.example.com. type A,but it was not found</Message></Messages></InvalidChangeBatch>"++sqs :: ByteStringLazy+sqs = "<ErrorResponse><Error><Type>Sender</Type><Code>InvalidParameterValue</Code><Message>Value (quename_nonalpha) for parameter QueueName is invalid. Must be an alphanumeric String of 1 to 80 in length</Message></Error><RequestId>42d59b56-7407-4c4a-be0f-4c88daeea257</RequestId></ErrorResponse>"
+ test/Test/Amazonka/Sign/V2Header.hs view
@@ -0,0 +1,283 @@+-- |+-- Module      : Test.Amazonka.Sign.V2Header.BaseSpec+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Test.Amazonka.Sign.V2Header (tests) where++import Amazonka.Data hiding (length)+import Amazonka.Prelude+import Amazonka.Sign.V2Header+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 qualified Data.Text as Text+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 (QValue (Nothing :: Maybe ByteString)) @?= 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 (QList []) @?= QList [],+          testCase "should keep a list of Nothing QValues" $+            constructSigningQuery (QList [QValue Nothing]) @?= QList [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 (QValue Nothing) @?= "",+          testCase "should convert an empty value of QPair to just the key" $+            toSignerQueryBS (QPair "key" (QValue Nothing)) @?= "key",+          testCase "should convert an empty value of QPair followed by QValue to just the key and just the value" $+            toSignerQueryBS+              (QList [QPair "key" (QValue Nothing), 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 (QPair "key" (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+      == QValue (Nothing :: Maybe ByteString)++-- Generators / properties for uninteresting query pairs++prop_UninterestingQPairs :: Property+prop_UninterestingQPairs =+  QC.forAll uninterestingQPairs $ \qpair ->+    constructSigningQuery qpair == QValue Nothing++uninterestingQPairs :: Gen QueryString+uninterestingQPairs =+  toQuery <$> ((,) <$> nonEmptyText <*> uninterestingQValues)++-- Generators / properties for interesting query pairs++prop_InterestingQPairs :: Property+prop_InterestingQPairs =+  QC.forAll interestingQPairs $ \qpair ->+    constructSigningQuery qpair /= 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 QueryString+interestingQPairs =+  toQuery <$> ((,) <$> interestingQueryKey <*> uninterestingQValues)++-- Generators / properties for query lists++prop_UninterestingQLists :: Property+prop_UninterestingQLists =+  QC.forAll uninterestingQLists $+    not . containsAnything . constructSigningQuery++uninterestingQLists :: Gen QueryString+uninterestingQLists =+  toQueryList+    <$> nonEmptyByteString+    <*> QC.listOf+      ( QC.frequency+          [ (1, uninterestingQPairs),+            (1, uninterestingQValues),+            (1, uninterestingQLists)+          ]+      )++containsAnything :: QueryString -> Bool+containsAnything = \case+  QValue v -> isJust v+  QPair {} -> True+  QList qs -> any containsAnything qs++interestingQLists :: Gen QueryString+interestingQLists =+  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 $ \hs ->+    constructSigningHeader hs == snd hs++prop_InterestingHeaders :: Property+prop_InterestingHeaders =+  QC.forAll interestingHeaderGenerator $ \hs ->+    constructSigningHeader hs == snd hs++prop_InterestingAwsHeaders :: Property+prop_InterestingAwsHeaders =+  QC.forAll interestingAwsHeaderGenerator $ \hs ->+    constructSigningHeader hs+      == (CI.foldedCase (fst hs) <> ":" <> snd hs)++-- 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 headers == length sortedHeaders && allIncreasing sortedHeaders+  where+    sortedHeaders = List.sort headers++-- Generators for Text / QueryValues++nonEmptyByteString :: Gen ByteString+nonEmptyByteString = BS8.pack <$> nonEmptyString++uninterestingQValues :: Gen QueryString+uninterestingQValues = toQuery <$> nonEmptyText++nonEmptyText :: Gen Text.Text+nonEmptyText = Text.pack <$> nonEmptyString++nonEmptyString :: Gen String+nonEmptyString = QC.listOf1 QC.arbitrary
+ test/Test/Amazonka/Sign/V4.hs view
@@ -0,0 +1,36 @@+-- |+-- Module      : Test.Amazonka.Sign.V$+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Test.Amazonka.Sign.V4 (tests) where++import qualified Test.Amazonka.Sign.V4.Base as Base+import qualified Test.Amazonka.Sign.V4.Chunked as Chunked+import Test.Tasty (TestTree, testGroup)++-- Write some V4 signing properties:+--  test canonical query+--  test query+--  test canonical headers+--  test signed headers+--  test time format+--  test host, x-amz-date, content-sha256 headers exist+--  test empty path+--  test empty query++tests :: TestTree+tests =+  testGroup+    "v4"+    [ testGroup+        "base"+        [ Base.tests+        ],+      testGroup+        "chunked"+        [ Chunked.tests+        ]+    ]
+ test/Test/Amazonka/Sign/V4/Base.hs view
@@ -0,0 +1,190 @@+-- |+-- Module      : Test.AWS.Sign.V4+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Test.Amazonka.Sign.V4.Base where++import Amazonka.Core+import Amazonka.Data+import Amazonka.Prelude+import Amazonka.Sign.V4+import Amazonka.Sign.V4.Base as Base+import qualified Data.Foldable as Fold+import Test.Amazonka.Arbitrary ()+import qualified Test.QuickCheck as QC+import Test.QuickCheck.Property ()+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++tests :: TestTree+tests =+  testGroup+    "paths"+    [ testProperty "request paths are escaped once" testRequestPathsEscapedOnce,+      testProperty "S3 canonical paths are escaped once" testS3CanonicalPathsEscapedOnce,+      testProperty "non-S3 canonical paths are escaped twice" testNonS3CanonicalPathsEscapedTwice,+      testCase "empty path" testEmptyPath,+      testCase "base path" testBasePath,+      testCase "S3 canonical path encoding example" testS3CanonicalPathExample,+      testCase "non-S3 canonical path encoding example" testNonS3CanonicalPathExample,+      testCase "S3 canonical path is not normalized" testS3ShouldNotNormalize,+      testCase "non-S3 canonical path is normalized" testNonS3ShouldNormalize+    ]++testRequestPathsEscapedOnce :: Property+testRequestPathsEscapedOnce = QC.forAll (mkV4Paths args) $ \(raw, reqPath, _) ->+  untag reqPath == toBS (escapePath raw)+  where+    args =+      V4PathArgs+        { genAbbrev = arbitrary,+          genBasePath = mkNormalizedPath,+          genPath = mkNormalizedPath+        }++testS3CanonicalPathsEscapedOnce :: Property+testS3CanonicalPathsEscapedOnce = QC.forAll (mkV4Paths args) $ \(_, reqPath, canonicalPath') ->+  untag reqPath == untag canonicalPath'+  where+    args =+      V4PathArgs+        { genAbbrev = pure "S3",+          genBasePath = mkNormalizedPath,+          genPath = mkNormalizedPath+        }++testNonS3CanonicalPathsEscapedTwice :: Property+testNonS3CanonicalPathsEscapedTwice = QC.forAll (mkV4Paths args) $ \(raw, _, canonicalPath') ->+  untag canonicalPath' == toBS (escapePathTwice raw)+  where+    args =+      V4PathArgs+        { genAbbrev = mkNonS3Service,+          genBasePath = mkNormalizedPath,+          genPath = mkNormalizedPath+        }++testEmptyPath :: Assertion+testEmptyPath = do+  (_, reqPath, canonicalPath') <-+    generate . mkV4Paths $+      V4PathArgs+        { genAbbrev = arbitrary,+          genBasePath = pure mempty,+          genPath = pure mempty+        }+  toBS reqPath @?= "/"+  toBS canonicalPath' @?= "/"++testBasePath :: Assertion+testBasePath = do+  basePath <- generate arbitrary+  path <- generate arbitrary+  (_, reqPath, _) <-+    generate . mkV4Paths $+      V4PathArgs+        { genAbbrev = arbitrary,+          genBasePath = pure basePath,+          genPath = pure path+        }+  toBS reqPath @?= toBS (escapePath $ basePath <> path)++testNonS3CanonicalPathExample :: Assertion+testNonS3CanonicalPathExample = do+  let example = Raw ["documents and settings"]++  (_, reqPath, canonicalPath') <-+    generate . mkV4Paths $+      V4PathArgs+        { genAbbrev = mkNonS3Service,+          genBasePath = pure mempty,+          genPath = pure example+        }+  toBS reqPath @?= "/documents%20and%20settings"+  toBS canonicalPath' @?= "/documents%2520and%2520settings"++testS3CanonicalPathExample :: Assertion+testS3CanonicalPathExample = do+  let example = Raw ["documents and settings"]++  (_, reqPath, canonicalPath') <-+    generate . mkV4Paths $+      V4PathArgs+        { genAbbrev = pure "S3",+          genBasePath = pure mempty,+          genPath = pure example+        }+  toBS reqPath @?= "/documents%20and%20settings"+  untag canonicalPath' @?= untag reqPath++testS3ShouldNotNormalize :: Assertion+testS3ShouldNotNormalize = do+  let key = Raw ["foo", "..", "bar", ".", "baz", "."]++  (_, reqPath, canonicalPath') <-+    generate . mkV4Paths $+      V4PathArgs+        { genAbbrev = pure "S3",+          genBasePath = pure mempty,+          genPath = pure key+        }+  toBS reqPath @?= "/foo/../bar/./baz/."+  untag canonicalPath' @?= untag reqPath++testNonS3ShouldNormalize :: Assertion+testNonS3ShouldNormalize = do+  let key = Raw ["foo", "..", "bar", ".", "baz", "."]++  (_, reqPath, canonicalPath') <-+    generate . mkV4Paths $+      V4PathArgs+        { genAbbrev = mkNonS3Service,+          genBasePath = pure mempty,+          genPath = pure key+        }+  toBS reqPath @?= "/bar/baz"+  untag canonicalPath' @?= untag reqPath++data V4PathArgs = V4PathArgs+  { genAbbrev :: Gen Abbrev,+    genBasePath :: Gen RawPath,+    genPath :: Gen RawPath+  }++mkV4Paths :: V4PathArgs -> Gen (RawPath, Base.Path, CanonicalPath)+mkV4Paths V4PathArgs {..} = do+  aReq <- arbitrary :: Gen (Request ())+  aBasePath <- genBasePath+  aPath <- genPath+  aService@Service {endpoint} <- arbitrary+  anAbbrev <- genAbbrev+  aBody <- toHashed <$> (arbitrary :: Gen ByteString)++  let reg = NorthVirginia+      end = endpoint reg+      svc =+        aService+          { signer = v4,+            abbrev = anAbbrev,+            endpoint = const $ end {basePath = aBasePath}+          }+      req =+        aReq+          { path = aPath,+            service = svc,+            body = Hashed aBody+          }++  pure (fullRawPath reg req, escapedPath reg req, canonicalPath reg req)++mkNormalizedPath :: Gen RawPath+mkNormalizedPath = arbitrary `suchThat` noDots+  where+    noDots (Raw xs :: RawPath) = isNothing $ Fold.find (\x -> x == "." || x == "..") xs++mkNonS3Service :: Gen Abbrev+mkNonS3Service = arbitrary `suchThat` (/= "S3")
+ test/Test/Amazonka/Sign/V4/Chunked.hs view
@@ -0,0 +1,83 @@+-- |+-- Module      : Test.Amazonka.Sign.V$+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Test.Amazonka.Sign.V4.Chunked (tests) where++import Amazonka.Core hiding (length)+import Amazonka.Prelude hiding (elem)+import Amazonka.Sign.V4+import qualified Data.ByteString.Char8 as BS8+import qualified Data.Conduit.List as Conduit+import qualified Data.Foldable as Fold+import qualified Network.HTTP.Conduit as Client+import Numeric (showHex)+import Test.Amazonka.Arbitrary ()+import qualified Test.QuickCheck as QC+import Test.QuickCheck.Property ()+import Test.Tasty+import Test.Tasty.QuickCheck++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 signedRequest)+     in 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 signedRequest)+         in 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 signedRequest)+         in 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 :: Gen (Request ())+  aService <- arbitrary++  let svc = aService {signer = v4}++      req =+        aReq+          { body = Chunked (mkBody bs),+            service = svc+          }++  requestSign req <$> arbitrary <*> arbitrary <*> arbitrary++mkBody :: [BS8.ByteString] -> ChunkedBody+mkBody bs =+  ChunkedBody+    defaultChunkSize+    (fromIntegral . sum $ fmap BS8.length bs)+    (Conduit.sourceList bs)
+ test/Test/Amazonka/Util.hs view
@@ -0,0 +1,121 @@+-- |+-- Module      : Test.Amazonka.Util+-- Copyright   : (c) 2013-2023 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Test.Amazonka.Util where++import Amazonka.Data+import Amazonka.Prelude+import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Lazy as LBS+import Language.Haskell.TH+import Language.Haskell.TH.Quote+import Test.Tasty+import Test.Tasty.HUnit++doc :: QuasiQuoter+doc =+  QuasiQuoter+    { quoteExp = stringE,+      quotePat = const $ error "No quotePat  defined.",+      quoteType = const $ error "No quoteType defined.",+      quoteDec = const $ error "No quoteDec  defined."+    }++-- | Dummy root element for testing nested structures.+newtype X a = X a+  deriving stock (Eq, Show)++instance ToQuery a => ToQuery (X a) where+  toQuery (X x) = "x" =: x++instance FromXML a => FromXML (X a) where+  parseXML = fmap X . parseXML++instance ToXML a => ToElement (X a) where+  toElement (X x) = mkElement "x" x++instance FromJSON a => FromJSON (X a) where+  parseJSON = withObject "X" (fmap X . (.: "x"))++instance ToJSON a => ToJSON (X a) where+  toJSON (X x) = object ["x" .= x]++testFromText ::+  (FromText a, Show a, Eq a) =>+  TestName ->+  Text ->+  a ->+  TestTree+testFromText n t x = testCase n (Right x @?= fromText t)++testToText ::+  (ToText a, Show a, Eq a) =>+  TestName ->+  Text ->+  a ->+  TestTree+testToText n t x = testCase n (t @?= toText x)++testToQuery ::+  (ToQuery a, Show a, Eq a) =>+  TestName ->+  ByteString ->+  a ->+  TestTree+testToQuery n bs x = testCase n (bs @=? toBS (toQuery (X x)))++testFromXML ::+  (FromXML a, Show a, Eq a) =>+  TestName ->+  ByteStringLazy ->+  a ->+  TestTree+testFromXML n bs x =+  testCase n $+    Right (X x) @?= (decodeXML (wrapXML bs) >>= parseXML)++testToXML ::+  (ToXML a, Show a, Eq a) =>+  TestName ->+  ByteStringLazy ->+  a ->+  TestTree+testToXML n bs x = testCase n $ wrapXML bs @?= encodeXML (X x)++testFromJSON ::+  (FromJSON a, Show a, Eq a) =>+  TestName ->+  ByteStringLazy ->+  a ->+  TestTree+testFromJSON n bs x =+  testCase n $+    Right (X x) @?= eitherDecode' ("{\"x\":" <> bs <> "}")++testToJSON ::+  (ToJSON a, Show a, Eq a) =>+  TestName ->+  ByteStringLazy ->+  a ->+  TestTree+testToJSON n bs x = testCase n (bs @?= Aeson.encode x)++str :: ByteStringLazy -> ByteStringLazy+str bs = "\"" <> bs <> "\""++wrapXML :: ByteStringLazy -> ByteStringLazy+wrapXML bs =+  "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" <> "<x>" <> bs <> "</x>"++maxInt :: Int+maxInt = maxBound++minInt :: Int+minInt = minBound++toLazyBS :: ToByteString a => a -> ByteStringLazy+toLazyBS = LBS.fromStrict . toBS