diff --git a/src/Network/WebSockets/Simple.hs b/src/Network/WebSockets/Simple.hs
--- a/src/Network/WebSockets/Simple.hs
+++ b/src/Network/WebSockets/Simple.hs
@@ -21,16 +21,17 @@
   ) where
 
 import Network.WebSockets (DataMessage (..), sendTextData, sendClose, receiveDataMessage, acceptRequest, ConnectionException (..))
-import Network.Wai.Trans (ServerAppT, ClientAppT)
+import Network.WebSockets.Trans (ServerAppT, ClientAppT)
 import Data.Profunctor (Profunctor (..))
 import Data.Aeson (ToJSON (..), FromJSON (..))
 import qualified Data.Aeson as Aeson
 import Data.ByteString.Lazy (ByteString)
+import Data.Singleton.Class (Extractable (..))
 
 import Control.Monad (forever)
 import Control.Monad.IO.Class (MonadIO (..))
 import Control.Monad.Catch (Exception, throwM, MonadThrow, catch, MonadCatch)
-import Control.Monad.Trans.Control (MonadBaseControl (..))
+import Control.Monad.Trans.Control.Aligned (MonadBaseControl (..))
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.STM (atomically, newTVarIO, readTVarIO, writeTVar)
 
@@ -96,14 +97,14 @@
 
 
 -- | This can throw a 'WebSocketSimpleError' to the main thread via 'Control.Concurrent.Async.link' when json parsing fails.
-toClientAppT :: forall send receive m
-              . ( ToJSON send
-                , FromJSON receive
-                , MonadIO m
-                , MonadBaseControl IO m
-                , MonadThrow m
-                , MonadCatch m
-                )
+toClientAppT :: forall send receive m stM
+              . ToJSON send
+             => FromJSON receive
+             => MonadIO m
+             => MonadBaseControl IO m stM
+             => MonadThrow m
+             => MonadCatch m
+             => Extractable stM
              => WebSocketsApp m receive send
              -> ClientAppT m () -- WebSocketsAppThreads
 toClientAppT WebSocketsApp{onOpen,onReceive,onClose} conn = do
@@ -119,24 +120,30 @@
   onOpen params
 
   liftBaseWith $ \runInBase ->
-    let go' = forever $ do
+    let runM :: forall a. m a -> IO a
+        runM = fmap runSingleton . runInBase
+
+        go' :: IO ()
+        go' = forever $ do
           data' <- receiveDataMessage conn
           let data'' = case data' of
                         Text xs _ -> xs
                         Binary xs -> xs
+          putStrLn $ show data''
           case Aeson.decode data'' of
             Nothing -> throwM (JSONParseError data'')
-            Just received -> runInBase (onReceive params received)
-    in  go' `catch` (\e -> () <$ (runInBase (onClose ClosedOnReceive e)))
+            Just received -> runM (onReceive params received)
+    in  go' `catch` (runM . onClose ClosedOnReceive)
 
 
 
 toServerAppT :: ( ToJSON send
                 , FromJSON receive
                 , MonadIO m
-                , MonadBaseControl IO m
+                , MonadBaseControl IO m stM
                 , MonadThrow m
                 , MonadCatch m
+                , Extractable stM
                 ) => WebSocketsApp m receive send -> ServerAppT m
 toServerAppT wsApp pending =
   liftIO (acceptRequest pending) >>= toClientAppT wsApp
diff --git a/src/Network/WebSockets/Simple/PingPong.hs b/src/Network/WebSockets/Simple/PingPong.hs
--- a/src/Network/WebSockets/Simple/PingPong.hs
+++ b/src/Network/WebSockets/Simple/PingPong.hs
@@ -11,8 +11,9 @@
 import Data.Aeson (ToJSON (..), FromJSON (..))
 import Data.Aeson.Types (Value (Array, String), typeMismatch)
 import qualified Data.Vector as V
+import Data.Singleton.Class (Extractable (..))
 import Control.Monad (forever)
-import Control.Monad.Trans.Control (MonadBaseControl (..))
+import Control.Monad.Trans.Control.Aligned (MonadBaseControl (..))
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async (async, cancel)
 import Control.Concurrent.STM (atomically, newEmptyTMVarIO, putTMVar, takeTMVar)
@@ -38,13 +39,14 @@
 
 
 
-pingPong :: ( MonadBaseControl IO m
+pingPong :: ( MonadBaseControl IO m stM
+            , Extractable stM
             )
          => Int -- ^ Delay in microseconds
          -> WebSocketsApp m receive send
          -> m (WebSocketsApp m (PingPong receive) (PingPong send))
-pingPong delay WebSocketsApp{onOpen,onReceive,onClose} = do
-  pingingThread <- liftBaseWith $ \_ -> newEmptyTMVarIO
+pingPong delay WebSocketsApp{onOpen,onReceive,onClose} = liftBaseWith $ \_ -> do
+  pingingThread <- newEmptyTMVarIO
 
   pure WebSocketsApp
     { onOpen = \params@WebSocketsAppParams{send} -> do
diff --git a/src/Test/WebSockets/Simple.hs b/src/Test/WebSockets/Simple.hs
--- a/src/Test/WebSockets/Simple.hs
+++ b/src/Test/WebSockets/Simple.hs
@@ -8,9 +8,10 @@
 module Test.WebSockets.Simple where
 
 import Network.WebSockets.Simple (WebSocketsApp (..), WebSocketsAppParams (..), ConnectionException (..), CloseOrigin (..))
-import Control.Monad (forever, void)
+import Data.Singleton.Class (Extractable (..))
+import Control.Monad (forever)
 import Control.Monad.IO.Class (MonadIO (..))
-import Control.Monad.Trans.Control (MonadBaseControl (..))
+import Control.Monad.Trans.Control.Aligned (MonadBaseControl (..))
 import Control.Concurrent.Async (Async, async)
 import Control.Concurrent.STM (atomically)
 import Control.Concurrent.STM.TChan (TChan, newTChan, writeTChan, readTChan)
@@ -18,9 +19,10 @@
 
 
 -- | Runs two 'WebSocketsApp's together in a forged channel.
-runConnected :: forall send receive m
+runConnected :: forall send receive m stM
               . ( MonadIO m
-                , MonadBaseControl IO m
+                , MonadBaseControl IO m stM
+                , Extractable stM
                 )
              => WebSocketsApp m receive send
              -> WebSocketsApp m send receive
@@ -41,14 +43,14 @@
 
   sToR <- liftBaseWith $ \runInBase -> async $ forever $ do
     s <- atomically $ readTChan sendChan
-    void $ runInBase $ onReceive sendsRreceivesS WebSocketsAppParams
+    fmap runSingleton $ runInBase $ onReceive sendsRreceivesS WebSocketsAppParams
       { send = sendToReceive
       , close
       } s
 
   rToS <- liftBaseWith $ \runInBase -> async $ forever $ do
     r <- atomically $ readTChan receiveChan
-    void $ runInBase $ onReceive sendsSreceivesR WebSocketsAppParams
+    fmap runSingleton $ runInBase $ onReceive sendsSreceivesR WebSocketsAppParams
       { send = sendToSend
       , close
       } r
diff --git a/websockets-simple.cabal b/websockets-simple.cabal
--- a/websockets-simple.cabal
+++ b/websockets-simple.cabal
@@ -2,10 +2,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: b864ea883942ac76ccc4d385c87d3c8613080be5d10c29723565111d84ef549b
+-- hash: bf5ddb451632a405334939c43f387b4312612ae76051e88ebd8cba2f80ac63dc
 
 name:           websockets-simple
-version:        0.1.1
+version:        0.1.2
 synopsis:       Composable websockets clients
 description:    See README at <https://github.com/athanclark/websockets-simple#readme>
 category:       Web
@@ -40,13 +40,14 @@
     , base >=4.9 && <5
     , bytestring
     , exceptions
-    , monad-control
+    , extractable-singleton >=0.0.1
+    , monad-control-aligned >=0.0.1
     , profunctors
     , stm
     , transformers
     , vector
-    , wai-transformers
-    , websockets >=0.12.3
+    , wai-transformers >=0.1.0
+    , websockets >=0.12.4
   default-language: Haskell2010
 
 test-suite spec
@@ -67,15 +68,16 @@
     , base >=4.9 && <5
     , bytestring
     , exceptions
+    , extractable-singleton >=0.0.1
     , hspec
-    , monad-control
+    , monad-control-aligned >=0.0.1
     , profunctors
     , stm
     , tasty
     , tasty-hspec
     , transformers
     , vector
-    , wai-transformers
-    , websockets >=0.12.3
+    , wai-transformers >=0.1.0
+    , websockets >=0.12.4
     , websockets-simple
   default-language: Haskell2010