-- |
-- Module      : Amazonka.Response
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
--
-- Functions contained in this module fully consume the body and thus close
-- the connection. This is needed to avoid hitting this issue:
-- <https://github.com/brendanhay/amazonka/issues/490>.
--
-- The only exception is 'receiveBody', which passes a streaming response
-- body to a callback and thus is not allowed to close the connection. Users
-- of streaming functions are advised to be careful and consume the response
-- body manually if they want the connection to be closed promptly.
--
-- Note that using 'runResourceT' will always close the connection.
module Amazonka.Response
  ( receiveNull,
    receiveEmpty,
    receiveXMLWrapper,
    receiveXML,
    receiveJSON,
    receiveBytes,
    receiveBody,
  )
where

import Amazonka.Data
import Amazonka.Prelude hiding (error)
import Amazonka.Types
import qualified Control.Monad.Trans.Except as Except
import Control.Monad.Trans.Resource (liftResourceT)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as LBS
import Data.Conduit ()
import qualified Data.Conduit as Conduit
import qualified Data.Conduit.Binary as Conduit.Binary
import Data.Functor (($>))
import qualified Network.HTTP.Client as Client
import Network.HTTP.Types (ResponseHeaders)
import qualified Text.XML as XML

receiveNull ::
  MonadResource m =>
  AWSResponse a ->
  (ByteStringLazy -> IO ByteStringLazy) ->
  Service ->
  Proxy a ->
  ClientResponse ClientBody ->
  m (Either Error (ClientResponse (AWSResponse a)))
receiveNull :: forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
receiveNull AWSResponse a
rs ByteStringLazy -> IO ByteStringLazy
_ =
  forall (m :: * -> *) a.
MonadResource m =>
(ClientResponse ()
 -> Int
 -> ResponseHeaders
 -> ClientBody
 -> m (Either String (AWSResponse a)))
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
stream forall a b. (a -> b) -> a -> b
$ \ClientResponse ()
r Int
_ ResponseHeaders
_ ClientBody
_ ->
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. Response a -> IO ()
Client.responseClose ClientResponse ()
r) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a b. b -> Either a b
Right AWSResponse a
rs

receiveEmpty ::
  MonadResource m =>
  (Int -> ResponseHeaders -> () -> Either String (AWSResponse a)) ->
  (ByteStringLazy -> IO ByteStringLazy) ->
  Service ->
  Proxy a ->
  ClientResponse ClientBody ->
  m (Either Error (ClientResponse (AWSResponse a)))
receiveEmpty :: forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
receiveEmpty Int -> ResponseHeaders -> () -> Either String (AWSResponse a)
f ByteStringLazy -> IO ByteStringLazy
_ =
  forall (m :: * -> *) a.
MonadResource m =>
(ClientResponse ()
 -> Int
 -> ResponseHeaders
 -> ClientBody
 -> m (Either String (AWSResponse a)))
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
stream forall a b. (a -> b) -> a -> b
$ \ClientResponse ()
r Int
s ResponseHeaders
h ClientBody
_ ->
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. Response a -> IO ()
Client.responseClose ClientResponse ()
r) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int -> ResponseHeaders -> () -> Either String (AWSResponse a)
f Int
s ResponseHeaders
h ()

receiveXMLWrapper ::
  MonadResource m =>
  Text ->
  (Int -> ResponseHeaders -> [XML.Node] -> Either String (AWSResponse a)) ->
  (ByteStringLazy -> IO ByteStringLazy) ->
  Service ->
  Proxy a ->
  ClientResponse ClientBody ->
  m (Either Error (ClientResponse (AWSResponse a)))
receiveXMLWrapper :: forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
receiveXMLWrapper Text
n Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a)
f = forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
receiveXML (\Int
s ResponseHeaders
h [Node]
x -> [Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
.@ Text
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a)
f Int
s ResponseHeaders
h)

receiveXML ::
  MonadResource m =>
  (Int -> ResponseHeaders -> [XML.Node] -> Either String (AWSResponse a)) ->
  (ByteStringLazy -> IO ByteStringLazy) ->
  Service ->
  Proxy a ->
  ClientResponse ClientBody ->
  m (Either Error (ClientResponse (AWSResponse a)))
