Fixed parser denial of service through deep nesting and nested list types

RELEASE_NOTES.md

@@ -334,3 +334,6 @@
 * Fixed validation error accumulation, which was quadratic in the number of errors
 * Fixed the subscription single root field rule ignoring the fields selected before a fragment spread and counting a fragment spread twice when it is spread twice
 * Added `AstError.Create`, which creates a validation error
+* **Breaking Change** `Parser.parse` and `Parser.tryParse` now reject a document whose braces, brackets and parentheses, outside of strings and comments, are nested deeper than `DocumentLimitsDefaults.MaxNestingDepth` (128), with a syntax error giving the line and column of the first one too deep. Deeper documents used to overflow the stack, which terminated the process
+* Fixed parsing time growing exponentially with the nesting of list types in variable definitions: a 100-deep `[[…Int…]]` never finished parsing
+* Fixed `Parser.tryParse` throwing `OverflowException`, and so an HTTP server answering with an unhandled exception, for an integer out of the range of 64-bit integers; it is now a syntax error

src/FSharp.Data.GraphQL.Shared/DocumentLimits.fs

@@ -1,13 +1,17 @@
 namespace FSharp.Data.GraphQL
 
-/// Default limits on the work that an untrusted document can cause while it is validated.
+/// Default limits on the work that an untrusted document can cause while it is parsed and validated.
 [<RequireQualifiedAccess>]
 module DocumentLimitsDefaults =
 
     /// <summary>
-    /// The maximum nesting depth of a document once its fragment spreads are inlined.
+    /// The maximum nesting depth of a document.
     /// <para>
-    /// Every selection set of a field, every inline fragment and every fragment spread adds one level.
+    /// The parser counts nested braces, brackets and parentheses outside of strings and comments, before it parses the document.
+    /// </para>
+    /// <para>
+    /// Validation counts nesting once fragment spreads are inlined: every selection set of a field, every inline fragment and
+    /// every fragment spread adds one level.
     /// </para>
     /// </summary>
     [<Literal>]
@@ -20,7 +24,7 @@ module DocumentLimitsDefaults =
     /// operations and fragment definitions of the document.
     /// </para>
     /// <para>
-    /// Validation and planning take time in proportion to this number, so a higher limit lets a small document
+    /// The work of validating and planning a document grows with this number, so a higher limit lets a small document
     /// keep a server busy for longer.
     /// </para>
     /// </summary>

src/FSharp.Data.GraphQL.Shared/Parser.fs

@@ -5,23 +5,28 @@
 module FSharp.Data.GraphQL.Parser
 
 open System
+open System.Globalization
 open FParsec
 open FSharp.Data.GraphQL.Ast
 open FsToolkit.ErrorHandling
 
 [<AutoOpen>]
 module internal Internal =
 
+    // 2.1.3 LineTerminator
+    //   New Line (U+000A)
+    //   Carriage Return (U+000D)New Line (U+000A) | (U+000D)New Line (U+000A)
+    // This grammar also ends comments and strings at the Unicode line (U+2028) and paragraph (U+2029) separators.
+    // tryFindNestingViolation must split comments and strings exactly as the grammar does, so both use this set.
+    let lineTerminatorChars = [| '\u000A'; '\u000D'; '\u2028'; '\u2029' |]
+
     // 2.1.7 Ignored tokens
     let ignored =
         // 2.1.2 WhiteSpace
         //    Horizontal Tab (U+0009) | Space (U+0020)
         let whiteSpace = skipAnyOf [| '\u0009'; '\u000B'; '\u000C'; '\u0020'; '\u00A0' |]
 
-        // 2.1.3 LineTerminator
-        //   New Line (U+000A)
-        //   Carriage Return (U+000D)New Line (U+000A) | (U+000D)New Line (U+000A)
-        let lineTerminators = skipAnyOf [| '\u000A'; '\u000D'; '\u2028'; '\u2029' |]
+        let lineTerminators = skipAnyOf lineTerminatorChars
 
         // 2.1.4 CommentChar
         //  SourceCharacter but not LineTerminator
