diff --git a/testsuite/tests/typecheck/should_compile/T23861.hs b/testsuite/tests/typecheck/should_compile/T23861.hs
new file mode 100644
index 0000000000000000000000000000000000000000..a2b7a8077d4bb4c2a69a44456489b8854b4bdc8f
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T23861.hs
@@ -0,0 +1,13 @@
+module M where
+
+newtype GetDiscardingUnlift a = MkGetDiscardingUnlift
+    { unGetDiscardingUnlift :: forall m. Either a m
+    }
+
+build :: forall a. a -> GetDiscardingUnlift a
+build w =
+    case build w of
+        MkGetDiscardingUnlift getDiscardingUnlift' ->
+         let getDiscardingUnlift'' :: forall m. Either a m
+             getDiscardingUnlift'' = getDiscardingUnlift' @m
+         in  MkGetDiscardingUnlift getDiscardingUnlift''
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 0b98018f813eb57f5875e405dcfddae3ac137efe..a842adc21a95668b8daaa9cacfb609bafc74bee3 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -891,3 +891,4 @@ test('T18986b', normal, compile, [''])
 test('T23413', normal, compile, [''])
 test('TcIncompleteRecSel', normal, compile, ['-Wincomplete-record-selectors'])
 test('InstanceWarnings', normal, multimod_compile, ['InstanceWarnings', ''])
+test('T23861', normal, compile, [''])