From 8b9699f2447d1f4b273211f304cc3009687d1c98 Mon Sep 17 00:00:00 2001
From: Oleg Grenrus <oleg.grenrus@iki.fi>
Date: Thu, 3 Jul 2025 14:14:52 +0300
Subject: [PATCH] Fix #1138: Check for control characters in text literals
 everywhere

---
 aeson.cabal                                |  1 +
 src/Data/Aeson/Decoding/ByteString.hs      |  4 +++-
 src/Data/Aeson/Decoding/ByteString/Lazy.hs |  4 +++-
 src/Data/Aeson/Decoding/Text.hs            |  4 +++-
 tests/Regression/Issue1138.hs              | 23 ++++++++++++++++++++++
 tests/UnitTests.hs                         |  2 ++
 6 files changed, 35 insertions(+), 3 deletions(-)
 create mode 100644 tests/Regression/Issue1138.hs

diff --git a/aeson.cabal b/aeson.cabal
index 3951e4920..f65000982 100644
--- a/aeson.cabal
+++ b/aeson.cabal
@@ -176,6 +176,7 @@ test-suite aeson-tests
     Regression.Issue571
     Regression.Issue687
     Regression.Issue967
+    Regression.Issue1138
     RFC8785
     SerializationFormatSpec
     Types
diff --git a/src/Data/Aeson/Decoding/ByteString.hs b/src/Data/Aeson/Decoding/ByteString.hs
index 6ba082bbe..3794a6c96 100644
--- a/src/Data/Aeson/Decoding/ByteString.hs
+++ b/src/Data/Aeson/Decoding/ByteString.hs
@@ -153,7 +153,9 @@ scanStringLiteral ok err bs0 = go 0 bs0 where
             Right t -> ok t (BS.drop (n + 1) bs0)
             Left e  -> err (show e)
         Just (92, bs') -> goSlash (n + 1) bs'
-        Just (_,  bs') -> goEsc (n + 1) bs'
+        Just (w8, bs')
+            | w8 < 0x20  -> errCC
+            | otherwise  -> goEsc (n + 1) bs'
 
     goSlash :: Int -> ByteString -> r
     goSlash !n !bs = case BS.uncons bs of
diff --git a/src/Data/Aeson/Decoding/ByteString/Lazy.hs b/src/Data/Aeson/Decoding/ByteString/Lazy.hs
index 9e699d036..ef134f535 100644
--- a/src/Data/Aeson/Decoding/ByteString/Lazy.hs
+++ b/src/Data/Aeson/Decoding/ByteString/Lazy.hs
@@ -159,7 +159,9 @@ scanStringLiteral ok err bs0 = go 0 bs0 where
             Right t -> ok t (lbsDrop (n + 1) bs0)
             Left e  -> err (show e)
         Just (92, bs') -> goSlash (n + 1) bs'
-        Just (_,  bs') -> goEsc (n + 1) bs'
+        Just (w8, bs')
+            | w8 < 0x20  -> errCC
+            | otherwise  -> goEsc (n + 1) bs'
 
     goSlash :: Int -> ByteString -> r
     goSlash !n !bs = case LBS.uncons bs of
diff --git a/src/Data/Aeson/Decoding/Text.hs b/src/Data/Aeson/Decoding/Text.hs
index efceaff65..fe5a897b8 100644
--- a/src/Data/Aeson/Decoding/Text.hs
+++ b/src/Data/Aeson/Decoding/Text.hs
@@ -163,7 +163,9 @@ scanStringLiteral ok err bs0 = go 0 bs0 where
             Right t -> ok t (unsafeDropPoints (n + 1) bs0)
             Left e  -> err (show e)
         Just (92, bs') -> goSlash (n + 1) bs'
-        Just (_,  bs') -> goEsc (n + 1) bs'
+        Just (w8, bs')
+            | w8 < 0x20  -> errCC
+            | otherwise  -> goEsc (n + 1) bs'
 
     goSlash :: Int -> Text -> r
     goSlash !n !bs = case unconsPoint bs of
diff --git a/tests/Regression/Issue1138.hs b/tests/Regression/Issue1138.hs
new file mode 100644
index 000000000..3e319b902
--- /dev/null
+++ b/tests/Regression/Issue1138.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Regression.Issue1138 (issue1138) where
+
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (testCase, assertFailure)
+
+import Data.Aeson
+
+assertDecodeFailure :: Either String Value -> IO ()
+assertDecodeFailure (Right v) = assertFailure $ "Unexpected success: " ++ show v
+assertDecodeFailure (Left _)  = return ()
+
+issue1138 :: TestTree
+issue1138 = testGroup "Issue #1138" $ map (testCase "-")
+  [ assertDecodeFailure $ eitherDecode "\"\t\""
+  , assertDecodeFailure $ eitherDecode "\"\\\\\t\""
+
+  , assertDecodeFailure $ eitherDecodeStrict "\"\t\""
+  , assertDecodeFailure $ eitherDecodeStrict "\"\\\\\t\""
+
+  , assertDecodeFailure $ eitherDecodeStrictText "\"\t\""
+  , assertDecodeFailure $ eitherDecodeStrictText "\"\\\\\t\""
+  ]
diff --git a/tests/UnitTests.hs b/tests/UnitTests.hs
index 227504bb2..c9dda427e 100644
--- a/tests/UnitTests.hs
+++ b/tests/UnitTests.hs
@@ -64,6 +64,7 @@ import Regression.Issue351
 import Regression.Issue571
 import Regression.Issue687
 import Regression.Issue967
+import Regression.Issue1138
 import UnitTests.OmitNothingFieldsNote
 import UnitTests.FromJSONKey
 import UnitTests.Hashable
@@ -568,6 +569,7 @@ tests = testGroup "unit" [
   , issue571
   , issue687
   , issue967
+  , issue1138
   , keyMapInsertWithTests
   , omitNothingFieldsNoteTests
   , noThunksTests