receiveXML :: forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
receiveXML = forall (m :: * -> *) b a.
MonadResource m =>
(ByteStringLazy -> Either String b)
-> (Int -> ResponseHeaders -> b -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
deserialise forall a. FromXML a => ByteStringLazy -> Either String a
decodeXML

receiveJSON ::
  MonadResource m =>
  (Int -> ResponseHeaders -> Aeson.Object -> Either String (AWSResponse a)) ->
  (ByteStringLazy -> IO ByteStringLazy) ->
  Service ->
  Proxy a ->
  ClientResponse ClientBody ->
  m (Either Error (ClientResponse (AWSResponse a)))
receiveJSON :: forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
receiveJSON = forall (m :: * -> *) b a.
MonadResource m =>
(ByteStringLazy -> Either String b)
-> (Int -> ResponseHeaders -> b -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
deserialise forall a. FromJSON a => ByteStringLazy -> Either String a
Aeson.eitherDecode'

receiveBytes ::
  MonadResource m =>
  (Int -> ResponseHeaders -> ByteString -> Either String (AWSResponse a)) ->
  (ByteStringLazy -> IO ByteStringLazy) ->
  Service ->
  Proxy a ->
  ClientResponse ClientBody ->
  m (Either Error (ClientResponse (AWSResponse a)))
receiveBytes :: forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders -> ByteString -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
receiveBytes = forall (m :: * -> *) b a.
MonadResource m =>
(ByteStringLazy -> Either String b)
-> (Int -> ResponseHeaders -> b -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
deserialise (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringLazy -> ByteString
LBS.toStrict)

receiveBody ::
  MonadResource m =>
  (Int -> ResponseHeaders -> ResponseBody -> Either String (AWSResponse a)) ->
  (ByteStringLazy -> IO ByteStringLazy) ->
  Service ->
  Proxy a ->
  ClientResponse ClientBody ->
  m (Either Error (ClientResponse (AWSResponse a)))
receiveBody :: forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders
 -> ResponseBody
 -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
receiveBody Int
-> ResponseHeaders -> ResponseBody -> Either String (AWSResponse a)
f ByteStringLazy -> IO ByteStringLazy
_ =
  forall (m :: * -> *) a.
MonadResource m =>
(ClientResponse ()
 -> Int
 -> ResponseHeaders
 -> ClientBody
 -> m (Either String (AWSResponse a)))
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
stream forall a b. (a -> b) -> a -> b
$ \ClientResponse ()
_ Int
s ResponseHeaders
h ClientBody
x ->
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
-> ResponseHeaders -> ResponseBody -> Either String (AWSResponse a)
f Int
s ResponseHeaders
h (ClientBody -> ResponseBody
ResponseBody ClientBody
x))

-- | Deserialise an entire response body, such as an XML or JSON payload.
deserialise ::
  MonadResource m =>
  (ByteStringLazy -> Either String b) ->
  (Int -> ResponseHeaders -> b -> Either String (AWSResponse a)) ->
  (ByteStringLazy -> IO ByteStringLazy) ->
  Service ->
  Proxy a ->
  ClientResponse ClientBody ->
  m (Either Error (ClientResponse (AWSResponse a)))
deserialise :: forall (m :: * -> *) b a.
MonadResource m =>
(ByteStringLazy -> Either String b)
-> (Int -> ResponseHeaders -> b -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
deserialise ByteStringLazy -> Either String b
reader Int -> ResponseHeaders -> b -> Either String (AWSResponse a)
parser ByteStringLazy -> IO ByteStringLazy
responseBodyHook Service {Maybe Seconds
ByteString
S3AddressingStyle
Signer
Retry
Abbrev
Status -> Bool
Status -> ResponseHeaders -> ByteStringLazy -> Error
Region -> Endpoint
$sel:retry:Service :: Service -> Retry
$sel:error:Service :: Service -> Status -> ResponseHeaders -> ByteStringLazy -> Error
$sel:check:Service :: Service -> Status -> Bool
$sel:timeout:Service :: Service -> Maybe Seconds
$sel:endpoint:Service :: Service -> Region -> Endpoint
$sel:endpointPrefix:Service :: Service -> ByteString
$sel:s3AddressingStyle:Service :: Service -> S3AddressingStyle
$sel:version:Service :: Service -> ByteString
$sel:signingName:Service :: Service -> ByteString
$sel:signer:Service :: Service -> Signer
$sel:abbrev:Service :: Service -> Abbrev
retry :: Retry
error :: Status -> ResponseHeaders -> ByteStringLazy -> Error
check :: Status -> Bool
timeout :: Maybe Seconds
endpoint :: Region -> Endpoint
endpointPrefix :: ByteString
s3AddressingStyle :: S3AddressingStyle
version :: ByteString
signingName :: ByteString
signer :: Signer
abbrev :: Abbrev
..} Proxy a
_ ClientResponse ClientBody
rs =
  forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Except.runExceptT forall a b. (a -> b) -> a -> b
$ do
    let status :: Status
status = forall body. Response body -> Status
Client.responseStatus ClientResponse ClientBody
rs
        headers :: ResponseHeaders
headers = forall body. Response body -> ResponseHeaders
Client.responseHeaders ClientResponse ClientBody
rs

    ByteStringLazy
body <- forall (m :: * -> *).
MonadResource m =>
ClientBody -> m ByteStringLazy
sinkLBS (forall body. Response body -> body
Client.responseBody ClientResponse ClientBody
rs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringLazy -> IO ByteStringLazy
responseBodyHook

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Status -> Bool
check Status
status) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE (Status -> ResponseHeaders -> ByteStringLazy -> Error
error Status
status ResponseHeaders
headers ByteStringLazy
body)

    case ByteStringLazy -> Either String b
reader ByteStringLazy
body forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ResponseHeaders -> b -> Either String (AWSResponse a)
parser (forall a. Enum a => a -> Int
fromEnum Status
status) ResponseHeaders
headers of
      Right AWSResponse a
ok -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (AWSResponse a
ok forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ClientResponse ClientBody
rs)
      Left String
err ->
        forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE forall a b. (a -> b) -> a -> b
$
          SerializeError -> Error
SerializeError (Abbrev
-> Status -> Maybe ByteStringLazy -> String -> SerializeError
SerializeError' Abbrev
abbrev Status
status (forall a. a -> Maybe a
Just ByteStringLazy
body) String
err)

-- | Stream a raw response body, such as an S3 object payload.
stream ::
  MonadResource m =>
  ( ClientResponse () ->
    Int ->
    ResponseHeaders ->
    ClientBody ->
    m (Either String (AWSResponse a))
  ) ->
  Service ->
  Proxy a ->
  ClientResponse ClientBody ->
  m (Either Error (ClientResponse (AWSResponse a)))
stream :: forall (m :: * -> *) a.
MonadResource m =>
(ClientResponse ()
 -> Int
 -> ResponseHeaders
 -> ClientBody
 -> m (Either String (AWSResponse a)))
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
stream ClientResponse ()
-> Int
-> ResponseHeaders
-> ClientBody
-> m (Either String (AWSResponse a))
parser Service {Maybe Seconds
ByteString
S3AddressingStyle
Signer
Retry
Abbrev
Status -> Bool
Status -> ResponseHeaders -> ByteStringLazy -> Error
Region -> Endpoint
retry :: Retry
error :: Status -> ResponseHeaders -> ByteStringLazy -> Error
check :: Status -> Bool
timeout :: Maybe Seconds
endpoint :: Region -> Endpoint
endpointPrefix :: ByteString
s3AddressingStyle :: S3AddressingStyle
version :: ByteString
signingName :: ByteString
signer :: Signer
abbrev :: Abbrev
$sel:retry:Service :: Service -> Retry
$sel:error:Service :: Service -> Status -> ResponseHeaders -> ByteStringLazy -> Error
$sel:check:Service :: Service -> Status -> Bool
$sel:timeout:Service :: Service -> Maybe Seconds
$sel:endpoint:Service :: Service -> Region -> Endpoint
$sel:endpointPrefix:Service :: Service -> ByteString
$sel:s3AddressingStyle:Service :: Service -> S3AddressingStyle
$sel:version:Service :: Service -> ByteString
$sel:signingName:Service :: Service -> ByteString
$sel:signer:Service :: Service -> Signer
$sel:abbrev:Service :: Service -> Abbrev
..} Proxy a
_ ClientResponse ClientBody
rs =
  forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Except.runExceptT forall a b. (a -> b) -> a -> b
$ do
    let status :: Status
status = forall body. Response body -> Status
Client.responseStatus ClientResponse ClientBody
rs
        headers :: ResponseHeaders
headers = forall body. Response body -> ResponseHeaders
Client.responseHeaders ClientResponse ClientBody
rs
        body :: ClientBody
body = forall body. Response body -> body
Client.responseBody ClientResponse ClientBody
rs

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Status -> Bool
check Status
status) forall a b. (a -> b) -> a -> b
$ do
      ByteStringLazy
lazy <- forall (m :: * -> *).
MonadResource m =>
ClientBody -> m ByteStringLazy
sinkLBS ClientBody
body
      forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE (Status -> ResponseHeaders -> ByteStringLazy -> Error
error Status
status ResponseHeaders
headers ByteStringLazy
lazy)

    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ClientResponse ()
-> Int
-> ResponseHeaders
-> ClientBody
-> m (Either String (AWSResponse a))
parser (forall (f :: * -> *) a. Functor f => f a -> f ()
void ClientResponse ClientBody
rs) (forall a. Enum a => a -> Int
fromEnum Status
status) ResponseHeaders
headers ClientBody
body) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right AWSResponse a
ok -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (AWSResponse a
ok forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ClientResponse ClientBody
rs)
      Left String
err ->
        forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE forall a b. (a -> b) -> a -> b
$
          SerializeError -> Error
SerializeError (Abbrev
-> Status -> Maybe ByteStringLazy -> String -> SerializeError
SerializeError' Abbrev
abbrev Status
status forall a. Maybe a
Nothing String
err)

sinkLBS :: MonadResource m => ClientBody -> m ByteStringLazy
sinkLBS :: forall (m :: * -> *).
MonadResource m =>
ClientBody -> m ByteStringLazy
sinkLBS ClientBody
bdy = forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT (ClientBody
bdy forall (m :: * -> *) a r.
Monad m =>
ConduitT () a m () -> ConduitT a Void m r -> m r
`Conduit.connect` forall (m :: * -> *) o.
Monad m =>
ConduitT ByteString o m ByteStringLazy
Conduit.Binary.sinkLbs)