{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeFamilies      #-}

-- |
-- Module      : Network.AWS.Response
-- Copyright   : (c) 2013-2016 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
--
module Network.AWS.Response where

import           Control.Applicative          (pure)
import           Control.Monad.Catch
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Resource
import           Data.Aeson
import           Data.Conduit
import qualified Data.Conduit.Binary          as Conduit
import           Data.Monoid
import           Data.Proxy
import           Data.Text                    (Text)
import           Network.AWS.Data.Body
import           Network.AWS.Data.ByteString
import           Network.AWS.Data.Log
import           Network.AWS.Data.XML
import           Network.AWS.Types
import           Network.HTTP.Conduit         hiding (Proxy, Request, Response)
import           Network.HTTP.Types
import           Text.XML                     (Node)

receiveNull :: MonadResource m
            => Rs a
            -> Logger
            -> Service
            -> Proxy a
            -> ClientResponse
            -> m (Response a)
receiveNull rs _ = stream $ \_ _ x ->
    liftResourceT (x $$+- pure (Right rs))

receiveEmpty :: MonadResource m
             => (Int -> ResponseHeaders -> () -> Either String (Rs a))
             -> Logger
             -> Service
             -> Proxy a
             -> ClientResponse
             -> m (Response a)
receiveEmpty f _ = stream $ \s h x ->
    liftResourceT (x $$+- pure (f s h ()))

receiveXMLWrapper :: MonadResource m
                  => Text
                  -> (Int -> ResponseHeaders -> [Node] -> Either String (Rs a))
                  -> Logger
                  -> Service
                  -> Proxy a
                  -> ClientResponse
                  -> m (Response a)
receiveXMLWrapper n f = receiveXML (\s h x -> x .@ n >>= f s h)

receiveXML :: MonadResource m
           => (Int -> ResponseHeaders -> [Node] -> Either String (Rs a))
           -> Logger
           -> Service
           -> Proxy a
           -> ClientResponse
           -> m (Response a)
receiveXML = deserialise decodeXML

receiveJSON :: MonadResource m
            => (Int -> ResponseHeaders -> Object -> Either String (Rs a))
            -> Logger
            -> Service
            -> Proxy a
            -> ClientResponse
            -> m (Response a)
receiveJSON = deserialise eitherDecode'

receiveBody :: MonadResource m
            => (Int -> ResponseHeaders -> RsBody -> Either String (Rs a))
            -> Logger
            -> Service
            -> Proxy a
            -> ClientResponse
            -> m (Response a)
receiveBody f _ = stream $ \s h x -> pure (f s h (RsBody x))

-- | Deserialise an entire response body, such as an XML or JSON payload.
deserialise :: MonadResource m
            => (LazyByteString -> Either String b)
            -> (Int -> ResponseHeaders -> b -> Either String (Rs a))
            -> Logger
            -> Service
            -> Proxy a
            -> ClientResponse
            -> m (Response a)
deserialise g f l Service{..} _ rs = do
    let s = responseStatus  rs
        h = responseHeaders rs
        x = responseBody    rs
    b <- sinkLBS x
    if not (_svcCheck s)
        then throwM (_svcError s h b)
        else do
            liftIO . l Debug . build $ "[Raw Response Body] {\n" <> b <> "\n}"
            case g b >>= f (fromEnum s) h of
                Right r -> pure (s, r)
                Left  e -> throwM . SerializeError $
                    SerializeError' _svcAbbrev s (Just b) e

-- | Stream a raw response body, such as an S3 object payload.
stream :: MonadResource m
       => (Int -> ResponseHeaders -> ResponseBody -> m (Either String (Rs a)))
       -> Service
       -> Proxy a
       -> ClientResponse
       -> m (Response a)
stream f Service{..} _ rs = do
    let s = responseStatus  rs
        h = responseHeaders rs
        x = responseBody    rs
    if not (_svcCheck s)
        then sinkLBS x >>= throwM . _svcError s h
        else do
            e <- f (fromEnum s) h x
            either (throwM . SerializeError . SerializeError' _svcAbbrev s Nothing)
                   (pure . (s,))
                   e

sinkLBS :: MonadResource m => ResponseBody -> m LazyByteString
sinkLBS bdy = liftResourceT (bdy $$+- Conduit.sinkLbs)