diff --git a/daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/AuthPropagationSpec.scala b/daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/AuthPropagationSpec.scala index ba712aad983f..71f8422daf39 100644 --- a/daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/AuthPropagationSpec.scala +++ b/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 diff --git a/daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/AuthorizationSpec.scala b/daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/AuthorizationSpec.scala index d0b389fde06a..f3d2fb96a937 100644 --- a/daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/AuthorizationSpec.scala +++ b/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 diff --git a/daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/BlindingSpec.scala b/daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/BlindingSpec.scala index b28a2426ce3f..6923f8b3344e 100644 --- a/daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/BlindingSpec.scala +++ b/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._ diff --git a/daml-lf/interpreter/src/test/scala/com/digitalasset/daml/lf/speedy/ExceptionTest.scala b/daml-lf/interpreter/src/test/scala/com/digitalasset/daml/lf/speedy/ExceptionTest.scala index f1756b47af5f..6f3a588124d6 100644 --- a/daml-lf/interpreter/src/test/scala/com/digitalasset/daml/lf/speedy/ExceptionTest.scala +++ b/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 { diff --git a/daml-lf/interpreter/src/test/scala/com/digitalasset/daml/lf/speedy/TailCallTest.scala b/daml-lf/interpreter/src/test/scala/com/digitalasset/daml/lf/speedy/TailCallTest.scala index d96224b6541c..4637923be354 100644 --- a/daml-lf/interpreter/src/test/scala/com/digitalasset/daml/lf/speedy/TailCallTest.scala +++ b/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 = diff --git a/security-evidence.md b/security-evidence.md new file mode 100644 index 000000000000..c70b97d15131 --- /dev/null +++ b/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) + + diff --git a/security/BUILD.bazel b/security/BUILD.bazel new file mode 100644 index 000000000000..b2c701e86f60 --- /dev/null +++ b/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"], +) diff --git a/security/EvidenceSecurity.hs b/security/EvidenceSecurity.hs new file mode 100644 index 000000000000..6341fd09f2d7 --- /dev/null +++ b/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 "" 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"