{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE BangPatterns          #-}

module Aws.Aws
( -- * Logging
  LogLevel(..)
, Logger
, defaultLog
  -- * Configuration
, Configuration(..)
, baseConfiguration
, dbgConfiguration
  -- * Transaction runners
  -- ** Safe runners
, aws
, awsRef
, pureAws
, memoryAws
, simpleAws
  -- ** Unsafe runners
, unsafeAws
, unsafeAwsRef
  -- ** URI runners
, awsUri
  -- * Iterated runners
--, awsIteratedAll
, awsIteratedSource
, awsIteratedSource'
, awsIteratedList
, awsIteratedList'
)
where

import           Aws.Core
import           Control.Applicative
import           Control.Monad
import qualified Control.Monad.Catch          as E
import           Control.Monad.IO.Class
import           Control.Monad.Trans
import           Control.Monad.Trans.Resource
import qualified Data.ByteString              as B
import qualified Data.ByteString.Lazy         as L
import qualified Data.CaseInsensitive         as CI
import qualified Data.Conduit                 as C
import qualified Data.Conduit.List            as CL
import           Data.IORef
import           Data.Monoid
import qualified Data.Text                    as T
import qualified Data.Text.Encoding           as T
import qualified Data.Text.IO                 as T
import qualified Network.HTTP.Conduit         as HTTP
import qualified Network.HTTP.Client.TLS      as HTTP
import           System.IO                    (stderr)
import           Prelude

-- | The severity of a log message, in rising order.
data LogLevel
    = Debug
    | Info
    | Warning
    | Error
    deriving (Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogLevel -> ShowS
showsPrec :: Int -> LogLevel -> ShowS
$cshow :: LogLevel -> String
show :: LogLevel -> String
$cshowList :: [LogLevel] -> ShowS
showList :: [LogLevel] -> ShowS
Show, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
/= :: LogLevel -> LogLevel -> Bool
Eq, Eq LogLevel
Eq LogLevel =>
(LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
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 :: LogLevel -> LogLevel -> Ordering
compare :: LogLevel -> LogLevel -> Ordering
$c< :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
>= :: LogLevel -> LogLevel -> Bool
$cmax :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
min :: LogLevel -> LogLevel -> LogLevel
Ord)

-- | The interface for any logging function. Takes log level and a log message, and can perform an arbitrary
-- IO action.
type Logger = LogLevel -> T.Text -> IO ()

-- | The default logger @defaultLog minLevel@, which prints log messages above level @minLevel@ to @stderr@.
defaultLog :: LogLevel -> Logger
defaultLog :: LogLevel -> Logger
defaultLog LogLevel
minLevel LogLevel
lev Text
t | LogLevel
lev LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
minLevel = Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ LogLevel -> String
forall a. Show a => a -> String
show LogLevel
lev, Text
": ", Text
t]
                          | Bool
otherwise       = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | The configuration for an AWS request. You can use multiple configurations in parallel, even over the same HTTP
-- connection manager.
data Configuration
    = Configuration {
        -- | Whether to restrict the signature validity with a plain timestamp, or with explicit expiration
        -- (absolute or relative).
        Configuration -> TimeInfo
timeInfo    :: TimeInfo
        -- | AWS access credentials.
      , Configuration -> Credentials
credentials :: Credentials
        -- | The error / message logger.
      , Configuration -> Logger
logger      :: Logger
      , Configuration -> Maybe Proxy
proxy       :: Maybe HTTP.Proxy
      }

-- | The default configuration, with credentials loaded from environment variable or configuration file
-- (see 'loadCredentialsDefault').
baseConfiguration :: MonadIO io => io Configuration
baseConfiguration :: forall (io :: * -> *). MonadIO io => io Configuration
baseConfiguration = IO Configuration -> io Configuration
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Configuration -> io Configuration)
-> IO Configuration -> io Configuration
forall a b. (a -> b) -> a -> b
$ do
  cr <- IO (Maybe Credentials)
forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
loadCredentialsDefault
  case cr of
    Maybe Credentials
Nothing -> NoCredentialsException -> IO Configuration
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
E.throwM (NoCredentialsException -> IO Configuration)
-> NoCredentialsException -> IO Configuration
forall a b. (a -> b) -> a -> b
$ String -> NoCredentialsException
NoCredentialsException String
"could not locate aws credentials"
    Just Credentials
cr' -> Configuration -> IO Configuration
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Configuration {
                      timeInfo :: TimeInfo
timeInfo = TimeInfo
Timestamp
                    , credentials :: Credentials
credentials = Credentials
cr'
                    , logger :: Logger
logger = LogLevel -> Logger
defaultLog LogLevel
Warning
                    , proxy :: Maybe Proxy
proxy = Maybe Proxy
forall a. Maybe a
Nothing
                    }

-- | Debug configuration, which logs much more verbosely.
dbgConfiguration :: MonadIO io => io Configuration
dbgConfiguration :: forall (io :: * -> *). MonadIO io => io Configuration
dbgConfiguration = do
  c <- io Configuration
forall (io :: * -> *). MonadIO io => io Configuration
baseConfiguration
  return c { logger = defaultLog Debug }

-- | Run an AWS transaction, with HTTP manager and metadata wrapped in a 'Response'.
--
-- All errors are caught and wrapped in the 'Response' value.
--
-- Metadata is logged at level 'Info'.
--
-- Usage (with existing 'HTTP.Manager'):
-- @
--     resp <- aws cfg serviceCfg manager request
-- @
aws :: (Transaction r a)
      => Configuration
      -> ServiceConfiguration r NormalQuery
      -> HTTP.Manager
      -> r
      -> ResourceT IO (Response (ResponseMetadata a) a)
aws :: forall r a.
Transaction r a =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> ResourceT IO (Response (ResponseMetadata a) a)
aws = Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> ResourceT IO (Response (ResponseMetadata a) a)
forall r a.
(ResponseConsumer r a, Loggable (ResponseMetadata a),
 SignQuery r) =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> ResourceT IO (Response (ResponseMetadata a) a)
unsafeAws

-- | Run an AWS transaction, with HTTP manager and metadata returned in an 'IORef'.
--
-- Errors are not caught, and need to be handled with exception handlers.
--
-- Metadata is not logged.
--
-- Usage (with existing 'HTTP.Manager'):
-- @
--     ref <- newIORef mempty;
--     resp <- awsRef cfg serviceCfg manager request
-- @

-- Unfortunately, the ";" above seems necessary, as haddock does not want to split lines for me.
awsRef :: (Transaction r a)
      => Configuration
      -> ServiceConfiguration r NormalQuery
      -> HTTP.Manager
      -> IORef (ResponseMetadata a)
      -> r
      -> ResourceT IO a
awsRef :: forall r a.
Transaction r a =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> IORef (ResponseMetadata a)
-> r
-> ResourceT IO a
awsRef = Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> IORef (ResponseMetadata a)
-> r
-> ResourceT IO a
forall r a.
(ResponseConsumer r a, SignQuery r) =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> IORef (ResponseMetadata a)
-> r
-> ResourceT IO a
unsafeAwsRef

-- | Run an AWS transaction, with HTTP manager and without metadata.
--
-- Metadata is logged at level 'Info'.
--
-- Usage (with existing 'HTTP.Manager'):
-- @
--     resp <- aws cfg serviceCfg manager request
-- @
pureAws :: (Transaction r a)
      => Configuration
      -> ServiceConfiguration r NormalQuery
      -> HTTP.Manager
      -> r
      -> ResourceT IO a
