Generate security evidence by documenting security testcases

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,19 @@
+# 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",
+        "split",
+        "system-filepath",
+    ],
+    src_strip_prefix = "src",
+    visibility = ["//visibility:public"],
+)

security/EvidenceSecurity.hs

@@ -0,0 +1,133 @@
+-- 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)
+import Data.List (intercalate, (\\), sortOn)
+import Data.List.Extra (trim,groupOn)
+import Data.List.Split (splitOn)
+import Data.Map (Map)
+import System.Exit (exitWith,ExitCode(ExitSuccess,ExitFailure))
+import System.FilePath (splitPath)
+import System.IO.Extra (hPutStrLn,stderr)
+import Text.Read (readMaybe)
+import qualified Data.Map as Map (fromList,toList)
+
+{-
+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
+  rawLines <- lines <$> getContents
+  let parsed = map parseLine rawLines
+  let lines = [ line | Right line <- parsed ]
+  let cats = [ cat | Line{cat} <- lines ]
+  let missingCats = [minBound ..maxBound] \\ cats
+  let errs = [ err | Left err <- parsed ] ++ map NoTestsForCategory missingCats
+  let n_errs = length errs
+  when (n_errs >= 1) $ do
+    hPutStrLn stderr "** Errors while Evidencing Security; exiting with non-zero exit code."
+    sequence_ [hPutStrLn stderr $ "** (" ++ show i ++ ") " ++ formatError err | (i,err) <- zip [1::Int ..] errs]
+  putStrLn (ppCollated (collateLines lines))
+  exitWith (if n_errs == 0 then ExitSuccess else ExitFailure n_errs)
+
+data Category = Authorization | Privacy | Semantics | Performance
+  deriving (Eq,Ord,Bounded,Enum,Show)
+
+data Description = Description
+  { filename:: FilePath
+  , lineno:: Int
+  , freeText:: String
+  }
+
+data Line = Line { cat :: Category, desc :: Description }
+
+newtype Collated = Collated (Map Category [Description])
+
+data Err
+  = FailedToSplitLineOn4colons String
+  | FailedToParseLinenumFrom String String
+  | UnknownCategoryInLine String String
+  | NoTestsForCategory Category
+
+parseLine :: String -> Either Err Line
+parseLine lineStr = do
+  let sep = ":"
+  case splitOn sep lineStr of
+    filename : linenoString : _magicComment_ : tag : rest@(_:_) -> do
+      case categoryFromTag (trim tag) of
+        Nothing -> Left (UnknownCategoryInLine (trim tag) lineStr)
+        Just cat -> do
+          case readMaybe @Int linenoString of
+            Nothing -> Left (FailedToParseLinenumFrom linenoString lineStr)
+            Just lineno -> do
+              let freeText = trim (intercalate sep rest)
+              let desc = Description {filename,lineno,freeText}
+              Right (Line {cat,desc})
+    _ ->
+      Left (FailedToSplitLineOn4colons lineStr)
+
+categoryFromTag :: String -> Maybe Category
+categoryFromTag = \case
+  "Authorization" -> Just Authorization
+  "Privacy" -> Just Privacy
+  "Semantics" -> Just Semantics
+  "Performance" -> Just Performance
+  _ -> Nothing
+
+collateLines :: [Line] -> Collated
+collateLines lines =
+  Collated $ Map.fromList
+  [ (cat, [ desc | Line{desc} <- group ])
+  | group@(Line{cat}:_) <- groupOn (\Line{cat} -> cat) lines
+  ]
+
+formatError :: Err -> String
+formatError = \case
+  FailedToSplitLineOn4colons line -> "failed to parse line (expected 4 colons): " ++ line
+  FailedToParseLinenumFrom s line -> "failed to parse line-number from '" ++ show s ++ "' in line: " ++ line
+  UnknownCategoryInLine s line -> "unknown category '" ++ s ++ "' in line: " ++ line
+  NoTestsForCategory cat -> "no tests found for category: " ++ show cat
+
+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} =
+  "- " ++ 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"