Report divulgence warning at commit location. (#10329)

* Pass commitLocation along in engine warning log. changelog_begin changelog_end * Use commitLocation in diagnostics. * scalafmt * update divulgence test * Fix commitLocation and expected diagnostic locations
digital-asset · Jul 20, 2021 · b701caa · b701caa
1 parent 742bdcb
commit b701caa
Show file tree

Hide file tree

Showing 13 changed files with 85 additions and 39 deletions.
diff --git a/compiler/damlc/daml-ide-core/src/Development/IDE/Core/Rules/Daml.hs b/compiler/damlc/daml-ide-core/src/Development/IDE/Core/Rules/Daml.hs
@@ -821,9 +821,9 @@ runScenariosRule =
               let scenarioName = LF.qualObject scenario
               let mbLoc = NM.lookup scenarioName (LF.moduleValues m) >>= LF.dvalLocation
               let range = maybe noRange sourceLocToRange mbLoc
-              pure (toDiagnostic file world range res , (vr, res))
+              pure (toDiagnostics world file range res, (vr, res))
       let (diags, results) = unzip scenarioResults
-      pure (catMaybes diags, Just results)
+      pure (concat diags, Just results)
 
 runScriptsRule :: Options -> Rules ()
 runScriptsRule opts =
@@ -840,9 +840,9 @@ runScriptsRule opts =
               let scenarioName = LF.qualObject scenario
               let mbLoc = NM.lookup scenarioName (LF.moduleValues m) >>= LF.dvalLocation
               let range = maybe noRange sourceLocToRange mbLoc
-              pure (toDiagnostic file world range res, (vr, res))
+              pure (toDiagnostics world file range res, (vr, res))
       let (diags, results) = unzip scenarioResults
-      pure (catMaybes diags, Just results)
+      pure (concat diags, Just results)
 
 runScenariosScriptsPkg ::
        NormalizedFilePath
@@ -872,11 +872,11 @@ runScenariosScriptsPkg projRoot extPkg pkgs = do
                       ctxId
                       script
           pure $
-              [ (toDiagnostic pkgName' world noRange res, (vr, res))
+              [ (toDiagnostics world pkgName' noRange res, (vr, res))
               | (vr, res) <- scenarioResults ++ scriptResults
               ]
     let (diags, results) = unzip rs
-    pure (catMaybes diags, Just results)
+    pure (concat diags, Just results)
   where
     pkg = LF.extPackagePkg extPkg
     pkgId = LF.extPackageId extPkg
@@ -899,20 +899,23 @@ runScenariosScriptsPkg projRoot extPkg pkgs = do
             , LF.moduleName mod /= LF.ModuleName ["Daml", "Script"]
             ]
 
-toDiagnostic ::
-       NormalizedFilePath
-    -> LF.World
+toDiagnostics ::
+       LF.World
+    -> NormalizedFilePath
     -> Range
     -> Either SS.Error SS.ScenarioResult
-    -> Maybe FileDiagnostic
-toDiagnostic file world range = \case
-    Left err -> Just $ mkDiagnostic DsError $ formatScenarioError world err
-    Right SS.ScenarioResult{..}
-        | V.null scenarioResultWarnings -> Nothing
-        | otherwise -> Just $ mkDiagnostic DsWarning $
-            LF.prettyWarningMessages scenarioResultWarnings
+    -> [FileDiagnostic]
+toDiagnostics world scenarioFile scenarioRange = \case
+    Left err -> pure $ mkDiagnostic DsError (scenarioFile, scenarioRange) $
+        formatScenarioError world err
+    Right SS.ScenarioResult{..} ->
+        [ mkDiagnostic DsWarning fileRange (LF.prettyWarningMessage warning)
+        | warning <- V.toList scenarioResultWarnings
+        , let fileRange = fileRangeFromMaybeLocation $
+                SS.warningMessageCommitLocation warning
+        ]
   where
-    mkDiagnostic severity pretty = (file, ShowDiag, ) $ Diagnostic
+    mkDiagnostic severity (file, range) pretty = (file, ShowDiag, ) $ Diagnostic
         { _range = range
         , _severity = Just severity
         , _source = Just "Script"
@@ -922,6 +925,26 @@ toDiagnostic file world range = \case
         , _relatedInformation = Nothing
         }
 
+    fileRangeFromMaybeLocation :: Maybe SS.Location -> (NormalizedFilePath, Range)
+    fileRangeFromMaybeLocation mbLocation =
+        fromMaybe (scenarioFile, scenarioRange) $ do
+            location <- mbLocation
+            lfModule <- LF.lookupLocationModule world location
+            filePath <- LF.moduleSource lfModule
+            Just (toNormalizedFilePath' filePath, rangeFromLocation location)
+
+    rangeFromLocation :: SS.Location -> LSP.Range
+    rangeFromLocation SS.Location{..} = Range
+        { _start = LSP.Position
+            { _line = fromIntegral locationStartLine
+            , _character = fromIntegral locationStartCol
+            }
+        , _end = LSP.Position
+            { _line = fromIntegral locationEndLine
+            , _character = fromIntegral locationEndCol
+            }
+        }
+
 encodeModule :: LF.Version -> LF.Module -> Action (SS.Hash, BS.ByteString)
 encodeModule lfVersion m =
     case LF.moduleSource m of

diff --git a/compiler/damlc/tests/daml-test-files/DiscloseViaChoiceObserver.daml b/compiler/damlc/tests/daml-test-files/DiscloseViaChoiceObserver.daml
@@ -4,7 +4,7 @@
 module DiscloseViaChoiceObserver where
 
 -- @SINCE-LF 1.11
--- @WARN range=27:1-27:5; Use of divulged contracts is deprecated
+-- @WARN range=37:15-37:67; Use of divulged contracts is deprecated
 
 -- This example demonstrates the canonical use of choice-observers to achieve disclosure.
 

diff --git a/compiler/damlc/tests/daml-test-files/Divulgence.daml b/compiler/damlc/tests/daml-test-files/Divulgence.daml
@@ -44,7 +44,8 @@ template DisclosureDelegation
         do
           fetch secretCid -- actor will divulge secretCid to p
 
--- @WARN range=48:1-48:5; Use of divulged contracts is deprecated
+-- @WARN range=84:3-85:20; Use of divulged contracts is deprecated
+-- @WARN range=88:3-89:46; Use of divulged contracts is deprecated
 main = scenario do
   me <- getParty "Me"
   spy <- getParty "Spy"

diff --git a/compiler/damlc/tests/daml-test-files/ExceptionSemantics.daml b/compiler/damlc/tests/daml-test-files/ExceptionSemantics.daml
@@ -4,7 +4,7 @@
 -- @SINCE-LF-FEATURE DAML_EXCEPTIONS
 -- @ERROR range=131:1-131:23; Unhandled exception: ExceptionSemantics:E
 -- @ERROR range=146:1-146:25; Unhandled exception: DA.Exception.ArithmeticError:ArithmeticError@cb0552debf219cc909f51cbb5c3b41e9981d39f8f645b1f35e2ef5be2e0b858a with message = "ArithmeticError while evaluating (DIV_INT64 1 0)."
--- @WARN range=172:1-172:11; Use of divulged contracts is deprecated
+-- @WARN range=180:3-180:43; Use of divulged contracts is deprecated
 -- @ERROR range=183:1-183:11; Attempt to exercise a consumed contract
 module ExceptionSemantics where
 

diff --git a/compiler/damlc/tests/daml-test-files/MoreChoiceObserverDivulgence.daml b/compiler/damlc/tests/daml-test-files/MoreChoiceObserverDivulgence.daml
@@ -30,7 +30,7 @@ template Divulger with
         _ <- fetch id
         pure ()
 
--- @WARN range=35:1-35:5; Use of divulged contracts is deprecated
+-- @WARN range=47:15-47:67; Use of divulged contracts is deprecated
 test : Scenario ()
 test = scenario do
     alice <- getParty "Alice"

diff --git a/compiler/scenario-service/client/src/DA/Daml/LF/PrettyScenario.hs b/compiler/scenario-service/client/src/DA/Daml/LF/PrettyScenario.hs
@@ -7,10 +7,11 @@ module DA.Daml.LF.PrettyScenario
   ( prettyScenarioResult
   , prettyScenarioError
   , prettyBriefScenarioError
-  , prettyWarningMessages
+  , prettyWarningMessage
   , renderScenarioResult
   , renderScenarioError
   , lookupDefLocation
+  , lookupLocationModule
   , scenarioNotInFileNote
   , fileWScenarioNoLongerCompilesNote
   , ModuleRef
@@ -117,6 +118,11 @@ lookupModule world mbPkgId modName = do
        _ -> LF.PRSelf
   eitherToMaybe (LF.lookupModule (LF.Qualified pkgRef modName ()) world)
 
+lookupLocationModule :: LF.World -> Location -> Maybe LF.Module
+lookupLocationModule world Location{..} =
+    lookupModule world locationPackage $
+        unmangleModuleName (TL.toStrict locationModule)
+
 parseNodeId :: NodeId -> [Integer]
 parseNodeId =
     fmap (fromMaybe 0 . readMaybe . dropHash . TL.unpack)
@@ -125,11 +131,6 @@ parseNodeId =
   where
     dropHash s = fromMaybe s $ stripPrefix "#" s
 
-prettyWarningMessages
-  :: V.Vector WarningMessage -> Doc SyntaxClass
-prettyWarningMessages warnings
-  = vcat (map prettyWarningMessage (V.toList warnings))
-
 prettyScenarioResult
   :: LF.World -> ScenarioResult -> Doc SyntaxClass
 prettyScenarioResult world (ScenarioResult steps nodes retValue _finaltime traceLog warnings) =
@@ -142,7 +143,7 @@ prettyScenarioResult world (ScenarioResult steps nodes retValue _finaltime trace
         $ filter isActive (V.toList nodes)
 
       ppTrace = vcat $ map prettyTraceMessage (V.toList traceLog)
-      ppWarnings = prettyWarningMessages warnings
+      ppWarnings = vcat $ map prettyWarningMessage (V.toList warnings)
   in vsep
     [ label_ "Transactions: " ppSteps
     , label_ "Active contracts: " ppActive

diff --git a/compiler/scenario-service/client/src/DA/Daml/LF/ScenarioServiceClient.hs b/compiler/scenario-service/client/src/DA/Daml/LF/ScenarioServiceClient.hs
@@ -22,6 +22,8 @@ module DA.Daml.LF.ScenarioServiceClient
   , LowLevel.BackendError(..)
   , LowLevel.Error(..)
   , LowLevel.ScenarioResult(..)
+  , LowLevel.WarningMessage(..)
+  , LowLevel.Location(..)
   , Hash
   , encodeModule
   ) where

diff --git a/compiler/scenario-service/client/src/DA/Daml/LF/ScenarioServiceClient/LowLevel.hs b/compiler/scenario-service/client/src/DA/Daml/LF/ScenarioServiceClient/LowLevel.hs
@@ -22,6 +22,8 @@ module DA.Daml.LF.ScenarioServiceClient.LowLevel
   , runScenario
   , runScript
   , SS.ScenarioResult(..)
+  , SS.WarningMessage(..)
+  , SS.Location(..)
   , encodeScenarioModule
   , ScenarioServiceException(..)
   ) where

diff --git a/compiler/scenario-service/protos/scenario_service.proto b/compiler/scenario-service/protos/scenario_service.proto
@@ -388,7 +388,8 @@ message TraceMessage {
 }
 
 message WarningMessage {
-  string message = 1;
+  Location commitLocation = 1; // optional
+  string message = 2;
 }
 
 // The scenario interpretation result.

diff --git a/...cenario-service/server/src/main/scala/com/digitalasset/daml/lf/scenario/Conversions.scala b/...cenario-service/server/src/main/scala/com/digitalasset/daml/lf/scenario/Conversions.scala
@@ -7,7 +7,7 @@ package scenario
 import com.daml.lf.data.{ImmArray, Numeric, Ref}
 import com.daml.lf.ledger.EventId
 import com.daml.lf.scenario.api.{v1 => proto}
-import com.daml.lf.speedy.{SError, SValue, TraceLog, WarningLog}
+import com.daml.lf.speedy.{SError, SValue, TraceLog, Warning, WarningLog}
 import com.daml.lf.transaction.{GlobalKey, IncompleteTransaction, Node => N, NodeId}
 import com.daml.lf.ledger._
 import com.daml.lf.value.{Value => V}
@@ -275,9 +275,10 @@ final class Conversions(
     builder.setMessage(msgAndLoc._1).build
   }
 
-  private[this] def convertSWarningMessage(msg: String): proto.WarningMessage = {
+  private[this] def convertSWarningMessage(warning: Warning): proto.WarningMessage = {
     val builder = proto.WarningMessage.newBuilder
-    builder.setMessage(msg).build
+    warning.commitLocation.map(loc => builder.setCommitLocation(convertLocation(loc)))
+    builder.setMessage(warning.message).build
   }
 
   def convertFailedAuthorization(

diff --git a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Speedy.scala b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Speedy.scala
@@ -752,7 +752,11 @@ private[lf] object Speedy {
         case SVisibleToStakeholders.Visible => ()
         case SVisibleToStakeholders.NotVisible(actAs, readAs) =>
           this.warningLog.add(
-            s"Tried to fetch or exercise ${contract.templateId} contract ${cid} but none of the reading parties actAs = ${actAs}, readAs = ${readAs} are a stakeholder ${contract.stakeholders}. Use of divulged contracts is deprecated and incompatible with pruning"
+            Warning(
+              commitLocation = onLedger.commitLocation,
+              message =
+                s"Tried to fetch or exercise ${contract.templateId} contract ${cid} but none of the reading parties actAs = ${actAs}, readAs = ${readAs} are a stakeholder ${contract.stakeholders}. Use of divulged contracts is deprecated and incompatible with pruning",
+            )
           )
       }
     }
@@ -778,6 +782,7 @@ private[lf] object Speedy {
         traceLog: TraceLog = newTraceLog,
         warningLog: WarningLog = newWarningLog,
         contractKeyUniqueness: ContractKeyUniquenessMode = ContractKeyUniquenessMode.On,
+        commitLocation: Option[Location] = None,
     ): Machine = {
       val pkg2TxVersion =
         compiledPackages.interface.packageLanguageVersion.andThen(
@@ -798,7 +803,7 @@ private[lf] object Speedy {
             .initial(pkg2TxVersion, contractKeyUniqueness, submissionTime, initialSeeding),
           committers = committers,
           readAs = readAs,
-          commitLocation = None,
+          commitLocation = commitLocation,
           dependsOnTime = false,
           globalDiscriminators = globalCids.collect { case V.ContractId.V1(discriminator, _) =>
             discriminator

diff --git a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/WarningLog.scala b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/WarningLog.scala
@@ -5,14 +5,23 @@ package com.daml.lf.speedy
 
 import org.slf4j.Logger
 import scala.collection.mutable.ArrayBuffer
+import com.daml.lf.data.Ref.Location
+
+private[lf] final case class Warning(
+    commitLocation: Option[Location],
+    message: String,
+) {
+  def messageWithLocation: String =
+    s"${Pretty.prettyLoc(commitLocation).renderWideStream.mkString}: $message"
+}
 
 private[lf] final class WarningLog(logger: Logger) {
-  private[this] val buffer = new ArrayBuffer[String](initialSize = 10)
+  private[this] val buffer = new ArrayBuffer[Warning](initialSize = 10)
 
-  def add(message: String): Unit = {
-    logger.warn(message)
-    buffer += message
+  def add(warning: Warning): Unit = {
+    logger.warn(warning.messageWithLocation)
+    buffer += warning
   }
 
-  def iterator: Iterator[String] = buffer.iterator
+  def iterator: Iterator[Warning] = buffer.iterator
 }
diff --git a/daml-lf/scenario-interpreter/src/main/scala/com/digitalasset/daml/lf/ScenarioRunner.scala b/daml-lf/scenario-interpreter/src/main/scala/com/digitalasset/daml/lf/ScenarioRunner.scala
@@ -404,6 +404,7 @@ object ScenarioRunner {
       readAs = readAs,
       traceLog = traceLog,
       warningLog = warningLog,
+      commitLocation = location,
     )
     val onLedger = ledgerMachine.withOnLedger(NameOf.qualifiedNameOfCurrentFunc)(identity)
     @tailrec