diff --git a/bench/Async.hs b/bench/Async.hs
deleted file mode 100644
index 6849e0f0ce8094cd8813c4c7c4c214d8d4982848..0000000000000000000000000000000000000000
--- a/bench/Async.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-module Async where
-
-import Control.Concurrent (forkIO)
-import Control.Concurrent.MVar
-
-newtype Async a = Async (MVar a)
-
-async :: IO a -> IO (Async a)
-async action = do
-    mvar <- newEmptyMVar
-    _ <- forkIO $ do
-        x <- action
-        putMVar mvar x
-    pure (Async mvar)
-
-wait :: Async a -> IO a
-wait (Async a) = takeMVar a
diff --git a/bench/ChanBench.hs b/bench/ChanBench.hs
index cb488564f60be321f4164ce1e18d7b727e084824..caddd05548e4be82df71968716b904159b528545 100644
--- a/bench/ChanBench.hs
+++ b/bench/ChanBench.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes, ScopedTypeVariables, RankNTypes, TypeApplications #-}
 
+import Control.Concurrent.Async
 import Control.Monad
 import Data.Foldable (traverse_)
 import System.Environment
@@ -11,8 +12,6 @@ import Control.Concurrent.STM
 import Control.Concurrent.STM.TQueue
 import Control.Concurrent.STM.TBQueue
 
-import Async
-
 class Channel c where
     newc :: IO (c a)
     readc :: c a -> IO a
diff --git a/bench/Makefile b/bench/Makefile
deleted file mode 100644
index 2a45fad981f8f0fc921bb4a4ac4dc975507f4469..0000000000000000000000000000000000000000
--- a/bench/Makefile
+++ /dev/null
@@ -1,6 +0,0 @@
-GHC=ghc
-
-# Run chanbench for 4 different channel types, 3 different benchmarks
-all:
-	for i in CHAN TCHAN TQUEUE TBQUEUE; do $(GHC) -D$$i -O2 -fforce-recomp chanbench.hs -o chanbench-$$i; done
-	for i in 0 1 2; do echo; echo === test $$i ===; for j in CHAN TCHAN TQUEUE TBQUEUE; do printf "%-10s" $$j; time ./chanbench-$$j $$i 2000000; done; done
diff --git a/bench/stm-bench.cabal b/bench/stm-bench.cabal
index 8062d6aefe42550a3af1411a371ee0efbf09baca..b230720fe1904ce13e452ecad1ed430c5e3e6ebc 100644
--- a/bench/stm-bench.cabal
+++ b/bench/stm-bench.cabal
@@ -13,8 +13,6 @@ description:
 benchmark chanbench
     type:             exitcode-stdio-1.0
     main-is:          ChanBench.hs
-    other-modules:
-        Async
-    build-depends:    base, stm, tasty, tasty-bench
+    build-depends:    base, stm, async, tasty, tasty-bench
     default-language: Haskell2010
     ghc-options:      -O2 -threaded -with-rtsopts=-N