{-# 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
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
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
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
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
$cp1Ord :: Eq 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 (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 :: io Configuration
baseConfiguration = IO Configuration -> io Configuration
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
  Maybe Credentials
cr <- IO (Maybe Credentials)
forall (io :: * -> *). MonadIO io => io (Maybe Credentials)
loadCredentialsDefault
  case Maybe Credentials
cr of
    Maybe Credentials
Nothing -> NoCredentialsException -> IO Configuration
forall (m :: * -> *) e a. (MonadThrow m, 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 (m :: * -> *) a. Monad m => a -> m a
return Configuration :: TimeInfo -> Credentials -> Logger -> Maybe Proxy -> Configuration
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 :: io Configuration
dbgConfiguration = do
  Configuration
c <- io Configuration
forall (io :: * -> *). MonadIO io => io Configuration
baseConfiguration
  Configuration -> io Configuration
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 :: 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 :: 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 :: 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 :: 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 (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 :: Configuration
-> ServiceConfiguration r NormalQuery -> r -> io (MemoryResponse a)
simpleAws Configuration
cfg ServiceConfiguration r NormalQuery
scfg r
request = IO (MemoryResponse a) -> io (MemoryResponse 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
manager <- IO Manager -> ResourceT IO Manager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Manager
HTTP.getGlobalManager
    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
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 :: 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 <- IO (IORef (ResponseMetadata a))
-> ResourceT IO (IORef (ResponseMetadata 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 :: ResourceT IO a -> ResourceT IO (Either SomeException a)
catchAll = (SomeException -> ResourceT IO (Either SomeException a))
-> ResourceT IO (Either SomeException a)
-> ResourceT IO (Either SomeException a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
E.handle (Either SomeException a -> ResourceT IO (Either SomeException 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either SomeException a
forall a b. b -> Either a b
Right

  Either SomeException a
resp <- ResourceT IO a -> ResourceT IO (Either SomeException a)
forall a. ResourceT IO a -> ResourceT IO (Either SomeException a)
catchAll (ResourceT IO a -> ResourceT IO (Either SomeException a))
-> ResourceT IO a -> ResourceT IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$
            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 Configuration
cfg ServiceConfiguration r NormalQuery
scfg Manager
manager IORef (ResponseMetadata a)
metadataRef r
request
  ResponseMetadata a
metadata <- IO (ResponseMetadata a) -> ResourceT IO (ResponseMetadata a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ResponseMetadata a) -> ResourceT IO (ResponseMetadata a))
-> IO (ResponseMetadata a) -> ResourceT IO (ResponseMetadata a)
forall a b. (a -> b) -> a -> b
$ IORef (ResponseMetadata a) -> IO (ResponseMetadata a)
forall a. IORef a -> IO a
readIORef IORef (ResponseMetadata a)
metadataRef
  IO () -> ResourceT IO ()
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
Info (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Response metadata: " Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` ResponseMetadata a -> Text
forall a. Loggable a => a -> Text
toLogText ResponseMetadata a
metadata
  Response (ResponseMetadata a) a
-> ResourceT IO (Response (ResponseMetadata a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response (ResponseMetadata a) a
 -> ResourceT IO (Response (ResponseMetadata a) a))
-> Response (ResponseMetadata a) a
-> ResourceT IO (Response (ResponseMetadata a) a)
forall a b. (a -> b) -> a -> b
$ ResponseMetadata a
-> Either SomeException a -> Response (ResponseMetadata a) a
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 :: 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 <- IO SignatureData -> ResourceT IO SignatureData
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 (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 :: SignedQuery
q = {-# SCC "unsafeAwsRef:signQuery" #-} r
-> ServiceConfiguration r NormalQuery
-> SignatureData
-> SignedQuery
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 = IO () -> ResourceT IO ()
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
  String -> ResourceT IO ()
logDebug (String -> ResourceT IO ()) -> String -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ String
"String to sign: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (SignedQuery -> ByteString
sqStringToSign SignedQuery
q)
  !Request
httpRequest <- {-# SCC "unsafeAwsRef:httpRequest" #-} IO Request -> ResourceT IO Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> ResourceT IO Request)
-> IO Request -> ResourceT IO Request
forall a b. (a -> b) -> a -> b
$ do
    Request
req <- SignedQuery -> IO Request
queryToHttpRequest SignedQuery
q
    Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> IO Request) -> Request -> IO Request
forall a b. (a -> b) -> a -> b
$ Request
req { proxy :: Maybe Proxy
HTTP.proxy = Configuration -> Maybe Proxy
proxy Configuration
cfg }
  String -> ResourceT IO ()
logDebug (String -> ResourceT IO ()) -> String -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ String
"Host: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Request -> ByteString
HTTP.host Request
httpRequest)
  String -> ResourceT IO ()
logDebug (String -> ResourceT IO ()) -> String -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ String
"Path: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Request -> ByteString
HTTP.path Request
httpRequest)
  String -> ResourceT IO ()
logDebug (String -> ResourceT IO ()) -> String -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ String
"Query string: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Request -> ByteString
HTTP.queryString Request
httpRequest)
  String -> ResourceT IO ()
logDebug (String -> ResourceT IO ()) -> String -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ String
"Header: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RequestHeaders -> String
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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()
  Response (ConduitM () ByteString (ResourceT IO) ())
hresp <- {-# SCC "unsafeAwsRef:http" #-} Request
-> Manager
-> ResourceT
     IO (Response (ConduitM () ByteString (ResourceT IO) ()))
forall (m :: * -> *) i.
MonadResource m =>
Request -> Manager -> m (Response (ConduitM i ByteString m ()))
HTTP.http Request
httpRequest Manager
manager
  String -> ResourceT IO ()
logDebug (String -> ResourceT IO ()) -> String -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ String
"Response status: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Status -> String
forall a. Show a => a -> String
show (Response (ConduitM () ByteString (ResourceT IO) ()) -> Status
forall body. Response body -> Status
HTTP.responseStatus Response (ConduitM () ByteString (ResourceT IO) ())
hresp)
  RequestHeaders -> (Header -> ResourceT IO ()) -> ResourceT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Response (ConduitM () ByteString (ResourceT IO) ())
-> RequestHeaders
forall body. Response body -> RequestHeaders
HTTP.responseHeaders Response (ConduitM () ByteString (ResourceT IO) ())
hresp) ((Header -> ResourceT IO ()) -> ResourceT IO ())
-> (Header -> ResourceT IO ()) -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ \(HeaderName
hname,ByteString
hvalue) -> IO () -> ResourceT IO ()
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" #-} Request
-> r -> IORef (ResponseMetadata a) -> HTTPResponseConsumer a
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 :: Configuration
-> ServiceConfiguration request UriOnlyQuery
-> request
-> io ByteString
awsUri Configuration
cfg ServiceConfiguration request UriOnlyQuery
info request
request = IO ByteString -> io ByteString
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
  SignatureData
sd <- TimeInfo -> Credentials -> IO SignatureData
signatureData TimeInfo
ti Credentials
cr
  let q :: SignedQuery
q = request
-> ServiceConfiguration request UriOnlyQuery
-> SignatureData
-> SignedQuery
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 (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"String to sign: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (SignedQuery -> ByteString
sqStringToSign SignedQuery
q)
  ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
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 :: Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> Producer (ResourceT IO) (Response (ResponseMetadata a) a)
awsIteratedSource Configuration
cfg ServiceConfiguration r NormalQuery
scfg Manager
manager r
req_ = (r -> ResourceT IO (a, Response (ResponseMetadata a) a))
-> r -> Producer (ResourceT IO) (Response (ResponseMetadata a) a)
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 <- 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
a <- Response (ResponseMetadata a) a -> ResourceT IO a
forall (io :: * -> *) m a. MonadIO io => Response m a -> io a
readResponseIO Response (ResponseMetadata a) a
res
        (a, Response (ResponseMetadata a) a)
-> ResourceT IO (a, Response (ResponseMetadata a) a)
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 :: Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> Producer (ResourceT IO) i
awsIteratedList Configuration
cfg ServiceConfiguration r NormalQuery
scfg Manager
manager r
req = (r -> ResourceT IO a) -> r -> Producer (ResourceT IO) i
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 = 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
    -> C.Producer m b
awsIteratedSource' :: (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) <- m (a, b) -> ConduitT i b m (a, b)
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
          b -> ConduitT i b m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield b
b
          case r -> a -> Maybe r
forall r a. IteratedTransaction r a => r -> a -> Maybe r
nextIteratedRequest r
q a
a of
            Maybe r
Nothing -> () -> ConduitT i b m ()
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' :: (r -> m b) -> r -> Producer m c
awsIteratedList' r -> m b
run r
r0 =
    (r -> m (b, b)) -> r -> Producer m b
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 ConduitT i b m () -> ConduitT b c m () -> ConduitT i c m ()
forall (m :: * -> *) a b c r.
Monad m =>
Conduit a m b -> ConduitT b c m r -> ConduitT a c m r
C.=$=
    (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