pureAws :: forall r a.
Transaction r a =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> ResourceT IO a
pureAws Configuration
cfg ServiceConfiguration r NormalQuery
scfg Manager
mgr r
req = Response (ResponseMetadata a) a -> ResourceT IO a
forall (io :: * -> *) m a. MonadIO io => Response m a -> io a
readResponseIO (Response (ResponseMetadata a) a -> ResourceT IO a)
-> ResourceT IO (Response (ResponseMetadata a) a) -> ResourceT IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> ResourceT IO (Response (ResponseMetadata a) a)
forall r a.
Transaction r a =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> ResourceT IO (Response (ResponseMetadata a) a)
aws Configuration
cfg ServiceConfiguration r NormalQuery
scfg Manager
mgr r
req

-- | Run an AWS transaction, with HTTP manager and without metadata.
--
-- Metadata is logged at level 'Info'.
--
-- Usage (with existing 'HTTP.Manager'):
-- @
--     resp <- aws cfg serviceCfg manager request
-- @
memoryAws :: (Transaction r a, AsMemoryResponse a, MonadIO io)
      => Configuration
      -> ServiceConfiguration r NormalQuery
      -> HTTP.Manager
      -> r
      -> io (MemoryResponse a)
memoryAws :: forall r a (io :: * -> *).
(Transaction r a, AsMemoryResponse a, MonadIO io) =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> io (MemoryResponse a)
memoryAws Configuration
cfg ServiceConfiguration r NormalQuery
scfg Manager
mgr r
req = IO (MemoryResponse a) -> io (MemoryResponse a)
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MemoryResponse a) -> io (MemoryResponse a))
-> IO (MemoryResponse a) -> io (MemoryResponse a)
forall a b. (a -> b) -> a -> b
$ ResourceT IO (MemoryResponse a) -> IO (MemoryResponse a)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (MemoryResponse a) -> IO (MemoryResponse a))
-> ResourceT IO (MemoryResponse a) -> IO (MemoryResponse a)
forall a b. (a -> b) -> a -> b
$ a -> ResourceT IO (MemoryResponse a)
forall resp.
AsMemoryResponse resp =>
resp -> ResourceT IO (MemoryResponse resp)
loadToMemory (a -> ResourceT IO (MemoryResponse a))
-> ResourceT IO a -> ResourceT IO (MemoryResponse a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Response (ResponseMetadata a) a -> ResourceT IO a
forall (io :: * -> *) m a. MonadIO io => Response m a -> io a
readResponseIO (Response (ResponseMetadata a) a -> ResourceT IO a)
-> ResourceT IO (Response (ResponseMetadata a) a) -> ResourceT IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> ResourceT IO (Response (ResponseMetadata a) a)
forall r a.
Transaction r a =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> ResourceT IO (Response (ResponseMetadata a) a)
aws Configuration
cfg ServiceConfiguration r NormalQuery
scfg Manager
mgr r
req

-- | Run an AWS transaction, /without/ HTTP manager and without metadata.
--
-- Metadata is logged at level 'Info'.
--
-- Note that this is potentially less efficient than using 'aws', because HTTP connections cannot be re-used.
--
-- Usage:
-- @
--     resp <- simpleAws cfg serviceCfg request
-- @
simpleAws :: (Transaction r a, AsMemoryResponse a, MonadIO io)
            => Configuration
            -> ServiceConfiguration r NormalQuery
            -> r
            -> io (MemoryResponse a)
simpleAws :: forall r a (io :: * -> *).
(Transaction r a, AsMemoryResponse a, MonadIO io) =>
Configuration
-> ServiceConfiguration r NormalQuery -> r -> io (MemoryResponse a)
simpleAws Configuration
cfg ServiceConfiguration r NormalQuery
scfg r
request = IO (MemoryResponse a) -> io (MemoryResponse a)
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MemoryResponse a) -> io (MemoryResponse a))
-> IO (MemoryResponse a) -> io (MemoryResponse a)
forall a b. (a -> b) -> a -> b
$ ResourceT IO (MemoryResponse a) -> IO (MemoryResponse a)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (MemoryResponse a) -> IO (MemoryResponse a))
-> ResourceT IO (MemoryResponse a) -> IO (MemoryResponse a)
forall a b. (a -> b) -> a -> b
$ do
    manager <- IO Manager -> ResourceT IO Manager
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Manager
HTTP.getGlobalManager
    loadToMemory =<< readResponseIO =<< aws cfg scfg manager request

