{-# 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.Default
import Data.HashMap.Strict as H
import Data.Text (Text)
import Test.Framework (Test, defaultMain, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit hiding (Test)
import Utils
import Web.PayPal.Adaptive
import Web.PayPal.Adaptive.Internal

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"
      correctDeposit
  , 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 -> Withdrawal
withdrawal userAddr = def
  { _wdAmount = USD 1
  , _wdReceiverEmail = userAddr
  }

deposit :: Text -> Deposit
deposit userAddr = def
  { _dpAmount = USD 1
  , _dpSenderEmail = userAddr
  }

assrt :: Either AdaptiveErr () -> IO ()
assrt (Left e) = assertFailure (show e) >> fail "check failed"
assrt (Right _) = return ()


correctWithdrawal :: Assertion
correctWithdrawal = do
  (client, userEmail, _) <- config
  payResp <- assertRight =<< toPayPal client (withdrawal userEmail)
  (assrt . checkLookup) =<< assertRight =<< toPayPal client (LookupPayKey . _prPayKey $ payResp)
  where
    checkLookup :: PayResp -> Either AdaptiveErr ()
    checkLookup a = do
      payExecStatusCompleted a
      info <- getPayInfo a
      transactionStatusCompleted a info
      errorFieldNothing a
      checkPayKey a
      Right ()

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

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

    checkLookup :: PayResp -> Either AdaptiveErr ()
    checkLookup a = do
      payExecStatusCompleted a
      info <- getPayInfo a
      unless (_piTransactionStatus info == Nothing) $ Left (AeShouldNotHappen a
        "a pending withdrawal should not have transaction status in this situation")
      errorFieldNothing a
      checkPayKey a
      Right ()

withdrawalNotEnoughFunds :: Assertion
withdrawalNotEnoughFunds = do
  (client, userEmail, _) <- config
  adaptiveErr <- assertLeft =<< toPayPal client (largeWithdrawal userEmail)
  assertEqual "send error due to not enough funds" (AeErrCodes [520009]) adaptiveErr
  where
    largeWithdrawal :: Text -> Withdrawal
    largeWithdrawal userAddr = def
      { _wdAmount = USD 1000000
      , _wdReceiverEmail = userAddr
      }

correctDeposit :: Assertion
correctDeposit = do
  (client, userEmail, _) <- config
  payResp <- assertRight =<< toPayPal client (deposit userEmail)
  (assrt . checkLookup) =<< assertRight =<< toPayPal client (LookupPayKey . _prPayKey $ payResp)
  where
    checkLookup :: PayResp -> Either AdaptiveErr ()
    checkLookup a = do
      payExecStatusCreated a
      info <- getPayInfo a
      unless (_piTransactionStatus info == Nothing) $ Left (AeShouldNotHappen a
        "an uncompleted deposit should not have transaction status in this situation")
      errorFieldNothing a
      checkPayKey a
      Right ()

depositAccountAddressDNE :: Assertion
depositAccountAddressDNE = do
  (client, userEmail, notSandboxEmail) <- config
  let c = incorrectEmailClient notSandboxEmail client
  payResp <- assertRight =<< toPayPal c (deposit userEmail)
  (assrt . checkLookup) =<< assertRight =<< toPayPal client (LookupPayKey . _prPayKey $ payResp)
  where
    checkLookup :: PayResp -> Either AdaptiveErr ()
    checkLookup a = do
      payExecStatusCreated a
      info <- getPayInfo a
      unless (_piTransactionStatus info == Nothing) $ Left (AeShouldNotHappen a
        "a deposit should not have transaction status in this situation")
      errorFieldNothing a
      checkPayKey a
      Right ()

depositUserAddressDNE :: Assertion
depositUserAddressDNE = do
  (client, _, notSandboxEmail) <- config
  adaptiveErr <- assertLeft =<< toPayPal client (deposit notSandboxEmail)
  assertEqual "create error due to a nonexistent user address" AeNoSuchEmail adaptiveErr