Transactions

Threads

Timeouts

Each block of code inside the atomically function is a transaction. When you read and write TVars within a transaction, you are shielded from the effects of any other threads that may also be messing with the variables concurrently.

In celebration of how transactional variables free us from a lot of messy concerns that usually complicate concurrent programming, here is a classic demonstration that simulates passing money around between bank accounts.

transactions.hs

These are our standard imports from stm for working with mutable references.

import Control.Monad.STM
import Control.Concurrent.STM.TVar

This demonstration will create a bunch of concurrent threads that perform actions at random.

import Control.Concurrent (forkIO, threadDelay)

We use the mwc-random library to generate random numbers.

import System.Random.MWC (createSystemRandom, uniformR)

We will store the list of accounts in a sequence to allow efficient lookups by index when selecting an account at random.

import qualified Data.Sequence as Seq

import Control.Monad (forever)
import Data.Foldable (asum, for_)
import Data.Traversable (for)

main =
  do

First we initialize ten TVars representing ten account balances.

    accountList <-
        for [1..10] $ \_ ->
            atomically (newTVar (100 :: Integer))

The standard list type is great for looping over, but for any other access pattern we look to other data structures. Here we’ll want to look up accounts by their position in the list, so we’ll store them in a Seq. The randomAccount function uses uniformR to generate a random list index, then uses Seq.index to grab the account at that position.

    let
        accountSeq = Seq.fromList accountList

        randomAccount rng =
          do
            i <- uniformR (1, Seq.length accountSeq) rng
            return (Seq.index accountSeq (i - 1))

Next we start many threads to create frantic account activity.

    for_ [1..500] $ \_ ->
        forkIO $
          do

Each thread has its own random number generator.

            rng <- createSystemRandom

These threads run in an infinite loop; they will stop only when the program ends.

            forever $
              do

Between each iteration, a brief pause lasting somewhere between ten and fifty microseconds.

                d <- uniformR (10, 50) rng
                threadDelay d

In each loop iteration, one transaction. Two accounts are chosen at random to be the sender and the recipient.

                sender    <- randomAccount rng
                recipient <- randomAccount rng

                amount <-
                  do

The amount to transfer is also selected at random, a number between one and ten.

                    x <- uniformR (1, 10) rng
                    return (toInteger (x :: Int))

Now we come to the interesting transaction.

                atomically $
                  asum

First it reduces the sender’s balance by the transfer amount, then checks to make sure that this did not overdraw the account. If the new balance is below zero, the transaction is aborted.

                    [ do
                        modifyTVar' sender (\x -> x - amount)
                        readTVar sender >>= \x -> check (x >= 0)

Then it increases the recipient’s balance by the same amount.

                        modifyTVar' recipient (\x -> x + amount)

The alternative possibility, reached if the first transaction aborts, is to return without doing anything. (If we did not include this branch, then the thread would block until the transaction is able to run successfully.)

                    , return ()
                    ]

The final piece of the program is to make some observations of the program state so we can see what’s happening. We’ll repeat this four times, pausing for half of a second between each sample.

    for_ [1..4] $ \_ ->
      do
        threadDelay 500000

In a single transaction, we read all of the account balances.

        balances <- atomically (for accountList readTVar)

Then we print the list of balances and their sum total.

        putStrLn (show balances)
        putStrLn ("Total: " ++ show (sum balances))

Since the transactions are random, you’ll see a different result every time you run this program. But, no matter what:

No account balance ever drops below zero.
The total amount of money among the accounts remains at 1,000.

$ runhaskell transactions.hs
[507,66,64,14,76,33,23,30,103,84]
Total: 1000
[211,81,78,118,70,182,74,65,62,59]
Total: 1000
[181,262,175,77,14,52,0,229,1,9]
Total: 1000
[14,118,45,12,350,214,149,16,53,29]
Total: 1000

Next: Timeouts