content: {-# LANGUAGE FlexibleContexts  #-}
  {-# LANGUAGE CPP               #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  module Web.Stripe.Client.HttpClient
         (
           StripeRequest(..)
         , StripeError(..)
         , StripeConfig(..)
  
         , stripe
         , stripeManager
         , stripeConn
  
           -- * low-level
         , withConnection
         , withManager
         , callAPI
  
         ) where
  
  import qualified Control.Arrow
  import qualified Data.ByteString.Lazy     as BSL
  import           Data.Maybe
  import qualified Data.Text.Encoding       as TE
  import qualified Network.HTTP.Types       as Http
  
  import Data.Aeson               as A
  import Data.ByteString          (ByteString)
  import Data.Monoid              ((<>))
  #if MIN_VERSION_http_client(0,5,13)
  import Network.HTTP.Client      as Http hiding (withManager, withConnection)
  #else
  import Network.HTTP.Client      as Http hiding (withManager)
  #endif
  import Network.HTTP.Client.TLS  as TLS
  
  import qualified Web.Stripe.StripeRequest as S
  
  import Web.Stripe.Client (APIVersion (..), StripeConfig (..),
                            StripeError (..), StripeKey (..),
                            defaultEndpoint, Endpoint (..),
                            StripeRequest, StripeReturn,
                            attemptDecode, handleStream,
                            parseFail, toBytestring,
                            unknownCode, Protocol (..))
  
  
  -- | Create a request to 'Stripe's API.
  --
  -- This function uses the global TLS manager from @http-client-tls@
  -- via 'getGlobalManager'.
  stripe :: FromJSON (StripeReturn a)
         => StripeConfig
         -> StripeRequest a
         -> IO (Either StripeError (StripeReturn a))
  stripe config request = do
      man <- TLS.getGlobalManager
      callAPI man fromJSON config request
  
  -- | Create a request to 'Stripe's API using a 'Manager'.
  stripeManager :: FromJSON (StripeReturn a)
                => Manager
                -> StripeConfig
                -> StripeRequest a
                -> IO (Either StripeError (StripeReturn a))
  stripeManager manager config request = callAPI manager fromJSON config request
  
  -- | Create a request to 'Stripe's API using a 'Manager'.
  --
  -- This function is used to maintain compatibility w/
  -- @stripe-http-streams@. However, the terminology in @http-streams@
  -- uses 'Connection' whereas @http-client@ uses connection 'Manager'.
  stripeConn :: FromJSON (StripeReturn a)
             => Manager
             -> StripeConfig
             -> StripeRequest a
             -> IO (Either StripeError (StripeReturn a))
  stripeConn = stripeManager
  
  withConnection :: (Manager -> IO (Either StripeError a))
                 -> IO (Either StripeError a)
  withConnection = withManager
  
  withManager :: (Manager -> IO (Either StripeError a))
              -> IO (Either StripeError a)
  withManager m = do
  
      -- @http-client@ has a set of deprecated `withManager` functions
      -- that are not necessary to safely prevent a 'Manager' from
      -- leaking resources. "Manager's will be closed and shutdown
      -- automatically (and safely) via gargage collection.
      manager <- TLS.getGlobalManager
      m manager
  
  -- | Create a request to 'Stripe's API using an existing 'Manager'
  --
  -- This is a low-level function. In most cases you probably want to
  -- use 'stripe' or 'stripeManager'.
  callAPI :: Manager
          -> (Value -> Result b)
          -> StripeConfig
          -> StripeRequest a
          -> IO (Either StripeError b)
  callAPI man fromJSON' config stripeRequest = do
  
      res <- httpLbs mkStripeRequest man
  
      let status = Http.statusCode (Http.responseStatus res)
  
      if not (attemptDecode status) then
          return unknownCode
  
      else do
          case A.eitherDecode (Http.responseBody res) of
              Left e  -> pure $ parseFail e
              Right a -> pure $ handleStream fromJSON' status $ return a
    where
      mkStripeRequest =
  
          let req = Http.applyBasicAuth (getStripeKey (secretKey config)) mempty $
                    defaultRequest {
                      Http.method = m2m (S.method stripeRequest)
                    , Http.secure = endpointProtocol (fromMaybe defaultEndpoint (stripeEndpoint config)) == HTTPS
                    , Http.host = endpointUrl $ fromMaybe defaultEndpoint (stripeEndpoint config)
                    , Http.port = endpointPort $ fromMaybe defaultEndpoint (stripeEndpoint config)
                    , Http.path = "/v1/" <> TE.encodeUtf8 (S.endpoint stripeRequest)
                    , Http.requestHeaders = [
                          ("Stripe-Version", toBytestring stripeVersion)
                        , ("Connection", "Keep-Alive")
                        ]
                    , Http.checkResponse = \_ _ -> return ()
                    }
  
              stripeQueryParams = fmap
                                    (Control.Arrow.second Just)
                                    (S.queryParams stripeRequest)
  
          in if S.GET == S.method stripeRequest then
                 Http.setQueryString stripeQueryParams req
             else
                 urlEncodeBody (S.queryParams stripeRequest) req
  
  m2m :: S.Method -> Http.Method
  m2m S.GET    = Http.methodGet
  m2m S.POST   = Http.methodPost
  m2m S.DELETE = Http.methodDelete
  
  -- | This function is used instead of http-client's built-in 'urlEncodedBody' as
  -- the request method is set explicitly to POST in 'urlEncodeBody' but Stripe
  -- uses POST\/PUT\/DELETE. A PR should be submitted to http-client to fix
  -- eventually.
  urlEncodeBody :: [(ByteString, ByteString)] -> Request -> Request
  urlEncodeBody headers req = req {
        requestBody = RequestBodyLBS (BSL.fromChunks body)
      , requestHeaders =
          ("Content-Type", "application/x-www-form-urlencoded")
        : filter (\(x, _) -> x /= "Content-Type") (requestHeaders req)
      }
    where
      body = pure (Http.renderSimpleQuery False headers)
  
  stripeVersion :: APIVersion
  stripeVersion = V20141007
  