    {-# LANGUAGE CPP #-}
    module Aws.Core
    ( -- * Logging
      Loggable(..)
      -- * Response
      -- ** Metadata in responses
    , Response(..)
    , readResponse
    , readResponseIO
    , tellMetadata
    , tellMetadataRef
    , mapMetadata
      -- ** Response data consumers
    , HTTPResponseConsumer
    , ResponseConsumer(..)
      -- ** Memory response
    , AsMemoryResponse(..)
      -- ** List response
    , ListResponse(..)
      -- ** Exception types
    , XmlException(..)
    , HeaderException(..)
    , FormException(..)
    , NoCredentialsException(..)
    , throwStatusCodeException
      -- ** Response deconstruction helpers
    , readHex2
      -- *** XML
    , elContent
    , elCont
    , force
    , forceM
    , textReadBool
    , textReadInt
    , readInt
    , xmlCursorConsumer
      -- * Query
    , SignedQuery(..)
    , NormalQuery
    , UriOnlyQuery
    , queryToHttpRequest
    , queryToUri
      -- ** Expiration
    , TimeInfo(..)
    , AbsoluteTimeInfo(..)
    , fromAbsoluteTimeInfo
    , makeAbsoluteTimeInfo
     -- ** Signature
    , SignatureData(..)
    , signatureData
    , SignQuery(..)
    , AuthorizationHash(..)
    , amzHash
    , signature
    , credentialV4
    , authorizationV4
    , authorizationV4'
    , signatureV4
      -- ** Query construction helpers
    , queryList
    , awsBool
    , awsTrue
    , awsFalse
    , fmtTime
    , fmtRfc822Time
    , rfc822Time
    , fmtAmzTime
    , fmtTimeEpochSeconds
    , parseHttpDate
    , httpDate1
    , textHttpDate
    , iso8601UtcDate
      -- * Transactions
    , Transaction
    , IteratedTransaction(..)
      -- * Credentials
    , Credentials(..)
    , makeCredentials
    , credentialsDefaultFile
    , credentialsDefaultKey
    , loadCredentialsFromFile
    , loadCredentialsFromEnv
    , loadCredentialsFromInstanceMetadata
    , loadCredentialsFromEnvOrFile
    , loadCredentialsFromEnvOrFileOrInstanceMetadata
    , loadCredentialsDefault
    , anonymousCredentials
      -- * Service configuration
    , DefaultServiceConfiguration(..)
      -- * HTTP types
    , Protocol(..)
    , defaultPort
    , Method(..)
    , httpMethod
    )
    where

    import           Aws.Ec2.InstanceMetadata
    import           Aws.Network
    import qualified Blaze.ByteString.Builder as Blaze
    import           Control.Applicative
    import           Control.Arrow
    import qualified Control.Exception        as E
    import           Control.Monad
    import           Control.Monad.IO.Class
    import           Control.Monad.Trans.Resource (ResourceT, MonadThrow (throwM))
    import qualified Crypto.Hash              as CH
    import qualified Crypto.MAC.HMAC          as CMH
    import qualified Data.Aeson               as A
    import qualified Data.ByteArray           as ByteArray
    import           Data.ByteString          (ByteString)
    import qualified Data.ByteString          as B
    import qualified Data.ByteString.Base16   as Base16
    import qualified Data.ByteString.Base64   as Base64
    import           Data.ByteString.Char8    ({- IsString -})
    import qualified Data.ByteString.Lazy     as L
    import qualified Data.ByteString.UTF8     as BU
    import           Data.Char
    import           Data.Conduit             ((.|))
    import qualified Data.Conduit             as C
    #if MIN_VERSION_http_conduit(2,2,0)
    import qualified Data.Conduit.Binary      as CB
    #endif
    import qualified Data.Conduit.List        as CL
    import           Data.Kind
    import           Data.IORef
    import           Data.List
    import qualified Data.Map                 as M
    import           Data.Maybe
    import           Data.Monoid
    import qualified Data.Text                as T
    import qualified Data.Text.Encoding       as T
    import qualified Data.Text.IO             as T
    import           Data.Time
    import qualified Data.Traversable         as Traversable
    import           Data.Typeable
    import           Data.Word
    import qualified Network.HTTP.Conduit     as HTTP
    import qualified Network.HTTP.Client.TLS  as HTTP
    import qualified Network.HTTP.Types       as HTTP
    import           System.Directory
    import           System.Environment
    import           System.FilePath          ((</>))
    #if !MIN_VERSION_time(1,5,0)
    import           System.Locale
    #endif
    import qualified Text.XML                 as XML
    import qualified Text.XML.Cursor          as Cu
    import           Text.XML.Cursor          hiding (force, forceM)
    import           Prelude
    -------------------------------------------------------------------------------

    -- | Types that can be logged (textually).
    class Loggable a where
        toLogText :: a -> T.Text

    -- | A response with metadata. Can also contain an error response, or
    -- an internal error, via 'Attempt'.
    --
    -- Response forms a Writer-like monad.
    data Response m a = Response { forall m a. Response m a -> m
    responseMetadata :: m
                                 , forall m a. Response m a -> Either SomeException a
    responseResult :: Either E.SomeException a }
        deriving (Int -> Response m a -> ShowS
    [Response m a] -> ShowS
    Response m a -> String
    (Int -> Response m a -> ShowS)
    -> (Response m a -> String)
    -> ([Response m a] -> ShowS)
    -> Show (Response m a)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall m a. (Show m, Show a) => Int -> Response m a -> ShowS
    forall m a. (Show m, Show a) => [Response m a] -> ShowS
    forall m a. (Show m, Show a) => Response m a -> String
    $cshowsPrec :: forall m a. (Show m, Show a) => Int -> Response m a -> ShowS
    showsPrec :: Int -> Response m a -> ShowS
    $cshow :: forall m a. (Show m, Show a) => Response m a -> String
    show :: Response m a -> String
    $cshowList :: forall m a. (Show m, Show a) => [Response m a] -> ShowS
    showList :: [Response m a] -> ShowS
    Show, (forall a b. (a -> b) -> Response m a -> Response m b)
    -> (forall a b. a -> Response m b -> Response m a)
    -> Functor (Response m)
    forall a b. a -> Response m b -> Response m a
    forall a b. (a -> b) -> Response m a -> Response m b
    forall m a b. a -> Response m b -> Response m a
    forall m a b. (a -> b) -> Response m a -> Response m b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall m a b. (a -> b) -> Response m a -> Response m b
    fmap :: forall a b. (a -> b) -> Response m a -> Response m b
    $c<$ :: forall m a b. a -> Response m b -> Response m a
    <$ :: forall a b. a -> Response m b -> Response m a
    Functor)

    -- | Read a response result (if it's a success response, fail otherwise).
    readResponse :: MonadThrow n => Response m a -> n a
    readResponse :: forall (n :: * -> *) m a. MonadThrow n => Response m a -> n a
    readResponse = (SomeException -> n a)
    -> (a -> n a) -> Either SomeException a -> n a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either SomeException -> n a
    forall e a. (HasCallStack, Exception e) => e -> n a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM a -> n a
    forall a. a -> n a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either SomeException a -> n a)
    -> (Response m a -> Either SomeException a) -> Response m a -> n a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Response m a -> Either SomeException a
    forall m a. Response m a -> Either SomeException a
    responseResult

    -- | Read a response result (if it's a success response, fail otherwise). In MonadIO.
    readResponseIO :: MonadIO io => Response m a -> io a
    readResponseIO :: forall (io :: * -> *) m a. MonadIO io => Response m a -> io a
    readResponseIO = IO a -> io a
    forall a. IO a -> io a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> io a) -> (Response m a -> IO a) -> Response m a -> io a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Response m a -> IO a
    forall (n :: * -> *) m a. MonadThrow n => Response m a -> n a
    readResponse

    -- | An empty response with some metadata.
    tellMetadata :: m -> Response m ()
    tellMetadata :: forall m. m -> Response m ()
    tellMetadata m
    m = m -> Either SomeException () -> Response m ()
    forall m a. m -> Either SomeException a -> Response m a
    Response m
    m (() -> Either SomeException ()
    forall a. a -> Either SomeException a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    -- | Apply a function to the metadata.
    mapMetadata :: (m -> n) -> Response m a -> Response n a
    mapMetadata :: forall m n a. (m -> n) -> Response m a -> Response n a
    mapMetadata m -> n
    f (Response m
    m Either SomeException a
    a) = n -> Either SomeException a -> Response n a
    forall m a. m -> Either SomeException a -> Response m a
    Response (m -> n
    f m
    m) Either SomeException a
    a

    --multiResponse :: Monoid m => Response m a -> Response [m] a ->

    instance Monoid m => Applicative (Response m) where
        pure :: forall a. a -> Response m a
    pure a
    x = m -> Either SomeException a -> Response m a
    forall m a. m -> Either SomeException a -> Response m a
    Response m
    forall a. Monoid a => a
    mempty (a -> Either SomeException a
    forall a b. b -> Either a b
    Right a
    x)
        <*> :: forall a b. Response m (a -> b) -> Response m a -> Response m b
    (<*>) = Response m (a -> b) -> Response m a -> Response m b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monoid m => Monad (Response m) where
        return :: forall a. a -> Response m a
    return a
    x = m -> Either SomeException a -> Response m a
    forall m a. m -> Either SomeException a -> Response m a
    Response m
    forall a. Monoid a => a
    mempty (a -> Either SomeException a
    forall a b. b -> Either a b
    Right a
    x)
        Response m
    m1 (Left SomeException
    e) >>= :: forall a b. Response m a -> (a -> Response m b) -> Response m b
    >>= a -> Response m b
    _ = m -> Either SomeException b -> Response m b
    forall m a. m -> Either SomeException a -> Response m a
    Response m
    m1 (SomeException -> Either SomeException b
    forall a b. a -> Either a b
    Left SomeException
    e)
        Response m
    m1 (Right a
    x) >>= a -> Response m b
    f = let Response m
    m2 Either SomeException b
    y = a -> Response m b
    f a
    x
                                      in m -> Either SomeException b -> Response m b
    forall m a. m -> Either SomeException a -> Response m a
    Response (m
    m1 m -> m -> m
    forall a. Monoid a => a -> a -> a
    `mappend` m
    m2) Either SomeException b
    y -- currently using First-semantics, Last SHOULD work too

    instance Monoid m => MonadThrow (Response m) where
        throwM :: forall e a. (HasCallStack, Exception e) => e -> Response m a
    throwM e
    e = m -> Either SomeException a -> Response m a
    forall m a. m -> Either SomeException a -> Response m a
    Response m
    forall a. Monoid a => a
    mempty (e -> Either SomeException a
    forall e a.
    (HasCallStack, Exception e) =>
    e -> Either SomeException a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM e
    e)

    -- | Add metadata to an 'IORef' (using 'mappend').
    tellMetadataRef :: Monoid m => IORef m -> m -> IO ()
    tellMetadataRef :: forall m. Monoid m => IORef m -> m -> IO ()
    tellMetadataRef IORef m
    r m
    m = IORef m -> (m -> m) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef IORef m
    r (m -> m -> m
    forall a. Monoid a => a -> a -> a
    `mappend` m
    m)

    -- | A full HTTP response parser. Takes HTTP status, response headers, and response body.
    type HTTPResponseConsumer a = HTTP.Response (C.ConduitM () ByteString (ResourceT IO) ())
                                  -> ResourceT IO a

    -- | Class for types that AWS HTTP responses can be parsed into.
    --
    -- The request is also passed for possibly required additional metadata.
    --
    -- Note that for debugging, there is an instance for 'L.ByteString'.
    class Monoid (ResponseMetadata resp) => ResponseConsumer req resp where
        -- | Metadata associated with a response. Typically there is one
        -- metadata type for each AWS service.
        type ResponseMetadata resp

        -- | Response parser. Takes the corresponding AWS request, the derived
        -- @http-client@ request (for error reporting), an 'IORef' for metadata, and
        -- HTTP response data.
        responseConsumer :: HTTP.Request -> req -> IORef (ResponseMetadata resp) -> HTTPResponseConsumer resp

    -- | Does not parse response. For debugging.
    instance ResponseConsumer r (HTTP.Response L.ByteString) where
        type ResponseMetadata (HTTP.Response L.ByteString) = ()
        responseConsumer :: Request
    -> r
    -> IORef (ResponseMetadata (Response ByteString))
    -> HTTPResponseConsumer (Response ByteString)
    responseConsumer Request
    _ r
    _ IORef (ResponseMetadata (Response ByteString))
    _ Response (ConduitM () ByteString (ResourceT IO) ())
    resp = do
            bss <- ConduitT () Void (ResourceT IO) [ByteString]
    -> ResourceT IO [ByteString]
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    C.runConduit (ConduitT () Void (ResourceT IO) [ByteString]
     -> ResourceT IO [ByteString])
    -> ConduitT () Void (ResourceT IO) [ByteString]
    -> ResourceT IO [ByteString]
    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) [ByteString]
    -> ConduitT () Void (ResourceT IO) [ByteString]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT ByteString Void (ResourceT IO) [ByteString]
    forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
    CL.consume
            return resp
                { HTTP.responseBody = L.fromChunks bss
                }

    -- | Class for responses that are fully loaded into memory
    class AsMemoryResponse resp where
        type MemoryResponse resp :: Type
        loadToMemory :: resp -> ResourceT IO (MemoryResponse resp)

    -- | Responses that have one main list in them, and perhaps some decoration.
    class ListResponse resp item | resp -> item where
        listResponse :: resp -> [item]

    -- | Associates a request type and a response type in a bi-directional way.
    --
    -- This allows the type-checker to infer the response type when given
    -- the request type and vice versa.
    --
    -- Note that the actual request generation and response parsing
    -- resides in 'SignQuery' and 'ResponseConsumer' respectively.
    class (SignQuery r, ResponseConsumer r a, Loggable (ResponseMetadata a))
          => Transaction r a
          | r -> a

    -- | A transaction that may need to be split over multiple requests, for example because of upstream response size limits.
    class Transaction r a => IteratedTransaction r a | r -> a where
        nextIteratedRequest :: r -> a -> Maybe r

    -- | Signature version 4: ((region, service),(date,key))
    type V4Key = ((B.ByteString,B.ByteString),(B.ByteString,B.ByteString))

    -- | AWS access credentials.
    data Credentials
        = Credentials {
            -- | AWS Access Key ID.
            Credentials -> ByteString
    accessKeyID :: B.ByteString
            -- | AWS Secret Access Key.
          , Credentials -> ByteString
    secretAccessKey :: B.ByteString
            -- | Signing keys for signature version 4
          , Credentials -> IORef [V4Key]
    v4SigningKeys :: IORef [V4Key]
            -- | Signed IAM token
          , Credentials -> Maybe ByteString
    iamToken :: Maybe B.ByteString
            -- | Set when the credentials are intended for anonymous access.
          , Credentials -> Bool
    isAnonymousCredentials :: Bool
          }
    instance Show Credentials where
        show :: Credentials -> String
    show c :: Credentials
    c@(Credentials {}) = String
    "Credentials{accessKeyID=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ByteString -> String
    forall a. Show a => a -> String
    show (Credentials -> ByteString
    accessKeyID Credentials
    c) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ",secretAccessKey=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ByteString -> String
    forall a. Show a => a -> String
    show (Credentials -> ByteString
    secretAccessKey Credentials
    c) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ",iamToken=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Maybe ByteString -> String
    forall a. Show a => a -> String
    show (Credentials -> Maybe ByteString
    iamToken Credentials
    c) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "}"

    makeCredentials :: MonadIO io
                    => B.ByteString -- ^ AWS Access Key ID
                    -> B.ByteString -- ^ AWS Secret Access Key
                    -> io Credentials
    makeCredentials :: forall (io :: * -> *).
    MonadIO io =>
    ByteString -> ByteString -> io Credentials
    makeCredentials ByteString
    accessKeyID ByteString
    secretAccessKey = IO Credentials -> io Credentials
    forall a. IO a -> io a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Credentials -> io Credentials)
    -> IO Credentials -> io Credentials
    forall a b. (a -> b) -> a -> b
    $ do
        v4SigningKeys <- [V4Key] -> IO (IORef [V4Key])
    forall a. a -> IO (IORef a)
    newIORef []
        let iamToken = Maybe a
    forall a. Maybe a
    Nothing
        let isAnonymousCredentials = Bool
    False
        return Credentials { .. }

    -- | The file where access credentials are loaded, when using 'loadCredentialsDefault'.
    -- May return 'Nothing' if @HOME@ is unset.
    --
    -- Value: /<user directory>/@/.aws-keys@
    credentialsDefaultFile :: MonadIO io => io (Maybe FilePath)
    credentialsDefaultFile :: forall (io :: * -> *). MonadIO io => io (Maybe String)
    credentialsDefaultFile = IO (Maybe String) -> io (Maybe String)
    forall a. IO a -> io a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe String) -> io (Maybe String))
    -> IO (Maybe String) -> io (Maybe String)
    forall a b. (a -> b) -> a -> b
    $ IO String -> IO (Maybe String)
    forall a. IO a -> IO (Maybe a)
    tryMaybe ((String -> ShowS
    </> String
    ".aws-keys") ShowS -> IO String -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO String
    getHomeDirectory)

    tryMaybe :: IO a -> IO (Maybe a)
    tryMaybe :: forall a. IO a -> IO (Maybe a)
    tryMaybe IO a
    action = IO (Maybe a) -> (SomeException -> IO (Maybe a)) -> IO (Maybe a)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch (a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> IO a -> IO (Maybe a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO a
    action) SomeException -> IO (Maybe a)
    forall a. SomeException -> IO (Maybe a)
    f
      where
        f :: E.SomeException -> IO (Maybe a)
        f :: forall a. SomeException -> IO (Maybe a)
    f SomeException
    _ = Maybe a -> IO (Maybe a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing

    -- | The key to be used in the access credential file that is loaded, when using 'loadCredentialsDefault'.
    --
    -- Value: @default@
    credentialsDefaultKey :: T.Text
    credentialsDefaultKey :: Text
    credentialsDefaultKey = Text
    "default"

    -- | Load credentials from a (text) file given a key name.
    --
    -- The file consists of a sequence of lines, each in the following format:
    --
    -- @keyName awsKeyID awsKeySecret@
    loadCredentialsFromFile :: MonadIO io => FilePath -> T.Text -> io (Maybe Credentials)
    loadCredentialsFromFile :: forall (io :: * -> *).
    MonadIO io =>
    String -> Text -> io (Maybe Credentials)
    loadCredentialsFromFile String
    file Text
    key = IO (Maybe Credentials) -> io (Maybe Credentials)
    forall a. IO a -> io a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe Credentials) -> io (Maybe Credentials))
    -> IO (Maybe Credentials) -> io (Maybe Credentials)
    forall a b. (a -> b) -> a -> b
    $ do
      exists <- String -> IO Bool
    doesFileExist String
    file
      if exists
        then do
          contents <- map T.words . T.lines <$> T.readFile file
          Traversable.sequence $ do
            [_key, keyID, secret] <- find (hasKey key) contents
            return (makeCredentials (T.encodeUtf8 keyID) (T.encodeUtf8 secret))
        else return Nothing
      where
        hasKey :: a -> [a] -> Bool
    hasKey a
    _ [] = Bool
    False
        hasKey a
    k (a
    k2 : [a]
    _) = a
    k a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    k2

    -- | Load credentials from the environment variables @AWS_ACCESS_KEY_ID@ and @AWS_ACCESS_KEY_SECRET@
    --   (or @AWS_SECRET_ACCESS_KEY@), if possible.
    loadCredentialsFromEnv :: MonadIO io => io (Maybe Credentials)
    loadCredentialsFromEnv :: forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
    loadCredentialsFromEnv = IO (Maybe Credentials) -> io (Maybe Credentials)
    forall a. IO a -> io a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe Credentials) -> io (Maybe Credentials))
    -> IO (Maybe Credentials) -> io (Maybe Credentials)
    forall a b. (a -> b) -> a -> b
    $ do
      env <- IO [(String, String)]
    getEnvironment
      let lk = (String -> ByteString) -> Maybe String -> Maybe ByteString
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Text -> ByteString
    T.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack) (Maybe String -> Maybe ByteString)
    -> (String -> Maybe String) -> String -> Maybe ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> [(String, String)] -> Maybe String)
    -> [(String, String)] -> String -> Maybe String
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup [(String, String)]
    env
          keyID = String -> Maybe ByteString
    lk String
    "AWS_ACCESS_KEY_ID"
          secret = String -> Maybe ByteString
    lk String
    "AWS_ACCESS_KEY_SECRET" Maybe ByteString -> Maybe ByteString -> Maybe ByteString
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` String -> Maybe ByteString
    lk String
    "AWS_SECRET_ACCESS_KEY"
          setSession Credentials
    creds = Credentials
    creds { iamToken = lk "AWS_SESSION_TOKEN" }
          makeCredentials' ByteString
    k ByteString
    s = Credentials -> Credentials
    setSession (Credentials -> Credentials) -> IO Credentials -> IO Credentials
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ByteString -> ByteString -> IO Credentials
    forall (io :: * -> *).
    MonadIO io =>
    ByteString -> ByteString -> io Credentials
    makeCredentials ByteString
    k ByteString
    s
      Traversable.sequence $ makeCredentials' <$> keyID <*> secret

    loadCredentialsFromInstanceMetadata :: MonadIO io => io (Maybe Credentials)
    loadCredentialsFromInstanceMetadata :: forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
    loadCredentialsFromInstanceMetadata = do
        mgr <- IO Manager -> io Manager
    forall a. IO a -> io a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO Manager
    HTTP.getGlobalManager
        -- check if the path is routable
        avail <- liftIO $ hostAvailable "169.254.169.254"
        if not avail
          then return Nothing
          else do
            info <- liftIO $ E.catch (getInstanceMetadata mgr "latest/meta-data/iam" "info" >>= return . Just) (\(HttpException
    _ :: HTTP.HttpException) -> Maybe ByteString -> IO (Maybe ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ByteString
    forall a. Maybe a
    Nothing)
            let infodict = Maybe ByteString
    info Maybe ByteString
    -> (ByteString -> Maybe (Map String String))
    -> Maybe (Map String String)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ByteString -> Maybe (Map String String)
    forall a. FromJSON a => ByteString -> Maybe a
    A.decode :: Maybe (M.Map String String)
                info'    = Maybe (Map String String)
    infodict Maybe (Map String String)
    -> (Map String String -> Maybe String) -> Maybe String
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> Map String String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup String
    "InstanceProfileArn"
            case info' of
              Just String
    name ->
                do
                  let name' :: String
    name' = Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop Int
    1 ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '/') ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String
    name
                  creds <- IO (Maybe ByteString) -> io (Maybe ByteString)
    forall a. IO a -> io a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe ByteString) -> io (Maybe ByteString))
    -> IO (Maybe ByteString) -> io (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ IO (Maybe ByteString)
    -> (HttpException -> IO (Maybe ByteString))
    -> IO (Maybe ByteString)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch (Manager -> String -> String -> IO ByteString
    getInstanceMetadata Manager
    mgr String
    "latest/meta-data/iam/security-credentials" String
    name' IO ByteString
    -> (ByteString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe ByteString -> IO (Maybe ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ByteString -> IO (Maybe ByteString))
    -> (ByteString -> Maybe ByteString)
    -> ByteString
    -> IO (Maybe ByteString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just) (\(HttpException
    _ :: HTTP.HttpException) -> Maybe ByteString -> IO (Maybe ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ByteString
    forall a. Maybe a
    Nothing)
                  -- this token lasts ~6 hours
                  let dict   = Maybe ByteString
    creds Maybe ByteString
    -> (ByteString -> Maybe (Map String String))
    -> Maybe (Map String String)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ByteString -> Maybe (Map String String)
    forall a. FromJSON a => ByteString -> Maybe a
    A.decode :: Maybe (M.Map String String)
                      keyID  = Maybe (Map String String)
    dict  Maybe (Map String String)
    -> (Map String String -> Maybe String) -> Maybe String
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> Map String String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup String
    "AccessKeyId"
                      secret = Maybe (Map String String)
    dict  Maybe (Map String String)
    -> (Map String String -> Maybe String) -> Maybe String
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> Map String String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup String
    "SecretAccessKey"
                      token  = Maybe (Map String String)
    dict  Maybe (Map String String)
    -> (Map String String -> Maybe String) -> Maybe String
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> Map String String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup String
    "Token"
                  ref <- liftIO $ newIORef []
                  return (Credentials <$> (T.encodeUtf8 . T.pack <$> keyID)
                                      <*> (T.encodeUtf8 . T.pack <$> secret)
                                      <*> return ref
                                      <*> (Just . T.encodeUtf8 . T.pack <$> token)
                                      <*> return False)
              Maybe String
    Nothing -> Maybe Credentials -> io (Maybe Credentials)
    forall a. a -> io a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Credentials
    forall a. Maybe a
    Nothing

    -- | Load credentials from environment variables if possible, or alternatively from a file with a given key name.
    --
    -- See 'loadCredentialsFromEnv' and 'loadCredentialsFromFile' for details.
    loadCredentialsFromEnvOrFile :: MonadIO io => FilePath -> T.Text -> io (Maybe Credentials)
    loadCredentialsFromEnvOrFile :: forall (io :: * -> *).
    MonadIO io =>
    String -> Text -> io (Maybe Credentials)
    loadCredentialsFromEnvOrFile String
    file Text
    key =
      do
        envcr <- io (Maybe Credentials)
    forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
    loadCredentialsFromEnv
        case envcr of
          Just Credentials
    cr -> Maybe Credentials -> io (Maybe Credentials)
    forall a. a -> io a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Credentials -> Maybe Credentials
    forall a. a -> Maybe a
    Just Credentials
    cr)
          Maybe Credentials
    Nothing -> String -> Text -> io (Maybe Credentials)
    forall (io :: * -> *).
    MonadIO io =>
    String -> Text -> io (Maybe Credentials)
    loadCredentialsFromFile String
    file Text
    key

    -- | Load credentials from environment variables if possible, or alternatively from the instance metadata store, or alternatively from a file with a given key name.
    --
    -- See 'loadCredentialsFromEnv', 'loadCredentialsFromFile' and 'loadCredentialsFromInstanceMetadata' for details.
    loadCredentialsFromEnvOrFileOrInstanceMetadata :: MonadIO io => FilePath -> T.Text -> io (Maybe Credentials)
    loadCredentialsFromEnvOrFileOrInstanceMetadata :: forall (io :: * -> *).
    MonadIO io =>
    String -> Text -> io (Maybe Credentials)
    loadCredentialsFromEnvOrFileOrInstanceMetadata String
    file Text
    key =
      do
        envcr <- io (Maybe Credentials)
    forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
    loadCredentialsFromEnv
        case envcr of
          Just Credentials
    cr -> Maybe Credentials -> io (Maybe Credentials)
    forall a. a -> io a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Credentials -> Maybe Credentials
    forall a. a -> Maybe a
    Just Credentials
    cr)
          Maybe Credentials
    Nothing ->
            do
              filecr <- String -> Text -> io (Maybe Credentials)
    forall (io :: * -> *).
    MonadIO io =>
    String -> Text -> io (Maybe Credentials)
    loadCredentialsFromFile String
    file Text
    key
              case filecr of
                Just Credentials
    cr -> Maybe Credentials -> io (Maybe Credentials)
    forall a. a -> io a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Credentials -> Maybe Credentials
    forall a. a -> Maybe a
    Just Credentials
    cr)
                Maybe Credentials
    Nothing -> io (Maybe Credentials)
    forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
    loadCredentialsFromInstanceMetadata

    -- | Load credentials from environment variables if possible, or alternative from the default file with the default
    -- key name.
    --
    -- Default file: /<user directory>/@/.aws-keys@
    -- Default key name: @default@
    --
    -- See 'loadCredentialsFromEnv' and 'loadCredentialsFromFile' for details.
    loadCredentialsDefault :: MonadIO io => io (Maybe Credentials)
    loadCredentialsDefault :: forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
    loadCredentialsDefault = do
      mfile <- io (Maybe String)
    forall (io :: * -> *). MonadIO io => io (Maybe String)
    credentialsDefaultFile
      case mfile of
          Just String
    file -> String -> Text -> io (Maybe Credentials)
    forall (io :: * -> *).
    MonadIO io =>
    String -> Text -> io (Maybe Credentials)
    loadCredentialsFromEnvOrFileOrInstanceMetadata String
    file Text
    credentialsDefaultKey
          Maybe String
    Nothing   -> io (Maybe Credentials)
    forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
    loadCredentialsFromEnv

    -- | Make a dummy Credentials that can be used to access some AWS services
    -- anonymously.
    anonymousCredentials :: MonadIO io => io Credentials
    anonymousCredentials :: forall (io :: * -> *). MonadIO io => io Credentials
    anonymousCredentials = do
      cr <- ByteString -> ByteString -> io Credentials
    forall (io :: * -> *).
    MonadIO io =>
    ByteString -> ByteString -> io Credentials
    makeCredentials ByteString
    forall a. Monoid a => a
    mempty ByteString
    forall a. Monoid a => a
    mempty
      return (cr { isAnonymousCredentials = True })

    -- | Protocols supported by AWS. Currently, all AWS services use the HTTP or HTTPS protocols.
    data Protocol
        = HTTP
        | HTTPS
        deriving (Protocol -> Protocol -> Bool
    (Protocol -> Protocol -> Bool)
    -> (Protocol -> Protocol -> Bool) -> Eq Protocol
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Protocol -> Protocol -> Bool
    == :: Protocol -> Protocol -> Bool
    $c/= :: Protocol -> Protocol -> Bool
    /= :: Protocol -> Protocol -> Bool
    Eq,ReadPrec [Protocol]
    ReadPrec Protocol
    Int -> ReadS Protocol
    ReadS [Protocol]
    (Int -> ReadS Protocol)
    -> ReadS [Protocol]
    -> ReadPrec Protocol
    -> ReadPrec [Protocol]
    -> Read Protocol
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS Protocol
    readsPrec :: Int -> ReadS Protocol
    $creadList :: ReadS [Protocol]
    readList :: ReadS [Protocol]
    $creadPrec :: ReadPrec Protocol
    readPrec :: ReadPrec Protocol
    $creadListPrec :: ReadPrec [Protocol]
    readListPrec :: ReadPrec [Protocol]
    Read,Int -> Protocol -> ShowS
    [Protocol] -> ShowS
    Protocol -> String
    (Int -> Protocol -> ShowS)
    -> (Protocol -> String) -> ([Protocol] -> ShowS) -> Show Protocol
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Protocol -> ShowS
    showsPrec :: Int -> Protocol -> ShowS
    $cshow :: Protocol -> String
    show :: Protocol -> String
    $cshowList :: [Protocol] -> ShowS
    showList :: [Protocol] -> ShowS
    Show,Eq Protocol
    Eq Protocol =>
    (Protocol -> Protocol -> Ordering)
    -> (Protocol -> Protocol -> Bool)
    -> (Protocol -> Protocol -> Bool)
    -> (Protocol -> Protocol -> Bool)
    -> (Protocol -> Protocol -> Bool)
    -> (Protocol -> Protocol -> Protocol)
    -> (Protocol -> Protocol -> Protocol)
    -> Ord Protocol
    Protocol -> Protocol -> Bool
    Protocol -> Protocol -> Ordering
    Protocol -> Protocol -> Protocol
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Protocol -> Protocol -> Ordering
    compare :: Protocol -> Protocol -> Ordering
    $c< :: Protocol -> Protocol -> Bool
    < :: Protocol -> Protocol -> Bool
    $c<= :: Protocol -> Protocol -> Bool
    <= :: Protocol -> Protocol -> Bool
    $c> :: Protocol -> Protocol -> Bool
    > :: Protocol -> Protocol -> Bool
    $c>= :: Protocol -> Protocol -> Bool
    >= :: Protocol -> Protocol -> Bool
    $cmax :: Protocol -> Protocol -> Protocol
    max :: Protocol -> Protocol -> Protocol
    $cmin :: Protocol -> Protocol -> Protocol
    min :: Protocol -> Protocol -> Protocol
    Ord,Typeable)

    -- | The default port to be used for a protocol if no specific port is specified.
    defaultPort :: Protocol -> Int
    defaultPort :: Protocol -> Int
    defaultPort Protocol
    HTTP = Int
    80
    defaultPort Protocol
    HTTPS = Int
    443

    -- | Request method. Not all request methods are supported by all services.
    data Method
        = Head      -- ^ HEAD method. Put all request parameters in a query string and HTTP headers.
        | Get       -- ^ GET method. Put all request parameters in a query string and HTTP headers.
        | PostQuery -- ^ POST method. Put all request parameters in a query string and HTTP headers, but send the query string
                    --   as a POST payload
        | Post      -- ^ POST method. Sends a service- and request-specific request body.
        | Put       -- ^ PUT method.
        | Delete    -- ^ DELETE method.
        deriving (Int -> Method -> ShowS
    [Method] -> ShowS
    Method -> String
    (Int -> Method -> ShowS)
    -> (Method -> String) -> ([Method] -> ShowS) -> Show Method
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Method -> ShowS
    showsPrec :: Int -> Method -> ShowS
    $cshow :: Method -> String
    show :: Method -> String
    $cshowList :: [Method] -> ShowS
    showList :: [Method] -> ShowS
    Show, Method -> Method -> Bool
    (Method -> Method -> Bool)
    -> (Method -> Method -> Bool) -> Eq Method
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Method -> Method -> Bool
    == :: Method -> Method -> Bool
    $c/= :: Method -> Method -> Bool
    /= :: Method -> Method -> Bool
    Eq, Eq Method
    Eq Method =>
    (Method -> Method -> Ordering)
    -> (Method -> Method -> Bool)
    -> (Method -> Method -> Bool)
    -> (Method -> Method -> Bool)
    -> (Method -> Method -> Bool)
    -> (Method -> Method -> Method)
    -> (Method -> Method -> Method)
    -> Ord Method
    Method -> Method -> Bool
    Method -> Method -> Ordering
    Method -> Method -> Method
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Method -> Method -> Ordering
    compare :: Method -> Method -> Ordering
    $c< :: Method -> Method -> Bool
    < :: Method -> Method -> Bool
    $c<= :: Method -> Method -> Bool
    <= :: Method -> Method -> Bool
    $c> :: Method -> Method -> Bool
    > :: Method -> Method -> Bool
    $c>= :: Method -> Method -> Bool
    >= :: Method -> Method -> Bool
    $cmax :: Method -> Method -> Method
    max :: Method -> Method -> Method
    $cmin :: Method -> Method -> Method
    min :: Method -> Method -> Method
    Ord)

    -- | HTTP method associated with a request method.
    httpMethod :: Method -> HTTP.Method
    httpMethod :: Method -> ByteString
    httpMethod Method
    Head      = ByteString
    "HEAD"
    httpMethod Method
    Get       = ByteString
    "GET"
    httpMethod Method
    PostQuery = ByteString
    "POST"
    httpMethod Method
    Post      = ByteString
    "POST"
    httpMethod Method
    Put       = ByteString
    "PUT"
    httpMethod Method
    Delete    = ByteString
    "DELETE"

    -- | A pre-signed medium-level request object.
    data SignedQuery
        = SignedQuery {
            -- | Request method.
            SignedQuery -> Method
    sqMethod :: !Method
            -- | Protocol to be used.
          , SignedQuery -> Protocol
    sqProtocol :: !Protocol
            -- | HTTP host.
          , SignedQuery -> ByteString
    sqHost :: !B.ByteString
            -- | IP port.
          , SignedQuery -> Int
    sqPort :: !Int
            -- | HTTP path.
          , SignedQuery -> ByteString
    sqPath :: !B.ByteString
            -- | Query string list (used with 'Get' and 'PostQuery').
          , SignedQuery -> Query
    sqQuery :: !HTTP.Query
            -- | Request date/time.
          , SignedQuery -> Maybe UTCTime
    sqDate :: !(Maybe UTCTime)
            -- | Authorization string (if applicable), for @Authorization@ header.  See 'authorizationV4'
          , SignedQuery -> Maybe (IO ByteString)
    sqAuthorization :: !(Maybe (IO B.ByteString))
            -- | Request body content type.
          , SignedQuery -> Maybe ByteString
    sqContentType :: !(Maybe B.ByteString)
            -- | Request body content MD5.
          , SignedQuery -> Maybe (Digest MD5)
    sqContentMd5 :: !(Maybe (CH.Digest CH.MD5))
            -- | Additional Amazon "amz" headers.
          , SignedQuery -> RequestHeaders
    sqAmzHeaders :: !HTTP.RequestHeaders
            -- | Additional non-"amz" headers.
          , SignedQuery -> RequestHeaders
    sqOtherHeaders :: !HTTP.RequestHeaders
            -- | Request body (used with 'Post' and 'Put').
          , SignedQuery -> Maybe RequestBody
    sqBody :: !(Maybe HTTP.RequestBody)
            -- | String to sign. Note that the string is already signed, this is passed mostly for debugging purposes.
          , SignedQuery -> ByteString
    sqStringToSign :: !B.ByteString
          }
        --deriving (Show)

    -- | Create a HTTP request from a 'SignedQuery' object.
    queryToHttpRequest :: SignedQuery -> IO HTTP.Request
    queryToHttpRequest :: SignedQuery -> IO Request
    queryToHttpRequest SignedQuery{Int
    Query
    RequestHeaders
    Maybe (IO ByteString)
    Maybe UTCTime
    Maybe ByteString
    Maybe (Digest MD5)
    Maybe RequestBody
    ByteString
    Method
    Protocol
    sqMethod :: SignedQuery -> Method
    sqProtocol :: SignedQuery -> Protocol
    sqHost :: SignedQuery -> ByteString
    sqPort :: SignedQuery -> Int
    sqPath :: SignedQuery -> ByteString
    sqQuery :: SignedQuery -> Query
    sqDate :: SignedQuery -> Maybe UTCTime
    sqAuthorization :: SignedQuery -> Maybe (IO ByteString)
    sqContentType :: SignedQuery -> Maybe ByteString
    sqContentMd5 :: SignedQuery -> Maybe (Digest MD5)
    sqAmzHeaders :: SignedQuery -> RequestHeaders
    sqOtherHeaders :: SignedQuery -> RequestHeaders
    sqBody :: SignedQuery -> Maybe RequestBody
    sqStringToSign :: SignedQuery -> ByteString
    sqMethod :: Method
    sqProtocol :: Protocol
    sqHost :: ByteString
    sqPort :: Int
    sqPath :: ByteString
    sqQuery :: Query
    sqDate :: Maybe UTCTime
    sqAuthorization :: Maybe (IO ByteString)
    sqContentType :: Maybe ByteString
    sqContentMd5 :: Maybe (Digest MD5)
    sqAmzHeaders :: RequestHeaders
    sqOtherHeaders :: RequestHeaders
    sqBody :: Maybe RequestBody
    sqStringToSign :: ByteString
    ..} =  do
        mauth <- IO (Maybe ByteString)
    -> (IO ByteString -> IO (Maybe ByteString))
    -> Maybe (IO ByteString)
    -> IO (Maybe ByteString)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Maybe ByteString -> IO (Maybe ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ByteString
    forall a. Maybe a
    Nothing) (ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just(ByteString -> Maybe ByteString)
    -> IO ByteString -> IO (Maybe ByteString)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) Maybe (IO ByteString)
    sqAuthorization
        return $ HTTP.defaultRequest {
            HTTP.method = httpMethod sqMethod
          , HTTP.secure = case sqProtocol of
                            Protocol
    HTTP -> Bool
    False
                            Protocol
    HTTPS -> Bool
    True
          , HTTP.host = sqHost
          , HTTP.port = sqPort
          , HTTP.path = sqPath
          , HTTP.queryString =
              if sqMethod == PostQuery
                then ""
                else HTTP.renderQuery False sqQuery

          , HTTP.requestHeaders = catMaybes [ checkDate (\UTCTime
    d -> (HeaderName
    "Date", UTCTime -> ByteString
    fmtRfc822Time UTCTime
    d)) sqDate
                                            , fmap (\ByteString
    c -> (HeaderName
    "Content-Type", ByteString
    c)) contentType
                                            , fmap (\Digest MD5
    md5 -> (HeaderName
    "Content-MD5", ByteString -> ByteString
    Base64.encode (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Digest MD5 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    ByteArray.convert Digest MD5
    md5)) sqContentMd5
                                            , fmap (\ByteString
    auth -> (HeaderName
    "Authorization", ByteString
    auth)) mauth]
                                  ++ sqAmzHeaders
                                  ++ sqOtherHeaders
          , HTTP.requestBody =

            -- An explicityly defined body parameter should overwrite everything else.
            case sqBody of
              Just RequestBody
    x -> RequestBody
    x
              Maybe RequestBody
    Nothing ->
                -- a POST query should convert its query string into the body
                case Method
    sqMethod of
                  Method
    PostQuery -> ByteString -> RequestBody
    HTTP.RequestBodyLBS (ByteString -> RequestBody)
    -> (Builder -> ByteString) -> Builder -> RequestBody
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> ByteString
    Blaze.toLazyByteString (Builder -> RequestBody) -> Builder -> RequestBody
    forall a b. (a -> b) -> a -> b
    $
                               Bool -> Query -> Builder
    HTTP.renderQueryBuilder Bool
    False Query
    sqQuery
                  Method
    _         -> Int64 -> Builder -> RequestBody
    HTTP.RequestBodyBuilder Int64
    0 Builder
    forall a. Monoid a => a
    mempty

          , HTTP.decompress = HTTP.alwaysDecompress
    #if MIN_VERSION_http_conduit(2,2,0)
          , HTTP.checkResponse = \Request
    _ Response (IO ByteString)
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #else
          , HTTP.checkStatus = \_ _ _-> Nothing
    #endif

          , HTTP.redirectCount = 10
          }
        where
          checkDate :: (UTCTime -> Header) -> Maybe UTCTime -> Maybe Header
    checkDate UTCTime -> Header
    f Maybe UTCTime
    mb = Maybe Header
    -> (ByteString -> Maybe Header) -> Maybe ByteString -> Maybe Header
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (UTCTime -> Header
    f (UTCTime -> Header) -> Maybe UTCTime -> Maybe Header
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe UTCTime
    mb) (Maybe Header -> ByteString -> Maybe Header
    forall a b. a -> b -> a
    const Maybe Header
    forall a. Maybe a
    Nothing) (Maybe ByteString -> Maybe Header)
    -> Maybe ByteString -> Maybe Header
    forall a b. (a -> b) -> a -> b
    $ HeaderName -> RequestHeaders -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "date" RequestHeaders
    sqOtherHeaders
          -- An explicitly defined content-type should override everything else.
          contentType :: Maybe ByteString
    contentType = Maybe ByteString
    sqContentType Maybe ByteString -> Maybe ByteString -> Maybe ByteString
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Maybe ByteString
    defContentType
          defContentType :: Maybe ByteString
    defContentType = case Method
    sqMethod of
                             Method
    PostQuery -> ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    "application/x-www-form-urlencoded; charset=utf-8"
                             Method
    _ -> Maybe ByteString
    forall a. Maybe a
    Nothing

    -- | Create a URI fro a 'SignedQuery' object.
    --
    -- Unused / incompatible fields will be silently ignored.
    queryToUri :: SignedQuery -> B.ByteString
    queryToUri :: SignedQuery -> ByteString
    queryToUri SignedQuery{Int
    Query
    RequestHeaders
    Maybe (IO ByteString)
    Maybe UTCTime
    Maybe ByteString
    Maybe (Digest MD5)
    Maybe RequestBody
    ByteString
    Method
    Protocol
    sqMethod :: SignedQuery -> Method
    sqProtocol :: SignedQuery -> Protocol
    sqHost :: SignedQuery -> ByteString
    sqPort :: SignedQuery -> Int
    sqPath :: SignedQuery -> ByteString
    sqQuery :: SignedQuery -> Query
    sqDate :: SignedQuery -> Maybe UTCTime
    sqAuthorization :: SignedQuery -> Maybe (IO ByteString)
    sqContentType :: SignedQuery -> Maybe ByteString
    sqContentMd5 :: SignedQuery -> Maybe (Digest MD5)
    sqAmzHeaders :: SignedQuery -> RequestHeaders
    sqOtherHeaders :: SignedQuery -> RequestHeaders
    sqBody :: SignedQuery -> Maybe RequestBody
    sqStringToSign :: SignedQuery -> ByteString
    sqMethod :: Method
    sqProtocol :: Protocol
    sqHost :: ByteString
    sqPort :: Int
    sqPath :: ByteString
    sqQuery :: Query
    sqDate :: Maybe UTCTime
    sqAuthorization :: Maybe (IO ByteString)
    sqContentType :: Maybe ByteString
    sqContentMd5 :: Maybe (Digest MD5)
    sqAmzHeaders :: RequestHeaders
    sqOtherHeaders :: RequestHeaders
    sqBody :: Maybe RequestBody
    sqStringToSign :: ByteString
    ..}
        = [ByteString] -> ByteString
    B.concat [
           case Protocol
    sqProtocol of
             Protocol
    HTTP -> ByteString
    "http://"
             Protocol
    HTTPS -> ByteString
    "https://"
          , ByteString
    sqHost
          , if Int
    sqPort Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Protocol -> Int
    defaultPort Protocol
    sqProtocol then ByteString
    "" else Text -> ByteString
    T.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Char
    ':' Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show Int
    sqPort
          , ByteString
    sqPath
          , Bool -> Query -> ByteString
    HTTP.renderQuery Bool
    True Query
    sqQuery
          ]

    -- | Whether to restrict the signature validity with a plain timestamp, or with explicit expiration
    -- (absolute or relative).
    data TimeInfo
        = Timestamp                                      -- ^ Use a simple timestamp to let AWS check the request validity.
        | ExpiresAt { TimeInfo -> UTCTime
    fromExpiresAt :: UTCTime }         -- ^ Let requests expire at a specific fixed time.
        | ExpiresIn { TimeInfo -> NominalDiffTime
    fromExpiresIn :: NominalDiffTime } -- ^ Let requests expire a specific number of seconds after they
                                                         -- were generated.
        deriving (Int -> TimeInfo -> ShowS
    [TimeInfo] -> ShowS
    TimeInfo -> String
    (Int -> TimeInfo -> ShowS)
    -> (TimeInfo -> String) -> ([TimeInfo] -> ShowS) -> Show TimeInfo
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TimeInfo -> ShowS
    showsPrec :: Int -> TimeInfo -> ShowS
    $cshow :: TimeInfo -> String
    show :: TimeInfo -> String
    $cshowList :: [TimeInfo] -> ShowS
    showList :: [TimeInfo] -> ShowS
    Show)

    -- | Like 'TimeInfo', but with all relative times replaced by absolute UTC.
    data AbsoluteTimeInfo
        = AbsoluteTimestamp { AbsoluteTimeInfo -> UTCTime
    fromAbsoluteTimestamp :: UTCTime }
        | AbsoluteExpires { AbsoluteTimeInfo -> UTCTime
    fromAbsoluteExpires :: UTCTime }
        deriving (Int -> AbsoluteTimeInfo -> ShowS
    [AbsoluteTimeInfo] -> ShowS
    AbsoluteTimeInfo -> String
    (Int -> AbsoluteTimeInfo -> ShowS)
    -> (AbsoluteTimeInfo -> String)
    -> ([AbsoluteTimeInfo] -> ShowS)
    -> Show AbsoluteTimeInfo
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> AbsoluteTimeInfo -> ShowS
    showsPrec :: Int -> AbsoluteTimeInfo -> ShowS
    $cshow :: AbsoluteTimeInfo -> String
    show :: AbsoluteTimeInfo -> String
    $cshowList :: [AbsoluteTimeInfo] -> ShowS
    showList :: [AbsoluteTimeInfo] -> ShowS
    Show)

    -- | Just the UTC time value.
    fromAbsoluteTimeInfo :: AbsoluteTimeInfo -> UTCTime
    fromAbsoluteTimeInfo :: AbsoluteTimeInfo -> UTCTime
    fromAbsoluteTimeInfo (AbsoluteTimestamp UTCTime
    time) = UTCTime
    time
    fromAbsoluteTimeInfo (AbsoluteExpires UTCTime
    time) = UTCTime
    time

    -- | Convert 'TimeInfo' to 'AbsoluteTimeInfo' given the current UTC time.
    makeAbsoluteTimeInfo :: TimeInfo -> UTCTime -> AbsoluteTimeInfo
    makeAbsoluteTimeInfo :: TimeInfo -> UTCTime -> AbsoluteTimeInfo
    makeAbsoluteTimeInfo TimeInfo
    Timestamp     UTCTime
    now = UTCTime -> AbsoluteTimeInfo
    AbsoluteTimestamp UTCTime
    now
    makeAbsoluteTimeInfo (ExpiresAt UTCTime
    t) UTCTime
    _   = UTCTime -> AbsoluteTimeInfo
    AbsoluteExpires UTCTime
    t
    makeAbsoluteTimeInfo (ExpiresIn NominalDiffTime
    s) UTCTime
    now = UTCTime -> AbsoluteTimeInfo
    AbsoluteExpires (UTCTime -> AbsoluteTimeInfo) -> UTCTime -> AbsoluteTimeInfo
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime -> UTCTime -> UTCTime
    addUTCTime NominalDiffTime
    s UTCTime
    now

    -- | Data that is always required for signing requests.
    data SignatureData
        = SignatureData {
            -- | Expiration or timestamp.
            SignatureData -> AbsoluteTimeInfo
    signatureTimeInfo :: AbsoluteTimeInfo
            -- | Current time.
          , SignatureData -> UTCTime
    signatureTime :: UTCTime
            -- | Access credentials.
          , SignatureData -> Credentials
    signatureCredentials :: Credentials
          }

    -- | Create signature data using the current system time.
    signatureData :: TimeInfo -> Credentials -> IO SignatureData
    signatureData :: TimeInfo -> Credentials -> IO SignatureData
    signatureData TimeInfo
    rti Credentials
    cr = do
      now <- IO UTCTime
    getCurrentTime
      let ti = TimeInfo -> UTCTime -> AbsoluteTimeInfo
    makeAbsoluteTimeInfo TimeInfo
    rti UTCTime
    now
      return SignatureData { signatureTimeInfo = ti, signatureTime = now, signatureCredentials = cr }

    -- | Tag type for normal queries.
    data NormalQuery
    -- | Tag type for URI-only queries.
    data UriOnlyQuery

    -- | A "signable" request object. Assembles together the Query, and signs it in one go.
    class SignQuery request where
        -- | Additional information, like API endpoints and service-specific preferences.
        type ServiceConfiguration request :: Type {- Query Type -} -> Type

        -- | Create a 'SignedQuery' from a request, additional 'Info', and 'SignatureData'.
        signQuery :: request -> ServiceConfiguration request queryType -> SignatureData -> SignedQuery

    -- | Supported crypto hashes for the signature.
    data AuthorizationHash
        = HmacSHA1
        | HmacSHA256
        deriving (Int -> AuthorizationHash -> ShowS
    [AuthorizationHash] -> ShowS
    AuthorizationHash -> String
    (Int -> AuthorizationHash -> ShowS)
    -> (AuthorizationHash -> String)
    -> ([AuthorizationHash] -> ShowS)
    -> Show AuthorizationHash
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> AuthorizationHash -> ShowS
    showsPrec :: Int -> AuthorizationHash -> ShowS
    $cshow :: AuthorizationHash -> String
    show :: AuthorizationHash -> String
    $cshowList :: [AuthorizationHash] -> ShowS
    showList :: [AuthorizationHash] -> ShowS
    Show)

    -- | Authorization hash identifier as expected by Amazon.
    amzHash :: AuthorizationHash -> B.ByteString
    amzHash :: AuthorizationHash -> ByteString
    amzHash AuthorizationHash
    HmacSHA1 = ByteString
    "HmacSHA1"
    amzHash AuthorizationHash
    HmacSHA256 = ByteString
    "HmacSHA256"

    -- | Create a signature. Usually, AWS wants a specifically constructed string to be signed.
    --
    -- The signature is a HMAC-based hash of the string and the secret access key.
    signature :: Credentials -> AuthorizationHash -> B.ByteString -> B.ByteString
    signature :: Credentials -> AuthorizationHash -> ByteString -> ByteString
    signature Credentials
    cr AuthorizationHash
    ah ByteString
    input = ByteString -> ByteString
    Base64.encode ByteString
    sig
        where
          sig :: ByteString
    sig = case AuthorizationHash
    ah of
                  AuthorizationHash
    HmacSHA1 -> HMAC SHA1 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    ByteArray.convert (ByteString -> ByteString -> HMAC SHA1
    forall key message a.
    (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
    key -> message -> HMAC a
    CMH.hmac (Credentials -> ByteString
    secretAccessKey Credentials
    cr) ByteString
    input :: CMH.HMAC CH.SHA1)
                  AuthorizationHash
    HmacSHA256 -> HMAC SHA256 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    ByteArray.convert (ByteString -> ByteString -> HMAC SHA256
    forall key message a.
    (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
    key -> message -> HMAC a
    CMH.hmac (Credentials -> ByteString
    secretAccessKey Credentials
    cr) ByteString
    input :: CMH.HMAC CH.SHA256)

    -- | Generates the Credential string, required for V4 signatures.
    credentialV4
        :: SignatureData
        -> B.ByteString -- ^ region, e.g. us-east-1
        -> B.ByteString -- ^ service, e.g. dynamodb
        -> B.ByteString
    credentialV4 :: SignatureData -> ByteString -> ByteString -> ByteString
    credentialV4 SignatureData
    sd ByteString
    region ByteString
    service = [ByteString] -> ByteString
    B.concat
        [ Credentials -> ByteString
    accessKeyID (SignatureData -> Credentials
    signatureCredentials SignatureData
    sd)
        , ByteString
    "/"
        , ByteString
    date
        , ByteString
    "/"
        , ByteString
    region
        , ByteString
    "/"
        , ByteString
    service
        , ByteString
    "/aws4_request"
        ]
        where
            date :: ByteString
    date = String -> UTCTime -> ByteString
    fmtTime String
    "%Y%m%d" (UTCTime -> ByteString) -> UTCTime -> ByteString
    forall a b. (a -> b) -> a -> b
    $ SignatureData -> UTCTime
    signatureTime SignatureData
    sd

    -- | Use this to create the Authorization header to set into 'sqAuthorization'.
    -- See <http://docs.aws.amazon.com/general/latest/gr/signature-version-4.html>: you must create the
    -- canonical request as explained by Step 1 and this function takes care of Steps 2 and 3.
    authorizationV4 :: SignatureData
                    -> AuthorizationHash
                    -> B.ByteString -- ^ region, e.g. us-east-1
                    -> B.ByteString -- ^ service, e.g. dynamodb
                    -> B.ByteString -- ^ SignedHeaders, e.g. content-type;host;x-amz-date;x-amz-target
                    -> B.ByteString -- ^ canonicalRequest (before hashing)
                    -> IO B.ByteString
    authorizationV4 :: SignatureData
    -> AuthorizationHash
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> IO ByteString
    authorizationV4 SignatureData
    sd AuthorizationHash
    ah ByteString
    region ByteString
    service ByteString
    headers ByteString
    canonicalRequest = do
        let ref :: IORef [V4Key]
    ref = Credentials -> IORef [V4Key]
    v4SigningKeys (Credentials -> IORef [V4Key]) -> Credentials -> IORef [V4Key]
    forall a b. (a -> b) -> a -> b
    $ SignatureData -> Credentials
    signatureCredentials SignatureData
    sd
            date :: ByteString
    date = String -> UTCTime -> ByteString
    fmtTime String
    "%Y%m%d" (UTCTime -> ByteString) -> UTCTime -> ByteString
    forall a b. (a -> b) -> a -> b
    $ SignatureData -> UTCTime
    signatureTime SignatureData
    sd

        -- Lookup existing signing key
        allkeys <- IORef [V4Key] -> IO [V4Key]
    forall a. IORef a -> IO a
    readIORef IORef [V4Key]
    ref
        let mkey = case (ByteString, ByteString)
    -> [V4Key] -> Maybe (ByteString, ByteString)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup (ByteString
    region,ByteString
    service) [V4Key]
    allkeys of
                Just (ByteString
    d,ByteString
    k) | ByteString
    d ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString
    date -> Maybe ByteString
    forall a. Maybe a
    Nothing
                           | Bool
    otherwise -> ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    k
                Maybe (ByteString, ByteString)
    Nothing -> Maybe ByteString
    forall a. Maybe a
    Nothing

        -- possibly create a new signing key
        let createNewKey = IORef [V4Key]
    -> ([V4Key] -> ([V4Key], ByteString)) -> IO ByteString
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef [V4Key]
    ref (([V4Key] -> ([V4Key], ByteString)) -> IO ByteString)
    -> ([V4Key] -> ([V4Key], ByteString)) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \[V4Key]
    keylist ->
                let kSigning :: ByteString
    kSigning = SignatureData
    -> AuthorizationHash -> ByteString -> ByteString -> ByteString
    signingKeyV4 SignatureData
    sd AuthorizationHash
    ah ByteString
    region ByteString
    service
                    lstK :: (ByteString, ByteString)
    lstK     = (ByteString
    region,ByteString
    service)
                    keylist' :: [V4Key]
    keylist' = ((ByteString, ByteString)
    lstK,(ByteString
    date,ByteString
    kSigning)) V4Key -> [V4Key] -> [V4Key]
    forall a. a -> [a] -> [a]
    : (V4Key -> Bool) -> [V4Key] -> [V4Key]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (((ByteString, ByteString)
    lstK(ByteString, ByteString) -> (ByteString, ByteString) -> Bool
    forall a. Eq a => a -> a -> Bool
    /=)((ByteString, ByteString) -> Bool)
    -> (V4Key -> (ByteString, ByteString)) -> V4Key -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .V4Key -> (ByteString, ByteString)
    forall a b. (a, b) -> a
    fst) [V4Key]
    keylist
                 in ([V4Key]
    keylist', ByteString
    kSigning)

        -- finally, return the header
        constructAuthorizationV4Header sd ah region service headers
             .  signatureV4WithKey sd ah region service canonicalRequest
            <$> maybe createNewKey return mkey

    -- | IO free version of @authorizationV4@, use this if you need
    -- to compute the signature outside of IO.
    authorizationV4'
        :: SignatureData
        -> AuthorizationHash
        -> B.ByteString -- ^ region, e.g. us-east-1
        -> B.ByteString -- ^ service, e.g. dynamodb
        -> B.ByteString -- ^ SignedHeaders, e.g. content-type;host;x-amz-date;x-amz-target
        -> B.ByteString -- ^ canonicalRequest (before hashing)
        -> B.ByteString
    authorizationV4' :: SignatureData
    -> AuthorizationHash
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    authorizationV4' SignatureData
    sd AuthorizationHash
    ah ByteString
    region ByteString
    service ByteString
    headers ByteString
    canonicalRequest
        = SignatureData
    -> AuthorizationHash
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    constructAuthorizationV4Header SignatureData
    sd AuthorizationHash
    ah ByteString
    region ByteString
    service ByteString
    headers
            (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ SignatureData
    -> AuthorizationHash
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    signatureV4 SignatureData
    sd AuthorizationHash
    ah ByteString
    region ByteString
    service ByteString
    canonicalRequest

    constructAuthorizationV4Header
        :: SignatureData
        -> AuthorizationHash
        -> B.ByteString -- ^ region, e.g. us-east-1
        -> B.ByteString -- ^ service, e.g. dynamodb
        -> B.ByteString -- ^ SignedHeaders, e.g. content-type;host;x-amz-date;x-amz-target
        -> B.ByteString -- ^ signature
        -> B.ByteString
    constructAuthorizationV4Header :: SignatureData
    -> AuthorizationHash
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    constructAuthorizationV4Header SignatureData
    sd AuthorizationHash
    ah ByteString
    region ByteString
    service ByteString
    headers ByteString
    sig = [ByteString] -> ByteString
    B.concat
        [ ByteString
    alg
        , ByteString
    " Credential="
        , SignatureData -> ByteString -> ByteString -> ByteString
    credentialV4 SignatureData
    sd ByteString
    region ByteString
    service
        , ByteString
    ",SignedHeaders="
        , ByteString
    headers
        , ByteString
    ",Signature="
        , ByteString
    sig
        ]
        where
            alg :: ByteString
    alg = case AuthorizationHash
    ah of
                AuthorizationHash
    HmacSHA1 -> ByteString
    "AWS4-HMAC-SHA1"
                AuthorizationHash
    HmacSHA256 -> ByteString
    "AWS4-HMAC-SHA256"

    -- | Compute the signature for V4
    signatureV4WithKey
        :: SignatureData
        -> AuthorizationHash
        -> B.ByteString -- ^ region, e.g. us-east-1
        -> B.ByteString -- ^ service, e.g. dynamodb
        -> B.ByteString -- ^ canonicalRequest (before hashing)
        -> B.ByteString -- ^ signing key
        -> B.ByteString
    signatureV4WithKey :: SignatureData
    -> AuthorizationHash
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    signatureV4WithKey SignatureData
    sd AuthorizationHash
    ah ByteString
    region ByteString
    service ByteString
    canonicalRequest ByteString
    key = ByteString -> ByteString
    Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString -> ByteString
    mkHmac ByteString
    key ByteString
    stringToSign
        where
            date :: ByteString
    date = String -> UTCTime -> ByteString
    fmtTime String
    "%Y%m%d" (UTCTime -> ByteString) -> UTCTime -> ByteString
    forall a b. (a -> b) -> a -> b
    $ SignatureData -> UTCTime
    signatureTime SignatureData
    sd
            mkHmac :: ByteString -> ByteString -> ByteString
    mkHmac ByteString
    k ByteString
    i = case AuthorizationHash
    ah of
                AuthorizationHash
    HmacSHA1 -> HMAC SHA1 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    ByteArray.convert (ByteString -> ByteString -> HMAC SHA1
    forall key message a.
    (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
    key -> message -> HMAC a
    CMH.hmac ByteString
    k ByteString
    i :: CMH.HMAC CH.SHA1)
                AuthorizationHash
    HmacSHA256 -> HMAC SHA256 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    ByteArray.convert (ByteString -> ByteString -> HMAC SHA256
    forall key message a.
    (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
    key -> message -> HMAC a
    CMH.hmac ByteString
    k ByteString
    i :: CMH.HMAC CH.SHA256)
            mkHash :: ByteString -> ByteString
    mkHash ByteString
    i = case AuthorizationHash
    ah of
                AuthorizationHash
    HmacSHA1 -> Digest SHA1 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    ByteArray.convert (ByteString -> Digest SHA1
    forall ba a.
    (ByteArrayAccess ba, HashAlgorithm a) =>
    ba -> Digest a
    CH.hash ByteString
    i :: CH.Digest CH.SHA1)
                AuthorizationHash
    HmacSHA256 -> 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
    i :: CH.Digest CH.SHA256)
            alg :: ByteString
    alg = case AuthorizationHash
    ah of
                AuthorizationHash
    HmacSHA1 -> ByteString
    "AWS4-HMAC-SHA1"
                AuthorizationHash
    HmacSHA256 -> ByteString
    "AWS4-HMAC-SHA256"

            -- now do the signature
            canonicalRequestHash :: ByteString
    canonicalRequestHash = ByteString -> ByteString
    Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    mkHash ByteString
    canonicalRequest
            stringToSign :: ByteString
    stringToSign = [ByteString] -> ByteString
    B.concat
                [ ByteString
    alg
                , ByteString
    "\n"
                , String -> UTCTime -> ByteString
    fmtTime String
    "%Y%m%dT%H%M%SZ" (UTCTime -> ByteString) -> UTCTime -> ByteString
    forall a b. (a -> b) -> a -> b
    $ SignatureData -> UTCTime
    signatureTime SignatureData
    sd
                , ByteString
    "\n"
                , ByteString
    date
                , ByteString
    "/"
                , ByteString
    region
                , ByteString
    "/"
                , ByteString
    service
                , ByteString
    "/aws4_request\n"
                , ByteString
    canonicalRequestHash
                ]

    signingKeyV4
        :: SignatureData
        -> AuthorizationHash
        -> B.ByteString -- ^ region, e.g. us-east-1
        -> B.ByteString -- ^ service, e.g. dynamodb
        -> B.ByteString
    signingKeyV4 :: SignatureData
    -> AuthorizationHash -> ByteString -> ByteString -> ByteString
    signingKeyV4 SignatureData
    sd AuthorizationHash
    ah ByteString
    region ByteString
    service = ByteString
    kSigning
        where
            mkHmac :: ByteString -> ByteString -> ByteString
    mkHmac ByteString
    k ByteString
    i = case AuthorizationHash
    ah of
                AuthorizationHash
    HmacSHA1 -> HMAC SHA1 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    ByteArray.convert (ByteString -> ByteString -> HMAC SHA1
    forall key message a.
    (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
    key -> message -> HMAC a
    CMH.hmac ByteString
    k ByteString
    i :: CMH.HMAC CH.SHA1)
                AuthorizationHash
    HmacSHA256 -> HMAC SHA256 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    ByteArray.convert (ByteString -> ByteString -> HMAC SHA256
    forall key message a.
    (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
    key -> message -> HMAC a
    CMH.hmac ByteString
    k ByteString
    i :: CMH.HMAC CH.SHA256)
            date :: ByteString
    date = String -> UTCTime -> ByteString
    fmtTime String
    "%Y%m%d" (UTCTime -> ByteString) -> UTCTime -> ByteString
    forall a b. (a -> b) -> a -> b
    $ SignatureData -> UTCTime
    signatureTime SignatureData
    sd
            secretKey :: ByteString
    secretKey = Credentials -> ByteString
    secretAccessKey (Credentials -> ByteString) -> Credentials -> ByteString
    forall a b. (a -> b) -> a -> b
    $ SignatureData -> Credentials
    signatureCredentials SignatureData
    sd
            kDate :: ByteString
    kDate = ByteString -> ByteString -> ByteString
    mkHmac (ByteString
    "AWS4" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    secretKey) ByteString
    date
            kRegion :: ByteString
    kRegion = ByteString -> ByteString -> ByteString
    mkHmac ByteString
    kDate ByteString
    region
            kService :: ByteString
    kService = ByteString -> ByteString -> ByteString
    mkHmac ByteString
    kRegion ByteString
    service
            kSigning :: ByteString
    kSigning = ByteString -> ByteString -> ByteString
    mkHmac ByteString
    kService ByteString
    "aws4_request"

    signatureV4
        :: SignatureData
        -> AuthorizationHash
        -> B.ByteString -- ^ region, e.g. us-east-1
        -> B.ByteString -- ^ service, e.g. dynamodb
        -> B.ByteString -- ^ canonicalRequest (before hashing)
        -> B.ByteString
    signatureV4 :: SignatureData
    -> AuthorizationHash
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    signatureV4 SignatureData
    sd AuthorizationHash
    ah ByteString
    region ByteString
    service ByteString
    canonicalRequest
        = SignatureData
    -> AuthorizationHash
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    signatureV4WithKey SignatureData
    sd AuthorizationHash
    ah ByteString
    region ByteString
    service ByteString
    canonicalRequest
            (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ SignatureData
    -> AuthorizationHash -> ByteString -> ByteString -> ByteString
    signingKeyV4 SignatureData
    sd AuthorizationHash
    ah ByteString
    region ByteString
    service

    -- | Default configuration for a specific service.
    class DefaultServiceConfiguration config where
        -- | Default service configuration.
        defServiceConfig :: config

        -- | Default debugging-only configuration. (Normally using HTTP instead of HTTPS for easier debugging.)
        debugServiceConfig :: config
        debugServiceConfig = config
    forall config. DefaultServiceConfiguration config => config
    defServiceConfig

    -- | @queryList f prefix xs@ constructs a query list from a list of
    -- elements @xs@, using a common prefix @prefix@, and a transformer
    -- function @f@.
    --
    -- A dot (@.@) is interspersed between prefix and generated key.
    --
    -- Example:
    --
    -- @queryList swap \"pfx\" [(\"a\", \"b\"), (\"c\", \"d\")]@ evaluates to @[(\"pfx.b\", \"a\"), (\"pfx.d\", \"c\")]@
    -- (except with ByteString instead of String, of course).
    queryList :: (a -> [(B.ByteString, B.ByteString)]) -> B.ByteString -> [a] -> [(B.ByteString, B.ByteString)]
    queryList :: forall a.
    (a -> [(ByteString, ByteString)])
    -> ByteString -> [a] -> [(ByteString, ByteString)]
    queryList a -> [(ByteString, ByteString)]
    f ByteString
    prefix [a]
    xs = [[(ByteString, ByteString)]] -> [(ByteString, ByteString)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[(ByteString, ByteString)]] -> [(ByteString, ByteString)])
    -> [[(ByteString, ByteString)]] -> [(ByteString, ByteString)]
    forall a b. (a -> b) -> a -> b
    $ (ByteString
     -> [(ByteString, ByteString)] -> [(ByteString, ByteString)])
    -> [ByteString]
    -> [[(ByteString, ByteString)]]
    -> [[(ByteString, ByteString)]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith ByteString
    -> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
    forall {d}. ByteString -> [(ByteString, d)] -> [(ByteString, d)]
    combine [ByteString]
    prefixList ((a -> [(ByteString, ByteString)])
    -> [a] -> [[(ByteString, ByteString)]]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> [(ByteString, ByteString)]
    f [a]
    xs)
        where prefixList :: [ByteString]
    prefixList = (Int -> ByteString) -> [Int] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map (ByteString -> ByteString -> ByteString
    dot ByteString
    prefix (ByteString -> ByteString)
    -> (Int -> ByteString) -> Int -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ByteString
    BU.fromString (String -> ByteString) -> (Int -> String) -> Int -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show) [(Int
    1 :: Int) ..]
              combine :: ByteString -> [(ByteString, d)] -> [(ByteString, d)]
    combine ByteString
    pf = ((ByteString, d) -> (ByteString, d))
    -> [(ByteString, d)] -> [(ByteString, d)]
    forall a b. (a -> b) -> [a] -> [b]
    map (((ByteString, d) -> (ByteString, d))
     -> [(ByteString, d)] -> [(ByteString, d)])
    -> ((ByteString, d) -> (ByteString, d))
    -> [(ByteString, d)]
    -> [(ByteString, d)]
    forall a b. (a -> b) -> a -> b
    $ (ByteString -> ByteString) -> (ByteString, d) -> (ByteString, d)
    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 (ByteString
    pf ByteString -> ByteString -> ByteString
    `dot`)
              dot :: ByteString -> ByteString -> ByteString
    dot ByteString
    x ByteString
    y = [ByteString] -> ByteString
    B.concat [ByteString
    x, String -> ByteString
    BU.fromString String
    ".", ByteString
    y]

    -- | A \"true\"/\"false\" boolean as requested by some services.
    awsBool :: Bool -> B.ByteString
    awsBool :: Bool -> ByteString
    awsBool Bool
    True = ByteString
    "true"
    awsBool Bool
    False = ByteString
    "false"

    -- | \"true\"
    awsTrue :: B.ByteString
    awsTrue :: ByteString
    awsTrue = Bool -> ByteString
    awsBool Bool
    True

    -- | \"false\"
    awsFalse :: B.ByteString
    awsFalse :: ByteString
    awsFalse = Bool -> ByteString
    awsBool Bool
    False

    -- | Format time according to a format string, as a ByteString.
    fmtTime :: String -> UTCTime -> B.ByteString
    fmtTime :: String -> UTCTime -> ByteString
    fmtTime String
    s UTCTime
    t = String -> ByteString
    BU.fromString (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    s UTCTime
    t

    rfc822Time :: String
    rfc822Time :: String
    rfc822Time = String
    "%a, %0d %b %Y %H:%M:%S GMT"

    -- | Format time in RFC 822 format.
    fmtRfc822Time :: UTCTime -> B.ByteString
    fmtRfc822Time :: UTCTime -> ByteString
    fmtRfc822Time = String -> UTCTime -> ByteString
    fmtTime String
    rfc822Time

    -- | Format time in yyyy-mm-ddThh-mm-ss format.
    fmtAmzTime :: UTCTime -> B.ByteString
    fmtAmzTime :: UTCTime -> ByteString
    fmtAmzTime = String -> UTCTime -> ByteString
    fmtTime String
    "%Y-%m-%dT%H:%M:%S"

    -- | Format time as seconds since the Unix epoch.
    fmtTimeEpochSeconds :: UTCTime -> B.ByteString
    fmtTimeEpochSeconds :: UTCTime -> ByteString
    fmtTimeEpochSeconds = String -> UTCTime -> ByteString
    fmtTime String
    "%s"

    -- | Parse HTTP-date (section 3.3.1 of RFC 2616)
    parseHttpDate :: String -> Maybe UTCTime
    parseHttpDate :: String -> Maybe UTCTime
    parseHttpDate String
    s =     String -> String -> Maybe UTCTime
    p String
    "%a, %d %b %Y %H:%M:%S GMT" String
    s -- rfc1123-date
                      Maybe UTCTime -> Maybe UTCTime -> Maybe UTCTime
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> String -> String -> Maybe UTCTime
    p String
    "%A, %d-%b-%y %H:%M:%S GMT" String
    s -- rfc850-date
                      Maybe UTCTime -> Maybe UTCTime -> Maybe UTCTime
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> String -> String -> Maybe UTCTime
    p String
    "%a %b %_d %H:%M:%S %Y" String
    s     -- asctime-date
                      Maybe UTCTime -> Maybe UTCTime -> Maybe UTCTime
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> String -> String -> Maybe UTCTime
    p String
    "%Y-%m-%dT%H:%M:%S%QZ" String
    s      -- iso 8601
                      Maybe UTCTime -> Maybe UTCTime -> Maybe UTCTime
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> String -> String -> Maybe UTCTime
    p String
    "%Y-%m-%dT%H:%M:%S%Q%Z" String
    s     -- iso 8601
      where p :: String -> String -> Maybe UTCTime
    p = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> String -> String -> m t
    parseTimeM Bool
    True TimeLocale
    defaultTimeLocale

    -- | HTTP-date (section 3.3.1 of RFC 2616, first type - RFC1123-style)
    httpDate1 :: String
    httpDate1 :: String
    httpDate1 = String
    "%a, %d %b %Y %H:%M:%S GMT" -- rfc1123-date

    -- | Format (as Text) HTTP-date (section 3.3.1 of RFC 2616, first type - RFC1123-style)
    textHttpDate :: UTCTime -> T.Text
    textHttpDate :: UTCTime -> Text
    textHttpDate = String -> Text
    T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    httpDate1

    iso8601UtcDate :: String
    iso8601UtcDate :: String
    iso8601UtcDate = String
    "%Y-%m-%dT%H:%M:%S%QZ"

    -- | Parse a two-digit hex number.
    readHex2 :: [Char] -> Maybe Word8
    readHex2 :: String -> Maybe Word8
    readHex2 [Char
    c1,Char
    c2] = do n1 <- Char -> Maybe Int
    readHex1 Char
    c1
                          n2 <- readHex1 c2
                          return . fromIntegral $ n1 * 16 + n2
        where
          readHex1 :: Char -> Maybe Int
    readHex1 Char
    c | Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    '0' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    '9' = Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> Int -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Char -> Int
    ord Char
    '0'
                     | Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    'A' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    'F' = Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> Int -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Char -> Int
    ord Char
    'A' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    10
                     | Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    'a' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    'f' = Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> Int -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Char -> Int
    ord Char
    'a' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    10
          readHex1 Char
    _                        = Maybe Int
    forall a. Maybe a
    Nothing
    readHex2 String
    _ = Maybe Word8
    forall a. Maybe a
    Nothing

    -- XML

    -- | An error that occurred during XML parsing / validation.
    newtype XmlException = XmlException { XmlException -> String
    xmlErrorMessage :: String }
        deriving (Int -> XmlException -> ShowS
    [XmlException] -> ShowS
    XmlException -> String
    (Int -> XmlException -> ShowS)
    -> (XmlException -> String)
    -> ([XmlException] -> ShowS)
    -> Show XmlException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> XmlException -> ShowS
    showsPrec :: Int -> XmlException -> ShowS
    $cshow :: XmlException -> String
    show :: XmlException -> String
    $cshowList :: [XmlException] -> ShowS
    showList :: [XmlException] -> ShowS
    Show, Typeable)

    instance E.Exception XmlException

    -- | An error that occurred during header parsing / validation.
    newtype HeaderException = HeaderException { HeaderException -> String
    headerErrorMessage :: String }
        deriving (Int -> HeaderException -> ShowS
    [HeaderException] -> ShowS
    HeaderException -> String
    (Int -> HeaderException -> ShowS)
    -> (HeaderException -> String)
    -> ([HeaderException] -> ShowS)
    -> Show HeaderException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> HeaderException -> ShowS
    showsPrec :: Int -> HeaderException -> ShowS
    $cshow :: HeaderException -> String
    show :: HeaderException -> String
    $cshowList :: [HeaderException] -> ShowS
    showList :: [HeaderException] -> ShowS
    Show, Typeable)

    instance E.Exception HeaderException

    -- | An error that occurred during form parsing / validation.
    newtype FormException = FormException { FormException -> String
    formErrorMesage :: String }
        deriving (Int -> FormException -> ShowS
    [FormException] -> ShowS
    FormException -> String
    (Int -> FormException -> ShowS)
    -> (FormException -> String)
    -> ([FormException] -> ShowS)
    -> Show FormException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FormException -> ShowS
    showsPrec :: Int -> FormException -> ShowS
    $cshow :: FormException -> String
    show :: FormException -> String
    $cshowList :: [FormException] -> ShowS
    showList :: [FormException] -> ShowS
    Show, Typeable)

    instance E.Exception FormException

    -- | No credentials were found and an invariant was violated.
    newtype NoCredentialsException = NoCredentialsException { NoCredentialsException -> String
    noCredentialsErrorMessage :: String }
        deriving (Int -> NoCredentialsException -> ShowS
    [NoCredentialsException] -> ShowS
    NoCredentialsException -> String
    (Int -> NoCredentialsException -> ShowS)
    -> (NoCredentialsException -> String)
    -> ([NoCredentialsException] -> ShowS)
    -> Show NoCredentialsException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> NoCredentialsException -> ShowS
    showsPrec :: Int -> NoCredentialsException -> ShowS
    $cshow :: NoCredentialsException -> String
    show :: NoCredentialsException -> String
    $cshowList :: [NoCredentialsException] -> ShowS
    showList :: [NoCredentialsException] -> ShowS
    Show, Typeable)

    instance E.Exception NoCredentialsException

    -- | A helper to throw an 'HTTP.StatusCodeException'.
    throwStatusCodeException :: MonadThrow m => HTTP.Request -> HTTP.Response (C.ConduitM () ByteString m ()) -> m a
    throwStatusCodeException :: forall (m :: * -> *) a.
    MonadThrow m =>
    Request -> Response (ConduitM () ByteString m ()) -> m a
    throwStatusCodeException Request
    req Response (ConduitM () ByteString m ())
    resp = do
        let resp' :: Response ()
    resp' = (ConduitM () ByteString m () -> ())
    -> Response (ConduitM () ByteString m ()) -> Response ()
    forall a b. (a -> b) -> Response a -> Response b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (() -> ConduitM () ByteString m () -> ()
    forall a b. a -> b -> a
    const ()) Response (ConduitM () ByteString m ())
    resp
        -- only take first 10kB of error response
        body <- ConduitT () Void m ByteString -> m ByteString
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    C.runConduit (ConduitT () Void m ByteString -> m ByteString)
    -> ConduitT () Void m ByteString -> m ByteString
    forall a b. (a -> b) -> a -> b
    $ Response (ConduitM () ByteString m ())
    -> ConduitM () ByteString m ()
    forall body. Response body -> body
    HTTP.responseBody Response (ConduitM () ByteString m ())
    resp ConduitM () ByteString m ()
    -> ConduitT ByteString Void m ByteString
    -> ConduitT () Void m ByteString
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| Int -> ConduitT ByteString Void m ByteString
    forall (m :: * -> *) o.
    Monad m =>
    Int -> ConduitT ByteString o m ByteString
    CB.take (Int
    10Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    1024)
        let sce = Response () -> ByteString -> HttpExceptionContent
    HTTP.StatusCodeException Response ()
    resp' (ByteString -> ByteString
    L.toStrict ByteString
    body)
        throwM $ HTTP.HttpExceptionRequest req sce

    -- | A specific element (case-insensitive, ignoring namespace - sadly necessary), extracting only the textual contents.
    elContent :: T.Text -> Cursor -> [T.Text]
    elContent :: Text -> Cursor -> [Text]
    elContent Text
    name = Text -> Axis
    laxElement Text
    name Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Cursor -> [Text]
    content

    -- | Like 'elContent', but extracts 'String's instead of 'T.Text'.
    elCont :: T.Text -> Cursor -> [String]
    elCont :: Text -> Cursor -> [String]
    elCont Text
    name = Text -> Axis
    laxElement Text
    name Axis -> (Cursor -> [String]) -> Cursor -> [String]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Cursor -> [Text]
    content (Cursor -> [Text]) -> (Text -> String) -> Cursor -> [String]
    forall node a b.
    (Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
    &| Text -> String
    T.unpack

    -- | Extract the first element from a parser result list, and throw an 'XmlException' if the list is empty.
    force :: MonadThrow m => String -> [a] -> m a
    force :: forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
    force = XmlException -> [a] -> m a
    forall e (f :: * -> *) a.
    (Exception e, MonadThrow f) =>
    e -> [a] -> f a
    Cu.force (XmlException -> [a] -> m a)
    -> (String -> XmlException) -> String -> [a] -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> XmlException
    XmlException

    -- | Extract the first element from a monadic parser result list, and throw an 'XmlException' if the list is empty.
    forceM :: MonadThrow m => String -> [m a] -> m a
    forceM :: forall (m :: * -> *) a. MonadThrow m => String -> [m a] -> m a
    forceM = XmlException -> [m a] -> m a
    forall e (f :: * -> *) a.
    (Exception e, MonadThrow f) =>
    e -> [f a] -> f a
    Cu.forceM (XmlException -> [m a] -> m a)
    -> (String -> XmlException) -> String -> [m a] -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> XmlException
    XmlException

    -- | Read a boolean from a 'T.Text', throwing an 'XmlException' on failure.
    textReadBool :: MonadThrow m => T.Text -> m Bool
    textReadBool :: forall (m :: * -> *). MonadThrow m => Text -> m Bool
    textReadBool Text
    s = case Text -> String
    T.unpack Text
    s of
                      String
    "true"  -> Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                      String
    "false" -> Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                      String
    _        -> XmlException -> m Bool
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (XmlException -> m Bool) -> XmlException -> m Bool
    forall a b. (a -> b) -> a -> b
    $ String -> XmlException
    XmlException String
    "Invalid Bool"

    -- | Read an integer from a 'T.Text', throwing an 'XmlException' on failure.
    textReadInt :: (MonadThrow m, Num a) => T.Text -> m a
    textReadInt :: forall (m :: * -> *) a. (MonadThrow m, Num a) => Text -> m a
    textReadInt Text
    s = case ReadS Integer
    forall a. Read a => ReadS a
    reads ReadS Integer -> ReadS Integer
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack Text
    s of
                      [(Integer
    n,String
    "")] -> a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> m a) -> a -> m a
    forall a b. (a -> b) -> a -> b
    $ Integer -> a
    forall a. Num a => Integer -> a
    fromInteger Integer
    n
                      [(Integer, String)]
    _        -> 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 Integer"

    -- | Read an integer from a 'String', throwing an 'XmlException' on failure.
    readInt :: (MonadThrow m, Num a) => String -> m a
    readInt :: forall (m :: * -> *) a. (MonadThrow m, Num a) => String -> m a
    readInt String
    s = case ReadS Integer
    forall a. Read a => ReadS a
    reads String
    s of
                  [(Integer
    n,String
    "")] -> a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> m a) -> a -> m a
    forall a b. (a -> b) -> a -> b
    $ Integer -> a
    forall a. Num a => Integer -> a
    fromInteger Integer
    n
                  [(Integer, String)]
    _        -> 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 Integer"

    -- | Create a complete 'HTTPResponseConsumer' from a simple function that takes a 'Cu.Cursor' to XML in the response
    -- body.
    --
    -- This function is highly recommended for any services that parse relatively short XML responses. (If status and response
    -- headers are required, simply take them as function parameters, and pass them through to this function.)
    xmlCursorConsumer ::
        (Monoid m)
        => (Cu.Cursor -> Response m a)
        -> IORef m
        -> HTTPResponseConsumer a
    xmlCursorConsumer :: forall m a.
    Monoid m =>
    (Cursor -> Response m a) -> IORef m -> HTTPResponseConsumer a
    xmlCursorConsumer Cursor -> Response m a
    parse IORef m
    metadataRef Response (ConduitM () ByteString (ResourceT IO) ())
    res
        = 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) ())
    res 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
             let Response metadata x = parse cursor
             liftIO $ tellMetadataRef metadataRef metadata
             case x of
               Left SomeException
    err -> IO a -> ResourceT IO a
    forall a. IO a -> ResourceT IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> ResourceT IO a) -> IO a -> ResourceT IO a
    forall a b. (a -> b) -> a -> b
    $ 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
    err
               Right a
    v  -> a -> ResourceT IO a
    forall a. a -> ResourceT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    v