module Aws.Response
where
import Data.ByteString (ByteString)
import Data.Conduit (Source, ResourceT, ($$))
import Data.IORef
import Data.Monoid
import Data.Attempt (Attempt(..))
import qualified Control.Exception as E
import qualified Control.Failure as F
import qualified Data.ByteString.Lazy as L
import qualified Data.Conduit.List as CL
import qualified Network.HTTP.Conduit as HTTP
import qualified Network.HTTP.Types as HTTP
data Response m a = Response m (Attempt a)
deriving (Show, Functor)
tellMetadata :: m -> Response m ()
tellMetadata m = Response m (return ())
instance Monoid m => Monad (Response m) where
return x = Response mempty (Success x)
Response m1 (Failure e) >>= _ = Response m1 (Failure e)
Response m1 (Success x) >>= f = let Response m2 y = f x
in Response (m1 `mappend` m2) y
instance (Monoid m, E.Exception e) => F.Failure e (Response m) where
failure e = Response mempty (F.failure e)
tellMetadataRef :: Monoid m => IORef m -> m -> IO ()
tellMetadataRef r m = modifyIORef r (`mappend` m)
type HTTPResponseConsumer a = HTTP.Status
-> HTTP.ResponseHeaders
-> Source IO ByteString
-> ResourceT IO a
class ResponseConsumer r a where
type ResponseMetadata a
responseConsumer :: r -> IORef (ResponseMetadata a) -> HTTPResponseConsumer a
instance ResponseConsumer r (HTTP.Response L.ByteString) where
type ResponseMetadata (HTTP.Response L.ByteString) = ()
responseConsumer _ _ status headers bufsource = do
chunks <- bufsource $$ CL.consume
return (HTTP.Response status headers $ L.fromChunks chunks)