Add analyzer detecting double-wrapped Results.

Directory.Packages.props

@@ -15,5 +15,6 @@
     <PackageVersion Include="xunit.runner.visualstudio" Version="[2.8.2]" />
     <PackageVersion Include="Microsoft.NET.Test.Sdk" Version="[17.13.0]" />
     <PackageVersion Include="Argu" Version="[6.2.5]" />
+    <PackageVersion Include="FsToolkit.ErrorHandling" Version="[5.1.0]" />
   </ItemGroup>
 </Project>

README.md

@@ -87,4 +87,17 @@ This analyzer detects use of the constructors and `Create` methods of the `Rando
 | Code                | `IDURA-CRYPTO-002`                                                                                                          |
 | Message             | Do not use your own instance of RandomNumberGenerator. Depend on a global RNG pool to ensure stability of the generator.    |
 | Severity            | Warning                                                                                                                     |
+| Works in            | CLI, Ionide                                                                                                                 |
+
+### Did you mean to wrap this value in Result twice?
+Wrapping a value in the `Result` monad twice is often caused by accidentally ignoring a `Result.Error`.
+This can be catastrophic when doing validation of security-related properties.
+
+Intentionally wrapping a value twice is very rare, but can sometimes occur, so this is only a warning.
+
+| About this analyzer |                                                                                                                             |
+|---------------------|-----------------------------------------------------------------------------------------------------------------------------|
+| Code                | `IDURA-RESULT-006`                                                                                                          |
+| Message             | Double-wrapping values in Result is often caused by accidentally ignoring an error.                                         |
+| Severity            | Warning                                                                                                                     |
 | Works in            | CLI, Ionide                                                                                                                 |

src/FSharp.Analyzers/DoubleWrappedResultAnalyzer.fs

@@ -0,0 +1,99 @@
+module Idura.FSharp.Analyzers.DoubleWrappedResultAnalyzer
+
+open FSharp.Analyzers.SDK
+open FSharp.Analyzers.SDK.TASTCollecting
+open FSharp.Compiler.Text
+open FSharp.Compiler.Syntax
+open FSharp.Compiler.CodeAnalysis
+open FSharp.Compiler.Symbols
+
+[<Literal>]
+let code = "IDURA-RESULT-006"
+
+[<Literal>]
+let name = "Did you mean to wrap this value in Result twice?"
+
+[<Literal>]
+let msg = "Double-wrapping values in Result is often caused by accidentally ignoring an error"
+
+let private analyzer
+    (sourceText: ISourceText)
+    (_: ParsedInput)
+    (typedResults: FSharp.Compiler.Symbols.FSharpImplementationFileContents) : Async<Message list> = async {
+    let allDoubleWrappedResultBindings =
+        let allBindingsWithDoubleResult = ResizeArray<string * range>()
+
+        let (|LongIdentAsString|) (lid: SynLongIdent) =
+            lid.LongIdent |> List.map (fun ident -> ident.idText)
+
+        // If the type is a function, this recurses until it finds the "final" return type of the function
+        let rec getReturnType (t: FSharpType) =
+            if t.IsFunctionType then
+                let rangeType = t.GenericArguments[1]
+                getReturnType rangeType
+            else
+                t
+
+        let RESULT_TYPE_NAME = typedefof<Result<unit,unit>>.FullName
+
+        // FUTURE: In version 10.0.300 of FSharp.Compiler.Services, the BasicQualifiedName becomes an option
+        // which should allow us to remove the "try ... with" from this function
+        let isDoubleResult (t: FSharpType) =
+            let returnType = getReturnType t
+            try
+                if returnType.BasicQualifiedName = RESULT_TYPE_NAME then
+                    let okType = returnType.GenericArguments[0]
+                    okType.BasicQualifiedName = RESULT_TYPE_NAME
+                else
+                    false
+            with
+                | :? System.InvalidOperationException ->
+                    // This happens if the type does not have a name, e.g. if it is a tuple, type parameter, anonymous record, etc.
+                    false
+
+        let walker: TypedTreeCollectorBase = {
+            new TypedTreeCollectorBase() with
+                override _.WalkLet (var: FSharpMemberOrFunctionOrValue) expr body =
+                    match var.FullTypeSafe with
+                    | None -> ()
+                    | Some t ->
+                        if isDoubleResult t then
+                            allBindingsWithDoubleResult.Add(var.DisplayName, var.DeclarationLocation)
+                override _.WalkMemberOrFunctionOrValue (mfv: FSharpMemberOrFunctionOrValue) _ _ =
+                    match mfv.FullTypeSafe with
+                    | None -> ()
+                    | Some t ->
+                        if isDoubleResult t then
+                            allBindingsWithDoubleResult.Add(mfv.DisplayName, mfv.DeclarationLocation)
+
+        }
+
+        walkTast walker typedResults
+        allBindingsWithDoubleResult |> Seq.toList
+
+    return
+        List.map (fun (ident: string, range) ->
+            {
+                Type = name
+                Message = $"""%s{msg}: %s{ident}"""
+                Code = code
+                Severity = Severity.Warning
+                Range = range
+                Fixes = []
+            }
+        ) allDoubleWrappedResultBindings
+}
+
+[<CliAnalyzer(name)>]
+let cliAnalyzer (ctx: CliContext) : Async<Message list> =
+    match ctx.TypedTree with
+    | None -> async.Return []
+    | Some tast ->
+        analyzer ctx.SourceText ctx.ParseFileResults.ParseTree tast
+
+[<EditorAnalyzer(name)>]
+let editorAnalyzer (ctx: EditorContext) : Async<Message list> =
+    match ctx.TypedTree with
+    | None -> async.Return []
+    | Some tast ->
+        analyzer ctx.SourceText ctx.ParseFileResults.ParseTree tast

src/FSharp.Analyzers/FSharp.Analyzers.fsproj

@@ -29,12 +29,13 @@
     <PackageReference Include="FSharp.Analyzers.SDK" />
   </ItemGroup>
   <ItemGroup>
-    <None Include="$(SolutionDir)/README.md" Visible="false" Pack="true" PackagePath=""/>
+    <None Include="$(SolutionDir)/README.md" Visible="false" Pack="true" PackagePath="" />
   </ItemGroup>
   <ItemGroup>
     <Compile Include="MissingUnitArgumentFactAnalyzer.fs" />
     <Compile Include="MissingTypeAnnotationInlineDataAnalyzer.fs" />
     <Compile Include="DoNotUseYourOwnRandomAnalyzer.fs" />
+    <Compile Include="DoubleWrappedResultAnalyzer.fs" />
   </ItemGroup>
   <Target Name="_AddAnalyzersToOutput">
     <ItemGroup>

tests/FSharp.Analyzers.Tests/DoubleWrappedResultAnalyzerTests.fs

@@ -0,0 +1,44 @@
+module Idura.FSharp.Analyzers.Tests.DoubleWrappedResultAnalyzer
+
+open FSharp.Analyzers.SDK.Testing
+open TestHelpers
+
+open Xunit
+open Snapshooter
+open Snapshooter.Xunit
+
+open Idura.FSharp.Analyzers.DoubleWrappedResultAnalyzer
+
+let setupContext () = async {
+  let! opts =
+          mkOptionsFromProject
+              "net9.0"
+              [
+                {
+                  Name = "FsToolkit.Errorhandling"
+                  Version = "5.1.0"
+                }
+              ]
+          |> Async.AwaitTask
+  return opts
+}
+
+[<Theory>]
+[<MemberData(nameof(TestFiles.GetSources), parameters=[|"doubleWrappedResult/positive"|], MemberType=typeof<TestFiles>)>]
+let ``positive``(program : string, filename: string) =
+  let snapshotName = Snapshot.FullName(SnapshotNameExtension.Create filename)
+  runPositiveTest snapshotName setupContext cliAnalyzer program
+
+[<Theory>]
+[<MemberData(nameof(TestFiles.GetSources), parameters=[|"doubleWrappedResult/negative"|], MemberType=typeof<TestFiles>)>]
+let ``negative``(program : string, _: string) =
+  runNegativeTest setupContext cliAnalyzer program
+
+[<Fact>]
+let ``gives three warnings for TripleResult``() = async {
+  let! opts = setupContext()
+  let program = TestFiles.GetSource "doubleWrappedResult/positive/TripleResult.fs"
+  let ctx = getContext opts program
+  let! msgs = cliAnalyzer ctx
+  Assert.True(msgs.Length = 3)
+}

tests/FSharp.Analyzers.Tests/FSharp.Analyzers.Tests.fsproj

@@ -12,6 +12,7 @@
     <Compile Include="MissingUnitArgumentFactAnalyzerTests.fs" />
     <Compile Include="MissingTypeAnnotationInlineDataAnalyzerTests.fs" />
     <Compile Include="DoNotUseYourOwnRandomAnalyzerTests.fs" />
+    <Compile Include="DoubleWrappedResultAnalyzerTests.fs" />
   </ItemGroup>
 
   <ItemGroup>

tests/FSharp.Analyzers.Tests/__snapshots__/DoubleWrappedResultAnalyzer.positive_Basic.fs.snap

@@ -0,0 +1 @@
+[{"Code":"IDURA-RESULT-006","Fixes":[],"Message":"Double-wrapping values in Result is often caused by accidentally ignoring an error: main","Range":{"End":{"Line":15,"Column":8},"EndColumn":8,"EndLine":15,"FileName":"A.fs","Start":{"Line":15,"Column":4},"StartColumn":4,"StartLine":15},"Severity":{"Case":"Warning"},"Type":"Did you mean to wrap this value in Result twice?"}]

tests/FSharp.Analyzers.Tests/__snapshots__/DoubleWrappedResultAnalyzer.positive_LetBindingInFunction.fs.snap

@@ -0,0 +1 @@
+[{"Code":"IDURA-RESULT-006","Fixes":[],"Message":"Double-wrapping values in Result is often caused by accidentally ignoring an error: validate2","Range":{"End":{"Line":20,"Column":17},"EndColumn":17,"EndLine":20,"FileName":"A.fs","Start":{"Line":20,"Column":8},"StartColumn":8,"StartLine":20},"Severity":{"Case":"Warning"},"Type":"Did you mean to wrap this value in Result twice?"}]

tests/FSharp.Analyzers.Tests/__snapshots__/DoubleWrappedResultAnalyzer.positive_TripleResult.fs.snap

@@ -0,0 +1 @@
+[{"Code":"IDURA-RESULT-006","Fixes":[],"Message":"Double-wrapping values in Result is often caused by accidentally ignoring an error: validate2","Range":{"End":{"Line":15,"Column":13},"EndColumn":13,"EndLine":15,"FileName":"A.fs","Start":{"Line":15,"Column":4},"StartColumn":4,"StartLine":15},"Severity":{"Case":"Warning"},"Type":"Did you mean to wrap this value in Result twice?"},{"Code":"IDURA-RESULT-006","Fixes":[],"Message":"Double-wrapping values in Result is often caused by accidentally ignoring an error: main","Range":{"End":{"Line":19,"Column":8},"EndColumn":8,"EndLine":19,"FileName":"A.fs","Start":{"Line":19,"Column":4},"StartColumn":4,"StartLine":19},"Severity":{"Case":"Warning"},"Type":"Did you mean to wrap this value in Result twice?"},{"Code":"IDURA-RESULT-006","Fixes":[],"Message":"Double-wrapping values in Result is often caused by accidentally ignoring an error: c","Range":{"End":{"Line":22,"Column":9},"EndColumn":9,"EndLine":22,"FileName":"A.fs","Start":{"Line":22,"Column":8},"StartColumn":8,"StartLine":22},"Severity":{"Case":"Warning"},"Type":"Did you mean to wrap this value in Result twice?"}]

tests/FSharp.Analyzers.Tests/__snapshots__/DoubleWrappedResultAnalyzer.positive_WithoutTypeAnnotation.fs.snap

@@ -0,0 +1 @@
+[{"Code":"IDURA-RESULT-006","Fixes":[],"Message":"Double-wrapping values in Result is often caused by accidentally ignoring an error: main","Range":{"End":{"Line":15,"Column":8},"EndColumn":8,"EndLine":15,"FileName":"A.fs","Start":{"Line":15,"Column":4},"StartColumn":4,"StartLine":15},"Severity":{"Case":"Warning"},"Type":"Did you mean to wrap this value in Result twice?"}]

tests/FSharp.Analyzers.Tests/data/doubleWrappedResult/negative/DoesNotCrashOnArrayTypes.fs

@@ -0,0 +1,7 @@
+module M
+
+let main (input : string array) : string =
+  if input.Length > 0 then
+    input[0]
+  else
+    "none"

tests/FSharp.Analyzers.Tests/data/doubleWrappedResult/negative/DoesNotCrashOnTuples.fs

@@ -0,0 +1,4 @@
+module M
+
+let main : (string * string) =
+  "abc", "def"

tests/FSharp.Analyzers.Tests/data/doubleWrappedResult/negative/DoesNotCrashOnTypeParameters.fs

@@ -0,0 +1,4 @@
+module M
+
+let main (input : 'a) : 'a =
+  input

tests/FSharp.Analyzers.Tests/data/doubleWrappedResult/negative/IgnoreSingleResult.fs

@@ -0,0 +1,19 @@
+module M
+
+open FsToolkit.ErrorHandling
+
+let validateSubfunction (input : string) =
+    if (input <> "abc") then
+        Result.Error "Error"
+    else
+        Result.Ok input
+
+let validate (input : string) = result {
+    return! validateSubfunction input
+}
+
+let main : Result<string, string> = result {
+    let a = "def"
+    let! b = validate a
+    return b
+}

tests/FSharp.Analyzers.Tests/data/doubleWrappedResult/negative/IgnoreSingleResultWithoutTypeAnnotation.fs

@@ -0,0 +1,22 @@
+module M
+
+open FsToolkit.ErrorHandling
+
+let validateSubfunction (input : string) =
+    if (input <> "abc") then
+        Result.Error "Error"
+    else
+        Result.Ok input
+
+let validate (input : string) = result {
+    return! validateSubfunction input
+}
+
+let main = result {
+    let a = "def"
+    let! b = validate a
+    if true then
+        return b
+    else
+        return! Result.Error "check it out"
+}

tests/FSharp.Analyzers.Tests/data/doubleWrappedResult/positive/Basic.fs

@@ -0,0 +1,19 @@
+module M
+
+open FsToolkit.ErrorHandling
+
+let validateSubfunction (input : string) =
+    if (input <> "abc") then
+        Result.Error "Error"
+    else
+        Result.Ok input
+
+let validate (input : string) = result {
+    return! validateSubfunction input
+}
+
+let main : Result<Result<string, string>, string> = result {
+    let a = "def"
+    let b = validate a
+    return b
+}

tests/FSharp.Analyzers.Tests/data/doubleWrappedResult/positive/LetBindingInFunction.fs

@@ -0,0 +1,25 @@
+module M
+
+open FsToolkit.ErrorHandling
+
+let validateSubfunction (input : string) =
+    if (input <> "abc") then
+        Result.Error "Error"
+    else
+        Result.Ok input
+
+let validate (input : string) = result {
+    return! validateSubfunction input
+}
+
+let main : Result<string, string> = result {
+    let a = "def"
+    let b = validate a
+
+    // This should give a warning
+    let validate2 input = result {
+        return Result.bind validate input
+    }
+
+    return! b
+}

tests/FSharp.Analyzers.Tests/data/doubleWrappedResult/positive/TripleResult.fs

@@ -0,0 +1,24 @@
+module M
+
+open FsToolkit.ErrorHandling
+
+let validateSubfunction (input : string) =
+    if (input <> "abc") then
+        Result.Error "Error"
+    else
+        Result.Ok input
+
+let validate (input : string) = result {
+    return! validateSubfunction input
+}
+
+let validate2 input = result {
+    return Result.bind validate input
+}
+
+let main : Result<Result<Result<string, string>, string>, string> = result {
+    let a = "def"
+    let b = validate a
+    let c = validate2 b
+    return c
+}

tests/FSharp.Analyzers.Tests/data/doubleWrappedResult/positive/WithoutTypeAnnotation.fs

@@ -0,0 +1,22 @@
+module M
+
+open FsToolkit.ErrorHandling
+
+let validateSubfunction (input : string) =
+    if (input <> "abc") then
+        Result.Error "Error"
+    else
+        Result.Ok input
+
+let validate (input : string) = result {
+    return! validateSubfunction input
+}
+
+let main = result {
+    let a = "def"
+    let b = validate a
+    if true then
+        return b
+    else
+        return! Result.Error "check it out"
+}