@@ -103,7 +108,7 @@ module internal Internal =
                     |> char)
             pchar '\\' >>. (escaped <|> unicode)
 
-        let normalCharacter = noneOf [| '\u000A'; '\u000D'; '\u2028'; '\u2029'; '"' |]
+        let normalCharacter = noneOf [| yield! lineTerminatorChars; '"' |]
         let quote = pchar '"'
 
         between quote quote (manyChars (escapedCharacter <|> normalCharacter))
@@ -132,7 +137,13 @@ module internal Internal =
 
     // 2.9.1 IntValue
     //   IntegerPart
-    let integerValue = integerPart |>> int64
+    let integerValue =
+        // A conversion that throws would escape tryParse as an unhandled exception
+        integerPart
+        >>= fun text ->
+            match Int64.TryParse (text, NumberStyles.AllowLeadingSign, CultureInfo.InvariantCulture) with
+            | true, value -> preturn value
+            | false, _ -> fail $"The integer %s{text} is out of the range of 64-bit integers."
 
 
     // 2.9.2 FloatValue
@@ -231,10 +242,13 @@ module internal Internal =
     let inputType, inputTypeRef = createParserForwardedToRef ()
     let namedType = name |>> NamedType <?> "NamedType"
     let listType = betweenChars '[' ']' inputType |>> ListType <?> "ListType"
-    let nonNullType =
-        (listType <|> namedType) .>> pchar '!' |>> NonNullType
-        <?> "NonNullType"
-    inputTypeRef.Value <- choice [ attempt nonNullType; namedType; listType ]
+    // Parses the type once and then looks for '!': trying a non-null type first and backtracking to a nullable one
+    // parsed every nested list type twice, which took exponential time in the nesting depth
+    inputTypeRef.Value <-
+        pipe2 (listType <|> namedType) (opt (pchar '!')) (fun inputType nonNull ->
+            match nonNull with
+            | Some _ -> NonNullType inputType
+            | None -> inputType)
 
 
     // 2.4 Selection Sets
@@ -369,14 +383,96 @@ module internal Internal =
         |>> (fun definitions -> { Document.Definitions = definitions })
 
 
-/// Parses a GraphQL Document. Throws exception on invalid formats.
+/// <summary>
+/// The line and column of the first brace, bracket or parenthesis nested deeper than <paramref name="maxDepth"/>,
+/// skipping comments and strings.
+/// </summary>
+/// <remarks>
+/// <para>
+/// The parser recurses once per nesting level, so a deeply nested document overflows the stack, which terminates the process.
+/// This linear scan rejects such a document before it is parsed.
+/// </para>
+/// <para>
+/// It must split comments and strings exactly as the grammar does: a bracket the scan takes for comment or string text,
+/// but the grammar parses, escapes the limit. Comments and strings therefore end at the same line terminators as in the
+/// grammar, and there are no block strings, which the grammar does not support either.
+/// </para>
+/// <para>
+/// Lines and columns are 1-based and columns count UTF-16 code units. As in FParsec error positions,
+/// <c>\r\n</c>, <c>\r</c> and <c>\n</c> each start a new line.
+/// </para>
+/// </remarks>
+let internal tryFindNestingViolation (maxDepth : int) (query : string) : struct (int * int) voption =
+    let length = query.Length
+    let isLineTerminator (c : char) = Array.contains c lineTerminatorChars
+    let mutable depth = 0
+    let mutable line = 1
+    let mutable lineStart = 0
+    let mutable index = 0
+    let mutable violation = ValueNone
+    while violation.IsNone && index < length do
+        match query[index] with
+        | '#' ->
+            // A comment runs to the line terminator, which the next iteration handles
+            while index < length && not (isLineTerminator query[index]) do
+                index <- index + 1
+        | '"' ->
+            index <- index + 1
+            let mutable closed = false
+            while not closed && index < length do
+                match query[index] with
+                | '\\' -> index <- index + 2
+                | '"' ->
+                    index <- index + 1
+                    closed <- true
+                // A string cannot contain a line terminator, which the next iteration handles
+                | c when isLineTerminator c -> closed <- true
+                | _ -> index <- index + 1
+        | '{'
+        | '['
+        | '(' ->
+            depth <- depth + 1
+            if depth > maxDepth then
+                violation <- ValueSome (struct (line, index - lineStart + 1))
+            index <- index + 1
+        | '}'
+        | ']'
+        | ')' ->
+            if depth > 0 then
+                depth <- depth - 1
+            index <- index + 1
+        | '\r' ->
+            if index + 1 < length && query[index + 1] = '\n' then
+                index <- index + 1
+            index <- index + 1
+            line <- line + 1
+            lineStart <- index
+        | '\n' ->
+            index <- index + 1
+            line <- line + 1
+            lineStart <- index
+        | _ -> index <- index + 1
+    violation
+
+/// Formats the nesting violation the way FParsec formats a syntax error
+let private nestingErrorMessage (struct (line : int, column : int)) =
+    $"Error in Ln: %i{line} Col: %i{column}\nThe document is nested deeper than %i{DocumentLimitsDefaults.MaxNestingDepth} braces, brackets and parentheses."
+
+/// <summary>Parses a GraphQL Document. Throws exception on invalid formats.</summary>
+/// <exception cref="T:System.FormatException">The document is not valid GraphQL or is nested too deeply.</exception>
 let parse query =
