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

module Main where

import           Control.Applicative
import           Control.Monad
import           Data.Aeson
import qualified Data.ByteString.Lazy           as B
import           Data.HashMap.Strict            as H
import           Data.Text                      (Text)
import           PayPal.Adaptive
import qualified PayPal.Adaptive.Deposit        as DP
import           PayPal.Adaptive.Internal
import qualified PayPal.Adaptive.Lookup         as LP
import qualified PayPal.Adaptive.Withdrawal     as WD
import           Test.Framework                 (Test, defaultMain, testGroup)
import           Test.Framework.Providers.HUnit (testCase)
import           Test.HUnit                     hiding (Test)
import           Utils

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
  ]

-- | Currently the ID for all sandbox apps.
appId :: Text
appId = "APP-80W284485P519543T"

instance FromJSON Client where
  parseJSON = withObject "client credentials" $ \o ->
    Client appId                 <$>
    o .: "sandboxClientUid"      <*>
    pure Sandbox                 <*>
    o .: "sandboxClientPassword" <*>
    o .: "sandboxClientSig"      <*>
    o .: "sandboxAccountEmail"

config :: IO (Client, Text, Text)
config = do
  b <- B.readFile "sandbox.json"
  client <- assertRight (eitherDecode b)
  Object o <- assertRight (eitherDecode b)
  String userEmail <- assertJust "sandboxUserEmail not found"
    $ H.lookup "sandboxUserEmail" o
  String notSandboxEmail <- assertJust "randomNonSandboxUserEmail not found"
    $ H.lookup "randomNonSandboxUserEmail" o
  return (client, userEmail, notSandboxEmail)

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 =<< WD.req client (withdrawal userEmail)
  lpResp <- assertRight =<< LP.req client (LP.LookupPayKey $ _crPayKey wdResp)
  void $ assertRight (checkComplete lpResp)

withdrawalAccountAddressDNE :: Assertion
withdrawalAccountAddressDNE = do
  (client, userEmail, notSandboxEmail) <- config
  let c = incorrectEmailClient notSandboxEmail client
  adaptiveErr <- assertLeft =<< WD.req c (withdrawal userEmail)
  assertEqual "send error due to a nonexistent account address" AeNoSuchEmail adaptiveErr

withdrawalUserAddressDNE :: Assertion
withdrawalUserAddressDNE = do
  (client, _, notSandboxEmail) <- config
  payResp <- assertExpected =<< assertLeft =<< WD.req client (withdrawal notSandboxEmail)
  assertLookup =<< assertRight =<< LP.req client (LP.LookupPayKey $ _prPayKey payResp)
  where
    assertExpected :: AdaptiveErr -> IO PayResp
    assertExpected (AePending payResp) = do
      assertEqual
        "withdraw to nonexistent user addresses return no PayInfos"
        0 (length $ _prPayInfos payResp)
      return payResp
    assertExpected _ =
      assertFalse "send error due to a nonexistent user address didn't return AePending"
      >> fail "checkResp failed"

    assertLookup :: PayResp -> Assertion
    assertLookup a = do
      info <- assertRight $ do
        payExecStatusCompleted a
        errorFieldNothing a
        checkPayKey a
        getPayInfo a
      assertEqual "pending withdrawal transaction status" Nothing (_piTransactionStatus info)

withdrawalNotEnoughFunds :: Assertion
withdrawalNotEnoughFunds = do
  (client, userEmail, _) <- config
  adaptiveErr <- assertLeft =<< WD.req client (largeWithdrawal userEmail)
  assertEqual "send error due to not enough funds" (AeErrCodes [520009]) adaptiveErr
  where
    largeWithdrawal :: Text -> WD.Withdrawal
    largeWithdrawal userAddr = WD.Withdrawal
      { WD._amount        = USD 100000000
      , WD._receiverEmail = userAddr
      }

correctDepositBeginning :: Assertion
correctDepositBeginning = do
  (client, userEmail, _) <- config
  payKey <- assertRight =<< DP.req client (deposit userEmail)
  assertExpected =<< assertRight =<< LP.req client (LP.LookupPayKey payKey)
  where
    assertExpected :: PayResp -> Assertion
    assertExpected a = do
      info <- assertRight $ do
        payExecStatusCreated a
        errorFieldNothing a
        checkPayKey a
        getPayInfo a
      assertEqual "pending deposit transaction status" Nothing (_piTransactionStatus info)

depositAccountAddressDNE :: Assertion
depositAccountAddressDNE = do
  (client, userEmail, notSandboxEmail) <- config
  let c = incorrectEmailClient notSandboxEmail client
  payKey <- assertRight =<< DP.req c (deposit userEmail)
  assertExpected =<< assertRight =<< LP.req client (LP.LookupPayKey payKey)
  where
    assertExpected :: PayResp -> Assertion
    assertExpected a = do
      info <- assertRight $ do
        payExecStatusCreated a
        errorFieldNothing a
        checkPayKey a
        getPayInfo 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.req client (deposit notSandboxEmail)
  assertEqual "create error due to a nonexistent user address" AeNoSuchEmail adaptiveErr