added stateful PBT kata from SW Crafters Nantes

1 files changed, 140 insertions, 0 deletions

diff --git a/pbt/stateful-pbt/test/Exalt/APISpec.hs b/pbt/stateful-pbt/test/Exalt/APISpec.hs
new file mode 100644
index 0000000..dd89f2c
--- /dev/null
+++ b/pbt/stateful-pbt/test/Exalt/APISpec.hs
@@ -0,0 +1,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"