-    match run documents query with
-    | Success (result, _, _) -> result
-    | Failure (errorMsg, _, _) -> raise (System.FormatException (errorMsg))
-
-/// Parses a GraphQL Document. Throws exception on invalid formats.
+    match tryFindNestingViolation DocumentLimitsDefaults.MaxNestingDepth query with
+    | ValueSome position -> raise (FormatException (nestingErrorMessage position))
+    | ValueNone ->
+        match run documents query with
+        | Success (result, _, _) -> result
+        | Failure (errorMsg, _, _) -> raise (FormatException (errorMsg))
+
+/// Parses a GraphQL Document, returning the error message when the document is not valid GraphQL or is nested too deeply.
 let tryParse query =
-    match run documents query with
-    | Success (result, _, _) -> Result.Ok result
-    | Failure (errorMsg, _, _) -> Result.Error errorMsg
+    match tryFindNestingViolation DocumentLimitsDefaults.MaxNestingDepth query with
+    | ValueSome position -> Result.Error (nestingErrorMessage position)
+    | ValueNone ->
+        match run documents query with
+        | Success (result, _, _) -> Result.Ok result
+        | Failure (errorMsg, _, _) -> Result.Error errorMsg

tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj

@@ -105,6 +105,7 @@
     <Compile Include="AspNetCore/WebSocketConnectionTests.fs" />
     <Compile Include="TaskSeqFieldTests.fs" />
     <Compile Include="ValidationDoSTests.fs" />
+    <Compile Include="ParserLimitsTests.fs" />
     <Compile Include="AssemblyInfo.fs" />
   </ItemGroup>
 

tests/FSharp.Data.GraphQL.Tests/Helpers.fs

@@ -296,6 +296,26 @@ let waitForTask (timeout : TimeSpan) (message : string) (awaited : Task) : Task
         fail message
 }
 
+/// <summary>
+/// Runs the function on a thread with a 1 MiB stack, the smallest default thread stack among the supported platforms,
+/// and fails the test when the function does not complete within the timeout.
+/// </summary>
+/// <remarks>
+/// A stack overflow still terminates the test process, which fails the test run.
+/// </remarks>
+let runOnSmallStack (timeout : TimeSpan) (f : unit -> 'T) : 'T =
+    let completion = TaskCompletionSource<'T> (TaskCreationOptions.RunContinuationsAsynchronously)
+    let run () =
+        try
+            completion.SetResult (f ())
+        with ex ->
+            completion.SetException ex
+    let thread = Thread (ThreadStart run, 1024 * 1024, IsBackground = true)
+    thread.Start ()
+    if not (completion.Task.Wait timeout) then
+        fail $"The call did not complete within %O{timeout}."
+    completion.Task.Result
+
 open FSharp.Control
 
 /// Returns the value after the scaled delay