-- | Run an AWS transaction, without enforcing that response and request type form a valid transaction pair.
--
-- This is especially useful for debugging and development, you should not have to use it in production.
--
-- All errors are caught and wrapped in the 'Response' value.
--
-- Metadata is wrapped in the Response, and also logged at level 'Info'.
unsafeAws
  :: (ResponseConsumer r a,
      Loggable (ResponseMetadata a),
      SignQuery r) =>
     Configuration -> ServiceConfiguration r NormalQuery -> HTTP.Manager -> r -> ResourceT IO (Response (ResponseMetadata a) a)
unsafeAws :: forall r a.
(ResponseConsumer r a, Loggable (ResponseMetadata a),
 SignQuery r) =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> ResourceT IO (Response (ResponseMetadata a) a)
unsafeAws Configuration
cfg ServiceConfiguration r NormalQuery
scfg Manager
manager r
request = do
  metadataRef <- IO (IORef (ResponseMetadata a))
-> ResourceT IO (IORef (ResponseMetadata a))
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (ResponseMetadata a))
 -> ResourceT IO (IORef (ResponseMetadata a)))
-> IO (IORef (ResponseMetadata a))
-> ResourceT IO (IORef (ResponseMetadata a))
forall a b. (a -> b) -> a -> b
$ ResponseMetadata a -> IO (IORef (ResponseMetadata a))
forall a. a -> IO (IORef a)
newIORef ResponseMetadata a
forall a. Monoid a => a
mempty

  let catchAll :: ResourceT IO a -> ResourceT IO (Either E.SomeException a)
      catchAll = (SomeException -> ResourceT IO (Either SomeException a))
-> ResourceT IO (Either SomeException a)
-> ResourceT IO (Either SomeException a)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
E.handle (Either SomeException a -> ResourceT IO (Either SomeException a)
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException a -> ResourceT IO (Either SomeException a))
-> (SomeException -> Either SomeException a)
-> SomeException
-> ResourceT IO (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Either SomeException a
forall a b. a -> Either a b
Left) (ResourceT IO (Either SomeException a)
 -> ResourceT IO (Either SomeException a))
-> (ResourceT IO a -> ResourceT IO (Either SomeException a))
-> ResourceT IO a
-> ResourceT IO (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either SomeException a)
-> ResourceT IO a -> ResourceT IO (Either SomeException a)
forall a b. (a -> b) -> ResourceT IO a -> ResourceT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either SomeException a
forall a b. b -> Either a b
Right

  resp <- catchAll $
            unsafeAwsRef cfg scfg manager metadataRef request
  metadata <- liftIO $ readIORef metadataRef
  liftIO $ logger cfg Info $ "Response metadata: " `mappend` toLogText metadata
  return $ Response metadata resp

-- | Run an AWS transaction, without enforcing that response and request type form a valid transaction pair.
--
-- This is especially useful for debugging and development, you should not have to use it in production.
--
-- Errors are not caught, and need to be handled with exception handlers.
--
-- Metadata is put in the 'IORef', but not logged.
unsafeAwsRef
  :: (ResponseConsumer r a,
      SignQuery r) =>
     Configuration -> ServiceConfiguration r NormalQuery -> HTTP.Manager -> IORef (ResponseMetadata a) -> r -> ResourceT IO a
