Util.hs

module Web.Payments.Cielo.Util where

import           Control.Exception
import           Control.Lens
import           Control.Monad.Except
import           Control.Monad.Reader
import           Data.Aeson
import qualified Data.ByteString.Lazy     as BL
import           Data.Convertible
import           Data.Monoid              ((<>))
import           Data.Text                (Text)
import           Data.UUID
import           Data.UUID.V4
import           Network.HTTP.Client      (HttpException (..))
import           Network.HTTP.Types       (Status (..))
import           Network.Wreq             hiding (get, post, put)

import           Web.Payments.Cielo.Types

cieloRequestOptions :: MonadCielo m => m Options
cieloRequestOptions = do
    CieloConfig{..} <- ask
    let Merchant{..} = cieloConfigMerchant
        Environment{..} = cieloConfigEnvironment

    uuid <- liftIO $ toASCIIBytes <$> nextRandom
    return $ defaults & headers .~ [ ("Accept", "application/json")
                                    -- , ("Accept-Encoding", "gzip")
                                    -- , ("User-Agent", "Haskell Cielo")
                                   , ("MerchantId", convert merchantId)
                                   , ("MerchantKey", convert merchantKey)
                                   , ("RequestId", uuid)
                                   ]

sendRaw
    :: (MonadCielo m, ToJSON arg)
    => (Options -> String -> Value -> IO (Response BL.ByteString))
    -> String -> [(Text, Text)] -> arg -> m (Response BL.ByteString)
sendRaw requester url query arg = do
    CieloConfig _ Environment{..} <- ask
    opts <- cieloRequestOptions
    let targetUrl = convert environmentApiUrl <> url
        opts' = opts & params .~ query
        payload = toJSON arg
    eret <- liftIO $ try $ requester opts' targetUrl payload
    case eret of
        Left ex@(StatusCodeException status _ _) -> case status of
            Status 404 _ -> throwError (CieloNotFoundError url ex)
            Status 400 _ -> throwError (CieloInvalidError url ex (Just payload))
            _ -> throwError (CieloHttpException url ex (Just payload))
        Left ex -> throwError (CieloHttpException url ex (Just payload))
        Right ret -> return ret

getRaw
    :: (MonadCielo m)
    => String -> [(Text, Text)] -> m (Response BL.ByteString)
getRaw url query = do
    CieloConfig _ Environment{..} <- ask
    opts <- cieloRequestOptions
    let targetUrl = convert environmentApiQueryUrl <> url
        opts' = opts & params .~ query
    eret <- liftIO $ try $ getWith opts' targetUrl
    case eret of
        Left ex@(StatusCodeException status _ _) -> case status of
            Status 404 _ -> throwError (CieloNotFoundError url ex)
            Status 400 _ -> throwError (CieloInvalidError url ex Nothing)
            _ -> throwError (CieloHttpException url ex Nothing)
        Left ex -> throwError (CieloHttpException url ex Nothing)
        Right ret -> return ret

get
  :: (MonadCielo m, FromJSON b)
  => String -> [(Text, Text)] -> m b
get url query = do
    res <- getRaw url query
    case asJSON res of
        Right res' -> return (res' ^. responseBody)
        Left err -> throwError (CieloJSONError url err (res ^. responseBody))

send
    :: (MonadCielo m, ToJSON arg, FromJSON ret)
    => (Options -> String -> Value -> IO (Response BL.ByteString))
    -> String -> [(Text, Text)] -> arg -> m ret
send requester url query arg = do
    res <- sendRaw requester url query arg
    case asJSON res of
        Right res' -> return (res' ^. responseBody)
        Left err -> throwError (CieloJSONError url err (res ^. responseBody))

post :: (MonadCielo m, ToJSON arg, FromJSON ret) => String -> [(Text, Text)] -> arg -> m ret
post = send postWith

put :: (MonadCielo m, ToJSON arg, FromJSON ret) => String -> [(Text, Text)] -> arg -> m ret
put = send putWith