module PayPal.Adaptive.Core.Processing where
import qualified Data.Text as T
import Import
import PayPal.Adaptive.Core.PayResponse
data CompletePayResponse = CompletePayResponse
{ _cpPayKey :: PayKey
, _cpReceiver :: Receiver
, _cpTransactionId :: TransactionId
, _cpSenderTransactionId :: TransactionId
} deriving (Eq, Show)
data NotComplete
= NcIncomplete Text
| NcFailed Text
| NcShouldNotHappen Text
deriving (Eq, Show)
checkComplete :: PayResponse -> Either NotComplete CompletePayResponse
checkComplete pr = do
payStatusCompleted pr
info <- getPaymentInfo pr
sid <- transactionIdJust (_piSenderTransactionId info)
transactionStatusCompleted (_piTransactionStatus info)
transactionStatusCompleted (_piSenderTransactionStatus info)
tid <- transactionIdJust (_piTransactionId info)
errorFieldNothing pr
return $ CompletePayResponse (_prPayKey pr) (_piReceiver info) sid tid
where
transactionIdJust :: Maybe TransactionId -> Either NotComplete TransactionId
transactionIdJust Nothing = Left $ NcShouldNotHappen "expected a Just for Maybe TransactionId"
transactionIdJust (Just tid) = Right tid
errorFieldNothing :: PayResponse -> Either NotComplete ()
errorFieldNothing a
| _prPayError a == Nothing = Right ()
| otherwise =
Left $ NcShouldNotHappen "PayResponse error field is Just in otherwise correct payment"
transactionStatusCompleted :: Maybe TransactionStatus -> Either NotComplete ()
transactionStatusCompleted Nothing = Left (NcShouldNotHappen "TransactionStatus is Nothing")
transactionStatusCompleted (Just status) =
let msg = "TransactionStatus " <> T.pack (show status)
in case status of
TsCreated -> Left (NcIncomplete msg)
TsPending -> Left (NcIncomplete msg)
TsProcessing -> Left (NcIncomplete msg)
TsCompleted -> Right ()
TsDenied -> Left (NcFailed msg)
TsFailed -> Left (NcFailed msg)
TsRefunded -> Left (NcShouldNotHappen msg)
TsPartiallyRefunded -> Left (NcShouldNotHappen msg)
TsReversed -> Left (NcShouldNotHappen msg)
payStatusCompleted :: PayResponse -> Either NotComplete ()
payStatusCompleted a =
let status = _prPayStatus a
msg = "_prPayStatus: " <> T.pack (show status)
in case status of
PeCreated -> Left (NcIncomplete msg)
PeCompleted -> Right ()
PePending -> Left (NcIncomplete msg)
PeProcessing -> Left (NcIncomplete msg)
PeIncomplete -> Left (NcShouldNotHappen msg)
PeExpired -> Left (NcFailed msg)
PeError -> Left (NcFailed msg)
PeReversalError -> Left (NcShouldNotHappen msg)
getPaymentInfo :: PayResponse -> Either NotComplete PaymentInfo
getPaymentInfo a =
case _prPaymentInfos a of
[] -> Left $ NcIncomplete "no PaymentInfo"
[info] -> Right info
_ -> Left $ NcShouldNotHappen "more than one PaymentInfo"
$(makeLenses ''CompletePayResponse)
$(makePrisms ''NotComplete)