{-# LANGUAGE TemplateHaskell #-}

module PayPal.Adaptive.Core.Error where

import           Control.Exception
import           Data.ByteString.Lazy (ByteString)
import           Data.Text.Read
import qualified Data.Vector          as V

import           Import

-- | Text is an error message in all the below types.
--
-- AeShouldNotHappen is meant to cover PayPal responses to API requests
-- that this library doesn't support sending in the first place.
-- TODO: is this actually how we're using it?
data AdaptiveError
  = AeConnectionError SomeException
  | AeDecodeFailed    ByteString Text
  | AeErrorResponse   ByteString ErrorResponse
  deriving Show -- Eq can't be automatically derived because there's no Eq instance for SomeException.

data ErrorResponse = ErrorResponse { _unErrorResponse :: [PayError] } deriving (Eq, Show)

-- Error responses are what's returned if, e.g., your password is incorrect.
instance FromJSON ErrorResponse where
  parseJSON = withObject "ErrorResponse" $ \o ->
    ErrorResponse . V.toList <$> (traverse parseJSON =<< o .: "error")

data PayError = PayError { _errorCode    :: ErrorCode
                         , _errorMessage :: Text
                         } deriving (Eq, Show)

instance FromJSON PayError where
  parseJSON = withObject "PayError" $ \o -> PayError <$> o .: "errorId" <*> o .: "message"

newtype ErrorCode = ErrorCode { _unErrorCode :: Int } deriving Eq

instance Show ErrorCode where
  show n | n == invalidCredentials = "Error code " <> show (_unErrorCode n) <> " - invalid credentials"
         | n == noSuchEmail        = "Error code " <> show (_unErrorCode n) <> " - no such email"
         | otherwise               = "Error code " <> show (_unErrorCode n)

instance FromJSON ErrorCode where
  parseJSON = withText "ErrorCode" $ \t ->
    case decimal t of
      Left  _     -> fail "Could not parse error response code to Int"
      Right (b,_) -> return (ErrorCode b)

invalidCredentials :: ErrorCode
invalidCredentials = ErrorCode 520003

-- | Raised when the Deposit sender email or the Withdrawal account email doesn't exist.
noSuchEmail :: ErrorCode
noSuchEmail = ErrorCode 589039

$(makeLenses ''ErrorCode)
$(makeLenses ''ErrorResponse)
$(makeLenses ''PayError)
$(makePrisms ''AdaptiveError)