Generate security evidence by documenting security testcases (#11306)

* Generate security evidence by documenting security testcases.

CHANGELOG_BEGIN
CHANGELOG_END

* move generated file to root of repo, so links work

* formatError function instead of Show instance

* dont use Show instances for generating Markdown

* magic comment: SECURITY_TEST --> TEST_EVIDENCE

* use megaparsec and Data.Text

* remove redundant T.pack

* use: Text.Megaparsec.Char.space

daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/AuthPropagationSpec.scala

@@ -36,6 +36,7 @@ import org.scalatest.matchers.should.Matchers
 
 import scala.language.implicitConversions
 
+// TEST_EVIDENCE: Authorization: Engine level tests for _authorization_ check.
 class AuthPropagationSpec extends AnyFreeSpec with Matchers with Inside with BazelRunfiles {
 
   implicit private def toName(s: String): Name = Name.assertFromString(s)
@@ -313,6 +314,8 @@ class AuthPropagationSpec extends AnyFreeSpec with Matchers with Inside with Baz
     }
   }
 
+  // TEST_EVIDENCE: Authorization: Exercise within exercise: No implicit authorization from outer exercise.
+
   "Exercise (within exercise)" - {
 
     // Test that an inner exercise has only the authorization of the signatories and

daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/AuthorizationSpec.scala

@@ -17,6 +17,7 @@ import org.scalatest.matchers.should.Matchers
 
 import org.scalatest.Inside
 
+// TEST_EVIDENCE: Authorization: Unit test _authorization_ computations in: `CheckAuthorization`.
 class AuthorizationSpec extends AnyFreeSpec with Matchers with Inside {
 
   // Test the various forms of FailedAuthorization which can be returned from CheckAuthorization

daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/BlindingSpec.scala

@@ -11,6 +11,7 @@ import com.daml.lf.value.Value.ValueRecord
 import org.scalatest.matchers.should.Matchers
 import org.scalatest.freespec.AnyFreeSpec
 
+// TEST_EVIDENCE: Privacy: Unit test _blinding_ computation: `Blinding.blind`.
 class BlindingSpec extends AnyFreeSpec with Matchers {
 
   import TransactionBuilder.Implicits._

daml-lf/interpreter/src/test/scala/com/digitalasset/daml/lf/speedy/ExceptionTest.scala

@@ -21,6 +21,7 @@ import org.scalatest.prop.TableDrivenPropertyChecks
 import org.scalatest.matchers.should.Matchers
 import org.scalatest.wordspec.AnyWordSpec
 
+// TEST_EVIDENCE: Semantics: Exceptions, throw/catch.
 class ExceptionTest extends AnyWordSpec with Matchers with TableDrivenPropertyChecks {
 
   "unhandled throw" should {

daml-lf/interpreter/src/test/scala/com/digitalasset/daml/lf/speedy/TailCallTest.scala

@@ -15,6 +15,7 @@ import org.scalatest.prop.TableDrivenPropertyChecks
 import org.scalatest.matchers.should.Matchers
 import org.scalatest.wordspec.AnyWordSpec
 
+// TEST_EVIDENCE: Performance: Tail call optimization: Tail recursion does not blow the scala JVM stack.
 class TailCallTest extends AnyWordSpec with Matchers with TableDrivenPropertyChecks {
 
   val pkg =

security-evidence.md

@@ -0,0 +1,17 @@
+# Security tests, by category
+
+## Authorization:
+- Engine level tests for _authorization_ check.: [AuthPropagationSpec.scala](daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/AuthPropagationSpec.scala#L39)
+- Exercise within exercise: No implicit authorization from outer exercise.: [AuthPropagationSpec.scala](daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/AuthPropagationSpec.scala#L317)
+- Unit test _authorization_ computations in: `CheckAuthorization`.: [AuthorizationSpec.scala](daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/AuthorizationSpec.scala#L20)
+
+## Privacy:
+- Unit test _blinding_ computation: `Blinding.blind`.: [BlindingSpec.scala](daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/BlindingSpec.scala#L14)
+
+## Semantics:
+- Exceptions, throw/catch.: [ExceptionTest.scala](daml-lf/interpreter/src/test/scala/com/digitalasset/daml/lf/speedy/ExceptionTest.scala#L24)
+
+## Performance:
+- Tail call optimization: Tail recursion does not blow the scala JVM stack.: [TailCallTest.scala](daml-lf/interpreter/src/test/scala/com/digitalasset/daml/lf/speedy/TailCallTest.scala#L18)
+
+

security/BUILD.bazel

@@ -0,0 +1,21 @@
+# Copyright (c) 2021 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
+# SPDX-License-Identifier: Apache-2.0
+
+load("//bazel_tools:haskell.bzl", "da_haskell_binary")
+
+da_haskell_binary(
+    name = "evidence-security",
+    srcs = glob(["EvidenceSecurity.hs"]),
+    hackage_deps = [
+        "base",
+        "containers",
+        "extra",
+        "filepath",
+        "megaparsec",
+        "split",
+        "system-filepath",
+        "text",
+    ],
+    src_strip_prefix = "src",
+    visibility = ["//visibility:public"],
+)

security/EvidenceSecurity.hs

@@ -0,0 +1,146 @@
+-- Copyright (c) 2021 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
+-- SPDX-License-Identifier: Apache-2.0
+
+module Main (main) where
+
+import Control.Monad (when,void)
+import Data.List ((\\),sortOn)
+import Data.List.Extra (groupOn,foldl')
+import Data.Map (Map)
+import Data.Text (Text)
+import Data.Void (Void)
+import System.Exit (exitWith,ExitCode(ExitFailure))
+import System.FilePath (splitPath)
+import System.IO.Extra (hPutStrLn,stderr)
+import Text.Megaparsec (Parsec,runParser,errorBundlePretty,eof,takeWhileP,single,label,satisfy,noneOf,chunk,(<|>),some)
+import qualified Text.Megaparsec.Char (space)
+import qualified Data.Char as Char (isDigit,digitToInt)
+import qualified Data.Map as Map (fromList,toList)
+import qualified Data.Text as T (pack,unpack)
+import qualified Data.Text.IO as T (getContents)
+
+{-
+Generate _security evidence_ by documenting _security_ test cases.
+
+Security tests may be found anywhere in the Daml repository, and written in any language
+(scala, haskell, shell, etc). They are marked by the *magic comment*: "TEST_EVIDENCE"
+followed by a ":".
+
+Following the marker, the remaining text on the line is split on the next ":" to give:
+        Category : Free text description of the test case.
+
+There are a fixed set of categories, listed in the enum below. There expect at least one
+testcase for every category.
+
+The generated evidence is a markdown file, listing each testcase, grouped by Category. For
+each testcase we note the free-text with a link to the line in the original file.
+
+This program is expected to be run with stdin generated by a git grep command, and stdout
+redirected to the name of the generated file:
+
+```
+git grep --line-number TEST_EVIDENCE\: | bazel run security:evidence-security > security-evidence.md
+```
+-}
+
+main :: IO ()
+main = do
+  text <- T.getContents
+  lines <- parseLines text
+  let missingCats = [minBound..maxBound] \\ [ cat | Line{cat} <- lines ]
+  when (not $ null missingCats) $ do
+    messageAndExitFail ("No tests for categories: " ++ show missingCats)
+  putStrLn (ppCollated (collateLines lines))
+
+type Parser = Parsec Void Text
+
+parseLines :: Text -> IO [Line]
+parseLines text = do
+  case runParser theParser "<stdin>" text of
+    Right xs -> pure xs
+    Left e -> messageAndExitFail $ errorBundlePretty e
+
+messageAndExitFail :: String -> IO a
+messageAndExitFail message = do
+  hPutStrLn stderr "** EvidenceSecurity: generation failed:"
+  hPutStrLn stderr message
+  exitWith $ ExitFailure 1
+
+theParser :: Parser [Line]
+theParser = some line <* eof
+  where
+    line = do
+      filename <- some notColonOrNewline
+      colon
+      lineno <- number
+      colon
+      marker
+      colon
+      optWhiteSpace
+      cat <- parseCategory
+      colon
+      optWhiteSpace
+      freeText <- takeWhileP (Just "freetext") (/= '\n')
+      void $ single '\n'
+      pure Line {cat, desc = Description{filename,lineno,freeText}}
+
+    number = foldl' (\acc d -> 10*acc+d) 0 <$> some digit
+    digit = label "digit" $ Char.digitToInt <$> satisfy Char.isDigit
+
+    marker =
+      (void $ chunk "TEST_EVIDENCE")
+      <|> do void notColonOrNewline; marker
+
+    optWhiteSpace = Text.Megaparsec.Char.space
+
+    parseCategory = do
+      foldl1 (<|>)
+        [ do void $ chunk $ T.pack $ ppCategory cat; pure cat
+        | cat <- [minBound..maxBound]
+        ]
+
+    colon = void $ single ':'
+
+    notColonOrNewline = noneOf [':','\n']
+
+
+data Category = Authorization | Privacy | Semantics | Performance
+  deriving (Eq,Ord,Bounded,Enum,Show)
+
+data Description = Description
+  { filename:: FilePath
+  , lineno:: Int
+  , freeText:: Text
+  }
+
+data Line = Line { cat :: Category, desc :: Description }
+
+newtype Collated = Collated (Map Category [Description])
+
+collateLines :: [Line] -> Collated
+collateLines lines =
+  Collated $ Map.fromList
+  [ (cat, [ desc | Line{desc} <- group ])
+  | group@(Line{cat}:_) <- groupOn (\Line{cat} -> cat) lines
+  ]
+
+ppCollated :: Collated -> String
+ppCollated (Collated m) =
+  unlines (["# Security tests, by category",""] ++
+           [ unlines (("## " ++ ppCategory cat ++ ":") : map ppDescription (sortOn freeText descs))
+           | (cat,descs) <- sortOn fst (Map.toList m)
+           ])
+
+ppDescription :: Description -> String
+ppDescription Description{filename,lineno,freeText} =
+  "- " ++ T.unpack freeText ++  ": [" ++ basename filename ++ "](" ++ filename ++ "#L" ++ show lineno ++ ")"
+  where
+    basename :: FilePath -> FilePath
+    basename p = case reverse (splitPath p) of [] -> ""; x:_ -> x
+
+ppCategory :: Category -> String
+ppCategory = \case
+  Authorization -> "Authorization"
+  Privacy -> "Privacy"
+  Semantics -> "Semantics"
+  Performance -> "Performance"