unsafeAwsRef :: forall r a.
(ResponseConsumer r a, SignQuery r) =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> IORef (ResponseMetadata a)
-> r
-> ResourceT IO a
unsafeAwsRef Configuration
cfg ServiceConfiguration r NormalQuery
info Manager
manager IORef (ResponseMetadata a)
metadataRef r
request = do
  sd <- IO SignatureData -> ResourceT IO SignatureData
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignatureData -> ResourceT IO SignatureData)
-> IO SignatureData -> ResourceT IO SignatureData
forall a b. (a -> b) -> a -> b
$ TimeInfo -> Credentials -> IO SignatureData
signatureData (TimeInfo -> Credentials -> IO SignatureData)
-> (Configuration -> TimeInfo)
-> Configuration
-> Credentials
-> IO SignatureData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Configuration -> TimeInfo
timeInfo (Configuration -> Credentials -> IO SignatureData)
-> (Configuration -> Credentials)
-> Configuration
-> IO SignatureData
forall a b.
(Configuration -> a -> b)
-> (Configuration -> a) -> Configuration -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Configuration -> Credentials
credentials (Configuration -> IO SignatureData)
-> Configuration -> IO SignatureData
forall a b. (a -> b) -> a -> b
$ Configuration
cfg
  let !q = {-# SCC "unsafeAwsRef:signQuery" #-} r
-> ServiceConfiguration r NormalQuery
-> SignatureData
-> SignedQuery
forall queryType.
r
-> ServiceConfiguration r queryType -> SignatureData -> SignedQuery
forall request queryType.
SignQuery request =>
request
-> ServiceConfiguration request queryType
-> SignatureData
-> SignedQuery
signQuery r
request ServiceConfiguration r NormalQuery
info SignatureData
sd
  let logDebug = IO () -> ResourceT IO ()
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ())
-> (String -> IO ()) -> String -> ResourceT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Configuration -> Logger
logger Configuration
cfg LogLevel
Debug (Text -> IO ()) -> (String -> Text) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
  logDebug $ "String to sign: " ++ show (sqStringToSign q)
  !httpRequest <- {-# SCC "unsafeAwsRef:httpRequest" #-} liftIO $ do
    req <- queryToHttpRequest q
    return $ req { HTTP.proxy = proxy cfg }
  logDebug $ "Host: " ++ show (HTTP.host httpRequest)
  logDebug $ "Path: " ++ show (HTTP.path httpRequest)
  logDebug $ "Query string: " ++ show (HTTP.queryString httpRequest)
  logDebug $ "Header: " ++ show (HTTP.requestHeaders httpRequest)
  case HTTP.requestBody httpRequest of
    HTTP.RequestBodyLBS ByteString
lbs -> String -> ResourceT IO ()
logDebug (String -> ResourceT IO ()) -> String -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ String
"Body: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Int64 -> ByteString -> ByteString
L.take Int64
1000 ByteString
lbs)
    HTTP.RequestBodyBS ByteString
bs -> String -> ResourceT IO ()
logDebug (String -> ResourceT IO ()) -> String -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ String
"Body: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
B.take Int
1000 ByteString
bs)
    RequestBody
