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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
{-# LANGUAGE ScopedTypeVariables #-}
-- | Basic implementation of some stateful Property-Based Testing for
-- modelling/simulating some banking "Mainframe" API.
--
-- This "coding kata" was triggered Johan Martinsson and Mathieu Cans'
-- workshop at NewCrafts 2025, where they detailed the practice of
-- replacing mocks in testing with larger scale _integration tests_
-- using simulators instead of the real implementation at adapters'
-- boundaries.
--
-- It seems to me this idea is pretty close to the "common" practice in
-- FP-land to _model_ "effects" and use those models through _Stateful
-- Property-Based Testing_ to ensure implementation's conform to its
-- model. This makes it possible to then use the _model_ as a
-- _simulator_ in integration scenarios, but with a much wider range
-- of possible behaviours tested and exercised.
--
-- Note there's nothing new here, and it's even something I presented
-- years ago with Nicole Rausch at DDDEurope under the "catchy" name
-- of ["Homomorphic Event
-- Sourcing"](https://www.youtube.com/watch?v=KyOvBQ87aP4), in a more
-- confused way.
module Exalt.APISpec where
import Control.Monad (replicateM)
import Data.IORef (atomicModifyIORef', newIORef, readIORef)
import qualified Data.Map as Map
import Data.String (IsString)
import Test.Hspec (Spec, it, shouldBe)
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck (Arbitrary (..), NonEmptyList (..), choose, elements, forAll)
newtype Amount = EUR Int deriving (Eq, Show, Ord, Num)
instance Arbitrary Amount where
arbitrary = do
value <- choose (0, 100000)
return (EUR value)
newtype AccountNumber = AccountNumber String deriving (Eq, Show, Ord, IsString)
instance Arbitrary AccountNumber where
arbitrary = do
digits <- replicateM 22 (choose ('0', '9'))
country <- elements ["DE", "FR", "GB", "ES", "IT"]
return (AccountNumber (country ++ digits))
newtype MainframeApiError = InsufficientFunds Amount deriving (Eq, Show)
data MainframeApi = MainframeApi
{ deposit :: AccountNumber -> Amount -> IO (Either MainframeApiError ()),
withdraw :: AccountNumber -> Amount -> IO (Either MainframeApiError ()),
balance :: AccountNumber -> IO (Either MainframeApiError Amount)
}
initMainframeApi :: [(AccountNumber, Amount)] -> IO MainframeApi
initMainframeApi initialAccounts = do
ref <- newIORef $ Map.fromList initialAccounts
-- Initialize the mainframe API with existing accounts
return
MainframeApi
{ deposit = \accountNo amount -> do
atomicModifyIORef' ref $ \accountMap ->
case Map.lookup accountNo accountMap of
Just currentAmount ->
let newAmount = currentAmount + amount
in (Map.insert accountNo newAmount accountMap, Right ())
Nothing -> undefined,
withdraw = \accountNo amount -> do
atomicModifyIORef' ref $ \accountMap ->
case Map.lookup accountNo accountMap of
Just currentAmount
| amount > currentAmount ->
(accountMap, Left $ InsufficientFunds currentAmount) -- Insufficient funds
Just currentAmount ->
let newAmount = currentAmount - amount
in (Map.insert accountNo newAmount accountMap, Right ())
Nothing -> undefined,
balance = \accountNo -> do
readIORef ref >>= \accountMap ->
return $
maybe undefined Right $
Map.lookup accountNo accountMap
}
spec :: Spec
spec = do
let accountNumber = "DE89370400440532013000"
hundredEuros = EUR 10000
it "can deposit 100 EUR given an existing account" $ do
mainframeApi <- initMainframeApi [(accountNumber, hundredEuros)]
Right result <- deposit mainframeApi accountNumber hundredEuros
result `shouldBe` ()
prop "can retrieve balance given an existing account with 100 EUR" $
forAll arbitrary $ \(NonEmpty accounts) ->
forAll (elements accounts) $ \(accountNo, amount) -> do
mainframeApi <- initMainframeApi accounts
Right balance <- balance mainframeApi accountNo
balance `shouldBe` amount
prop "depositing any amount on existing account increases balance" $
forAll arbitrary $ \(NonEmpty accounts) ->
forAll (elements accounts) $ \(accountNo, initialAmount) ->
forAll arbitrary $ \depositAmount -> do
mainframeApi <- initMainframeApi accounts
Right () <- deposit mainframeApi accountNo depositAmount
Right newBalance <- balance mainframeApi accountNo
newBalance `shouldBe` (initialAmount + depositAmount)
prop "can withdraw up-to available balance of any account" $
forAll arbitrary $ \(NonEmpty accounts) ->
forAll (elements accounts) $ \(accountNo, initialAmount@(EUR initialValue)) ->
forAll (EUR <$> choose (0, initialValue)) $ \withdrawal -> do
mainframeApi <- initMainframeApi accounts
Right () <- withdraw mainframeApi accountNo withdrawal
Right newBalance <- balance mainframeApi accountNo
newBalance `shouldBe` (initialAmount - withdrawal)
prop "cannot withdraw more than available balance of any account" $
forAll arbitrary $ \(NonEmpty accounts) ->
forAll (elements accounts) $ \(accountNo, initialAmount@(EUR initialValue)) ->
forAll (EUR <$> choose (initialValue + 1, initialValue + 100000)) $ \withdrawal -> do
mainframeApi <- initMainframeApi accounts
result <- withdraw mainframeApi accountNo withdrawal
case result of
Left (InsufficientFunds amount) -> amount `shouldBe` initialAmount
Right _ -> error "Expected withdrawal to fail due to insufficient funds"
|
