{-# OPTIONS_GHC -fno-warn-orphans #-}

module Main where

import           Control.Monad
import qualified Data.ByteString.Lazy           as B
import           Test.Framework                 (Test, defaultMain, testGroup)
import           Test.Framework.Providers.HUnit (testCase)
import           Test.HUnit                     hiding (Test)

import           Import
import           PayPal.Adaptive
import qualified PayPal.Adaptive.Deposit        as DP
import qualified PayPal.Adaptive.Lookup         as LP
import qualified PayPal.Adaptive.Withdrawal     as WD

main :: IO ()
main = defaultMain [integrationRemote]

integrationRemote :: Test
integrationRemote = testGroup "remote"
  [ testCase
      "withdrawal succeeds with good arguments"
      correctWithdrawal
  , testCase
      "withdrawal with a bad account address gives the correct error"
      withdrawalAccountAddressDNE
  , testCase
      "withdrawal with a bad user address gives the correct error"
      withdrawalUserAddressDNE
  , testCase
      "withdrawal without a large enough balance gives the correct error"
      withdrawalNotEnoughFunds
  , testCase
      "deposit succeeds with good arguments"
      correctDepositBeginning
  , testCase
      "deposit with a bad account address does NOT produce an error"
      depositAccountAddressDNE
  , testCase
      "deposit with a bad user address gives the correct error"
      depositUserAddressDNE
  ]

newtype TestSettings = TestSettings { _unTestSettings :: (Client, Text, Text) }

instance FromJSON TestSettings where
  parseJSON = withObject "TestSettings" $ \o -> do
    client          <- o .: "client"
    userEmail       <- (.: "email_with_paypal_account") =<< o .: "other"
    nonSandboxEmail <- (.: "email_without_paypal_account") =<< o .: "other"
    return $ TestSettings (client,userEmail,nonSandboxEmail)

config :: IO (Client, Text, Text)
config = fmap _unTestSettings . assertRight . eitherDecode =<< B.readFile "sandbox.json"

incorrectEmailClient :: Text -> Client -> Client
incorrectEmailClient badAccountEmail (Client a b c d e _) = Client a b c d e badAccountEmail

withdrawal :: Text -> WD.Withdrawal
withdrawal userAddr = WD.Withdrawal
  { WD._amount        = USD 1
  , WD._receiverEmail = userAddr
  }

deposit :: Text -> DP.Deposit
deposit userAddr = DP.Deposit
  { DP._amount      = USD 1
  , DP._senderEmail = userAddr
  , DP._returnUrl   = "https://example.com/"
  , DP._cancelUrl   = "https://example.com/cancel"
  }


correctWithdrawal :: Assertion
correctWithdrawal = do
  (client, userEmail, _) <- config
  wdResp <- assertRight . checkComplete =<< fmap snd . assertRight =<< WD.request client (withdrawal userEmail)
  lpResp <- fmap snd . assertRight =<< LP.request client (LP.LookupPayKey $ _cpPayKey wdResp)
  void $ assertRight (checkComplete lpResp)

withdrawalAccountAddressDNE :: Assertion
withdrawalAccountAddressDNE = do
  (client, userEmail, notSandboxEmail) <- config
  let c = incorrectEmailClient notSandboxEmail client
  adaptiveErr <- assertLeft =<< WD.request c (withdrawal userEmail)
  case adaptiveErr of
    AeErrorResponse _ (ErrorResponse [PayError code _]) ->
      assertEqual "send error due to a nonexistent account address" noSuchEmail code
    e -> assertFailure $ "withdrawalAccountAddressDNE got unexpected error " <> show e

withdrawalUserAddressDNE :: Assertion
withdrawalUserAddressDNE = do
  (client, _, notSandboxEmail) <- config
  payResp <- fmap snd . assertRight =<< WD.request client (withdrawal notSandboxEmail)
  assertExpected payResp
  assertLookup =<< fmap snd . assertRight =<< LP.request client (LP.LookupPayKey $ _prPayKey payResp)
  where
    assertExpected :: PayResponse -> IO ()
    assertExpected payResp = do
      void . assertLeft $ checkComplete payResp
      assertEqual "withdraw to nonexistent user addresses return no PayInfos"
                  0
                  (length $ _prPaymentInfos payResp)

    assertLookup :: PayResponse -> Assertion
    assertLookup a = do
      assertEqual "withdrawalAccountAddressDNE _prPayStatus" PeCompleted (_prPayStatus a)
      info <- assertRight (getPaymentInfo a)
      assertEqual "pending withdrawal transaction status" Nothing (_piTransactionStatus info)

withdrawalNotEnoughFunds :: Assertion
withdrawalNotEnoughFunds = do
  (client, userEmail, _) <- config
  adaptiveErr <- assertLeft =<< WD.request client (largeWithdrawal userEmail)
  case adaptiveErr of
    AeErrorResponse _ (ErrorResponse [PayError code _]) ->
      assertEqual "send error due to not enough funds" (ErrorCode 520009) code
    e -> assertFailure $ "withdrawalAccountAddressDNE got unexpected error " <> show e
  where
    largeWithdrawal :: Text -> WD.Withdrawal
    largeWithdrawal userAddr = WD.Withdrawal
      { WD._amount        = USD 100000000
      , WD._receiverEmail = userAddr
      }

correctDepositBeginning :: Assertion
correctDepositBeginning = do
  (client, userEmail, _) <- config
  payKey <- fmap (_prPayKey . snd) . assertRight =<< DP.request client (deposit userEmail)
  assertExpected =<< fmap snd . assertRight =<< LP.request client (LP.LookupPayKey payKey)
  where
    assertExpected :: PayResponse -> Assertion
    assertExpected a = do
      assertEqual "correctDepositBeginning _prPayStatus" PeCreated (_prPayStatus a)
      info <- assertRight (getPaymentInfo a)
      assertEqual "pending deposit transaction status" Nothing (_piTransactionStatus info)

depositAccountAddressDNE :: Assertion
depositAccountAddressDNE = do
  (client, userEmail, notSandboxEmail) <- config
  let c = incorrectEmailClient notSandboxEmail client
  payKey <- fmap (_prPayKey . snd) . assertRight =<< DP.request c (deposit userEmail)
  assertExpected . snd =<< assertRight =<< LP.request client (LP.LookupPayKey payKey)
  where
    assertExpected :: PayResponse -> Assertion
    assertExpected a = do
      assertEqual "depositUserAddressDNE _prPayStatus" PeCreated (_prPayStatus a)
      info <- assertRight (getPaymentInfo a)
      assertEqual "status for deposit where to address isn't an account" Nothing (_piTransactionStatus info)

depositUserAddressDNE :: Assertion
depositUserAddressDNE = do
  (client, _, notSandboxEmail) <- config
  adaptiveErr <- assertLeft =<< DP.request client (deposit notSandboxEmail)
  case adaptiveErr of
    AeErrorResponse _ (ErrorResponse [PayError code _]) ->
      assertEqual "create error due to a nonexistent user address" noSuchEmail code
    e -> assertFailure $ "withdrawalAccountAddressDNE got unexpected error " <> show e