{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show, LogLevel -> LogLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Eq 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
min :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmax :: LogLevel -> LogLevel -> LogLevel
>= :: LogLevel -> LogLevel -> Bool
$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
compare :: LogLevel -> LogLevel -> Ordering
$ccompare :: LogLevel -> LogLevel -> Ordering
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 forall a. Ord a => a -> a -> Bool
>= LogLevel
minLevel = Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show LogLevel
lev, Text
": ", Text
t]
                          | Bool
otherwise       = 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Maybe Credentials
cr <- forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
loadCredentialsDefault
  case Maybe Credentials
cr of
    Maybe Credentials
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
E.throwM forall a b. (a -> b) -> a -> b
$ String -> NoCredentialsException
NoCredentialsException String
"could not locate aws credentials"
    Just Credentials
cr' -> 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 = 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
  Configuration
c <- forall (io :: * -> *). MonadIO io => io Configuration
baseConfiguration
  forall (m :: * -> *) a. Monad m => a -> m a
return Configuration
c { logger :: Logger
logger = LogLevel -> Logger
defaultLog LogLevel
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 = 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 = 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 = forall (io :: * -> *) m a. MonadIO io => Response m a -> io a
readResponseIO forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ forall resp.
AsMemoryResponse resp =>
resp -> ResourceT IO (MemoryResponse resp)
loadToMemory forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (io :: * -> *) m a. MonadIO io => Response m a -> io a
readResponseIO forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ do
    Manager
manager <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Manager
HTTP.getGlobalManager
    forall resp.
AsMemoryResponse resp =>
resp -> ResourceT IO (MemoryResponse resp)
loadToMemory forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (io :: * -> *) m a. MonadIO io => Response m a -> io a
readResponseIO forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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
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
  IORef (ResponseMetadata a)
metadataRef <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty

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

  Either SomeException a
resp <- forall a. ResourceT IO a -> ResourceT IO (Either SomeException a)
catchAll forall a b. (a -> b) -> a -> b
$
            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
scfg Manager
manager IORef (ResponseMetadata a)
metadataRef r
request
  ResponseMetadata a
metadata <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (ResponseMetadata a)
metadataRef
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Configuration -> Logger
logger Configuration
cfg LogLevel
Info forall a b. (a -> b) -> a -> b
$ Text
"Response metadata: " forall a. Monoid a => a -> a -> a
`mappend` forall a. Loggable a => a -> Text
toLogText ResponseMetadata a
metadata
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall m a. m -> Either SomeException a -> Response m a
Response ResponseMetadata a
metadata Either SomeException a
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
  SignatureData
sd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ TimeInfo -> Credentials -> IO SignatureData
signatureData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Configuration -> TimeInfo
timeInfo forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Configuration -> Credentials
credentials forall a b. (a -> b) -> a -> b
$ Configuration
cfg
  let !q :: SignedQuery
q = {-# SCC "unsafeAwsRef:signQuery" #-} forall request queryType.
SignQuery request =>
request
-> ServiceConfiguration request queryType
-> SignatureData
-> SignedQuery
signQuery r
request ServiceConfiguration r NormalQuery
info SignatureData
sd
  let logDebug :: String -> ResourceT IO ()
logDebug = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Configuration -> Logger
logger Configuration
cfg LogLevel
Debug forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
  String -> ResourceT IO ()
logDebug forall a b. (a -> b) -> a -> b
$ String
"String to sign: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (SignedQuery -> ByteString
sqStringToSign SignedQuery
q)
  !Request
httpRequest <- {-# SCC "unsafeAwsRef:httpRequest" #-} forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Request
req <- SignedQuery -> IO Request
queryToHttpRequest SignedQuery
q
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Request
req { proxy :: Maybe Proxy
HTTP.proxy = Configuration -> Maybe Proxy
proxy Configuration
cfg }
  String -> ResourceT IO ()
logDebug forall a b. (a -> b) -> a -> b
$ String
"Host: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Request -> ByteString
HTTP.host Request
httpRequest)
  String -> ResourceT IO ()
logDebug forall a b. (a -> b) -> a -> b
$ String
"Path: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Request -> ByteString
HTTP.path Request
httpRequest)
  String -> ResourceT IO ()
logDebug forall a b. (a -> b) -> a -> b
$ String
"Query string: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Request -> ByteString
HTTP.queryString Request
httpRequest)
  String -> ResourceT IO ()
logDebug forall a b. (a -> b) -> a -> b
$ String
"Header: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Request -> RequestHeaders
HTTP.requestHeaders Request
httpRequest)
  case Request -> RequestBody
HTTP.requestBody Request
httpRequest of
    HTTP.RequestBodyLBS ByteString
lbs -> String -> ResourceT IO ()
logDebug forall a b. (a -> b) -> a -> b
$ String
"Body: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int64 -> ByteString -> ByteString
L.take Int64
1000 ByteString
lbs)
    HTTP.RequestBodyBS ByteString
