Skip to content
Snippets Groups Projects
Commit de16b1a5 authored by Jean-Paul Calderone's avatar Jean-Paul Calderone
Browse files

Make gen of charges with vouchers more than vanishingly unlikely

This does a better job covering good and bad cases in the implementation,
though currently none of the values resulting are used so they're still not actually covered.
parent 0876e0d3
No related branches found
No related tags found
1 merge request!2Stripe webhook
...@@ -35,23 +35,19 @@ import Test.QuickCheck ...@@ -35,23 +35,19 @@ import Test.QuickCheck
( Property ( Property
, Gen , Gen
, arbitrary , arbitrary
, suchThat
, suchThatMap
, generate , generate
, forAll , forAll
, (===) , (===)
, (=/=) , (=/=)
) )
import Test.QuickCheck.Instances.Tuple
( (>*<)
)
import Util.WAI import Util.WAI
( postJSON ( postJSON
) )
import Util.Gen import Util.Gen
( GoodChargeEvent(GoodChargeEvent) ( ChargeEvents(GoodChargeEvent, BadChargeEvent)
, chargeSucceededEvents , chargeSucceededEvents
, hasVoucher , metaDatasWithVoucher
, metaDatasWithoutVoucher
) )
import Util.JSON import Util.JSON
( -- ToJSON instance for Event ( -- ToJSON instance for Event
...@@ -76,9 +72,6 @@ import PaymentServer.Persistence ...@@ -76,9 +72,6 @@ import PaymentServer.Persistence
( Voucher ( Voucher
, memory , memory
) )
import Data.List.Index
( insertAt
)
stripeAPI :: Proxy StripeAPI stripeAPI :: Proxy StripeAPI
stripeAPI = Proxy stripeAPI = Proxy
...@@ -102,26 +95,22 @@ spec_webhook = with app $ do ...@@ -102,26 +95,22 @@ spec_webhook = with app $ do
-- convention of giving the same name to *similar* functions. -- convention of giving the same name to *similar* functions.
describe "success behavior of POST /webhook" $ describe "success behavior of POST /webhook" $
it "responds to a JSON Event body with 200 (OK)" $ it "responds to a JSON Event body with 200 (OK)" $
property $ let
\(GoodChargeEvent event) -> test e =
postJSON "/webhook" (encode event) `shouldRespondWith` 200 { matchBody = MatchBody bodyMatcher } postJSON "/webhook" (encode e) `shouldRespondWith` 200 { matchBody = MatchBody bodyMatcher }
-- For now these are the same. Maybe they always will be? The HTTP
-- behavior is the same though the backend behavior may differ.
xtest_postWithEventBody (GoodChargeEvent e) = test e
xtest_postWithEventBody (BadChargeEvent e) = test e
in
property xtest_postWithEventBody
bodyMatcher :: [Network.HTTP.Types.Header] -> Body -> Maybe String bodyMatcher :: [Network.HTTP.Types.Header] -> Body -> Maybe String
bodyMatcher _ "{}" = Nothing bodyMatcher _ "{}" = Nothing
bodyMatcher _ body = Just $ show body bodyMatcher _ body = Just $ show body
metaDatasWithoutVoucher = (arbitrary :: Gen MetaData) `suchThat` (not . hasVoucher)
-- Just filtering out random metadatas that don't have a voucher makes for an
-- incredibly inefficient generator. So start without a voucher and then add
-- one.
metaDatasWithVoucher = ((arbitrary :: Gen Voucher) >*< metaDatasWithoutVoucher) `suchThatMap` (Just. uncurry addVoucher)
addVoucher :: Voucher -> MetaData -> MetaData
addVoucher voucher (MetaData []) = MetaData [("Voucher", voucher)]
addVoucher voucher (MetaData items) =
MetaData (insertAt (1234567 `mod` length items) ("Voucher", voucher) items)
prop_getVoucherFindsVoucher :: Property prop_getVoucherFindsVoucher :: Property
prop_getVoucherFindsVoucher = forAll metaDatasWithVoucher $ \x -> prop_getVoucherFindsVoucher = forAll metaDatasWithVoucher $ \x ->
getVoucher x =/= Nothing getVoucher x =/= Nothing
......
...@@ -2,24 +2,26 @@ ...@@ -2,24 +2,26 @@
module Util.Gen module Util.Gen
( chargeSucceededEvents ( chargeSucceededEvents
, metaDatasWithoutVoucher
, metaDatasWithVoucher
, posixTimes , posixTimes
, hasVoucher , hasVoucher
, GoodChargeEvent(GoodChargeEvent) , ChargeEvents(GoodChargeEvent, BadChargeEvent)
) where ) where
import Data.Text import Data.Text
( Text ( Text
) )
import Data.List.Index
( insertAt
)
import Data.Time.Clock import Data.Time.Clock
( UTCTime(UTCTime) ( UTCTime(UTCTime)
) )
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
( POSIXTime ( POSIXTime
, posixSecondsToUTCTime , posixSecondsToUTCTime
) )
import Web.Stripe.Types import Web.Stripe.Types
( Charge(Charge) ( Charge(Charge)
, StatementDescription(StatementDescription) , StatementDescription(StatementDescription)
...@@ -33,60 +35,36 @@ import Web.Stripe.Types ...@@ -33,60 +35,36 @@ import Web.Stripe.Types
, Amount(Amount) , Amount(Amount)
, StripeList(StripeList, list, totalCount, hasMore) , StripeList(StripeList, list, totalCount, hasMore)
) )
import Web.Stripe.Event import Web.Stripe.Event
( Event(Event, eventId, eventCreated, eventLiveMode, eventType, eventData, eventObject, eventPendingWebHooks, eventRequest) ( Event(Event, eventId, eventCreated, eventLiveMode, eventType, eventData, eventObject, eventPendingWebHooks, eventRequest)
, EventType(ChargeSucceededEvent) , EventType(ChargeSucceededEvent)
, EventData(ChargeEvent) , EventData(ChargeEvent)
, EventId(EventId) , EventId(EventId)
) )
import Test.QuickCheck import Test.QuickCheck
( Gen ( Gen
, Arbitrary , Arbitrary
, arbitrary , arbitrary
, Positive(Positive) , Positive(Positive)
, oneof , oneof
, suchThat
, suchThatMap , suchThatMap
) )
import Test.QuickCheck.Instances.Tuple
( (>*<)
)
import Test.QuickCheck.Instances.Time import Test.QuickCheck.Instances.Time
( -- Get the `Gen UTCTime` instance ( -- Get the `Gen UTCTime` instance
) )
import Test.QuickCheck.Instances.Text import Test.QuickCheck.Instances.Text
( -- Get the `Gen Text` instance ( -- Get the `Gen Text` instance
) )
import PaymentServer.Persistence
( Voucher
)
instance Arbitrary Charge where instance Arbitrary Charge where
arbitrary = Charge arbitrary = charges True
<$> arbitrary -- chargeId :: ChargeId
<*> return "charge" -- chargeObject :: Text
<*> posixTimes -- chargeCreated :: UTCTime
<*> arbitrary -- chargeLiveMode :: Bool
<*> arbitrary -- chargePaid :: Bool
<*> arbitrary -- chargeAmount :: Amount
<*> oneof
[ return UnknownCurrency
, return USD
] -- chargeCurrency :: Currency
<*> return False -- chargeRefunded :: Bool
<*> return Nothing -- chargeCreditCard :: Maybe Card
<*> arbitrary -- chargeCaptured :: Bool
<*> return mempty -- chargeRefunds :: StripeList Refund
<*> return Nothing -- chargeBalanceTransaction :: Maybe (Expandable TransactionId)
<*> return Nothing -- chargeFailureMessage :: Maybe Text
<*> return Nothing -- chargeFailureCode :: Maybe Text
<*> return 0 -- chargeAmountRefunded :: Int
<*> arbitrary -- chargeCustomerId :: Maybe (Expandable CustomerId)
<*> return Nothing -- chargeInvoice :: Maybe (Expandable InvoiceId)
<*> arbitrary -- chargeDescription :: Maybe Description
<*> return Nothing -- chargeDispute :: Maybe Dispute
<*> arbitrary -- chargeMetaData :: MetaData
<*> arbitrary -- chargeStatementDescription :: Maybe StatementDescription
<*> arbitrary -- chargeReceiptEmail :: Maybe Text
<*> arbitrary -- chargeReceiptNumber :: Maybe Text
instance Semigroup (StripeList a) where instance Semigroup (StripeList a) where
-- Very weak implementation -- Very weak implementation
...@@ -106,11 +84,20 @@ instance Arbitrary EventId where ...@@ -106,11 +84,20 @@ instance Arbitrary EventId where
instance Arbitrary StatementDescription where instance Arbitrary StatementDescription where
arbitrary = StatementDescription <$> arbitrary arbitrary = StatementDescription <$> arbitrary
metaDatasWithoutVoucher = (arbitrary :: Gen MetaData) `suchThat` (not . hasVoucher)
-- Just filtering out random metadatas that don't have a voucher makes for an
-- incredibly inefficient generator. So start without a voucher and then add
-- one.
metaDatasWithVoucher = ((arbitrary :: Gen Voucher) >*< metaDatasWithoutVoucher) `suchThatMap` (Just. uncurry addVoucher)
addVoucher :: Voucher -> MetaData -> MetaData
addVoucher voucher (MetaData []) = MetaData [("Voucher", voucher)]
addVoucher voucher (MetaData items) =
MetaData (insertAt (1234567 `mod` length items) ("Voucher", voucher) items)
instance Arbitrary MetaData where instance Arbitrary MetaData where
arbitrary = MetaData <$> arbitrary arbitrary = MetaData <$> arbitrary
instance Arbitrary Description where instance Arbitrary Description where
arbitrary = Description <$> arbitrary arbitrary = Description <$> arbitrary
...@@ -130,26 +117,68 @@ instance Arbitrary CustomerId where ...@@ -130,26 +117,68 @@ instance Arbitrary CustomerId where
instance Arbitrary a => Arbitrary (Expandable a) where instance Arbitrary a => Arbitrary (Expandable a) where
arbitrary = Id <$> arbitrary arbitrary = Id <$> arbitrary
chargeSucceededEvents :: Gen Event chargeSucceededEvents :: Bool -> Gen Event
chargeSucceededEvents = chargeSucceededEvents withVoucher =
Event Event
<$> arbitrary -- eventId <$> arbitrary -- eventId
<*> posixTimes -- eventCreated <*> posixTimes -- eventCreated
<*> arbitrary -- eventLiveMode <*> arbitrary -- eventLiveMode
<*> return ChargeSucceededEvent -- eventType <*> return ChargeSucceededEvent -- eventType
<*> (ChargeEvent <*> chargeEvents withVoucher -- eventData
<$> arbitrary -- the charge
) -- eventData
<*> return "event" -- eventObject <*> return "event" -- eventObject
<*> arbitrary -- eventPendingWebHooks <*> arbitrary -- eventPendingWebHooks
<*> arbitrary -- eventRequest <*> arbitrary -- eventRequest
data GoodChargeEvent = GoodChargeEvent Event deriving (Show, Eq) chargeEvents :: Bool -> Gen EventData
chargeEvents withVoucher =
ChargeEvent <$> charges withVoucher
charges :: Bool -> Gen Charge
charges withVoucher =
Charge
<$> arbitrary -- chargeId :: ChargeId
<*> return "charge" -- chargeObject :: Text
<*> posixTimes -- chargeCreated :: UTCTime
<*> arbitrary -- chargeLiveMode :: Bool
<*> arbitrary -- chargePaid :: Bool
<*> arbitrary -- chargeAmount :: Amount
<*> oneof
[ return UnknownCurrency
, return USD
] -- chargeCurrency :: Currency
<*> return False -- chargeRefunded :: Bool
<*> return Nothing -- chargeCreditCard :: Maybe Card
<*> arbitrary -- chargeCaptured :: Bool
<*> return mempty -- chargeRefunds :: StripeList Refund
<*> return Nothing -- chargeBalanceTransaction :: Maybe (Expandable TransactionId)
<*> return Nothing -- chargeFailureMessage :: Maybe Text
<*> return Nothing -- chargeFailureCode :: Maybe Text
<*> return 0 -- chargeAmountRefunded :: Int
<*> arbitrary -- chargeCustomerId :: Maybe (Expandable CustomerId)
<*> return Nothing -- chargeInvoice :: Maybe (Expandable InvoiceId)
<*> arbitrary -- chargeDescription :: Maybe Description
<*> return Nothing -- chargeDispute :: Maybe Dispute
<*> (
if withVoucher then
metaDatasWithVoucher
else
metaDatasWithVoucher
) -- chargeMetaData :: MetaData
<*> arbitrary -- chargeStatementDescription :: Maybe StatementDescription
<*> arbitrary -- chargeReceiptEmail :: Maybe Text
<*> arbitrary -- chargeReceiptNumber :: Maybe Text
instance Arbitrary GoodChargeEvent where data ChargeEvents
arbitrary = chargeSucceededEvents `suchThatMap` (Just . GoodChargeEvent) = GoodChargeEvent Event
| BadChargeEvent Event
deriving (Show, Eq)
instance Arbitrary ChargeEvents where
arbitrary = oneof
[ chargeSucceededEvents True `suchThatMap` (Just . GoodChargeEvent)
, chargeSucceededEvents False `suchThatMap` (Just . BadChargeEvent)
]
posixTimes :: Gen UTCTime posixTimes :: Gen UTCTime
posixTimes = (arbitrary :: Gen Integer) `suchThatMap` (Just . posixSecondsToUTCTime . fromIntegral . abs) posixTimes = (arbitrary :: Gen Integer) `suchThatMap` (Just . posixSecondsToUTCTime . fromIntegral . abs)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment