Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
{-# LANGUAGE OverloadedStrings #-}
-- | Tests related to PaymentServer.Processors.Stripe.
module Stripe
( tests
) where
import Test.Tasty
( TestTree
, testGroup
)
import Test.Tasty.HUnit
( testCase
, assertEqual
)
import Control.Monad.Trans.Except
( runExceptT
)
import Servant.Server
( Handler(runHandler')
, ServerError(ServerError)
)
import Web.Stripe.Types
( Currency(USD, AED)
)
import PaymentServer.Persistence
( memory
)
import PaymentServer.Processors.Stripe
( Charges(Charges)
, Acknowledgement(Ok)
, charge
)
import FakeStripe
( withFakeStripe
, chargeOkay
)
tests :: TestTree
tests = testGroup "Stripe"
[ chargeTests
]
chargeTests :: TestTree
chargeTests =
testGroup "Charges"
[ testCase "non-USD currency is rejected" $
withFakeStripe (return chargeOkay) $ \stripeConfig -> do
let amount = 650
let currency = AED
db <- memory
(Left (ServerError code _ _ _)) <- runExceptT . runHandler' $ charge stripeConfig db (Charges token voucher amount currency)
assertEqual "The result is an error" 400 code
, testCase "incorrect USD amount is rejected" $
withFakeStripe (return chargeOkay) $ \stripeConfig -> do
let amount = 649
let currency = USD
db <- memory
(Left (ServerError code _ _ _)) <- runExceptT . runHandler' $ charge stripeConfig db (Charges token voucher amount currency)
assertEqual "The result is an error" 400 code
, testCase "currect USD amount is accepted" $
withFakeStripe (return chargeOkay) $ \stripeConfig -> do
let amount = 650
let currency = USD
db <- memory
result <- runExceptT . runHandler' $ charge stripeConfig db (Charges token voucher amount currency)
assertEqual "The result is Ok" (Right Ok) result
]
where
token = "foo"
voucher = "bar"