diff --git a/Control/Concurrent/STM/TVar.hs b/Control/Concurrent/STM/TVar.hs
index bf451e17dd971a22814c49c33a64bfe1ee6dabdd..a1a65c75bba065c8f6c41f60661fdb27b14f1c1a 100644
--- a/Control/Concurrent/STM/TVar.hs
+++ b/Control/Concurrent/STM/TVar.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
 
 #if __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE Trustworthy #-}
@@ -73,7 +73,7 @@ modifyTVar' var f = do
 stateTVar :: TVar s -> (s -> (a, s)) -> STM a
 stateTVar var f = do
    s <- readTVar var
-   let (a, s') = f s -- since we destructure this, we are strict in f
+   let !(a, s') = f s
    writeTVar var s'
    return a
 {-# INLINE stateTVar #-}
diff --git a/changelog.md b/changelog.md
index ddcc400485ce03f5b0de72419e8af53bce617db9..4ae61747e8e91b20ea0988093c8dfdb29038fd14 100644
--- a/changelog.md
+++ b/changelog.md
@@ -1,5 +1,9 @@
 # Changelog for [`stm` package](http://hackage.haskell.org/package/stm)
 
+## Upcoming
+
+  * Fix strictness of `stateTVar` ([#69](https://github.com/haskell/stm/pull/69))
+
 ## 2.5.1.0 *Aug 2022*
 
   * Teach `flushTBQueue` to only flush queue when necessary