_ -> () -> ResourceT IO ()
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  hresp <- {-# SCC "unsafeAwsRef:http" #-} HTTP.http httpRequest manager
  logDebug $ "Response status: " ++ show (HTTP.responseStatus hresp)
  forM_ (HTTP.responseHeaders hresp) $ \(HeaderName
hname,ByteString
hvalue) -> IO () -> ResourceT IO ()
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$
    Configuration -> Logger
logger Configuration
cfg LogLevel
Debug (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
"Response header '" ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` HeaderName -> ByteString
forall s. CI s -> s
CI.original HeaderName
hname ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
"': '" ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
hvalue ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
"'"
  {-# SCC "unsafeAwsRef:responseConsumer" #-} responseConsumer httpRequest request metadataRef hresp

-- | Run a URI-only AWS transaction. Returns a URI that can be sent anywhere. Does not work with all requests.
--
-- Usage:
-- @
--     uri <- awsUri cfg request
-- @
awsUri :: (SignQuery request, MonadIO io)
         => Configuration -> ServiceConfiguration request UriOnlyQuery -> request -> io B.ByteString
awsUri :: forall request (io :: * -> *).
(SignQuery request, MonadIO io) =>
Configuration
-> ServiceConfiguration request UriOnlyQuery
-> request
-> io ByteString
awsUri Configuration
cfg ServiceConfiguration request UriOnlyQuery
info request
request = IO ByteString -> io ByteString
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> io ByteString) -> IO ByteString -> io ByteString
forall a b. (a -> b) -> a -> b
$ do
  let ti :: TimeInfo
ti = Configuration -> TimeInfo
timeInfo Configuration
cfg
      cr :: Credentials
cr = Configuration -> Credentials
credentials Configuration
cfg
  sd <- TimeInfo -> Credentials -> IO SignatureData
signatureData TimeInfo
ti Credentials
cr
  let q = request
-> ServiceConfiguration request UriOnlyQuery
-> SignatureData
-> SignedQuery
forall queryType.
request
-> ServiceConfiguration request queryType
-> SignatureData
-> SignedQuery
forall request queryType.
SignQuery request =>
request
-> ServiceConfiguration request queryType
-> SignatureData
-> SignedQuery
signQuery request
request ServiceConfiguration request UriOnlyQuery
info SignatureData
sd
  logger cfg Debug $ T.pack $ "String to sign: " ++ show (sqStringToSign q)
  return $ queryToUri q

{-
-- | Run an iterated AWS transaction. May make multiple HTTP requests.
awsIteratedAll :: (IteratedTransaction r a)
                  => Configuration
                  -> ServiceConfiguration r NormalQuery
                  -> HTTP.Manager
                  -> r
                  -> ResourceT IO (Response [ResponseMetadata a] a)
awsIteratedAll cfg scfg manager req_ = go req_ Nothing
  where go request prevResp = do Response meta respAttempt <- aws cfg scfg manager request
                                 case maybeCombineIteratedResponse prevResp <$> respAttempt of
                                   f@(Failure _) -> return (Response [meta] f)
                                   s@(Success resp) ->
                                     case nextIteratedRequest request resp of
                                       Nothing ->
                                         return (Response [meta] s)
                                       Just nextRequest ->
                                         mapMetadata (meta:) `liftM` go nextRequest (Just resp)
-}

awsIteratedSource
    :: (IteratedTransaction r a)
    => Configuration
    -> ServiceConfiguration r NormalQuery
    -> HTTP.Manager
    -> r
    -> forall i. C.ConduitT i (Response (ResponseMetadata a) a) (ResourceT IO) ()
awsIteratedSource :: forall r a.
IteratedTransaction r a =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> forall i.
   ConduitT i (Response (ResponseMetadata a) a) (ResourceT IO) ()
awsIteratedSource Configuration
cfg ServiceConfiguration r NormalQuery
scfg Manager
manager r
req_ = (r -> ResourceT IO (a, Response (ResponseMetadata a) a))
-> r
-> forall i.
   ConduitT i (Response (ResponseMetadata a) a) (ResourceT IO) ()
forall (m :: * -> *) r a b.
(Monad m, IteratedTransaction r a) =>
(r -> m (a, b)) -> r -> forall i. ConduitT i b m ()
awsIteratedSource' r -> ResourceT IO (a, Response (ResponseMetadata a) a)
run r
req_
  where
    run :: r -> ResourceT IO (a, Response (ResponseMetadata a) a)
run r
r = do
        res <- Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> ResourceT IO (Response (ResponseMetadata a) a)
forall r a.
Transaction r a =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> ResourceT IO (Response (ResponseMetadata a) a)
aws Configuration
cfg ServiceConfiguration r NormalQuery
scfg Manager
manager r
r
        a <- readResponseIO res
        return (a, res)


awsIteratedList
    :: (IteratedTransaction r a, ListResponse a i)
    => Configuration
    -> ServiceConfiguration r NormalQuery
    -> HTTP.Manager
    -> r
    -> forall j. C.ConduitT j i (ResourceT IO) ()
awsIteratedList :: forall r a i.
(IteratedTransaction r a, ListResponse a i) =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> forall j. ConduitT j i (ResourceT IO) ()
awsIteratedList Configuration
cfg ServiceConfiguration r NormalQuery
scfg Manager
manager r
req = (r -> ResourceT IO a)
-> r -> forall i. ConduitT i i (ResourceT IO) ()
forall (m :: * -> *) r b c.
(Monad m, IteratedTransaction r b, ListResponse b c) =>
(r -> m b) -> r -> forall i. ConduitT i c m ()
awsIteratedList' r -> ResourceT IO a
run r
req
  where
    run :: r -> ResourceT IO a
run r
r = Response (ResponseMetadata a) a -> ResourceT IO a
forall (io :: * -> *) m a. MonadIO io => Response m a -> io a
readResponseIO (Response (ResponseMetadata a) a -> ResourceT IO a)
-> ResourceT IO (Response (ResponseMetadata a) a) -> ResourceT IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> ResourceT IO (Response (ResponseMetadata a) a)
forall r a.
Transaction r a =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> ResourceT IO (Response (ResponseMetadata a) a)
aws Configuration
cfg ServiceConfiguration r NormalQuery
scfg Manager
manager r
r


-------------------------------------------------------------------------------
-- | A more flexible version of 'awsIteratedSource' that uses a
-- user-supplied run function. Useful for embedding AWS functionality
-- within application specific monadic contexts.
awsIteratedSource'
    :: (Monad m, IteratedTransaction r a)
    => (r -> m (a, b))
    -- ^ A runner function for executing transactions.
    -> r
    -- ^ An initial request
    -> forall i. C.ConduitT i b m ()
awsIteratedSource' :: forall (m :: * -> *) r a b.
(Monad m, IteratedTransaction r a) =>
(r -> m (a, b)) -> r -> forall i. ConduitT i b m ()
awsIteratedSource' r -> m (a, b)
run r
r0 = r -> ConduitT i b m ()
go r
r0
    where
      go :: r -> ConduitT i b m ()
go r
q = do
          (a, b) <- m (a, b) -> ConduitT i b m (a, b)
forall (m :: * -> *) a. Monad m => m a -> ConduitT i b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (a, b) -> ConduitT i b m (a, b))
-> m (a, b) -> ConduitT i b m (a, b)
forall a b. (a -> b) -> a -> b
$ r -> m (a, b)
run r
q
          C.yield b
          case nextIteratedRequest q a of
            Maybe r
Nothing -> () -> ConduitT i b m ()
forall a. a -> ConduitT i b m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just r
q' -> r -> ConduitT i b m ()
go r
q'


-------------------------------------------------------------------------------
-- | A more flexible version of 'awsIteratedList' that uses a
-- user-supplied run function. Useful for embedding AWS functionality
-- within application specific monadic contexts.
awsIteratedList'
    :: (Monad m, IteratedTransaction r b, ListResponse b c)
    => (r -> m b)
    -- ^ A runner function for executing transactions.
    -> r
    -- ^ An initial request
    -> forall i. C.ConduitT i c m ()
awsIteratedList' :: forall (m :: * -> *) r b c.
(Monad m, IteratedTransaction r b, ListResponse b c) =>
(r -> m b) -> r -> forall i. ConduitT i c m ()
awsIteratedList' r -> m b
run r
r0 =
    (r -> m (b, b)) -> r -> forall i. ConduitT i b m ()
forall (m :: * -> *) r a b.
(Monad m, IteratedTransaction r a) =>
(r -> m (a, b)) -> r -> forall i. ConduitT i b m ()
awsIteratedSource' r -> m (b, b)
run' r
r0 ConduitT i b m () -> ConduitT b c m () -> ConduitT i c m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
`C.fuse`
    (b -> [c]) -> ConduitT b c m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> [b]) -> ConduitT a b m ()
CL.concatMap b -> [c]
forall resp item. ListResponse resp item => resp -> [item]
listResponse
  where
    dupl :: b -> (b, b)
dupl b
a = (b
a,b
a)
    run' :: r -> m (b, b)
run' r
r = b -> (b, b)
forall {b}. b -> (b, b)
dupl (b -> (b, b)) -> m b -> m (b, b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` r -> m b
run r
r