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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
{-# LANGUAGE OverloadedStrings #-}
-- | Tests related to PaymentServer.Persistence and the persistence system in
-- general.
module Persistence
( tests
) where
import qualified Data.Text as Text
import Control.Exception
( Exception
, throwIO
, catch
)
import Test.Tasty
( TestTree
, testGroup
)
import Test.Tasty.HUnit
( testCase
, assertEqual
)
import System.IO
( openTempFile
)
import System.Directory
( getTemporaryDirectory
)
import PaymentServer.Persistence
( Voucher
, Fingerprint
, RedeemError(NotPaid, AlreadyRedeemed)
, PaymentError(AlreadyPaid)
, VoucherDatabase(payForVoucher, redeemVoucher)
, memory
, getDBConnection
)
data ArbitraryException = ArbitraryException
deriving (Show, Eq)
instance Exception ArbitraryException
tests :: TestTree
tests = testGroup "Persistence"
[ memoryDatabaseVoucherPaymentTests
, sqlite3DatabaseVoucherPaymentTests
]
voucher = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
fingerprint = "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
paySuccessfully = return ()
failPayment = throwIO ArbitraryException
makeVoucherPaymentTests
:: VoucherDatabase d
=> Text.Text
-> IO d
-> TestTree
makeVoucherPaymentTests label makeDatabase =
testGroup ("voucher payments (" ++ Text.unpack label ++ ")")
[ testCase "not paid for" $ do
db <- makeDatabase
result <- redeemVoucher db voucher fingerprint
assertEqual "redeeming unpaid voucher" (Left NotPaid) result
, testCase "paid for" $ do
db <- makeDatabase
() <- payForVoucher db voucher paySuccessfully
result <- redeemVoucher db voucher fingerprint
assertEqual "redeeming paid voucher" (Right ()) result
, testCase "allowed double redemption" $ do
db <- makeDatabase
() <- payForVoucher db voucher paySuccessfully
let redeem = redeemVoucher db voucher fingerprint
first <- redeem
second <- redeem
assertEqual "redeeming paid voucher" (Right ()) first
assertEqual "re-redeeming paid voucher" (Right ()) second
, testCase "disallowed double redemption" $ do
db <- makeDatabase
() <- payForVoucher db voucher paySuccessfully
let redeem = redeemVoucher db voucher
first <- redeem fingerprint
second <- redeem (Text.cons 'a' $ Text.tail fingerprint)
assertEqual "redeeming paid voucher" (Right ()) first
assertEqual "re-redeeming paid voucher" (Left AlreadyRedeemed) second
, testCase "pay with error" $ do
db <- makeDatabase
payForVoucher db voucher failPayment
`catch` assertEqual "failing a payment for a voucher" ArbitraryException
result <- redeemVoucher db voucher fingerprint
assertEqual "redeeming voucher with failed payment" (Left NotPaid) result
, testCase "disallowed double payment" $ do
db <- makeDatabase
let pay = payForVoucher db voucher paySuccessfully
() <- pay
pay `catch` assertEqual "double-paying for a voucher" AlreadyPaid
redeemResult <- redeemVoucher db voucher fingerprint
assertEqual "redeeming double-paid voucher" (Right ()) redeemResult
]
memoryDatabaseVoucherPaymentTests :: TestTree
memoryDatabaseVoucherPaymentTests = makeVoucherPaymentTests "memory" memory
sqlite3DatabaseVoucherPaymentTests :: TestTree
sqlite3DatabaseVoucherPaymentTests =
makeVoucherPaymentTests "sqlite3" $
do
tempdir <- getTemporaryDirectory
(path, handle) <- openTempFile tempdir "voucher-.db"
getDBConnection $ Text.pack path