diff --git a/connexpay/src/Web/Connexpay/Payments.hs b/connexpay/src/Web/Connexpay/Payments.hs index 86662bb..1f6a803 100644 --- a/connexpay/src/Web/Connexpay/Payments.hs +++ b/connexpay/src/Web/Connexpay/Payments.hs @@ -5,6 +5,7 @@ module Web.Connexpay.Payments , ExpirationDate(..) , Customer(..) , RiskData(..) + , AuthorizeResult(..) , AuthResponse(..) , TransactionStatus(..) , authorisePayment @@ -26,12 +27,13 @@ import Web.Connexpay.Types -- | Authorise a credit card payment. authorisePayment - :: Connexpay -> Env -> AuthRequest -> IO (Response AuthError AuthResponse) -authorisePayment connexpay env raw = guessResponseErrorType guessAuthError <$> - doRequest connexpay env "authonlys" RequestBody - { raw - , logMasker = maskAuthRequest - } + :: Connexpay -> Env -> AuthRequest -> IO (Response AuthError AuthorizeResult) +authorisePayment connexpay env raw = + bimapResponse (guessErrorType guessAuthError) postProcessAuthResponse <$> + doRequest connexpay env "authonlys" RequestBody + { raw + , logMasker = maskAuthRequest + } -- | Void payment voidPayment :: Connexpay -> Env -> VoidRequest -> IO (Response () ()) diff --git a/connexpay/src/Web/Connexpay/Payments/Types.hs b/connexpay/src/Web/Connexpay/Payments/Types.hs index 2a0f959..858a312 100644 --- a/connexpay/src/Web/Connexpay/Payments/Types.hs +++ b/connexpay/src/Web/Connexpay/Payments/Types.hs @@ -6,6 +6,7 @@ module Web.Connexpay.Payments.Types where import Data.Aeson import Data.Aeson.TH import Data.Fixed +import Data.Function import Data.Int (Int32) import Data.Maybe import Data.Text (Text) @@ -116,6 +117,30 @@ instance ToJSON RiskData where maskRiskData :: LogMasker RiskData maskRiskData = id +data AuthorizeResult + = Authorized AuthResponse + -- ^ Transaction has been created and authorized successfully + | Declined AuthResponse + -- ^ Transaction has been created, but not authorized, + -- e.g. declined by internal Connexpay fraud checks + | Ambiguous AuthResponse + -- ^ We can't interpret the result, e.g. wasProcess=true, + -- but transaction status is not approved. + -- Something for further investigation. + deriving stock (Show) + +postProcessAuthResponse :: AuthResponse -> AuthorizeResult +postProcessAuthResponse resp = resp & case (completed, statusOk) of + (True, True) -> Authorized + (False, False) -> Declined + _ -> Ambiguous + where + -- Connexpay documentation is not very clear about 'wasProcessed' semantics + -- when it is missing, so we are intentionally strict here with the idea + -- to warn about all 'Ambiguous' cases and adjust this code accordingly. + completed = resp.wasProcessed == Just True + statusOk = resp.status `elem` [TransactionApproved, TransactionApprovedWarning] + data AuthResponse = AuthResponse { guid :: AuthOnlyGuid , status :: TransactionStatus @@ -123,6 +148,7 @@ data AuthResponse = AuthResponse , processorResponseMessage :: Maybe Text , addressVerificationCode :: Maybe Text , cvvVerificationCode :: Maybe Text + , wasProcessed :: Maybe Bool } deriving stock (Show) -- | Transaction status in Connexpay @@ -139,7 +165,7 @@ data TransactionStatus -- ^ Processor errored out | TransactionOther Text -- ^ In case they return something unexpected - deriving stock (Show) + deriving stock (Eq, Show) instance FromJSON TransactionStatus where parseJSON = withText "TransactionStatus" $ pure . \case diff --git a/connexpay/src/Web/Connexpay/Types.hs b/connexpay/src/Web/Connexpay/Types.hs index d142c91..d41f855 100644 --- a/connexpay/src/Web/Connexpay/Types.hs +++ b/connexpay/src/Web/Connexpay/Types.hs @@ -67,8 +67,8 @@ bimapResponse f g = \case BadRequest body -> BadRequest body MissingOrExpiredToken -> MissingOrExpiredToken -guessResponseErrorType :: (Error () -> e) -> Response () a -> Response e a -guessResponseErrorType mkErr = bimapResponse (\e -> e { errorType = mkErr e }) id +guessErrorType :: (Error () -> e) -> Error () -> Error e +guessErrorType mkErr e = e { errorType = mkErr e } data Error e = Error { message :: Text