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..80ebe4a625cb 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 +// SECURITY_TEST: 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 } } + // SECURITY_TEST: 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..6b8f93df5367 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 +// SECURITY_TEST: 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..aab078dc6414 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 +// SECURITY_TEST: Privacy: Unit test _blinding_ computation: `Blinding.blind`. class BlindingSpec extends AnyFreeSpec with Matchers { import TransactionBuilder.Implicits._ diff --git a/security/BUILD.bazel b/security/BUILD.bazel new file mode 100644 index 000000000000..08bd89cdd9c4 --- /dev/null +++ b/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(["src/**/*.hs"]), + hackage_deps = [ + "base", + "containers", + "extra", + "filepath", + "split", + ], + src_strip_prefix = "src", + visibility = ["//visibility:public"], + deps = [], +) diff --git a/security/src/EvidenceSecurity.hs b/security/src/EvidenceSecurity.hs new file mode 100644 index 000000000000..77e1ea451bcb --- /dev/null +++ b/security/src/EvidenceSecurity.hs @@ -0,0 +1,98 @@ +-- 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 Data.List (intercalate) +import Data.List.Extra (trim,groupOn) +import Data.Map (Map) +import qualified Data.Map as Map (fromList,toList) +import Data.List.Split (splitOn) + +main :: IO () +main = do + print ("**Evidence Security**"::String) + rawLines <- getRawGitGrepOutput + let parsed = map parseLine rawLines + let errs = [ err | Left err <- parsed ] + let lines = [ line | Right line <- parsed ] + let collated = collateLines lines + print errs + print collated + -- NICK: check all catagories are covered + pure () + +-- NICK: document what is going on here, and the magic comment format + +newtype Collated = Collated (Map Catagory [Description]) + +data Err = FailedToParseLine | UnknownCatagory String deriving Show + +data Line = Line { cat :: Catagory, desc :: Description } + +data Description = Description + { filename:: FilePath + , lineno:: Int + , freeText:: String + } + +data Catagory = Authorization | Privacy | Semantics | Performance + deriving (Eq,Ord) + +-- NICK: read from file on stdin (or maybe directly produce the raw data) +getRawGitGrepOutput :: IO [String] +getRawGitGrepOutput = pure + [ "daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/AuthPropagationSpec.scala:// SECURITY_TEST: Authorization: Engine level tests for _authorization_ check." + , "daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/AuthPropagationSpec.scala: // SECURITY_TEST: Authorization: Exercise within exercise: No implicit authorization from outer exercise." + + , "daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/AuthorizationSpec.scala:// SECURITY_TEST: Authorization: Unit test _authorization_ computations in: `CheckAuthorization`." + , "daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/BlindingSpec.scala:// SECURITY_TEST: Privacy: Unit test _blinding_ computation: `Blinding.blind`." + ] + +parseLine :: String -> Either Err Line +parseLine string = do + let sep = ":" + case splitOn sep string of + filename : _magicComment_ : tag : rest -> do + case catagoryFromTag (trim tag) of + Nothing -> Left (UnknownCatagory (trim tag)) + Just cat -> do + let lineno = 42 -- NICK: need in raw data + let freeText = trim (intercalate sep rest) + let desc = Description {filename,lineno,freeText} + let line = Line {cat,desc} + Right line + _ -> + Left FailedToParseLine + +collateLines :: [Line] -> Collated +collateLines lines = + Collated $ Map.fromList + [ (cat, [ desc | Line{desc} <- group ]) + | group@(Line{cat}:_) <- groupOn (\Line{cat} -> cat) lines + ] + +catagoryFromTag :: String -> Maybe Catagory +catagoryFromTag = \case + "Authorization" -> Just Authorization + "Privacy" -> Just Privacy + "Semantics" -> Just Semantics + "Performance" -> Just Performance + _ -> Nothing + +instance Show Collated where + show (Collated m) = + unlines [ unlines ((show cat ++ ":") : map show descs) + | (cat,descs) <- Map.toList m + ] + +instance Show Description where + show Description{filename,lineno,freeText} = + "- " ++ freeText ++ " (" ++ filename ++ ":" ++ show lineno ++ ")" + +instance Show Catagory where + show = \case + Authorization -> "Authorization" + Privacy -> "Privacy" + Semantics -> "Semantics" + Performance -> "Performance"