bs -> String -> ResourceT IO ()
logDebug forall a b. (a -> b) -> a -> b
$ String
"Body: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
B.take Int
1000 ByteString
bs)
    RequestBody
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Response (ConduitM () ByteString (ResourceT IO) ())
hresp <- {-# SCC "unsafeAwsRef:http" #-} forall (m :: * -> *) i.
MonadResource m =>
Request -> Manager -> m (Response (ConduitM i ByteString m ()))
HTTP.http Request
httpRequest Manager
manager
  String -> ResourceT IO ()
logDebug forall a b. (a -> b) -> a -> b
$ String
"Response status: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall body. Response body -> Status
HTTP.responseStatus Response (ConduitM () ByteString (ResourceT IO) ())
hresp)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall body. Response body -> RequestHeaders
HTTP.responseHeaders Response (ConduitM () ByteString (ResourceT IO) ())
hresp) forall a b. (a -> b) -> a -> b
$ \(HeaderName
hname,ByteString
hvalue) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    Configuration -> Logger
logger Configuration
cfg LogLevel
Debug forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString
"Response header '" forall a. Monoid a => a -> a -> a
`mappend` forall s. CI s -> s
CI.original HeaderName
hname forall a. Monoid a => a -> a -> a
`mappend` ByteString
"': '" forall a. Monoid a => a -> a -> a
`mappend` ByteString
hvalue forall a. Monoid a => a -> a -> a
`mappend` ByteString
"'"
  {-# SCC "unsafeAwsRef:responseConsumer" #-} forall req resp.
ResponseConsumer req resp =>
Request
-> req
-> IORef (ResponseMetadata resp)
-> HTTPResponseConsumer resp
responseConsumer Request
httpRequest r
request IORef (ResponseMetadata a)
metadataRef Response (ConduitM () ByteString (ResourceT IO) ())
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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
  SignatureData
sd <- TimeInfo -> Credentials -> IO SignatureData
signatureData TimeInfo
ti Credentials
cr
  let q :: SignedQuery
q = forall request queryType.
SignQuery request =>
request
-> ServiceConfiguration request queryType
-> SignatureData
-> SignedQuery
signQuery request
request ServiceConfiguration request UriOnlyQuery
info SignatureData
sd
  Configuration -> Logger
logger Configuration
cfg LogLevel
Debug forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"String to sign: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (SignedQuery -> ByteString
sqStringToSign SignedQuery
q)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SignedQuery -> ByteString
queryToUri SignedQuery
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
    -> C.Producer (ResourceT IO) (Response (ResponseMetadata a) a)
awsIteratedSource :: forall r a.
IteratedTransaction r a =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> Producer (ResourceT IO) (Response (ResponseMetadata a) a)
awsIteratedSource Configuration
cfg ServiceConfiguration r NormalQuery
scfg Manager
manager r
req_ = forall (m :: * -> *) r a b.
(Monad m, IteratedTransaction r a) =>
(r -> m (a, b)) -> r -> Producer m b
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
        Response (ResponseMetadata a) a
res <- 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
a <- forall (io :: * -> *) m a. MonadIO io => Response m a -> io a
readResponseIO Response (ResponseMetadata a) a
res
        forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Response (ResponseMetadata a) a
res)


awsIteratedList
    :: (IteratedTransaction r a, ListResponse a i)
    => Configuration
    -> ServiceConfiguration r NormalQuery
    -> HTTP.Manager
    -> r
    -> C.Producer (ResourceT IO) i
awsIteratedList :: forall r a i.
(IteratedTransaction r a, ListResponse a i) =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> Producer (ResourceT IO) i
awsIteratedList Configuration
cfg ServiceConfiguration r NormalQuery
scfg Manager
manager r
req = forall (m :: * -> *) r b c.
(Monad m, IteratedTransaction r b, ListResponse b c) =>
(r -> m b) -> r -> Producer m c
awsIteratedList' r -> ResourceT IO a
run r
req
  where
    run :: r -> ResourceT IO a
run r
r = forall (io :: * -> *) m a. MonadIO io => Response m a -> io a
readResponseIO forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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
    -> C.Producer m b
awsIteratedSource' :: forall (m :: * -> *) r a b.
(Monad m, IteratedTransaction r a) =>
(r -> m (a, b)) -> r -> Producer m b
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
a, b
b) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ r -> m (a, b)
run r
q
          forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield b
b
          case forall r a. IteratedTransaction r a => r -> a -> Maybe r
nextIteratedRequest r
q a
a of
            Maybe r
Nothing -> 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
    -> C.Producer m c
awsIteratedList' :: forall (m :: * -> *) r b c.
(Monad m, IteratedTransaction r b, ListResponse b c) =>
(r -> m b) -> r -> Producer m c
awsIteratedList' r -> m b
run r
r0 =
    forall (m :: * -> *) r a b.
(Monad m, IteratedTransaction r a) =>
(r -> m (a, b)) -> r -> Producer m b
awsIteratedSource' r -> m (b, b)
run' r
r0 forall (m :: * -> *) a b c r.
Monad m =>
Conduit a m b -> ConduitT b c m r -> ConduitT a c m r
C.=$=
    forall (m :: * -> *) a b.
Monad m =>
(a -> [b]) -> ConduitT a b m ()
CL.concatMap 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 = forall {b}. b -> (b, b)
dupl forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` r -> m b
run r
r