    {-# LANGUAGE CPP, BangPatterns #-}
    module Aws.S3.Core where

    import           Aws.Core
    import           Control.Arrow                  (first, (***))
    import           Control.Monad
    import           Control.Monad.IO.Class
    import           Control.Monad.Trans.Resource   (MonadThrow, throwM)
    import           Data.Char                      (isAscii, isAlphaNum, toUpper, ord)
    import           Data.Conduit                   ((.|))
    import           Data.Function
    import           Data.Functor
    import           Data.IORef
    import           Data.List
    import           Data.Maybe
    import           Data.Monoid
    import qualified Data.Semigroup                 as Sem
    import           Control.Applicative            ((<|>))
    import           Data.Time
    import           Data.Typeable
    import           Numeric                        (showHex)
    #if !MIN_VERSION_time(1,5,0)
    import           System.Locale
    #endif
    import           Text.XML.Cursor                (($/), (&|))
    import qualified Data.Attoparsec.ByteString     as Atto
    import qualified Blaze.ByteString.Builder       as Blaze
    import qualified Blaze.ByteString.Builder.Char8 as Blaze8
    import qualified Control.Exception              as C
    import qualified Crypto.Hash                    as CH
    import qualified Data.ByteArray                 as ByteArray
    import qualified Data.ByteString                as B
    import qualified Data.ByteString.Char8          as B8
    import qualified Data.ByteString.Base16         as Base16
    import qualified Data.ByteString.Base64         as Base64
    import qualified Data.CaseInsensitive           as CI
    import qualified Data.Conduit                   as C
    import qualified Data.Map                       as Map
    import qualified Data.Text                      as T
    import qualified Data.Text.Encoding             as T
    import qualified Network.HTTP.Conduit           as HTTP
    import qualified Network.HTTP.Types             as HTTP
    import qualified Text.XML                       as XML
    import qualified Text.XML.Cursor                as Cu
    import           Prelude

    data S3Authorization
        = S3AuthorizationHeader
        | S3AuthorizationQuery
        deriving (Int -> S3Authorization -> ShowS
    [S3Authorization] -> ShowS
    S3Authorization -> String
    (Int -> S3Authorization -> ShowS)
    -> (S3Authorization -> String)
    -> ([S3Authorization] -> ShowS)
    -> Show S3Authorization
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> S3Authorization -> ShowS
    showsPrec :: Int -> S3Authorization -> ShowS
    $cshow :: S3Authorization -> String
    show :: S3Authorization -> String
    $cshowList :: [S3Authorization] -> ShowS
    showList :: [S3Authorization] -> ShowS
    Show)

    data RequestStyle
        = PathStyle -- ^ Requires correctly setting region endpoint, but allows non-DNS compliant bucket names in the US standard region.
        | BucketStyle -- ^ Bucket name must be DNS compliant.
        | VHostStyle
        deriving (Int -> RequestStyle -> ShowS
    [RequestStyle] -> ShowS
    RequestStyle -> String
    (Int -> RequestStyle -> ShowS)
    -> (RequestStyle -> String)
    -> ([RequestStyle] -> ShowS)
    -> Show RequestStyle
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> RequestStyle -> ShowS
    showsPrec :: Int -> RequestStyle -> ShowS
    $cshow :: RequestStyle -> String
    show :: RequestStyle -> String
    $cshowList :: [RequestStyle] -> ShowS
    showList :: [RequestStyle] -> ShowS
    Show)

    data S3SignPayloadMode
        = AlwaysUnsigned -- ^ Always use the "UNSIGNED-PAYLOAD" option.
        | SignWithEffort -- ^ Sign the payload when 'HTTP.RequestBody' is a on-memory one ('HTTP.RequestBodyLBS' or 'HTTP.RequestBodyBS'). Otherwise use the "UNSINGED-PAYLOAD" option.
        | AlwaysSigned   -- ^ Always sign the payload. Note: 'error' called when 'HTTP.RequestBody' is a streaming one.
        deriving (S3SignPayloadMode -> S3SignPayloadMode -> Bool
    (S3SignPayloadMode -> S3SignPayloadMode -> Bool)
    -> (S3SignPayloadMode -> S3SignPayloadMode -> Bool)
    -> Eq S3SignPayloadMode
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: S3SignPayloadMode -> S3SignPayloadMode -> Bool
    == :: S3SignPayloadMode -> S3SignPayloadMode -> Bool
    $c/= :: S3SignPayloadMode -> S3SignPayloadMode -> Bool
    /= :: S3SignPayloadMode -> S3SignPayloadMode -> Bool
    Eq, Int -> S3SignPayloadMode -> ShowS
    [S3SignPayloadMode] -> ShowS
    S3SignPayloadMode -> String
    (Int -> S3SignPayloadMode -> ShowS)
    -> (S3SignPayloadMode -> String)
    -> ([S3SignPayloadMode] -> ShowS)
    -> Show S3SignPayloadMode
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> S3SignPayloadMode -> ShowS
    showsPrec :: Int -> S3SignPayloadMode -> ShowS
    $cshow :: S3SignPayloadMode -> String
    show :: S3SignPayloadMode -> String
    $cshowList :: [S3SignPayloadMode] -> ShowS
    showList :: [S3SignPayloadMode] -> ShowS
    Show, ReadPrec [S3SignPayloadMode]
    ReadPrec S3SignPayloadMode
    Int -> ReadS S3SignPayloadMode
    ReadS [S3SignPayloadMode]
    (Int -> ReadS S3SignPayloadMode)
    -> ReadS [S3SignPayloadMode]
    -> ReadPrec S3SignPayloadMode
    -> ReadPrec [S3SignPayloadMode]
    -> Read S3SignPayloadMode
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS S3SignPayloadMode
    readsPrec :: Int -> ReadS S3SignPayloadMode
    $creadList :: ReadS [S3SignPayloadMode]
    readList :: ReadS [S3SignPayloadMode]
    $creadPrec :: ReadPrec S3SignPayloadMode
    readPrec :: ReadPrec S3SignPayloadMode
    $creadListPrec :: ReadPrec [S3SignPayloadMode]
    readListPrec :: ReadPrec [S3SignPayloadMode]
    Read, Typeable)

    data S3SignVersion
        = S3SignV2
        | S3SignV4 { S3SignVersion -> S3SignPayloadMode
    _s3SignPayloadMode :: S3SignPayloadMode }
        deriving (S3SignVersion -> S3SignVersion -> Bool
    (S3SignVersion -> S3SignVersion -> Bool)
    -> (S3SignVersion -> S3SignVersion -> Bool) -> Eq S3SignVersion
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: S3SignVersion -> S3SignVersion -> Bool
    == :: S3SignVersion -> S3SignVersion -> Bool
    $c/= :: S3SignVersion -> S3SignVersion -> Bool
    /= :: S3SignVersion -> S3SignVersion -> Bool
    Eq, Int -> S3SignVersion -> ShowS
    [S3SignVersion] -> ShowS
    S3SignVersion -> String
    (Int -> S3SignVersion -> ShowS)
    -> (S3SignVersion -> String)
    -> ([S3SignVersion] -> ShowS)
    -> Show S3SignVersion
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> S3SignVersion -> ShowS
    showsPrec :: Int -> S3SignVersion -> ShowS
    $cshow :: S3SignVersion -> String
    show :: S3SignVersion -> String
    $cshowList :: [S3SignVersion] -> ShowS
    showList :: [S3SignVersion] -> ShowS
    Show, ReadPrec [S3SignVersion]
    ReadPrec S3SignVersion
    Int -> ReadS S3SignVersion
    ReadS [S3SignVersion]
    (Int -> ReadS S3SignVersion)
    -> ReadS [S3SignVersion]
    -> ReadPrec S3SignVersion
    -> ReadPrec [S3SignVersion]
    -> Read S3SignVersion
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS S3SignVersion
    readsPrec :: Int -> ReadS S3SignVersion
    $creadList :: ReadS [S3SignVersion]
    readList :: ReadS [S3SignVersion]
    $creadPrec :: ReadPrec S3SignVersion
    readPrec :: ReadPrec S3SignVersion
    $creadListPrec :: ReadPrec [S3SignVersion]
    readListPrec :: ReadPrec [S3SignVersion]
    Read, Typeable)

    data S3Configuration qt
        = S3Configuration
           { forall qt. S3Configuration qt -> Protocol
    s3Protocol :: Protocol
           , forall qt. S3Configuration qt -> ByteString
    s3Endpoint :: B.ByteString
           , forall qt. S3Configuration qt -> Maybe ByteString
    s3Region :: Maybe B.ByteString
           , forall qt. S3Configuration qt -> RequestStyle
    s3RequestStyle :: RequestStyle
           , forall qt. S3Configuration qt -> Int
    s3Port :: Int
           , forall qt. S3Configuration qt -> Maybe ServerSideEncryption
    s3ServerSideEncryption :: Maybe ServerSideEncryption
           , forall qt. S3Configuration qt -> Bool
    s3UseUri :: Bool
           , forall qt. S3Configuration qt -> NominalDiffTime
    s3DefaultExpiry :: NominalDiffTime
           , forall qt. S3Configuration qt -> S3SignVersion
    s3SignVersion :: S3SignVersion
           , forall qt. S3Configuration qt -> Maybe LocationConstraint
    s3UserAgent :: Maybe T.Text
           }
        deriving (Int -> S3Configuration qt -> ShowS
    [S3Configuration qt] -> ShowS
    S3Configuration qt -> String
    (Int -> S3Configuration qt -> ShowS)
    -> (S3Configuration qt -> String)
    -> ([S3Configuration qt] -> ShowS)
    -> Show (S3Configuration qt)
    forall qt. Int -> S3Configuration qt -> ShowS
    forall qt. [S3Configuration qt] -> ShowS
    forall qt. S3Configuration qt -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall qt. Int -> S3Configuration qt -> ShowS
    showsPrec :: Int -> S3Configuration qt -> ShowS
    $cshow :: forall qt. S3Configuration qt -> String
    show :: S3Configuration qt -> String
    $cshowList :: forall qt. [S3Configuration qt] -> ShowS
    showList :: [S3Configuration qt] -> ShowS
    Show)

    instance DefaultServiceConfiguration (S3Configuration NormalQuery) where
      defServiceConfig :: S3Configuration NormalQuery
    defServiceConfig = Protocol -> ByteString -> Bool -> S3Configuration NormalQuery
    forall qt. Protocol -> ByteString -> Bool -> S3Configuration qt
    s3 Protocol
    HTTPS ByteString
    s3EndpointUsClassic Bool
    False

      debugServiceConfig :: S3Configuration NormalQuery
    debugServiceConfig = Protocol -> ByteString -> Bool -> S3Configuration NormalQuery
    forall qt. Protocol -> ByteString -> Bool -> S3Configuration qt
    s3 Protocol
    HTTP ByteString
    s3EndpointUsClassic Bool
    False

    instance DefaultServiceConfiguration (S3Configuration UriOnlyQuery) where
      defServiceConfig :: S3Configuration UriOnlyQuery
    defServiceConfig = Protocol -> ByteString -> Bool -> S3Configuration UriOnlyQuery
    forall qt. Protocol -> ByteString -> Bool -> S3Configuration qt
    s3 Protocol
    HTTPS ByteString
    s3EndpointUsClassic Bool
    True
      debugServiceConfig :: S3Configuration UriOnlyQuery
    debugServiceConfig = Protocol -> ByteString -> Bool -> S3Configuration UriOnlyQuery
    forall qt. Protocol -> ByteString -> Bool -> S3Configuration qt
    s3 Protocol
    HTTP ByteString
    s3EndpointUsClassic Bool
    True

    s3EndpointUsClassic :: B.ByteString
    s3EndpointUsClassic :: ByteString
    s3EndpointUsClassic = ByteString
    "s3.amazonaws.com"

    s3EndpointUsWest :: B.ByteString
    s3EndpointUsWest :: ByteString
    s3EndpointUsWest = ByteString
    "s3-us-west-1.amazonaws.com"

    s3EndpointUsWest2 :: B.ByteString
    s3EndpointUsWest2 :: ByteString
    s3EndpointUsWest2 = ByteString
    "s3-us-west-2.amazonaws.com"

    s3EndpointEu :: B.ByteString
    s3EndpointEu :: ByteString
    s3EndpointEu = ByteString
    "s3-eu-west-1.amazonaws.com"

    s3EndpointEuWest2 :: B.ByteString
    s3EndpointEuWest2 :: ByteString
    s3EndpointEuWest2 = ByteString
    "s3-eu-west-2.amazonaws.com"

    s3EndpointApSouthEast :: B.ByteString
    s3EndpointApSouthEast :: ByteString
    s3EndpointApSouthEast = ByteString
    "s3-ap-southeast-1.amazonaws.com"

    s3EndpointApSouthEast2 :: B.ByteString
    s3EndpointApSouthEast2 :: ByteString
    s3EndpointApSouthEast2 = ByteString
    "s3-ap-southeast-2.amazonaws.com"

    s3EndpointApNorthEast :: B.ByteString
    s3EndpointApNorthEast :: ByteString
    s3EndpointApNorthEast = ByteString
    "s3-ap-northeast-1.amazonaws.com"

    s3 :: Protocol -> B.ByteString -> Bool -> S3Configuration qt
    s3 :: forall qt. Protocol -> ByteString -> Bool -> S3Configuration qt
    s3 Protocol
    protocol ByteString
    endpoint Bool
    uri
        = S3Configuration
           { s3Protocol :: Protocol
    s3Protocol = Protocol
    protocol
           , s3Endpoint :: ByteString
    s3Endpoint = ByteString
    endpoint
           , s3Region :: Maybe ByteString
    s3Region = Maybe ByteString
    forall a. Maybe a
    Nothing
           , s3RequestStyle :: RequestStyle
    s3RequestStyle = RequestStyle
    BucketStyle
           , s3Port :: Int
    s3Port = Protocol -> Int
    defaultPort Protocol
    protocol
           , s3ServerSideEncryption :: Maybe ServerSideEncryption
    s3ServerSideEncryption = Maybe ServerSideEncryption
    forall a. Maybe a
    Nothing
           , s3UseUri :: Bool
    s3UseUri = Bool
    uri
           , s3DefaultExpiry :: NominalDiffTime
    s3DefaultExpiry = NominalDiffTime
    15NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    *NominalDiffTime
    60
           , s3SignVersion :: S3SignVersion
    s3SignVersion = S3SignVersion
    S3SignV2
           , s3UserAgent :: Maybe LocationConstraint
    s3UserAgent = Maybe LocationConstraint
    forall a. Maybe a
    Nothing
           }

    s3v4 :: Protocol -> B.ByteString -> Bool -> S3SignPayloadMode -> S3Configuration qt
    s3v4 :: forall qt.
    Protocol
    -> ByteString -> Bool -> S3SignPayloadMode -> S3Configuration qt
    s3v4 Protocol
    protocol ByteString
    endpoint Bool
    uri S3SignPayloadMode
    payload
        = S3Configuration
           { s3Protocol :: Protocol
    s3Protocol = Protocol
    protocol
           , s3Endpoint :: ByteString
    s3Endpoint = ByteString
    endpoint
           , s3Region :: Maybe ByteString
    s3Region = Maybe ByteString
    forall a. Maybe a
    Nothing
           , s3RequestStyle :: RequestStyle
    s3RequestStyle = RequestStyle
    BucketStyle
           , s3Port :: Int
    s3Port = Protocol -> Int
    defaultPort Protocol
    protocol
           , s3ServerSideEncryption :: Maybe ServerSideEncryption
    s3ServerSideEncryption = Maybe ServerSideEncryption
    forall a. Maybe a
    Nothing
           , s3UseUri :: Bool
    s3UseUri = Bool
    uri
           , s3DefaultExpiry :: NominalDiffTime
    s3DefaultExpiry = NominalDiffTime
    15NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    *NominalDiffTime
    60
           , s3SignVersion :: S3SignVersion
    s3SignVersion = S3SignPayloadMode -> S3SignVersion
    S3SignV4 S3SignPayloadMode
    payload
           , s3UserAgent :: Maybe LocationConstraint
    s3UserAgent = Maybe LocationConstraint
    forall a. Maybe a
    Nothing
           }

    type ErrorCode = T.Text

    data S3Error
        = S3Error {
            S3Error -> Status
    s3StatusCode :: HTTP.Status
          , S3Error -> LocationConstraint
    s3ErrorCode :: ErrorCode -- Error/Code
          , S3Error -> LocationConstraint
    s3ErrorMessage :: T.Text -- Error/Message
          , S3Error -> Maybe LocationConstraint
    s3ErrorResource :: Maybe T.Text -- Error/Resource
          , S3Error -> Maybe LocationConstraint
    s3ErrorHostId :: Maybe T.Text -- Error/HostId
          , S3Error -> Maybe LocationConstraint
    s3ErrorAccessKeyId :: Maybe T.Text -- Error/AWSAccessKeyId
          , S3Error -> Maybe ByteString
    s3ErrorStringToSign :: Maybe B.ByteString -- Error/StringToSignBytes (hexadecimal encoding)
          , S3Error -> Maybe LocationConstraint
    s3ErrorBucket :: Maybe T.Text -- Error/Bucket
          , S3Error -> Maybe LocationConstraint
    s3ErrorEndpointRaw :: Maybe T.Text -- Error/Endpoint (i.e. correct bucket location)
          , S3Error -> Maybe ByteString
    s3ErrorEndpoint :: Maybe B.ByteString -- Error/Endpoint without the bucket prefix
          }
        deriving (Int -> S3Error -> ShowS
    [S3Error] -> ShowS
    S3Error -> String
    (Int -> S3Error -> ShowS)
    -> (S3Error -> String) -> ([S3Error] -> ShowS) -> Show S3Error
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> S3Error -> ShowS
    showsPrec :: Int -> S3Error -> ShowS
    $cshow :: S3Error -> String
    show :: S3Error -> String
    $cshowList :: [S3Error] -> ShowS
    showList :: [S3Error] -> ShowS
    Show, Typeable)

    instance C.Exception S3Error

    data S3Metadata
        = S3Metadata {
            S3Metadata -> Maybe LocationConstraint
    s3MAmzId2 :: Maybe T.Text
          , S3Metadata -> Maybe LocationConstraint
    s3MRequestId :: Maybe T.Text
          }
        deriving (Int -> S3Metadata -> ShowS
    [S3Metadata] -> ShowS
    S3Metadata -> String
    (Int -> S3Metadata -> ShowS)
    -> (S3Metadata -> String)
    -> ([S3Metadata] -> ShowS)
    -> Show S3Metadata
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> S3Metadata -> ShowS
    showsPrec :: Int -> S3Metadata -> ShowS
    $cshow :: S3Metadata -> String
    show :: S3Metadata -> String
    $cshowList :: [S3Metadata] -> ShowS
    showList :: [S3Metadata] -> ShowS
    Show, Typeable)

    instance Sem.Semigroup S3Metadata where
        S3Metadata Maybe LocationConstraint
    a1 Maybe LocationConstraint
    r1 <> :: S3Metadata -> S3Metadata -> S3Metadata
    <> S3Metadata Maybe LocationConstraint
    a2 Maybe LocationConstraint
    r2 = Maybe LocationConstraint -> Maybe LocationConstraint -> S3Metadata
    S3Metadata (Maybe LocationConstraint
    a1 Maybe LocationConstraint
    -> Maybe LocationConstraint -> Maybe LocationConstraint
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Maybe LocationConstraint
    a2) (Maybe LocationConstraint
    r1 Maybe LocationConstraint
    -> Maybe LocationConstraint -> Maybe LocationConstraint
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Maybe LocationConstraint
    r2)

    instance Monoid S3Metadata where
        mempty :: S3Metadata
    mempty = Maybe LocationConstraint -> Maybe LocationConstraint -> S3Metadata
    S3Metadata Maybe LocationConstraint
    forall a. Maybe a
    Nothing Maybe LocationConstraint
    forall a. Maybe a
    Nothing
        mappend :: S3Metadata -> S3Metadata -> S3Metadata
    mappend = S3Metadata -> S3Metadata -> S3Metadata
    forall a. Semigroup a => a -> a -> a
    (Sem.<>)

    instance Loggable S3Metadata where
        toLogText :: S3Metadata -> LocationConstraint
    toLogText (S3Metadata Maybe LocationConstraint
    id2 Maybe LocationConstraint
    rid) = LocationConstraint
    "S3: request ID=" LocationConstraint -> LocationConstraint -> LocationConstraint
    forall a. Monoid a => a -> a -> a
    `mappend`
                                         LocationConstraint
    -> Maybe LocationConstraint -> LocationConstraint
    forall a. a -> Maybe a -> a
    fromMaybe LocationConstraint
    "<none>" Maybe LocationConstraint
    rid LocationConstraint -> LocationConstraint -> LocationConstraint
    forall a. Monoid a => a -> a -> a
    `mappend`
                                         LocationConstraint
    ", x-amz-id-2=" LocationConstraint -> LocationConstraint -> LocationConstraint
    forall a. Monoid a => a -> a -> a
    `mappend`
                                         LocationConstraint
    -> Maybe LocationConstraint -> LocationConstraint
    forall a. a -> Maybe a -> a
    fromMaybe LocationConstraint
    "<none>" Maybe LocationConstraint
    id2

    data S3Query
        = S3Query {
            S3Query -> Method
    s3QMethod :: Method
          , S3Query -> Maybe ByteString
    s3QBucket :: Maybe B.ByteString
          , S3Query -> Maybe ByteString
    s3QObject :: Maybe B.ByteString
          , S3Query -> Query
    s3QSubresources :: HTTP.Query
          , S3Query -> Query
    s3QQuery :: HTTP.Query
          , S3Query -> Maybe ByteString
    s3QContentType :: Maybe B.ByteString
          , S3Query -> Maybe (Digest MD5)
    s3QContentMd5 :: Maybe (CH.Digest CH.MD5)
          , S3Query -> RequestHeaders
    s3QAmzHeaders :: HTTP.RequestHeaders
          , S3Query -> RequestHeaders
    s3QOtherHeaders :: HTTP.RequestHeaders
          , S3Query -> Maybe RequestBody
    s3QRequestBody :: Maybe HTTP.RequestBody
          }

    instance Show S3Query where
        show :: S3Query -> String
    show S3Query{Query
    RequestHeaders
    Maybe ByteString
    Maybe (Digest MD5)
    Maybe RequestBody
    Method
    s3QMethod :: S3Query -> Method
    s3QBucket :: S3Query -> Maybe ByteString
    s3QObject :: S3Query -> Maybe ByteString
    s3QSubresources :: S3Query -> Query
    s3QQuery :: S3Query -> Query
    s3QContentType :: S3Query -> Maybe ByteString
    s3QContentMd5 :: S3Query -> Maybe (Digest MD5)
    s3QAmzHeaders :: S3Query -> RequestHeaders
    s3QOtherHeaders :: S3Query -> RequestHeaders
    s3QRequestBody :: S3Query -> Maybe RequestBody
    s3QMethod :: Method
    s3QBucket :: Maybe ByteString
    s3QObject :: Maybe ByteString
    s3QSubresources :: Query
    s3QQuery :: Query
    s3QContentType :: Maybe ByteString
    s3QContentMd5 :: Maybe (Digest MD5)
    s3QAmzHeaders :: RequestHeaders
    s3QOtherHeaders :: RequestHeaders
    s3QRequestBody :: Maybe RequestBody
    ..} = String
    "S3Query [" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                           String
    " method: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Method -> String
    forall a. Show a => a -> String
    show Method
    s3QMethod String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                           String
    " ; bucket: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Maybe ByteString -> String
    forall a. Show a => a -> String
    show Maybe ByteString
    s3QBucket String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                           String
    " ; subresources: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Query -> String
    forall a. Show a => a -> String
    show Query
    s3QSubresources String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                           String
    " ; query: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Query -> String
    forall a. Show a => a -> String
    show Query
    s3QQuery String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                           String
    " ; request body: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (case Maybe RequestBody
    s3QRequestBody of Maybe RequestBody
    Nothing -> String
    "no"; Maybe RequestBody
    _ -> String
    "yes") String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                           String
    "]"

    hAmzDate, hAmzContentSha256, hAmzAlgorithm, hAmzCredential, hAmzExpires, hAmzSignedHeaders, hAmzSignature, hAmzSecurityToken :: HTTP.HeaderName
    hAmzDate :: HeaderName
    hAmzDate          = HeaderName
    "X-Amz-Date"
    hAmzContentSha256 :: HeaderName
    hAmzContentSha256 = HeaderName
    "X-Amz-Content-Sha256"
    hAmzAlgorithm :: HeaderName
    hAmzAlgorithm     = HeaderName
    "X-Amz-Algorithm"
    hAmzCredential :: HeaderName
    hAmzCredential    = HeaderName
    "X-Amz-Credential"
    hAmzExpires :: HeaderName
    hAmzExpires       = HeaderName
    "X-Amz-Expires"
    hAmzSignedHeaders :: HeaderName
    hAmzSignedHeaders = HeaderName
    "X-Amz-SignedHeaders"
    hAmzSignature :: HeaderName
    hAmzSignature     = HeaderName
    "X-Amz-Signature"
    hAmzSecurityToken :: HeaderName
    hAmzSecurityToken = HeaderName
    "X-Amz-Security-Token"

    s3SignQuery :: S3Query -> S3Configuration qt -> SignatureData -> SignedQuery
    s3SignQuery :: forall qt.
    S3Query -> S3Configuration qt -> SignatureData -> SignedQuery
    s3SignQuery S3Query{Query
    RequestHeaders
    Maybe ByteString
    Maybe (Digest MD5)
    Maybe RequestBody
    Method
    s3QMethod :: S3Query -> Method
    s3QBucket :: S3Query -> Maybe ByteString
    s3QObject :: S3Query -> Maybe ByteString
    s3QSubresources :: S3Query -> Query
    s3QQuery :: S3Query -> Query
    s3QContentType :: S3Query -> Maybe ByteString
    s3QContentMd5 :: S3Query -> Maybe (Digest MD5)
    s3QAmzHeaders :: S3Query -> RequestHeaders
    s3QOtherHeaders :: S3Query -> RequestHeaders
    s3QRequestBody :: S3Query -> Maybe RequestBody
    s3QMethod :: Method
    s3QBucket :: Maybe ByteString
    s3QObject :: Maybe ByteString
    s3QSubresources :: Query
    s3QQuery :: Query
    s3QContentType :: Maybe ByteString
    s3QContentMd5 :: Maybe (Digest MD5)
    s3QAmzHeaders :: RequestHeaders
    s3QOtherHeaders :: RequestHeaders
    s3QRequestBody :: Maybe RequestBody
    ..} S3Configuration{ s3SignVersion :: forall qt. S3Configuration qt -> S3SignVersion
    s3SignVersion = S3SignVersion
    S3SignV2, Bool
    Int
    Maybe LocationConstraint
    Maybe ByteString
    Maybe ServerSideEncryption
    ByteString
    NominalDiffTime
    Protocol
    RequestStyle
    s3Protocol :: forall qt. S3Configuration qt -> Protocol
    s3Endpoint :: forall qt. S3Configuration qt -> ByteString
    s3Region :: forall qt. S3Configuration qt -> Maybe ByteString
    s3RequestStyle :: forall qt. S3Configuration qt -> RequestStyle
    s3Port :: forall qt. S3Configuration qt -> Int
    s3ServerSideEncryption :: forall qt. S3Configuration qt -> Maybe ServerSideEncryption
    s3UseUri :: forall qt. S3Configuration qt -> Bool
    s3DefaultExpiry :: forall qt. S3Configuration qt -> NominalDiffTime
    s3UserAgent :: forall qt. S3Configuration qt -> Maybe LocationConstraint
    s3Protocol :: Protocol
    s3Endpoint :: ByteString
    s3Region :: Maybe ByteString
    s3RequestStyle :: RequestStyle
    s3Port :: Int
    s3ServerSideEncryption :: Maybe ServerSideEncryption
    s3UseUri :: Bool
    s3DefaultExpiry :: NominalDiffTime
    s3UserAgent :: Maybe LocationConstraint
    .. } SignatureData{UTCTime
    AbsoluteTimeInfo
    Credentials
    signatureTimeInfo :: AbsoluteTimeInfo
    signatureTime :: UTCTime
    signatureCredentials :: Credentials
    signatureCredentials :: SignatureData -> Credentials
    signatureTime :: SignatureData -> UTCTime
    signatureTimeInfo :: SignatureData -> AbsoluteTimeInfo
    ..}
        = SignedQuery {
            sqMethod :: Method
    sqMethod = Method
    s3QMethod
          , sqProtocol :: Protocol
    sqProtocol = Protocol
    s3Protocol
          , sqHost :: ByteString
    sqHost = ByteString -> [ByteString] -> ByteString
    B.intercalate ByteString
    "." ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Maybe ByteString] -> [ByteString]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe ByteString]
    host
          , sqPort :: Int
    sqPort = Int
    s3Port
          , sqPath :: ByteString
    sqPath = [ByteString] -> ByteString
    forall a. Monoid a => [a] -> a
    mconcat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Maybe ByteString] -> [ByteString]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe ByteString]
    path
          , sqQuery :: Query
    sqQuery = Query
    sortedSubresources Query -> Query -> Query
    forall a. [a] -> [a] -> [a]
    ++ Query
    s3QQuery Query -> Query -> Query
    forall a. [a] -> [a] -> [a]
    ++ Query
    authQuery :: HTTP.Query
          , sqDate :: Maybe UTCTime
    sqDate = UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just UTCTime
    signatureTime
          , sqAuthorization :: Maybe (IO ByteString)
    sqAuthorization = Maybe (IO ByteString)
    authorization
          , sqContentType :: Maybe ByteString
    sqContentType = Maybe ByteString
    s3QContentType
          , sqContentMd5 :: Maybe (Digest MD5)
    sqContentMd5 = Maybe (Digest MD5)
    s3QContentMd5
          , sqAmzHeaders :: RequestHeaders
    sqAmzHeaders = RequestHeaders
    amzHeaders
          , sqOtherHeaders :: RequestHeaders
    sqOtherHeaders = RequestHeaders
    useragent RequestHeaders -> RequestHeaders -> RequestHeaders
    forall a. [a] -> [a] -> [a]
    ++ RequestHeaders
    s3QOtherHeaders
          , sqBody :: Maybe RequestBody
    sqBody = Maybe RequestBody
    s3QRequestBody
          , sqStringToSign :: ByteString
    sqStringToSign = ByteString
    stringToSign
          }
        where
          -- This also implements anonymous queries.
          isanon :: Bool
    isanon = Credentials -> Bool
    isAnonymousCredentials Credentials
    signatureCredentials
          amzHeaders :: RequestHeaders
    amzHeaders = RequestHeaders -> RequestHeaders
    forall {a}. Eq a => [(a, ByteString)] -> [(a, ByteString)]
    merge (RequestHeaders -> RequestHeaders)
    -> RequestHeaders -> RequestHeaders
    forall a b. (a -> b) -> a -> b
    $ ((HeaderName, ByteString) -> (HeaderName, ByteString) -> Ordering)
    -> RequestHeaders -> RequestHeaders
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (HeaderName -> HeaderName -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (HeaderName -> HeaderName -> Ordering)
    -> ((HeaderName, ByteString) -> HeaderName)
    -> (HeaderName, ByteString)
    -> (HeaderName, ByteString)
    -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (HeaderName, ByteString) -> HeaderName
    forall a b. (a, b) -> a
    fst) (RequestHeaders -> RequestHeaders)
    -> RequestHeaders -> RequestHeaders
    forall a b. (a -> b) -> a -> b
    $ RequestHeaders
    s3QAmzHeaders RequestHeaders -> RequestHeaders -> RequestHeaders
    forall a. [a] -> [a] -> [a]
    ++
            if Bool
    isanon
              then []
              else ((ByteString, ByteString) -> (HeaderName, ByteString))
    -> [(ByteString, ByteString)] -> RequestHeaders
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(ByteString
    k, ByteString
    v) -> (ByteString -> HeaderName
    forall s. FoldCase s => s -> CI s
    CI.mk ByteString
    k, ByteString
    v)) [(ByteString, ByteString)]
    iamTok
              where merge :: [(a, ByteString)] -> [(a, ByteString)]
    merge (x1 :: (a, ByteString)
    x1@(a
    k1,ByteString
    v1):x2 :: (a, ByteString)
    x2@(a
    k2,ByteString
    v2):[(a, ByteString)]
    xs) | a
    k1 a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    k2  = [(a, ByteString)] -> [(a, ByteString)]
    merge ((a
    k1, ByteString -> [ByteString] -> ByteString
    B8.intercalate ByteString
    "," [ByteString
    v1, ByteString
    v2]) (a, ByteString) -> [(a, ByteString)] -> [(a, ByteString)]
    forall a. a -> [a] -> [a]
    : [(a, ByteString)]
    xs)
                                                     | Bool
    otherwise = (a, ByteString)
    x1 (a, ByteString) -> [(a, ByteString)] -> [(a, ByteString)]
    forall a. a -> [a] -> [a]
    : [(a, ByteString)] -> [(a, ByteString)]
    merge ((a, ByteString)
    x2 (a, ByteString) -> [(a, ByteString)] -> [(a, ByteString)]
    forall a. a -> [a] -> [a]
    : [(a, ByteString)]
    xs)
                    merge [(a, ByteString)]
    xs = [(a, ByteString)]
    xs

          urlEncodedS3QObject :: Maybe ByteString
    urlEncodedS3QObject = Bool -> ByteString -> ByteString
    s3UriEncode Bool
    False (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe ByteString
    s3QObject
          ([Maybe ByteString]
    host, [Maybe ByteString]
    path) = case RequestStyle
    s3RequestStyle of
                           RequestStyle
    PathStyle   -> ([ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    s3Endpoint], [ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    "/", (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ByteString -> Char -> ByteString
    `B8.snoc` Char
    '/') Maybe ByteString
    s3QBucket, Maybe ByteString
    urlEncodedS3QObject])
                           RequestStyle
    BucketStyle -> ([Maybe ByteString
    s3QBucket, ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    s3Endpoint], [ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    "/", Maybe ByteString
    urlEncodedS3QObject])
                           RequestStyle
    VHostStyle  -> ([ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe ByteString
    s3Endpoint Maybe ByteString
    s3QBucket], [ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    "/", Maybe ByteString
    urlEncodedS3QObject])
          sortedSubresources :: Query
    sortedSubresources = Query -> Query
    forall a. Ord a => [a] -> [a]
    sort Query
    s3QSubresources
          canonicalizedResource :: Builder
    canonicalizedResource = Char -> Builder
    Blaze8.fromChar Char
    '/' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend`
                                  Builder -> (ByteString -> Builder) -> Maybe ByteString -> Builder
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Builder
    forall a. Monoid a => a
    mempty (\ByteString
    s -> ByteString -> Builder
    Blaze.copyByteString ByteString
    s Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Char -> Builder
    Blaze8.fromChar Char
    '/') Maybe ByteString
    s3QBucket Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend`
                                  Builder -> (ByteString -> Builder) -> Maybe ByteString -> Builder
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Builder
    forall a. Monoid a => a
    mempty ByteString -> Builder
    Blaze.copyByteString Maybe ByteString
    urlEncodedS3QObject Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend`
                                  Query -> Builder
    encodeQuerySign Query
    sortedSubresources
          -- query parameters overriding response headers must not be URI encoded when calculating signature
          -- http://docs.aws.amazon.com/AmazonS3/latest/dev/RESTAuthentication.html#ConstructingTheCanonicalizedResourceElement
          -- Note this is limited to amazon auth version 2 in the new auth version 4 this weird exception is not present
          encodeQuerySign :: Query -> Builder
    encodeQuerySign Query
    qs =
              let ceq :: Builder
    ceq = Char -> Builder
    Blaze8.fromChar Char
    '='
                  cqt :: Builder
    cqt = Char -> Builder
    Blaze8.fromChar Char
    '?'
                  camp :: Builder
    camp = Char -> Builder
    Blaze8.fromChar Char
    '&'
                  overrideParams :: [ByteString]
    overrideParams = (String -> ByteString) -> [String] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> ByteString
    B8.pack [String
    "response-content-type", String
    "response-content-language", String
    "response-expires", String
    "response-cache-control", String
    "response-content-disposition", String
    "response-content-encoding"]
                  encItem :: (ByteString, Maybe ByteString) -> Builder
    encItem (ByteString
    k, Maybe ByteString
    mv) =
                      let enc :: ByteString -> Builder
    enc = if ByteString
    k ByteString -> [ByteString] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ByteString]
    overrideParams then ByteString -> Builder
    Blaze.copyByteString else Bool -> ByteString -> Builder
    HTTP.urlEncodeBuilder Bool
    True
                      in  ByteString -> Builder
    enc ByteString
    k Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder -> (ByteString -> Builder) -> Maybe ByteString -> Builder
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Builder
    forall a. Monoid a => a
    mempty (Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    mappend Builder
    ceq (Builder -> Builder)
    -> (ByteString -> Builder) -> ByteString -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Builder
    enc) Maybe ByteString
    mv
              in case Builder -> [Builder] -> [Builder]
    forall a. a -> [a] -> [a]
    intersperse Builder
    camp (((ByteString, Maybe ByteString) -> Builder) -> Query -> [Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map (ByteString, Maybe ByteString) -> Builder
    encItem Query
    qs) of
                   [] -> Builder
    forall a. Monoid a => a
    mempty
                   [Builder]
    qs' -> [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat (Builder
    cqt Builder -> [Builder] -> [Builder]
    forall a. a -> [a] -> [a]
    :[Builder]
    qs')

          ti :: AbsoluteTimeInfo
    ti = case (Bool
    s3UseUri, AbsoluteTimeInfo
    signatureTimeInfo) of
                 (Bool
    False, AbsoluteTimeInfo
    ti') -> AbsoluteTimeInfo
    ti'
                 (Bool
    True, AbsoluteTimestamp UTCTime
    time) -> UTCTime -> AbsoluteTimeInfo
    AbsoluteExpires (UTCTime -> AbsoluteTimeInfo) -> UTCTime -> AbsoluteTimeInfo
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime
    s3DefaultExpiry NominalDiffTime -> UTCTime -> UTCTime
    `addUTCTime` UTCTime
    time
                 (Bool
    True, AbsoluteExpires UTCTime
    time) -> UTCTime -> AbsoluteTimeInfo
    AbsoluteExpires UTCTime
    time
          sig :: ByteString
    sig = Credentials -> AuthorizationHash -> ByteString -> ByteString
    signature Credentials
    signatureCredentials AuthorizationHash
    HmacSHA1 ByteString
    stringToSign
          iamTok :: [(ByteString, ByteString)]
    iamTok = [(ByteString, ByteString)]
    -> (ByteString -> [(ByteString, ByteString)])
    -> Maybe ByteString
    -> [(ByteString, ByteString)]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\ByteString
    x -> [(ByteString
    "x-amz-security-token", ByteString
    x)]) (Credentials -> Maybe ByteString
    iamToken Credentials
    signatureCredentials)
          stringToSign :: ByteString
    stringToSign = Builder -> ByteString
    Blaze.toByteString (Builder -> ByteString)
    -> ([[Builder]] -> Builder) -> [[Builder]] -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat ([Builder] -> Builder)
    -> ([[Builder]] -> [Builder]) -> [[Builder]] -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> [Builder] -> [Builder]
    forall a. a -> [a] -> [a]
    intersperse (Char -> Builder
    Blaze8.fromChar Char
    '\n') ([Builder] -> [Builder])
    -> ([[Builder]] -> [Builder]) -> [[Builder]] -> [Builder]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Builder]] -> [Builder]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat  ([[Builder]] -> ByteString) -> [[Builder]] -> ByteString
    forall a b. (a -> b) -> a -> b
    $
                           [[ByteString -> Builder
    Blaze.copyByteString (ByteString -> Builder) -> ByteString -> Builder
    forall a b. (a -> b) -> a -> b
    $ Method -> ByteString
    httpMethod Method
    s3QMethod]
                           , [Builder -> (Digest MD5 -> Builder) -> Maybe (Digest MD5) -> Builder
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Builder
    forall a. Monoid a => a
    mempty (ByteString -> Builder
    Blaze.copyByteString (ByteString -> Builder)
    -> (Digest MD5 -> ByteString) -> Digest MD5 -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    Base64.encode (ByteString -> ByteString)
    -> (Digest MD5 -> ByteString) -> Digest MD5 -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Digest MD5 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    ByteArray.convert) Maybe (Digest MD5)
    s3QContentMd5]
                           , [Builder -> (ByteString -> Builder) -> Maybe ByteString -> Builder
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Builder
    forall a. Monoid a => a
    mempty ByteString -> Builder
    Blaze.copyByteString Maybe ByteString
    s3QContentType]
                           , [ByteString -> Builder
    Blaze.copyByteString (ByteString -> Builder) -> ByteString -> Builder
    forall a b. (a -> b) -> a -> b
    $ case AbsoluteTimeInfo
    ti of
                                                       AbsoluteTimestamp UTCTime
    time -> UTCTime -> ByteString
    fmtRfc822Time UTCTime
    time
                                                       AbsoluteExpires UTCTime
    time -> UTCTime -> ByteString
    fmtTimeEpochSeconds UTCTime
    time]
                           , ((HeaderName, ByteString) -> Builder)
    -> RequestHeaders -> [Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map (HeaderName, ByteString) -> Builder
    amzHeader RequestHeaders
    amzHeaders
                           , [Builder
    canonicalizedResource]
                           ]
              where amzHeader :: (HeaderName, ByteString) -> Builder
    amzHeader (HeaderName
    k, ByteString
    v) = ByteString -> Builder
    Blaze.copyByteString (HeaderName -> ByteString
    forall s. CI s -> s
    CI.foldedCase HeaderName
    k) Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Char -> Builder
    Blaze8.fromChar Char
    ':' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` ByteString -> Builder
    Blaze.copyByteString ByteString
    v
          (Maybe (IO ByteString)
    authorization, Query
    authQuery) = case AbsoluteTimeInfo
    ti of
                                     AbsoluteTimestamp UTCTime
    _
                                            | Bool
    isanon -> (Maybe (IO ByteString)
    forall a. Maybe a
    Nothing, [])
                                            | Bool
    otherwise -> (IO ByteString -> Maybe (IO ByteString)
    forall a. a -> Maybe a
    Just (IO ByteString -> Maybe (IO ByteString))
    -> IO ByteString -> Maybe (IO ByteString)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    B.concat [ByteString
    "AWS ", Credentials -> ByteString
    accessKeyID Credentials
    signatureCredentials, ByteString
    ":", ByteString
    sig], [])
                                     AbsoluteExpires UTCTime
    time -> (Maybe (IO ByteString)
    forall a. Maybe a
    Nothing, [(ByteString, ByteString)] -> Query
    forall a. QueryLike a => a -> Query
    HTTP.toQuery ([(ByteString, ByteString)] -> Query)
    -> [(ByteString, ByteString)] -> Query
    forall a b. (a -> b) -> a -> b
    $ UTCTime -> [(ByteString, ByteString)]
    makeAuthQuery UTCTime
    time)
          makeAuthQuery :: UTCTime -> [(ByteString, ByteString)]
    makeAuthQuery UTCTime
    time
            | Bool
    isanon = []
            | Bool
    otherwise =
                    [ (ByteString
    "Expires" :: B8.ByteString, UTCTime -> ByteString
    fmtTimeEpochSeconds UTCTime
    time)
                    , (ByteString
    "AWSAccessKeyId", Credentials -> ByteString
    accessKeyID Credentials
    signatureCredentials)
                    , (ByteString
    "SignatureMethod", ByteString
    "HmacSHA256")
                    , (ByteString
    "Signature", ByteString
    sig)] [(ByteString, ByteString)]
    -> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
    forall a. [a] -> [a] -> [a]
    ++ [(ByteString, ByteString)]
    iamTok

          useragent :: RequestHeaders
    useragent = Maybe (HeaderName, ByteString) -> RequestHeaders
    forall a. Maybe a -> [a]
    maybeToList (Maybe (HeaderName, ByteString) -> RequestHeaders)
    -> Maybe (HeaderName, ByteString) -> RequestHeaders
    forall a b. (a -> b) -> a -> b
    $ (HeaderName
    HTTP.hUserAgent,) (ByteString -> (HeaderName, ByteString))
    -> (LocationConstraint -> ByteString)
    -> LocationConstraint
    -> (HeaderName, ByteString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LocationConstraint -> ByteString
    T.encodeUtf8 (LocationConstraint -> (HeaderName, ByteString))
    -> Maybe LocationConstraint -> Maybe (HeaderName, ByteString)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe LocationConstraint
    s3UserAgent
    s3SignQuery sq :: S3Query
    sq@S3Query{Query
    RequestHeaders
    Maybe ByteString
    Maybe (Digest MD5)
    Maybe RequestBody
    Method
    s3QMethod :: S3Query -> Method
    s3QBucket :: S3Query -> Maybe ByteString
    s3QObject :: S3Query -> Maybe ByteString
    s3QSubresources :: S3Query -> Query
    s3QQuery :: S3Query -> Query
    s3QContentType :: S3Query -> Maybe ByteString
    s3QContentMd5 :: S3Query -> Maybe (Digest MD5)
    s3QAmzHeaders :: S3Query -> RequestHeaders
    s3QOtherHeaders :: S3Query -> RequestHeaders
    s3QRequestBody :: S3Query -> Maybe RequestBody
    s3QMethod :: Method
    s3QBucket :: Maybe ByteString
    s3QObject :: Maybe ByteString
    s3QSubresources :: Query
    s3QQuery :: Query
    s3QContentType :: Maybe ByteString
    s3QContentMd5 :: Maybe (Digest MD5)
    s3QAmzHeaders :: RequestHeaders
    s3QOtherHeaders :: RequestHeaders
    s3QRequestBody :: Maybe RequestBody
    ..} sc :: S3Configuration qt
    sc@S3Configuration{ s3SignVersion :: forall qt. S3Configuration qt -> S3SignVersion
    s3SignVersion = S3SignV4 S3SignPayloadMode
    signpayload, Bool
    Int
    Maybe LocationConstraint
    Maybe ByteString
    Maybe ServerSideEncryption
    ByteString
    NominalDiffTime
    Protocol
    RequestStyle
    s3Protocol :: forall qt. S3Configuration qt -> Protocol
    s3Endpoint :: forall qt. S3Configuration qt -> ByteString
    s3Region :: forall qt. S3Configuration qt -> Maybe ByteString
    s3RequestStyle :: forall qt. S3Configuration qt -> RequestStyle
    s3Port :: forall qt. S3Configuration qt -> Int
    s3ServerSideEncryption :: forall qt. S3Configuration qt -> Maybe ServerSideEncryption
    s3UseUri :: forall qt. S3Configuration qt -> Bool
    s3DefaultExpiry :: forall qt. S3Configuration qt -> NominalDiffTime
    s3UserAgent :: forall qt. S3Configuration qt -> Maybe LocationConstraint
    s3Protocol :: Protocol
    s3Endpoint :: ByteString
    s3Region :: Maybe ByteString
    s3RequestStyle :: RequestStyle
    s3Port :: Int
    s3ServerSideEncryption :: Maybe ServerSideEncryption
    s3UseUri :: Bool
    s3DefaultExpiry :: NominalDiffTime
    s3UserAgent :: Maybe LocationConstraint
    .. } sd :: SignatureData
    sd@SignatureData{UTCTime
    AbsoluteTimeInfo
    Credentials
    signatureCredentials :: SignatureData -> Credentials
    signatureTime :: SignatureData -> UTCTime
    signatureTimeInfo :: SignatureData -> AbsoluteTimeInfo
    signatureTimeInfo :: AbsoluteTimeInfo
    signatureTime :: UTCTime
    signatureCredentials :: Credentials
    ..}
        | Credentials -> Bool
    isAnonymousCredentials Credentials
    signatureCredentials =
          S3Query
    -> S3Configuration (ZonkAny 0) -> SignatureData -> SignedQuery
    forall qt.
    S3Query -> S3Configuration qt -> SignatureData -> SignedQuery
    s3SignQuery S3Query
    sq (S3Configuration qt
    sc { s3SignVersion = S3SignV2 }) SignatureData
    sd
        | Bool
    otherwise = SignedQuery
          { sqMethod :: Method
    sqMethod = Method
    s3QMethod
          , sqProtocol :: Protocol
    sqProtocol = Protocol
    s3Protocol
          , sqHost :: ByteString
    sqHost = ByteString -> [ByteString] -> ByteString
    B.intercalate ByteString
    "." ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Maybe ByteString] -> [ByteString]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe ByteString]
    host
          , sqPort :: Int
    sqPort = Int
    s3Port
          , sqPath :: ByteString
    sqPath = [ByteString] -> ByteString
    forall a. Monoid a => [a] -> a
    mconcat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Maybe ByteString] -> [ByteString]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe ByteString]
    path
          , sqQuery :: Query
    sqQuery = Query
    queryString Query -> Query -> Query
    forall a. [a] -> [a] -> [a]
    ++ Query
    signatureQuery :: HTTP.Query
          , sqDate :: Maybe UTCTime
    sqDate = UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just UTCTime
    signatureTime
          , sqAuthorization :: Maybe (IO ByteString)
    sqAuthorization = Maybe (IO ByteString)
    authorization
          , sqContentType :: Maybe ByteString
    sqContentType = Maybe ByteString
    s3QContentType
          , sqContentMd5 :: Maybe (Digest MD5)
    sqContentMd5 = Maybe (Digest MD5)
    s3QContentMd5
          , sqAmzHeaders :: RequestHeaders
    sqAmzHeaders = Map HeaderName ByteString -> RequestHeaders
    forall k a. Map k a -> [(k, a)]
    Map.toList Map HeaderName ByteString
    amzHeaders
          , sqOtherHeaders :: RequestHeaders
    sqOtherHeaders = RequestHeaders
    useragent RequestHeaders -> RequestHeaders -> RequestHeaders
    forall a. [a] -> [a] -> [a]
    ++ RequestHeaders
    s3QOtherHeaders
          , sqBody :: Maybe RequestBody
    sqBody = Maybe RequestBody
    s3QRequestBody
          , sqStringToSign :: ByteString
    sqStringToSign = ByteString
    stringToSign
          }
        where
            -- V4 signing
            -- * <http://docs.aws.amazon.com/general/latest/gr/sigv4_signing.html>
            -- * <http://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-auth-using-authorization-header.html>
            -- * <http://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-query-string-auth.html>

            iamTok :: RequestHeaders
    iamTok = RequestHeaders
    -> (ByteString -> RequestHeaders)
    -> Maybe ByteString
    -> RequestHeaders
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\ByteString
    x -> [(HeaderName
    hAmzSecurityToken, ByteString
    x)]) (Maybe ByteString -> RequestHeaders)
    -> Maybe ByteString -> RequestHeaders
    forall a b. (a -> b) -> a -> b
    $ Credentials -> Maybe ByteString
    iamToken Credentials
    signatureCredentials

            amzHeaders :: Map HeaderName ByteString
    amzHeaders = RequestHeaders -> Map HeaderName ByteString
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList (RequestHeaders -> Map HeaderName ByteString)
    -> RequestHeaders -> Map HeaderName ByteString
    forall a b. (a -> b) -> a -> b
    $ (HeaderName
    hAmzDate, ByteString
    sigTime)(HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
    forall a. a -> [a] -> [a]
    :(HeaderName
    hAmzContentSha256, ByteString
    payloadHash)(HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
    forall a. a -> [a] -> [a]
    :RequestHeaders
    iamTok RequestHeaders -> RequestHeaders -> RequestHeaders
    forall a. [a] -> [a] -> [a]
    ++ RequestHeaders
    s3QAmzHeaders
                where
                    -- needs to match the one produces in the @authorizationV4@
                    sigTime :: ByteString
    sigTime = String -> UTCTime -> ByteString
    fmtTime String
    "%Y%m%dT%H%M%SZ" (UTCTime -> ByteString) -> UTCTime -> ByteString
    forall a b. (a -> b) -> a -> b
    $ UTCTime
    signatureTime
                    payloadHash :: ByteString
    payloadHash = case (S3SignPayloadMode
    signpayload, Maybe RequestBody
    s3QRequestBody) of
                        (S3SignPayloadMode
    AlwaysUnsigned, Maybe RequestBody
    _)                 -> ByteString
    "UNSIGNED-PAYLOAD"
                        (S3SignPayloadMode
    _, Maybe RequestBody
    Nothing)                        -> ByteString
    emptyBodyHash
                        (S3SignPayloadMode
    _, Just (HTTP.RequestBodyLBS ByteString
    lbs)) -> ByteString -> ByteString
    Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Digest SHA256 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    ByteArray.convert (ByteString -> Digest SHA256
    forall a. HashAlgorithm a => ByteString -> Digest a
    CH.hashlazy ByteString
    lbs :: CH.Digest CH.SHA256)
                        (S3SignPayloadMode
    _, Just (HTTP.RequestBodyBS ByteString
    bs))   -> ByteString -> ByteString
    Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Digest SHA256 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    ByteArray.convert (ByteString -> Digest SHA256
    forall ba a.
    (ByteArrayAccess ba, HashAlgorithm a) =>
    ba -> Digest a
    CH.hash ByteString
    bs :: CH.Digest CH.SHA256)
                        (S3SignPayloadMode
    SignWithEffort, Maybe RequestBody
    _)                 -> ByteString
    "UNSIGNED-PAYLOAD"
                        (S3SignPayloadMode
    AlwaysSigned, Maybe RequestBody
    _)                   -> String -> ByteString
    forall a. HasCallStack => String -> a
    error String
    "aws: RequestBody must be a on-memory one when AlwaysSigned mode."
                    emptyBodyHash :: ByteString
    emptyBodyHash = ByteString
    "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"

            ([Maybe ByteString]
    host, [Maybe ByteString]
    path) = case RequestStyle
    s3RequestStyle of
                RequestStyle
    PathStyle   -> ([ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    s3Endpoint], [ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    "/", (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ByteString -> Char -> ByteString
    `B8.snoc` Char
    '/') Maybe ByteString
    s3QBucket, Maybe ByteString
    urlEncodedS3QObject])
                RequestStyle
    BucketStyle -> ([Maybe ByteString
    s3QBucket, ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    s3Endpoint], [ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    "/", Maybe ByteString
    urlEncodedS3QObject])
                RequestStyle
    VHostStyle  -> ([ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe ByteString
    s3Endpoint Maybe ByteString
    s3QBucket], [ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    "/", Maybe ByteString
    urlEncodedS3QObject])
                where
                    urlEncodedS3QObject :: Maybe ByteString
    urlEncodedS3QObject = Bool -> ByteString -> ByteString
    s3UriEncode Bool
    False (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe ByteString
    s3QObject

            -- must provide host in the canonical headers.
            canonicalHeaders :: Map HeaderName ByteString
    canonicalHeaders = Map HeaderName ByteString
    -> Map HeaderName ByteString -> Map HeaderName ByteString
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    Map.union Map HeaderName ByteString
    amzHeaders (Map HeaderName ByteString -> Map HeaderName ByteString)
    -> (RequestHeaders -> Map HeaderName ByteString)
    -> RequestHeaders
    -> Map HeaderName ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RequestHeaders -> Map HeaderName ByteString
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList (RequestHeaders -> Map HeaderName ByteString)
    -> RequestHeaders -> Map HeaderName ByteString
    forall a b. (a -> b) -> a -> b
    $ [Maybe (HeaderName, ByteString)] -> RequestHeaders
    forall a. [Maybe a] -> [a]
    catMaybes
                [ (HeaderName, ByteString) -> Maybe (HeaderName, ByteString)
    forall a. a -> Maybe a
    Just (HeaderName
    "host", ByteString -> [ByteString] -> ByteString
    B.intercalate ByteString
    "." ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Maybe ByteString] -> [ByteString]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe ByteString]
    host)
                , (HeaderName
    "content-type",) (ByteString -> (HeaderName, ByteString))
    -> Maybe ByteString -> Maybe (HeaderName, ByteString)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe ByteString
    s3QContentType
                ]
            signedHeaders :: ByteString
    signedHeaders = ByteString -> [ByteString] -> ByteString
    B8.intercalate ByteString
    ";" ((HeaderName -> ByteString) -> [HeaderName] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map HeaderName -> ByteString
    forall s. CI s -> s
    CI.foldedCase ([HeaderName] -> [ByteString]) -> [HeaderName] -> [ByteString]
    forall a b. (a -> b) -> a -> b
    $ Map HeaderName ByteString -> [HeaderName]
    forall k a. Map k a -> [k]
    Map.keys Map HeaderName ByteString
    canonicalHeaders)
            stringToSign :: ByteString
    stringToSign = ByteString -> [ByteString] -> ByteString
    B.intercalate ByteString
    "\n" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $
                [ Method -> ByteString
    httpMethod Method
    s3QMethod                   -- method
                , [ByteString] -> ByteString
    forall a. Monoid a => [a] -> a
    mconcat ([ByteString] -> ByteString)
    -> ([Maybe ByteString] -> [ByteString])
    -> [Maybe ByteString]
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe ByteString] -> [ByteString]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe ByteString] -> ByteString)
    -> [Maybe ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Maybe ByteString]
    path             -- path
                , Bool -> Query -> ByteString
    s3RenderQuery Bool
    False (Query -> ByteString) -> Query -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Query -> Query
    forall a. Ord a => [a] -> [a]
    sort Query
    queryString -- query string
                ] [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++
                (HeaderName -> ByteString -> [ByteString])
    -> Map HeaderName ByteString -> [ByteString]
    forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
    Map.foldMapWithKey (\HeaderName
    a ByteString
    b -> [HeaderName -> ByteString
    forall s. CI s -> s
    CI.foldedCase HeaderName
    a ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    Sem.<> ByteString
    ":" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    Sem.<> ByteString
    b]) Map HeaderName ByteString
    canonicalHeaders [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++
                [ ByteString
    "" -- end headers
                , ByteString
    signedHeaders
                , Map HeaderName ByteString
    amzHeaders Map HeaderName ByteString -> HeaderName -> ByteString
    forall k a. Ord k => Map k a -> k -> a
    Map.! HeaderName
    hAmzContentSha256
                ]

            (Maybe (IO ByteString)
    authorization, Query
    signatureQuery, Query
    queryString) = case AbsoluteTimeInfo
    ti of
                AbsoluteTimestamp UTCTime
    _  -> (IO ByteString -> Maybe (IO ByteString)
    forall a. a -> Maybe a
    Just IO ByteString
    auth, [], Query
    allQueries)
                AbsoluteExpires UTCTime
    time ->
                    ( Maybe (IO ByteString)
    forall a. Maybe a
    Nothing
                    , [(HeaderName -> ByteString
    forall s. CI s -> s
    CI.original HeaderName
    hAmzSignature, ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    sig)]
                    , (Query
    allQueries Query -> Query -> Query
    forall a. [a] -> [a] -> [a]
    ++) (Query -> Query)
    -> (RequestHeaders -> Query) -> RequestHeaders -> Query
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(ByteString, ByteString)] -> Query
    forall a. QueryLike a => a -> Query
    HTTP.toQuery ([(ByteString, ByteString)] -> Query)
    -> (RequestHeaders -> [(ByteString, ByteString)])
    -> RequestHeaders
    -> Query
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((HeaderName, ByteString) -> (ByteString, ByteString))
    -> RequestHeaders -> [(ByteString, ByteString)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((HeaderName -> ByteString)
    -> (HeaderName, ByteString) -> (ByteString, ByteString)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first HeaderName -> ByteString
    forall s. CI s -> s
    CI.original) (RequestHeaders -> Query) -> RequestHeaders -> Query
    forall a b. (a -> b) -> a -> b
    $
                        [ (HeaderName
    hAmzAlgorithm, ByteString
    "AWS4-HMAC-SHA256")
                        , (HeaderName
    hAmzCredential, ByteString
    cred)
                        , (HeaderName
    hAmzDate, Map HeaderName ByteString
    amzHeaders Map HeaderName ByteString -> HeaderName -> ByteString
    forall k a. Ord k => Map k a -> k -> a
    Map.! HeaderName
    hAmzDate)
                        , (HeaderName
    hAmzExpires, String -> ByteString
    B8.pack (String -> ByteString)
    -> (NominalDiffTime -> String) -> NominalDiffTime -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Integer -> String
    forall a. Show a => a -> String
    show :: Integer -> String) (Integer -> String)
    -> (NominalDiffTime -> Integer) -> NominalDiffTime -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NominalDiffTime -> Integer
    forall b. Integral b => NominalDiffTime -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (NominalDiffTime -> ByteString) -> NominalDiffTime -> ByteString
    forall a b. (a -> b) -> a -> b
    $ UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime UTCTime
    time UTCTime
    signatureTime)
                        , (HeaderName
    hAmzSignedHeaders, ByteString
    signedHeaders)
                        ] RequestHeaders -> RequestHeaders -> RequestHeaders
    forall a. [a] -> [a] -> [a]
    ++ RequestHeaders
    iamTok
                    )
                where
                    allQueries :: Query
    allQueries = Query
    s3QSubresources Query -> Query -> Query
    forall a. [a] -> [a] -> [a]
    ++ Query
    s3QQuery
                    region :: ByteString
    region = ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe (ByteString -> ByteString
    s3ExtractRegion ByteString
    s3Endpoint) Maybe ByteString
    s3Region
                    auth :: IO ByteString
    auth = SignatureData
    -> AuthorizationHash
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> IO ByteString
    authorizationV4 SignatureData
    sd AuthorizationHash
    HmacSHA256 ByteString
    region ByteString
    "s3" ByteString
    signedHeaders ByteString
    stringToSign
                    sig :: ByteString
    sig  = SignatureData
    -> AuthorizationHash
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    signatureV4     SignatureData
    sd AuthorizationHash
    HmacSHA256 ByteString
    region ByteString
    "s3"               ByteString
    stringToSign
                    cred :: ByteString
    cred = SignatureData -> ByteString -> ByteString -> ByteString
    credentialV4    SignatureData
    sd            ByteString
    region ByteString
    "s3"
                    ti :: AbsoluteTimeInfo
    ti = case (Bool
    s3UseUri, AbsoluteTimeInfo
    signatureTimeInfo) of
                        (Bool
    False, AbsoluteTimeInfo
    t) -> AbsoluteTimeInfo
    t
                        (Bool
    True, AbsoluteTimestamp UTCTime
    time) -> UTCTime -> AbsoluteTimeInfo
    AbsoluteExpires (UTCTime -> AbsoluteTimeInfo) -> UTCTime -> AbsoluteTimeInfo
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime
    s3DefaultExpiry NominalDiffTime -> UTCTime -> UTCTime
    `addUTCTime` UTCTime
    time
                        (Bool
    True, AbsoluteExpires UTCTime
    time) -> UTCTime -> AbsoluteTimeInfo
    AbsoluteExpires UTCTime
    time

            useragent :: RequestHeaders
    useragent = Maybe (HeaderName, ByteString) -> RequestHeaders
    forall a. Maybe a -> [a]
    maybeToList (Maybe (HeaderName, ByteString) -> RequestHeaders)
    -> Maybe (HeaderName, ByteString) -> RequestHeaders
    forall a b. (a -> b) -> a -> b
    $ (HeaderName
    HTTP.hUserAgent,) (ByteString -> (HeaderName, ByteString))
    -> (LocationConstraint -> ByteString)
    -> LocationConstraint
    -> (HeaderName, ByteString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LocationConstraint -> ByteString
    T.encodeUtf8 (LocationConstraint -> (HeaderName, ByteString))
    -> Maybe LocationConstraint -> Maybe (HeaderName, ByteString)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe LocationConstraint
    s3UserAgent

    -- | Custom UriEncode function
    -- see <http://docs.aws.amazon.com/AmazonS3/latest/API/sig-v4-header-based-auth.html>
    s3UriEncode
        :: Bool         -- ^ Whether encode slash characters
        -> B.ByteString
        -> B.ByteString
    s3UriEncode :: Bool -> ByteString -> ByteString
    s3UriEncode Bool
    encodeSlash = (Char -> ByteString) -> ByteString -> ByteString
    B8.concatMap ((Char -> ByteString) -> ByteString -> ByteString)
    -> (Char -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ \Char
    c ->
        if (Char -> Bool
    isAscii Char
    c Bool -> Bool -> Bool
    && Char -> Bool
    isAlphaNum Char
    c) Bool -> Bool -> Bool
    || (Char
    c Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    nonEncodeMarks)
            then Char -> ByteString
    B8.singleton Char
    c
            else String -> ByteString
    B8.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Char
    '%' Char -> ShowS
    forall a. a -> [a] -> [a]
    : (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toUpper (Int -> ShowS
    forall a. Integral a => a -> ShowS
    showHex (Char -> Int
    ord Char
    c) String
    "")
        where
            nonEncodeMarks :: String
            nonEncodeMarks :: String
    nonEncodeMarks = if Bool
    encodeSlash
                then String
    "_-~."
                else String
    "_-~./"

    s3RenderQuery
        :: Bool -- ^ Whether prepend a question mark
        -> HTTP.Query
        -> B.ByteString
    s3RenderQuery :: Bool -> Query -> ByteString
    s3RenderQuery Bool
    qm = [ByteString] -> ByteString
    forall a. Monoid a => [a] -> a
    mconcat ([ByteString] -> ByteString)
    -> (Query -> [ByteString]) -> Query -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ByteString] -> [ByteString]
    qmf ([ByteString] -> [ByteString])
    -> (Query -> [ByteString]) -> Query -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    intersperse (Char -> ByteString
    B8.singleton Char
    '&') ([ByteString] -> [ByteString])
    -> (Query -> [ByteString]) -> Query -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((ByteString, Maybe ByteString) -> ByteString)
    -> Query -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map (ByteString, Maybe ByteString) -> ByteString
    renderItem
        where
            qmf :: [ByteString] -> [ByteString]
    qmf = if Bool
    qm then (ByteString
    "?"ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :) else [ByteString] -> [ByteString]
    forall a. a -> a
    id

            renderItem :: HTTP.QueryItem -> B8.ByteString
            renderItem :: (ByteString, Maybe ByteString) -> ByteString
    renderItem (ByteString
    k, Just ByteString
    v) = Bool -> ByteString -> ByteString
    s3UriEncode Bool
    True ByteString
    k ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    Sem.<> ByteString
    "=" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    Sem.<> Bool -> ByteString -> ByteString
    s3UriEncode Bool
    True ByteString
    v
            renderItem (ByteString
    k, Maybe ByteString
    Nothing) = Bool -> ByteString -> ByteString
    s3UriEncode Bool
    True ByteString
    k ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    Sem.<> ByteString
    "="

    -- | Extract a S3 region from the S3 endpoint. AWS encodes the region names
    -- in the hostnames of endpoints in a way that makes this possible,
    -- see: <http://docs.aws.amazon.com/general/latest/gr/rande.html#s3_region>
    -- For other S3 implementations, may instead need to specify s3Region.
    s3ExtractRegion :: B.ByteString -> B.ByteString
    s3ExtractRegion :: ByteString -> ByteString
    s3ExtractRegion ByteString
    "s3.amazonaws.com"            = ByteString
    "us-east-1"
    s3ExtractRegion ByteString
    "s3-external-1.amazonaws.com" = ByteString
    "us-east-1"
    s3ExtractRegion ByteString
    domain = (String -> ByteString)
    -> ([Word8] -> ByteString) -> Either String [Word8] -> ByteString
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (ByteString -> String -> ByteString
    forall a b. a -> b -> a
    const ByteString
    domain) [Word8] -> ByteString
    B.pack (Either String [Word8] -> ByteString)
    -> Either String [Word8] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Parser [Word8] -> ByteString -> Either String [Word8]
    forall a. Parser a -> ByteString -> Either String a
    Atto.parseOnly Parser [Word8]
    parser ByteString
    domain
        where
            -- s3.dualstack.<WA-DIR-N>.amazonaws.com
            -- s3-<WA-DIR-N>.amazonaws.com
            -- s3.<WA-DIR-N>.amazonaws.com
            parser :: Parser [Word8]
    parser = do
                _ <- ByteString -> Parser ByteString
    Atto.string ByteString
    "s3"
                _ <- Atto.string ".dualstack." <|> Atto.string "-" <|> Atto.string "."
                r <- Atto.manyTill Atto.anyWord8 $ Atto.string ".amazonaws.com"
                Atto.endOfInput
                return r

    s3ResponseConsumer :: HTTPResponseConsumer a
                             -> IORef S3Metadata
                             -> HTTPResponseConsumer a
    s3ResponseConsumer :: forall a.
    HTTPResponseConsumer a
    -> IORef S3Metadata -> HTTPResponseConsumer a
    s3ResponseConsumer HTTPResponseConsumer a
    inner IORef S3Metadata
    metadataRef = HTTPResponseConsumer a
    -> IORef S3Metadata -> HTTPResponseConsumer a
    forall a.
    HTTPResponseConsumer a
    -> IORef S3Metadata -> HTTPResponseConsumer a
    s3BinaryResponseConsumer HTTPResponseConsumer a
    inner' IORef S3Metadata
    metadataRef
      where inner' :: HTTPResponseConsumer a
    inner' Response (ConduitM () ByteString (ResourceT IO) ())
    resp =
              do
                !res <- HTTPResponseConsumer a
    inner Response (ConduitM () ByteString (ResourceT IO) ())
    resp
                return res

    s3BinaryResponseConsumer :: HTTPResponseConsumer a
                       -> IORef S3Metadata
                       -> HTTPResponseConsumer a
    s3BinaryResponseConsumer :: forall a.
    HTTPResponseConsumer a
    -> IORef S3Metadata -> HTTPResponseConsumer a
    s3BinaryResponseConsumer HTTPResponseConsumer a
    inner IORef S3Metadata
    metadata Response (ConduitM () ByteString (ResourceT IO) ())
    resp = do
          let headerString :: HeaderName -> Maybe LocationConstraint
    headerString = (ByteString -> LocationConstraint)
    -> Maybe ByteString -> Maybe LocationConstraint
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ByteString -> LocationConstraint
    T.decodeUtf8 (Maybe ByteString -> Maybe LocationConstraint)
    -> (HeaderName -> Maybe ByteString)
    -> HeaderName
    -> Maybe LocationConstraint
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HeaderName -> RequestHeaders -> Maybe ByteString)
    -> RequestHeaders -> HeaderName -> Maybe ByteString
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip HeaderName -> RequestHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup (Response (ConduitM () ByteString (ResourceT IO) ())
    -> RequestHeaders
    forall body. Response body -> RequestHeaders
    HTTP.responseHeaders Response (ConduitM () ByteString (ResourceT IO) ())
    resp)
          let amzId2 :: Maybe LocationConstraint
    amzId2 = HeaderName -> Maybe LocationConstraint
    headerString HeaderName
    "x-amz-id-2"
          let requestId :: Maybe LocationConstraint
    requestId = HeaderName -> Maybe LocationConstraint
    headerString HeaderName
    "x-amz-request-id"

          let m :: S3Metadata
    m = S3Metadata { s3MAmzId2 :: Maybe LocationConstraint
    s3MAmzId2 = Maybe LocationConstraint
    amzId2, s3MRequestId :: Maybe LocationConstraint
    s3MRequestId = Maybe LocationConstraint
    requestId }
          IO () -> ResourceT IO ()
    forall a. IO a -> ResourceT IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
    forall a b. (a -> b) -> a -> b
    $ IORef S3Metadata -> S3Metadata -> IO ()
    forall m. Monoid m => IORef m -> m -> IO ()
    tellMetadataRef IORef S3Metadata
    metadata S3Metadata
    m

          if Response (ConduitM () ByteString (ResourceT IO) ()) -> Status
    forall body. Response body -> Status
    HTTP.responseStatus Response (ConduitM () ByteString (ResourceT IO) ())
    resp Status -> Status -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Status
    HTTP.status300
            then HTTPResponseConsumer a
    forall a. HTTPResponseConsumer a
    s3ErrorResponseConsumer Response (ConduitM () ByteString (ResourceT IO) ())
    resp
            else HTTPResponseConsumer a
    inner Response (ConduitM () ByteString (ResourceT IO) ())
    resp

    s3XmlResponseConsumer :: (Cu.Cursor -> Response S3Metadata a)
                          -> IORef S3Metadata
                          -> HTTPResponseConsumer a
    s3XmlResponseConsumer :: forall a.
    (Cursor -> Response S3Metadata a)
    -> IORef S3Metadata -> HTTPResponseConsumer a
    s3XmlResponseConsumer Cursor -> Response S3Metadata a
    parse IORef S3Metadata
    metadataRef =
        HTTPResponseConsumer a
    -> IORef S3Metadata -> HTTPResponseConsumer a
    forall a.
    HTTPResponseConsumer a
    -> IORef S3Metadata -> HTTPResponseConsumer a
    s3ResponseConsumer ((Cursor -> Response S3Metadata a)
    -> IORef S3Metadata -> HTTPResponseConsumer a
    forall m a.
    Monoid m =>
    (Cursor -> Response m a) -> IORef m -> HTTPResponseConsumer a
    xmlCursorConsumer Cursor -> Response S3Metadata a
    parse IORef S3Metadata
    metadataRef) IORef S3Metadata
    metadataRef

    s3ErrorResponseConsumer :: HTTPResponseConsumer a
    s3ErrorResponseConsumer :: forall a. HTTPResponseConsumer a
    s3ErrorResponseConsumer Response (ConduitM () ByteString (ResourceT IO) ())
    resp
        = do doc <- ConduitT () Void (ResourceT IO) Document -> ResourceT IO Document
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    C.runConduit (ConduitT () Void (ResourceT IO) Document -> ResourceT IO Document)
    -> ConduitT () Void (ResourceT IO) Document
    -> ResourceT IO Document
    forall a b. (a -> b) -> a -> b
    $ Response (ConduitM () ByteString (ResourceT IO) ())
    -> ConduitM () ByteString (ResourceT IO) ()
    forall body. Response body -> body
    HTTP.responseBody Response (ConduitM () ByteString (ResourceT IO) ())
    resp ConduitM () ByteString (ResourceT IO) ()
    -> ConduitT ByteString Void (ResourceT IO) Document
    -> ConduitT () Void (ResourceT IO) Document
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ParseSettings -> ConduitT ByteString Void (ResourceT IO) Document
    forall (m :: * -> *) o.
    MonadThrow m =>
    ParseSettings -> ConduitT ByteString o m Document
    XML.sinkDoc ParseSettings
    forall a. Default a => a
    XML.def
             let cursor = Document -> Cursor
    Cu.fromDocument Document
    doc
             liftIO $ case parseError cursor of
               Right S3Error
    err      -> S3Error -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM S3Error
    err
               Left SomeException
    otherErr  -> SomeException -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM SomeException
    otherErr
        where
          parseError :: Cu.Cursor -> Either C.SomeException S3Error
          parseError :: Cursor -> Either SomeException S3Error
    parseError Cursor
    root = do code <- String
    -> [LocationConstraint] -> Either SomeException LocationConstraint
    forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
    force String
    "Missing error Code" ([LocationConstraint] -> Either SomeException LocationConstraint)
    -> [LocationConstraint] -> Either SomeException LocationConstraint
    forall a b. (a -> b) -> a -> b
    $ Cursor
    root Cursor -> (Cursor -> [LocationConstraint]) -> [LocationConstraint]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ LocationConstraint -> Cursor -> [LocationConstraint]
    elContent LocationConstraint
    "Code"
                               message <- force "Missing error Message" $ root $/ elContent "Message"
                               let resource = [LocationConstraint] -> Maybe LocationConstraint
    forall a. [a] -> Maybe a
    listToMaybe ([LocationConstraint] -> Maybe LocationConstraint)
    -> [LocationConstraint] -> Maybe LocationConstraint
    forall a b. (a -> b) -> a -> b
    $ Cursor
    root Cursor -> (Cursor -> [LocationConstraint]) -> [LocationConstraint]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ LocationConstraint -> Cursor -> [LocationConstraint]
    elContent LocationConstraint
    "Resource"
                                   hostId = [LocationConstraint] -> Maybe LocationConstraint
    forall a. [a] -> Maybe a
    listToMaybe ([LocationConstraint] -> Maybe LocationConstraint)
    -> [LocationConstraint] -> Maybe LocationConstraint
    forall a b. (a -> b) -> a -> b
    $ Cursor
    root Cursor -> (Cursor -> [LocationConstraint]) -> [LocationConstraint]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ LocationConstraint -> Cursor -> [LocationConstraint]
    elContent LocationConstraint
    "HostId"
                                   accessKeyId = [LocationConstraint] -> Maybe LocationConstraint
    forall a. [a] -> Maybe a
    listToMaybe ([LocationConstraint] -> Maybe LocationConstraint)
    -> [LocationConstraint] -> Maybe LocationConstraint
    forall a b. (a -> b) -> a -> b
    $ Cursor
    root Cursor -> (Cursor -> [LocationConstraint]) -> [LocationConstraint]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ LocationConstraint -> Cursor -> [LocationConstraint]
    elContent LocationConstraint
    "AWSAccessKeyId"
                                   bucket = [LocationConstraint] -> Maybe LocationConstraint
    forall a. [a] -> Maybe a
    listToMaybe ([LocationConstraint] -> Maybe LocationConstraint)
    -> [LocationConstraint] -> Maybe LocationConstraint
    forall a b. (a -> b) -> a -> b
    $ Cursor
    root Cursor -> (Cursor -> [LocationConstraint]) -> [LocationConstraint]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ LocationConstraint -> Cursor -> [LocationConstraint]
    elContent LocationConstraint
    "Bucket"
                                   endpointRaw = [LocationConstraint] -> Maybe LocationConstraint
    forall a. [a] -> Maybe a
    listToMaybe ([LocationConstraint] -> Maybe LocationConstraint)
    -> [LocationConstraint] -> Maybe LocationConstraint
    forall a b. (a -> b) -> a -> b
    $ Cursor
    root Cursor -> (Cursor -> [LocationConstraint]) -> [LocationConstraint]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ LocationConstraint -> Cursor -> [LocationConstraint]
    elContent LocationConstraint
    "Endpoint"
                                   endpoint = LocationConstraint -> ByteString
    T.encodeUtf8 (LocationConstraint -> ByteString)
    -> Maybe LocationConstraint -> Maybe ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (LocationConstraint
    -> LocationConstraint -> Maybe LocationConstraint
    T.stripPrefix (LocationConstraint
    -> Maybe LocationConstraint -> LocationConstraint
    forall a. a -> Maybe a -> a
    fromMaybe LocationConstraint
    "" Maybe LocationConstraint
    bucket LocationConstraint -> LocationConstraint -> LocationConstraint
    forall a. Semigroup a => a -> a -> a
    Sem.<> LocationConstraint
    ".") (LocationConstraint -> Maybe LocationConstraint)
    -> Maybe LocationConstraint -> Maybe LocationConstraint
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Maybe LocationConstraint
    endpointRaw)
                                   stringToSign = do unprocessed <- [String] -> Maybe String
    forall a. [a] -> Maybe a
    listToMaybe ([String] -> Maybe String) -> [String] -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ Cursor
    root Cursor -> (Cursor -> [String]) -> [String]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ LocationConstraint -> Cursor -> [String]
    elCont LocationConstraint
    "StringToSignBytes"
                                                     bytes <- mapM readHex2 $ words unprocessed
                                                     return $ B.pack bytes
                               return S3Error {
                                            s3StatusCode = HTTP.responseStatus resp
                                          , s3ErrorCode = code
                                          , s3ErrorMessage = message
                                          , s3ErrorResource = resource
                                          , s3ErrorHostId = hostId
                                          , s3ErrorAccessKeyId = accessKeyId
                                          , s3ErrorStringToSign = stringToSign
                                          , s3ErrorBucket = bucket
                                          , s3ErrorEndpointRaw = endpointRaw
                                          , s3ErrorEndpoint = endpoint
                                          }

    type CanonicalUserId = T.Text

    data UserInfo
        = UserInfo {
            UserInfo -> LocationConstraint
    userId          :: CanonicalUserId
          , UserInfo -> Maybe LocationConstraint
    userDisplayName :: Maybe T.Text
          }
        deriving (Int -> UserInfo -> ShowS
    [UserInfo] -> ShowS
    UserInfo -> String
    (Int -> UserInfo -> ShowS)
    -> (UserInfo -> String) -> ([UserInfo] -> ShowS) -> Show UserInfo
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> UserInfo -> ShowS
    showsPrec :: Int -> UserInfo -> ShowS
    $cshow :: UserInfo -> String
    show :: UserInfo -> String
    $cshowList :: [UserInfo] -> ShowS
    showList :: [UserInfo] -> ShowS
    Show)

    parseUserInfo :: MonadThrow m => Cu.Cursor -> m UserInfo
    parseUserInfo :: forall (m :: * -> *). MonadThrow m => Cursor -> m UserInfo
    parseUserInfo Cursor
    el = do id_ <- String -> [LocationConstraint] -> m LocationConstraint
    forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
    force String
    "Missing user ID" ([LocationConstraint] -> m LocationConstraint)
    -> [LocationConstraint] -> m LocationConstraint
    forall a b. (a -> b) -> a -> b
    $ Cursor
    el Cursor -> (Cursor -> [LocationConstraint]) -> [LocationConstraint]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ LocationConstraint -> Cursor -> [LocationConstraint]
    elContent LocationConstraint
    "ID"
                          displayName <- return $ case (el $/ elContent "DisplayName") of
                                                      (LocationConstraint
    x:[LocationConstraint]
    _) -> LocationConstraint -> Maybe LocationConstraint
    forall a. a -> Maybe a
    Just LocationConstraint
    x
                                                      []    -> Maybe LocationConstraint
    forall a. Maybe a
    Nothing
                          return UserInfo { userId = id_, userDisplayName = displayName }

    data CannedAcl
        = AclPrivate
        | AclPublicRead
        | AclPublicReadWrite
        | AclAuthenticatedRead
        | AclBucketOwnerRead
        | AclBucketOwnerFullControl
        | AclLogDeliveryWrite
        deriving (Int -> CannedAcl -> ShowS
    [CannedAcl] -> ShowS
    CannedAcl -> String
    (Int -> CannedAcl -> ShowS)
    -> (CannedAcl -> String)
    -> ([CannedAcl] -> ShowS)
    -> Show CannedAcl
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> CannedAcl -> ShowS
    showsPrec :: Int -> CannedAcl -> ShowS
    $cshow :: CannedAcl -> String
    show :: CannedAcl -> String
    $cshowList :: [CannedAcl] -> ShowS
    showList :: [CannedAcl] -> ShowS
    Show)

    writeCannedAcl :: CannedAcl -> T.Text
    writeCannedAcl :: CannedAcl -> LocationConstraint
    writeCannedAcl CannedAcl
    AclPrivate                = LocationConstraint
    "private"
    writeCannedAcl CannedAcl
    AclPublicRead             = LocationConstraint
    "public-read"
    writeCannedAcl CannedAcl
    AclPublicReadWrite        = LocationConstraint
    "public-read-write"
    writeCannedAcl CannedAcl
    AclAuthenticatedRead      = LocationConstraint
    "authenticated-read"
    writeCannedAcl CannedAcl
    AclBucketOwnerRead        = LocationConstraint
    "bucket-owner-read"
    writeCannedAcl CannedAcl
    AclBucketOwnerFullControl = LocationConstraint
    "bucket-owner-full-control"
    writeCannedAcl CannedAcl
    AclLogDeliveryWrite       = LocationConstraint
    "log-delivery-write"

    data StorageClass
        = Standard
        | StandardInfrequentAccess
        | ReducedRedundancy
        | Glacier
        | OtherStorageClass T.Text
        deriving (Int -> StorageClass -> ShowS
    [StorageClass] -> ShowS
    StorageClass -> String
    (Int -> StorageClass -> ShowS)
    -> (StorageClass -> String)
    -> ([StorageClass] -> ShowS)
    -> Show StorageClass
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> StorageClass -> ShowS
    showsPrec :: Int -> StorageClass -> ShowS
    $cshow :: StorageClass -> String
    show :: StorageClass -> String
    $cshowList :: [StorageClass] -> ShowS
    showList :: [StorageClass] -> ShowS
    Show)

    parseStorageClass :: T.Text -> StorageClass
    parseStorageClass :: LocationConstraint -> StorageClass
    parseStorageClass LocationConstraint
    "STANDARD"           = StorageClass
    Standard
    parseStorageClass LocationConstraint
    "STANDARD_IA"        = StorageClass
    StandardInfrequentAccess
    parseStorageClass LocationConstraint
    "REDUCED_REDUNDANCY" = StorageClass
    ReducedRedundancy
    parseStorageClass LocationConstraint
    "GLACIER"            = StorageClass
    Glacier
    parseStorageClass LocationConstraint
    s                    = LocationConstraint -> StorageClass
    OtherStorageClass LocationConstraint
    s

    writeStorageClass :: StorageClass -> T.Text
    writeStorageClass :: StorageClass -> LocationConstraint
    writeStorageClass StorageClass
    Standard                 = LocationConstraint
    "STANDARD"
    writeStorageClass StorageClass
    StandardInfrequentAccess = LocationConstraint
    "STANDARD_IA"
    writeStorageClass StorageClass
    ReducedRedundancy        = LocationConstraint
    "REDUCED_REDUNDANCY"
    writeStorageClass StorageClass
    Glacier                  = LocationConstraint
    "GLACIER"
    writeStorageClass (OtherStorageClass LocationConstraint
    s) = LocationConstraint
    s

    data ServerSideEncryption
        = AES256
        deriving (Int -> ServerSideEncryption -> ShowS
    [ServerSideEncryption] -> ShowS
    ServerSideEncryption -> String
    (Int -> ServerSideEncryption -> ShowS)
    -> (ServerSideEncryption -> String)
    -> ([ServerSideEncryption] -> ShowS)
    -> Show ServerSideEncryption
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ServerSideEncryption -> ShowS
    showsPrec :: Int -> ServerSideEncryption -> ShowS
    $cshow :: ServerSideEncryption -> String
    show :: ServerSideEncryption -> String
    $cshowList :: [ServerSideEncryption] -> ShowS
    showList :: [ServerSideEncryption] -> ShowS
    Show)

    parseServerSideEncryption :: MonadThrow m => T.Text -> m ServerSideEncryption
    parseServerSideEncryption :: forall (m :: * -> *).
    MonadThrow m =>
    LocationConstraint -> m ServerSideEncryption
    parseServerSideEncryption LocationConstraint
    "AES256" = ServerSideEncryption -> m ServerSideEncryption
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ServerSideEncryption
    AES256
    parseServerSideEncryption LocationConstraint
    s = XmlException -> m ServerSideEncryption
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (XmlException -> m ServerSideEncryption)
    -> (String -> XmlException) -> String -> m ServerSideEncryption
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> XmlException
    XmlException (String -> m ServerSideEncryption)
    -> String -> m ServerSideEncryption
    forall a b. (a -> b) -> a -> b
    $ String
    "Invalid Server Side Encryption: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ LocationConstraint -> String
    T.unpack LocationConstraint
    s

    writeServerSideEncryption :: ServerSideEncryption -> T.Text
    writeServerSideEncryption :: ServerSideEncryption -> LocationConstraint
    writeServerSideEncryption ServerSideEncryption
    AES256 = LocationConstraint
    "AES256"

    type Bucket = T.Text

    data BucketInfo
        = BucketInfo {
            BucketInfo -> LocationConstraint
    bucketName         :: Bucket
          , BucketInfo -> UTCTime
    bucketCreationDate :: UTCTime
          }
        deriving (Int -> BucketInfo -> ShowS
    [BucketInfo] -> ShowS
    BucketInfo -> String
    (Int -> BucketInfo -> ShowS)
    -> (BucketInfo -> String)
    -> ([BucketInfo] -> ShowS)
    -> Show BucketInfo
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> BucketInfo -> ShowS
    showsPrec :: Int -> BucketInfo -> ShowS
    $cshow :: BucketInfo -> String
    show :: BucketInfo -> String
    $cshowList :: [BucketInfo] -> ShowS
    showList :: [BucketInfo] -> ShowS
    Show)

    type Object = T.Text

    data ObjectId
        = ObjectId {
            ObjectId -> LocationConstraint
    oidBucket :: Bucket
          , ObjectId -> LocationConstraint
    oidObject :: Object
          , ObjectId -> Maybe LocationConstraint
    oidVersion :: Maybe T.Text
          }
        deriving (Int -> ObjectId -> ShowS
    [ObjectId] -> ShowS
    ObjectId -> String
    (Int -> ObjectId -> ShowS)
    -> (ObjectId -> String) -> ([ObjectId] -> ShowS) -> Show ObjectId
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ObjectId -> ShowS
    showsPrec :: Int -> ObjectId -> ShowS
    $cshow :: ObjectId -> String
    show :: ObjectId -> String
    $cshowList :: [ObjectId] -> ShowS
    showList :: [ObjectId] -> ShowS
    Show)

    data ObjectVersionInfo
        = ObjectVersion {
            ObjectVersionInfo -> LocationConstraint
    oviKey          :: T.Text
          , ObjectVersionInfo -> LocationConstraint
    oviVersionId    :: T.Text
          , ObjectVersionInfo -> Bool
    oviIsLatest     :: Bool
          , ObjectVersionInfo -> UTCTime
    oviLastModified :: UTCTime
          , ObjectVersionInfo -> LocationConstraint
    oviETag         :: T.Text
          , ObjectVersionInfo -> Integer
    oviSize         :: Integer
          , ObjectVersionInfo -> StorageClass
    oviStorageClass :: StorageClass
          , ObjectVersionInfo -> Maybe UserInfo
    oviOwner        :: Maybe UserInfo
          }
        | DeleteMarker {
            oviKey          :: T.Text
          , oviVersionId    :: T.Text
          , oviIsLatest     :: Bool
          , oviLastModified :: UTCTime
          , oviOwner        :: Maybe UserInfo
          }
        deriving (Int -> ObjectVersionInfo -> ShowS
    [ObjectVersionInfo] -> ShowS
    ObjectVersionInfo -> String
    (Int -> ObjectVersionInfo -> ShowS)
    -> (ObjectVersionInfo -> String)
    -> ([ObjectVersionInfo] -> ShowS)
    -> Show ObjectVersionInfo
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ObjectVersionInfo -> ShowS
    showsPrec :: Int -> ObjectVersionInfo -> ShowS
    $cshow :: ObjectVersionInfo -> String
    show :: ObjectVersionInfo -> String
    $cshowList :: [ObjectVersionInfo] -> ShowS
    showList :: [ObjectVersionInfo] -> ShowS
    Show)

    parseObjectVersionInfo :: MonadThrow m => Cu.Cursor -> m ObjectVersionInfo
    parseObjectVersionInfo :: forall (m :: * -> *). MonadThrow m => Cursor -> m ObjectVersionInfo
    parseObjectVersionInfo Cursor
    el
        = do key <- String -> [LocationConstraint] -> m LocationConstraint
    forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
    force String
    "Missing object Key" ([LocationConstraint] -> m LocationConstraint)
    -> [LocationConstraint] -> m LocationConstraint
    forall a b. (a -> b) -> a -> b
    $ Cursor
    el Cursor -> (Cursor -> [LocationConstraint]) -> [LocationConstraint]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ LocationConstraint -> Cursor -> [LocationConstraint]
    elContent LocationConstraint
    "Key"
             versionId <- force "Missing object VersionId" $ el $/ elContent "VersionId"
             isLatest <- forceM "Missing object IsLatest" $ el $/ elContent "IsLatest" &| textReadBool
             let time LocationConstraint
    s = case (Bool -> TimeLocale -> String -> String -> Maybe a
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> String -> String -> m t
    parseTimeM Bool
    True TimeLocale
    defaultTimeLocale String
    "%Y-%m-%dT%H:%M:%S%QZ" (String -> Maybe a) -> String -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ LocationConstraint -> String
    T.unpack LocationConstraint
    s) Maybe a -> Maybe a -> Maybe a
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
                               (Bool -> TimeLocale -> String -> String -> Maybe a
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> String -> String -> m t
    parseTimeM Bool
    True TimeLocale
    defaultTimeLocale String
    "%Y-%m-%dT%H:%M:%S%Q%Z" (String -> Maybe a) -> String -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ LocationConstraint -> String
    T.unpack LocationConstraint
    s) of
                            Maybe a
    Nothing -> XmlException -> m a
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (XmlException -> m a) -> XmlException -> m a
    forall a b. (a -> b) -> a -> b
    $ String -> XmlException
    XmlException String
    "Invalid time"
                            Just a
    v -> a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    v
             lastModified <- forceM "Missing object LastModified" $ el $/ elContent "LastModified" &| time
             owner <- case el $/ Cu.laxElement "Owner" &| parseUserInfo of
                        (m UserInfo
    x:[m UserInfo]
    _) -> (UserInfo -> Maybe UserInfo) -> m UserInfo -> m (Maybe UserInfo)
    forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
    fmap' UserInfo -> Maybe UserInfo
    forall a. a -> Maybe a
    Just m UserInfo
    x
                        [] -> Maybe UserInfo -> m (Maybe UserInfo)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe UserInfo
    forall a. Maybe a
    Nothing
             case Cu.node el of
               XML.NodeElement Element
    e | Element -> LocationConstraint
    elName Element
    e LocationConstraint -> LocationConstraint -> Bool
    forall a. Eq a => a -> a -> Bool
    == LocationConstraint
    "Version" ->
                 do eTag <- String -> [LocationConstraint] -> m LocationConstraint
    forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
    force String
    "Missing object ETag" ([LocationConstraint] -> m LocationConstraint)
    -> [LocationConstraint] -> m LocationConstraint
    forall a b. (a -> b) -> a -> b
    $ Cursor
    el Cursor -> (Cursor -> [LocationConstraint]) -> [LocationConstraint]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ LocationConstraint -> Cursor -> [LocationConstraint]
    elContent LocationConstraint
    "ETag"
                    size <- forceM "Missing object Size" $ el $/ elContent "Size" &| textReadInt
                    storageClass <- forceM "Missing object StorageClass" $ el $/ elContent "StorageClass" &| return . parseStorageClass
                    return ObjectVersion{
                                 oviKey          = key
                               , oviVersionId    = versionId
                               , oviIsLatest     = isLatest
                               , oviLastModified = lastModified
                               , oviETag         = eTag
                               , oviSize         = size
                               , oviStorageClass = storageClass
                               , oviOwner        = owner
                               }
               XML.NodeElement Element
    e | Element -> LocationConstraint
    elName Element
    e LocationConstraint -> LocationConstraint -> Bool
    forall a. Eq a => a -> a -> Bool
    == LocationConstraint
    "DeleteMarker" ->
                 ObjectVersionInfo -> m ObjectVersionInfo
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DeleteMarker{
                                 oviKey :: LocationConstraint
    oviKey          = LocationConstraint
    key
                               , oviVersionId :: LocationConstraint
    oviVersionId    = LocationConstraint
    versionId
                               , oviIsLatest :: Bool
    oviIsLatest     = Bool
    isLatest
                               , oviLastModified :: UTCTime
    oviLastModified = UTCTime
    lastModified
                               , oviOwner :: Maybe UserInfo
    oviOwner        = Maybe UserInfo
    owner
                               }
               Node
    _ -> XmlException -> m ObjectVersionInfo
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (XmlException -> m ObjectVersionInfo)
    -> XmlException -> m ObjectVersionInfo
    forall a b. (a -> b) -> a -> b
    $ String -> XmlException
    XmlException String
    "Invalid object version tag"
        where
          elName :: Element -> LocationConstraint
    elName = Name -> LocationConstraint
    XML.nameLocalName (Name -> LocationConstraint)
    -> (Element -> Name) -> Element -> LocationConstraint
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Element -> Name
    XML.elementName
          fmap' :: Monad m => (a -> b) -> m a -> m b
          fmap' :: forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
    fmap' a -> b
    f m a
    ma = m a
    ma m a -> (a -> m b) -> m b
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= b -> m b
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (b -> m b) -> (a -> b) -> a -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    f

    data ObjectInfo
        = ObjectInfo {
            ObjectInfo -> LocationConstraint
    objectKey          :: T.Text
          , ObjectInfo -> UTCTime
    objectLastModified :: UTCTime
          , ObjectInfo -> LocationConstraint
    objectETag         :: T.Text
          , ObjectInfo -> Integer
    objectSize         :: Integer
          , ObjectInfo -> StorageClass
    objectStorageClass :: StorageClass
          , ObjectInfo -> Maybe UserInfo
    objectOwner        :: Maybe UserInfo
          }
        deriving (Int -> ObjectInfo -> ShowS
    [ObjectInfo] -> ShowS
    ObjectInfo -> String
    (Int -> ObjectInfo -> ShowS)
    -> (ObjectInfo -> String)
    -> ([ObjectInfo] -> ShowS)
    -> Show ObjectInfo
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ObjectInfo -> ShowS
    showsPrec :: Int -> ObjectInfo -> ShowS
    $cshow :: ObjectInfo -> String
    show :: ObjectInfo -> String
    $cshowList :: [ObjectInfo] -> ShowS
    showList :: [ObjectInfo] -> ShowS
    Show)

    parseObjectInfo :: MonadThrow m => Cu.Cursor -> m ObjectInfo
    parseObjectInfo :: forall (m :: * -> *). MonadThrow m => Cursor -> m ObjectInfo
    parseObjectInfo Cursor
    el
        = do key <- String -> [LocationConstraint] -> m LocationConstraint
    forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
    force String
    "Missing object Key" ([LocationConstraint] -> m LocationConstraint)
    -> [LocationConstraint] -> m LocationConstraint
    forall a b. (a -> b) -> a -> b
    $ Cursor
    el Cursor -> (Cursor -> [LocationConstraint]) -> [LocationConstraint]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ LocationConstraint -> Cursor -> [LocationConstraint]
    elContent LocationConstraint
    "Key"
             let time LocationConstraint
    s = case (Bool -> TimeLocale -> String -> String -> Maybe a
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> String -> String -> m t
    parseTimeM Bool
    True TimeLocale
    defaultTimeLocale String
    "%Y-%m-%dT%H:%M:%S%QZ" (String -> Maybe a) -> String -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ LocationConstraint -> String
    T.unpack LocationConstraint
    s) Maybe a -> Maybe a -> Maybe a
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
                               (Bool -> TimeLocale -> String -> String -> Maybe a
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> String -> String -> m t
    parseTimeM Bool
    True TimeLocale
    defaultTimeLocale String
    "%Y-%m-%dT%H:%M:%S%Q%Z" (String -> Maybe a) -> String -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ LocationConstraint -> String
    T.unpack LocationConstraint
    s) of
                            Maybe a
    Nothing -> XmlException -> m a
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (XmlException -> m a) -> XmlException -> m a
    forall a b. (a -> b) -> a -> b
    $ String -> XmlException
    XmlException String
    "Invalid time"
                            Just a
    v -> a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    v
             lastModified <- forceM "Missing object LastModified" $ el $/ elContent "LastModified" &| time
             eTag <- force "Missing object ETag" $ el $/ elContent "ETag"
             size <- forceM "Missing object Size" $ el $/ elContent "Size" &| textReadInt
             storageClass <- forceM "Missing object StorageClass" $ el $/ elContent "StorageClass" &| return . parseStorageClass
             owner <- case el $/ Cu.laxElement "Owner" &| parseUserInfo of
                        (m UserInfo
    x:[m UserInfo]
    _) -> (UserInfo -> Maybe UserInfo) -> m UserInfo -> m (Maybe UserInfo)
    forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
    fmap' UserInfo -> Maybe UserInfo
    forall a. a -> Maybe a
    Just m UserInfo
    x
                        [] -> Maybe UserInfo -> m (Maybe UserInfo)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe UserInfo
    forall a. Maybe a
    Nothing
             return ObjectInfo{
                          objectKey          = key
                        , objectLastModified = lastModified
                        , objectETag         = eTag
                        , objectSize         = size
                        , objectStorageClass = storageClass
                        , objectOwner        = owner
                        }
        where
          fmap' :: Monad m => (a -> b) -> m a -> m b
          fmap' :: forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
    fmap' a -> b
    f m a
    ma = m a
    ma m a -> (a -> m b) -> m b
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= b -> m b
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (b -> m b) -> (a -> b) -> a -> m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    f

    data ObjectMetadata
        = ObjectMetadata {
            ObjectMetadata -> Bool
    omDeleteMarker         :: Bool
          , ObjectMetadata -> LocationConstraint
    omETag                 :: T.Text
          , ObjectMetadata -> UTCTime
    omLastModified         :: UTCTime
          , ObjectMetadata -> Maybe LocationConstraint
    omVersionId            :: Maybe T.Text
    -- TODO:
    --      , omExpiration           :: Maybe (UTCTime, T.Text)
          , ObjectMetadata -> [(LocationConstraint, LocationConstraint)]
    omUserMetadata         :: [(T.Text, T.Text)]
          , ObjectMetadata -> Maybe LocationConstraint
    omMissingUserMetadata  :: Maybe T.Text
          , ObjectMetadata -> Maybe ServerSideEncryption
    omServerSideEncryption :: Maybe ServerSideEncryption
          }
        deriving (Int -> ObjectMetadata -> ShowS
    [ObjectMetadata] -> ShowS
    ObjectMetadata -> String
    (Int -> ObjectMetadata -> ShowS)
    -> (ObjectMetadata -> String)
    -> ([ObjectMetadata] -> ShowS)
    -> Show ObjectMetadata
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ObjectMetadata -> ShowS
    showsPrec :: Int -> ObjectMetadata -> ShowS
    $cshow :: ObjectMetadata -> String
    show :: ObjectMetadata -> String
    $cshowList :: [ObjectMetadata] -> ShowS
    showList :: [ObjectMetadata] -> ShowS
    Show)

    parseObjectMetadata :: MonadThrow m => HTTP.ResponseHeaders -> m ObjectMetadata
    parseObjectMetadata :: forall (m :: * -> *).
    MonadThrow m =>
    RequestHeaders -> m ObjectMetadata
    parseObjectMetadata RequestHeaders
    h = Bool
    -> LocationConstraint
    -> UTCTime
    -> Maybe LocationConstraint
    -> [(LocationConstraint, LocationConstraint)]
    -> Maybe LocationConstraint
    -> Maybe ServerSideEncryption
    -> ObjectMetadata
    ObjectMetadata
                            (Bool
     -> LocationConstraint
     -> UTCTime
     -> Maybe LocationConstraint
     -> [(LocationConstraint, LocationConstraint)]
     -> Maybe LocationConstraint
     -> Maybe ServerSideEncryption
     -> ObjectMetadata)
    -> m Bool
    -> m (LocationConstraint
          -> UTCTime
          -> Maybe LocationConstraint
          -> [(LocationConstraint, LocationConstraint)]
          -> Maybe LocationConstraint
          -> Maybe ServerSideEncryption
          -> ObjectMetadata)
    forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
    `liftM` m Bool
    deleteMarker
                            m (LocationConstraint
       -> UTCTime
       -> Maybe LocationConstraint
       -> [(LocationConstraint, LocationConstraint)]
       -> Maybe LocationConstraint
       -> Maybe ServerSideEncryption
       -> ObjectMetadata)
    -> m LocationConstraint
    -> m (UTCTime
          -> Maybe LocationConstraint
          -> [(LocationConstraint, LocationConstraint)]
          -> Maybe LocationConstraint
          -> Maybe ServerSideEncryption
          -> ObjectMetadata)
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    `ap` m LocationConstraint
    etag
                            m (UTCTime
       -> Maybe LocationConstraint
       -> [(LocationConstraint, LocationConstraint)]
       -> Maybe LocationConstraint
       -> Maybe ServerSideEncryption
       -> ObjectMetadata)
    -> m UTCTime
    -> m (Maybe LocationConstraint
          -> [(LocationConstraint, LocationConstraint)]
          -> Maybe LocationConstraint
          -> Maybe ServerSideEncryption
          -> ObjectMetadata)
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    `ap` m UTCTime
    lastModified
                            m (Maybe LocationConstraint
       -> [(LocationConstraint, LocationConstraint)]
       -> Maybe LocationConstraint
       -> Maybe ServerSideEncryption
       -> ObjectMetadata)
    -> m (Maybe LocationConstraint)
    -> m ([(LocationConstraint, LocationConstraint)]
          -> Maybe LocationConstraint
          -> Maybe ServerSideEncryption
          -> ObjectMetadata)
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    `ap` Maybe LocationConstraint -> m (Maybe LocationConstraint)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe LocationConstraint
    versionId
    --                        `ap` expiration
                            m ([(LocationConstraint, LocationConstraint)]
       -> Maybe LocationConstraint
       -> Maybe ServerSideEncryption
       -> ObjectMetadata)
    -> m [(LocationConstraint, LocationConstraint)]
    -> m (Maybe LocationConstraint
          -> Maybe ServerSideEncryption -> ObjectMetadata)
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    `ap` [(LocationConstraint, LocationConstraint)]
    -> m [(LocationConstraint, LocationConstraint)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(LocationConstraint, LocationConstraint)]
    userMetadata
                            m (Maybe LocationConstraint
       -> Maybe ServerSideEncryption -> ObjectMetadata)
    -> m (Maybe LocationConstraint)
    -> m (Maybe ServerSideEncryption -> ObjectMetadata)
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    `ap` Maybe LocationConstraint -> m (Maybe LocationConstraint)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe LocationConstraint
    missingUserMetadata
                            m (Maybe ServerSideEncryption -> ObjectMetadata)
    -> m (Maybe ServerSideEncryption) -> m ObjectMetadata
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    `ap` m (Maybe ServerSideEncryption)
    serverSideEncryption
      where deleteMarker :: m Bool
    deleteMarker = case ByteString -> String
    B8.unpack (ByteString -> String) -> Maybe ByteString -> Maybe String
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` HeaderName -> RequestHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "x-amz-delete-marker" RequestHeaders
    h of
                             Maybe String
    Nothing -> Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                             Just String
    "true" -> Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                             Just String
    "false" -> Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                             Just String
    x -> HeaderException -> m Bool
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (HeaderException -> m Bool) -> HeaderException -> m Bool
    forall a b. (a -> b) -> a -> b
    $ String -> HeaderException
    HeaderException (String
    "Invalid x-amz-delete-marker " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    x)
            etag :: m LocationConstraint
    etag = case ByteString -> LocationConstraint
    T.decodeUtf8 (ByteString -> LocationConstraint)
    -> Maybe ByteString -> Maybe LocationConstraint
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` HeaderName -> RequestHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "ETag" RequestHeaders
    h of
                     Just LocationConstraint
    x -> LocationConstraint -> m LocationConstraint
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return LocationConstraint
    x
                     Maybe LocationConstraint
    Nothing -> HeaderException -> m LocationConstraint
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (HeaderException -> m LocationConstraint)
    -> HeaderException -> m LocationConstraint
    forall a b. (a -> b) -> a -> b
    $ String -> HeaderException
    HeaderException String
    "ETag missing"
            lastModified :: m UTCTime
    lastModified = case ByteString -> String
    B8.unpack (ByteString -> String) -> Maybe ByteString -> Maybe String
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` HeaderName -> RequestHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "Last-Modified" RequestHeaders
    h of
                             Just String
    ts -> case String -> Maybe UTCTime
    parseHttpDate String
    ts of
                                          Just UTCTime
    t -> UTCTime -> m UTCTime
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return UTCTime
    t
                                          Maybe UTCTime
    Nothing -> HeaderException -> m UTCTime
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (HeaderException -> m UTCTime) -> HeaderException -> m UTCTime
    forall a b. (a -> b) -> a -> b
    $ String -> HeaderException
    HeaderException (String
    "Invalid Last-Modified: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ts)
                             Maybe String
    Nothing -> HeaderException -> m UTCTime
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (HeaderException -> m UTCTime) -> HeaderException -> m UTCTime
    forall a b. (a -> b) -> a -> b
    $ String -> HeaderException
    HeaderException String
    "Last-Modified missing"
            versionId :: Maybe LocationConstraint
    versionId = ByteString -> LocationConstraint
    T.decodeUtf8 (ByteString -> LocationConstraint)
    -> Maybe ByteString -> Maybe LocationConstraint
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` HeaderName -> RequestHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "x-amz-version-id" RequestHeaders
    h
            -- expiration = return undefined
            userMetadata :: [(LocationConstraint, LocationConstraint)]
    userMetadata = (((LocationConstraint, LocationConstraint)
      -> Maybe (LocationConstraint, LocationConstraint))
     -> [(LocationConstraint, LocationConstraint)]
     -> [(LocationConstraint, LocationConstraint)])
    -> [(LocationConstraint, LocationConstraint)]
    -> ((LocationConstraint, LocationConstraint)
        -> Maybe (LocationConstraint, LocationConstraint))
    -> [(LocationConstraint, LocationConstraint)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((LocationConstraint, LocationConstraint)
     -> Maybe (LocationConstraint, LocationConstraint))
    -> [(LocationConstraint, LocationConstraint)]
    -> [(LocationConstraint, LocationConstraint)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe [(LocationConstraint, LocationConstraint)]
    ht (((LocationConstraint, LocationConstraint)
      -> Maybe (LocationConstraint, LocationConstraint))
     -> [(LocationConstraint, LocationConstraint)])
    -> ((LocationConstraint, LocationConstraint)
        -> Maybe (LocationConstraint, LocationConstraint))
    -> [(LocationConstraint, LocationConstraint)]
    forall a b. (a -> b) -> a -> b
    $
                           \(LocationConstraint
    k, LocationConstraint
    v) -> do i <- LocationConstraint
    -> LocationConstraint -> Maybe LocationConstraint
    T.stripPrefix LocationConstraint
    "x-amz-meta-" LocationConstraint
    k
                                         return (i, v)
            missingUserMetadata :: Maybe LocationConstraint
    missingUserMetadata = ByteString -> LocationConstraint
    T.decodeUtf8 (ByteString -> LocationConstraint)
    -> Maybe ByteString -> Maybe LocationConstraint
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` HeaderName -> RequestHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "x-amz-missing-meta" RequestHeaders
    h
            serverSideEncryption :: m (Maybe ServerSideEncryption)
    serverSideEncryption = case ByteString -> LocationConstraint
    T.decodeUtf8 (ByteString -> LocationConstraint)
    -> Maybe ByteString -> Maybe LocationConstraint
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` HeaderName -> RequestHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "x-amz-server-side-encryption" RequestHeaders
    h of
                                     Just LocationConstraint
    x -> Maybe ServerSideEncryption -> m (Maybe ServerSideEncryption)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ServerSideEncryption -> m (Maybe ServerSideEncryption))
    -> Maybe ServerSideEncryption -> m (Maybe ServerSideEncryption)
    forall a b. (a -> b) -> a -> b
    $ LocationConstraint -> Maybe ServerSideEncryption
    forall (m :: * -> *).
    MonadThrow m =>
    LocationConstraint -> m ServerSideEncryption
    parseServerSideEncryption LocationConstraint
    x
                                     Maybe LocationConstraint
    Nothing -> Maybe ServerSideEncryption -> m (Maybe ServerSideEncryption)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ServerSideEncryption
    forall a. Maybe a
    Nothing

            ht :: [(LocationConstraint, LocationConstraint)]
    ht = ((HeaderName, ByteString)
     -> (LocationConstraint, LocationConstraint))
    -> RequestHeaders -> [(LocationConstraint, LocationConstraint)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((ByteString -> LocationConstraint
    T.decodeUtf8 (ByteString -> LocationConstraint)
    -> (HeaderName -> ByteString) -> HeaderName -> LocationConstraint
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HeaderName -> ByteString
    forall s. CI s -> s
    CI.foldedCase) (HeaderName -> LocationConstraint)
    -> (ByteString -> LocationConstraint)
    -> (HeaderName, ByteString)
    -> (LocationConstraint, LocationConstraint)
    forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** ByteString -> LocationConstraint
    T.decodeUtf8) RequestHeaders
    h

    type LocationConstraint = T.Text

    locationUsClassic, locationUsWest, locationUsWest2, locationEu, locationEuWest2, locationEuFrankfurt, locationApSouthEast, locationApSouthEast2, locationApNorthEast, locationSA :: LocationConstraint
    locationUsClassic :: LocationConstraint
    locationUsClassic = LocationConstraint
    ""
    locationUsWest :: LocationConstraint
    locationUsWest = LocationConstraint
    "us-west-1"
    locationUsWest2 :: LocationConstraint
    locationUsWest2 = LocationConstraint
    "us-west-2"
    locationEu :: LocationConstraint
    locationEu = LocationConstraint
    "EU"
    locationEuWest2 :: LocationConstraint
    locationEuWest2 = LocationConstraint
    "eu-west-2"
    locationEuFrankfurt :: LocationConstraint
    locationEuFrankfurt = LocationConstraint
    "eu-central-1"
    locationApSouthEast :: LocationConstraint
    locationApSouthEast = LocationConstraint
    "ap-southeast-1"
    locationApSouthEast2 :: LocationConstraint
    locationApSouthEast2 = LocationConstraint
    "ap-southeast-2"
    locationApNorthEast :: LocationConstraint
    locationApNorthEast = LocationConstraint
    "ap-northeast-1"
    locationSA :: LocationConstraint
    locationSA = LocationConstraint
    "sa-east-1"

    normaliseLocation :: LocationConstraint -> LocationConstraint
    normaliseLocation :: LocationConstraint -> LocationConstraint
    normaliseLocation LocationConstraint
    location
      | LocationConstraint
    location LocationConstraint -> LocationConstraint -> Bool
    forall a. Eq a => a -> a -> Bool
    == LocationConstraint
    "eu-west-1" = LocationConstraint
    locationEu
      | Bool
    otherwise = LocationConstraint
    location