generic load testing tool A part of my day job is load-testing of our infrastructure. I wanted a tool to quickly write a load scenario for some application (DB, HTTP, ...).  I have tried to write something in Haskell (a fairly new language for me). Would someone help me improve by reviewing the code?
This is the main module:
module Load.Core
  ( runLoadN,
    Config (..),
  )
where

import Control.Concurrent (ThreadId, forkIO)
import Control.Concurrent.STM (STM, atomically, newEmptyTMVar, putTMVar, readTMVar)
import Control.Concurrent.STM.TBMQueue (TBMQueue, closeTBMQueue, newTBMQueue, readTBMQueue, writeTBMQueue)
import Control.Concurrent.STM.TSem (TSem, newTSem, signalTSem, waitTSem)
import Control.Concurrent.TokenBucket (newTokenBucket, tokenBucketWait)
import Control.Exception.Lifted (finally)
import Control.Monad (replicateM_, void)
import Control.Monad.Base (MonadBase, liftBase)
import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith)
import Data.Default (Default, def)
import Data.Word
import Numeric.Natural

data Config m a b c = Config
  { supplier :: m a,
    performer :: a -&gt; IO b,
    collector :: b -&gt; c -&gt; c,
    workers :: Natural,
    queue :: Natural,
    rate :: Double,
    burst :: Integer
  }

runLoadN :: (MonadBase IO m, MonadBaseControl IO m, Default c) =&gt; Natural -&gt; Config m a b c -&gt; m c
runLoadN nat cfg = do
  let n = toInt nat
  let w = toInt $ workers cfg
  let q = toInt $ queue cfg
  let b = fromIntegral $ burst cfg
  let r = toInvRate $ rate cfg
  let perf = performer cfg
  let coll = collector cfg
  let supp = supplier cfg

  jobq &lt;- atomically' $ newTBMQueue q
  resq &lt;- atomically' $ newTBMQueue q
  mvar &lt;- atomically' newEmptyTMVar
  sema &lt;- atomically' $ newTSem 0
  tobu &lt;- liftBase newTokenBucket

  startWorkers w perf jobq resq sema tobu r b
  _ &lt;- forkIO' $ closing resq $ \_ -&gt; waitForWorkers w sema
  _ &lt;- forkIO' $ closing jobq $ supplyRequests n supp
  _ &lt;- forkIO' $ collectResults coll def resq mvar
  atomically' . readTMVar $ mvar
  where
    collectResults f z resq mv = do
      mbNxt &lt;- atomically' $ readTBMQueue resq
      case mbNxt of
        Nothing -&gt; atomically' $ putTMVar mv z
        Just nxt -&gt; let z' = f nxt z in seq z' $ collectResults f z' resq mv

    supplyRequests n supp q = replicateM_ n (supp &gt;&gt;= \req -&gt; atomically' $ writeTBMQueue q req)

    waitForWorkers w sema = atomically' (replicateM_ w (waitTSem sema))

    startWorkers w perf jobq resq sema tobu r b = do
      replicateM_ w $ forkIO' $ signaling sema $ performRequests perf jobq resq tobu r b

    -- todo: what about exceptions?
    performRequests perf jobq resq tobu r b = run
      where
        run = do
          mbreq &lt;- atomically' (readTBMQueue jobq)
          case mbreq of
            Nothing -&gt; return ()
            Just req -&gt; do
              res &lt;- liftBase $ tokenBucketWait tobu b r &gt;&gt; perf req
              atomically' $ writeTBMQueue resq res
              run

-- performs f on the queue and closes it afterwards
--
-- use for sending requests, closing when done
closing :: (MonadBaseControl IO m) =&gt; TBMQueue a -&gt; (TBMQueue a -&gt; m ()) -&gt; m ()
closing q f = f q `finally` atomically' (closeTBMQueue q)

-- performs f and signals the the semaphore afterwards
--
-- use for worker threads, signaling that they are done
signaling :: (MonadBaseControl IO m) =&gt; TSem -&gt; m () -&gt; m ()
signaling sem f = f `finally` atomically' (signalTSem sem)

-- some convenience methods
--
--

forkIO' :: MonadBaseControl IO m =&gt; m () -&gt; m ThreadId
forkIO' m = liftBaseWith $ \runInBase -&gt; forkIO (void $ runInBase m)

atomically' :: (MonadBaseControl IO m) =&gt; STM a -&gt; m a
atomically' stm = liftBase $ atomically stm

toInt :: Natural -&gt; Int
toInt = fromIntegral . toInteger

toInvRate :: Double -&gt; Word64
toInvRate r = round (1e6 / r)


Repository can be found here: https://gitlab.com/michoffmann/load
From a quick glance, I would say you're on the right track. It might be worthwhile to bust up the work being done by Config into two components:

Config: the pure configuration elements; workers, queue, rate, burst; and
Env: the (effectful) environment state; supplier, performer, collector.

And then think about creating a few boiler-plate functions (not including the polymorphic Env bits):
new :: Config -&gt; IO Env
close :: Env -&gt; IO ()
check :: Env -&gt; IO Text

withConfig :: Config -&gt; (Config -&gt; Env -&gt; IO ()) -&gt; IO ()
withConfig c cont = bracket (new c) close (cont c)

Once you have this, you can create a new environment, play around with it, and properly close it in a robust way. As it stands, and given my workflow preferences, I would think that runLoadN is too monolithic for easy maintenance and extension.
General descriptions of these refactors include the handle pattern and the service pattern. The three layer cake is classic also though I suspect you don't need the extra complexity.
With runLoadN freed of environment setup and teardown you'll be able to see more clearly the key components of the process.
A few vague guesses about other aspect of the code:

I would work towards refactoring away the convenience functions. Do you really need the extra monadic complexity? Can it all be IO?

the collector looks like a WriterT or logger, and might be simplified by using those patterns.

There are a lot of polymorphic types being thrown around. Both m and IO, in particular, exists in Config, which might suggest some refactoring needed. I reckon you could aim for just an Env without any polymorphism.

If you're always altering pure Config types (with toInt), then it's better to change the Config types instead.

I would suggest that best practice is to define a defaultConfig :: Config explicitly, rather than run through Data.Default and use the anonymising def pattern