Reject input with non-whitespace leftovers

Author: andrewthad

json-syntax.cabal

@@ -31,7 +31,7 @@ library
     , array-builder >=0.1 && <0.2
     , array-chunks >=0.1.1 && <0.2
     , base >=4.12 && <5
-    , bytesmith >=0.3 && <0.4
+    , bytesmith >=0.3.2 && <0.4
     , byteslice >=0.1.3 && <0.3
     , scientific-notation >=0.1.1 && <0.2
     , text-short >=0.1.3 && <0.2
@@ -51,6 +51,7 @@ test-suite test
   ghc-options: -Wall -O2
   build-depends:
     , aeson
+    , array-chunks
     , base >=4.12.0.0 && <5
     , byteslice >=0.1.3
     , bytestring

src/Json.hs

@@ -1,5 +1,6 @@
 {-# language BangPatterns #-}
 {-# language BinaryLiterals #-}
+{-# language BlockArguments #-}
 {-# language DerivingStrategies #-}
 {-# language DeriveAnyClass #-}
 {-# language LambdaCase #-}
@@ -87,6 +88,7 @@ data SyntaxException
   | InvalidLeader
   | InvalidNumber
   | LeadingZero
+  | UnexpectedLeftovers
   deriving stock (Eq,Show)
   deriving anyclass (Exception)
 
@@ -114,14 +116,15 @@ isSpace w =
 
 -- | Decode a JSON syntax tree from a byte sequence.
 decode :: Bytes -> Either SyntaxException Value
-decode !bs = case P.parseBytes (P.skipWhile isSpace *> (Latin.any EmptyInput >>= parser)) bs of
-  P.Failure err -> Left err
-  -- Since parser only completes once the end of the input
-  -- has been reached, we do not need to check the length here.
-  P.Success (P.Slice _ _ cs) -> Right cs
+decode = P.parseBytesEither do
+  P.skipWhile isSpace
+  result <- Latin.any EmptyInput >>= parser
+  P.skipWhile isSpace
+  P.endOfInput UnexpectedLeftovers
+  pure result
 
 -- Precondition: skip over all space before calling this.
--- It will not skip space for you.
+-- It will not skip leading space for you. It does
 parser :: Char -> Parser SyntaxException s Value
 parser = \case
   '{' -> objectTrailedByBrace

test/Main.hs

@@ -12,6 +12,7 @@ import Twitter100 (encodedTwitter100,byteStringTwitter100)
 
 import qualified Data.Aeson as AE
 import qualified Data.Bytes as Bytes
+import qualified Data.Chunks as Chunks
 import qualified Data.HashMap.Strict as HM
 import qualified Data.Number.Scientific as SCI
 import qualified Data.Text.Short as TS
@@ -40,10 +41,24 @@ tests = testGroup "Tests"
       Right (J.Object (Exts.fromList [Exts.fromList [J.Member "foo" J.True, J.Member "bar" J.False]]))
       @=?
       J.decode (Bytes.fromAsciiString "{\"foo\" : true, \"bar\": false }")
-  , THU.testCase "D" $
+  , THU.testCase "E" $
       Right (J.String "Smile: 😂")
       @=?
       J.decode (shortTextToBytes "\"Smile: 😂\"")
+  , THU.testCase "F" $
+      Right (J.Array (Exts.fromList [Exts.fromList [ J.Object mempty, J.Object mempty, J.Null ]]))
+      @=?
+      J.decode (shortTextToBytes " [ {} , { } , null ] ")
+  , THU.testCase "G" $ case J.decode (shortTextToBytes " [ 55e2 , 1 ] ") of
+      Right (J.Array xs) -> case Exts.toList (Chunks.concat xs) of
+        [J.Number a, J.Number b] -> do
+          SCI.toWord32 a @=? Just 5500
+          SCI.toWord32 b @=? Just 1
+        _ -> fail "no good y"
+      _ -> fail "no good x"
+  , THU.testCase "H" $ case J.decode (shortTextToBytes " [] x") of
+      Left _ -> pure ()
+      Right _ -> fail "this was not supposed parse"
   , THU.testCase "Twitter100" $
       case J.decode (Bytes.fromByteArray encodedTwitter100) of
         Left _ -> fail "nope"