Scenario Service: Use an unique lf version for all the loaed modules. (…

…digital-asset#7062) CHANGELOG_BEGIN CHANGELOG_END Co-authored-by: Moritz Kiefer <moritz.kiefer@purelyfunctional.org>
conr2d · Aug 7, 2020 · 8bb4ccc · 8bb4ccc
1 parent ba22f5b
commit 8bb4ccc
Show file tree

Hide file tree

Showing 12 changed files with 47 additions and 41 deletions.
diff --git a/compiler/damlc/daml-ide-core/src/Development/IDE/Core/IdeState/Daml.hs b/compiler/damlc/daml-ide-core/src/Development/IDE/Core/IdeState/Daml.hs
@@ -58,7 +58,7 @@ withDamlIdeState
     -> IO a
 withDamlIdeState opts@Options{..} loggerH eventHandler f = do
     scenarioServiceConfig <- Scenario.readScenarioServiceConfig
-    Scenario.withScenarioService' optScenarioService loggerH scenarioServiceConfig $ \mbScenarioService -> do
+    Scenario.withScenarioService' optScenarioService optDamlLfVersion loggerH scenarioServiceConfig $ \mbScenarioService -> do
         vfs <- makeVFSHandle
         -- We only use withDamlIdeState outside of the IDE where we do not care about
         -- progress reporting.

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
@@ -728,7 +728,6 @@ contextForFile file = do
     pure SS.Context
         { ctxModules = Map.fromList encodedModules
         , ctxPackages = [(LF.dalfPackageId pkg, LF.dalfPackageBytes pkg) | pkg <- Map.elems pkgMap ++ Map.elems stablePackages]
-        , ctxDamlLfVersion = lfVersion
         , ctxSkipValidation = SS.SkipValidation (getSkipScenarioValidation envSkipScenarioValidation)
         }
 

diff --git a/compiler/damlc/lib/DA/Cli/Damlc.hs b/compiler/damlc/lib/DA/Cli/Damlc.hs
@@ -471,7 +471,7 @@ execIde telemetry (Debug debug) enableScenarioService options =
           initPackageDb options (InitPkgDb True)
           scenarioServiceConfig <- readScenarioServiceConfig
           withLogger $ \loggerH ->
-              withScenarioService' enableScenarioService loggerH scenarioServiceConfig $ \mbScenarioService -> do
+              withScenarioService' enableScenarioService (optDamlLfVersion options) loggerH scenarioServiceConfig $ \mbScenarioService -> do
                   sdkVersion <- getSdkVersion `catchIO` const (pure "Unknown (not started via the assistant)")
                   Logger.logInfo loggerH (T.pack $ "SDK version: " <> sdkVersion)
                   debouncer <- newAsyncDebouncer

diff --git a/compiler/damlc/tests/BUILD.bazel b/compiler/damlc/tests/BUILD.bazel
@@ -291,6 +291,7 @@ da_haskell_test(
     src_strip_prefix = "src",
     visibility = ["//visibility:public"],
     deps = [
+        "//compiler/daml-lf-ast",
         "//compiler/damlc/daml-compiler",
         "//compiler/damlc/daml-ide-core",
         "//compiler/damlc/daml-ide-core:ide-testing",
@@ -740,6 +741,7 @@ da_haskell_test(
     main_function = "DA.Test.ScriptService.main",
     deps = [
         "//:sdk-version-hs-lib",
+        "//compiler/daml-lf-ast",
         "//compiler/damlc:damlc-lib",
         "//compiler/damlc/daml-ide-core",
         "//compiler/damlc/daml-opts:daml-opts-types",

diff --git a/compiler/damlc/tests/src/DA/Test/DamlcIntegration.hs b/compiler/damlc/tests/src/DA/Test/DamlcIntegration.hs
@@ -62,6 +62,7 @@ import qualified Development.IDE.Types.Diagnostics as D
 import Development.IDE.GHC.Util
 import           Data.Tagged                  (Tagged (..))
 import qualified GHC
+import Options.Applicative (execParser, forwardOptions, info, many, strArgument)
 import Outputable (ppr, showSDoc)
 import qualified Proto3.Suite.JSONPB as JSONPB
 
@@ -89,7 +90,13 @@ instance IsOption LfVersionOpt where
 main :: IO ()
 main = do
  let scenarioConf = SS.defaultScenarioServiceConfig { SS.cnfJvmOptions = ["-Xmx200M"] }
- SS.withScenarioService Logger.makeNopHandle scenarioConf $ \scenarioService -> do
+ -- This is a bit hacky, we want the LF version before we hand over to
+ -- tasty. To achieve that we first pass with optparse-applicative ignoring
+ -- everything apart from the LF version.
+ LfVersionOpt lfVer <- do
+     let parser = optionCLParser <* many (strArgument @String mempty)
+     execParser (info parser forwardOptions)
+ SS.withScenarioService lfVer Logger.makeNopHandle scenarioConf $ \scenarioService -> do
   hSetEncoding stdout utf8
   setEnv "TASTY_NUM_THREADS" "1" True
   todoRef <- newIORef DList.empty

diff --git a/compiler/damlc/tests/src/DA/Test/ScriptService.hs b/compiler/damlc/tests/src/DA/Test/ScriptService.hs
@@ -7,6 +7,7 @@ import Control.Exception
 import Control.Monad
 import DA.Bazel.Runfiles
 import DA.Cli.Damlc.Packaging
+import qualified DA.Daml.LF.Ast.Version as LF
 import DA.Daml.LF.PrettyScenario (prettyScenarioError, prettyScenarioResult)
 import qualified DA.Daml.LF.ScenarioServiceClient as SS
 import DA.Daml.Options.Types
@@ -71,7 +72,7 @@ main =
       logger <- Logger.newStderrLogger Logger.Debug "script-service"
 
       -- Spinning up the scenario service is expensive so we do it once at the beginning.
-      SS.withScenarioService logger scenarioConfig $ \scriptService ->
+      SS.withScenarioService LF.versionDefault logger scenarioConfig $ \scriptService ->
         defaultMain $
           testGroup
             "Script Service"

diff --git a/compiler/damlc/tests/src/DA/Test/ShakeIdeClient.hs b/compiler/damlc/tests/src/DA/Test/ShakeIdeClient.hs
@@ -20,6 +20,7 @@ import System.Directory
 import System.Environment.Blank (setEnv)
 import Control.Monad.IO.Class
 
+import qualified DA.Daml.LF.Ast.Version as LF
 import DA.Daml.LF.ScenarioServiceClient as SS
 import Development.IDE.Types.Diagnostics
 import Development.IDE.Types.Location
@@ -28,7 +29,7 @@ import Development.IDE.Core.API.Testing
 import Development.IDE.Core.Service.Daml(VirtualResource(..))
 
 main :: IO ()
-main = SS.withScenarioService Logger.makeNopHandle scenarioConfig $ \scenarioService -> do
+main = SS.withScenarioService LF.versionDefault Logger.makeNopHandle scenarioConfig $ \scenarioService -> do
   -- The scenario service is a shared resource so running tests in parallel doesn’t work properly.
   setEnv "TASTY_NUM_THREADS" "1" True
   -- The startup of the scenario service is fairly expensive so instead of launching a separate

diff --git a/compiler/scenario-service/client/src/DA/Daml/LF/ScenarioServiceClient.hs b/compiler/scenario-service/client/src/DA/Daml/LF/ScenarioServiceClient.hs
@@ -58,8 +58,8 @@ data Options = Options
   , optLogError :: String -> IO ()
   }
 
-toLowLevelOpts :: Options -> LowLevel.Options
-toLowLevelOpts Options{..} =
+toLowLevelOpts :: LF.Version -> Options -> LowLevel.Options
+toLowLevelOpts optDamlLfVersion Options{..} =
     LowLevel.Options{..}
     where
         optRequestTimeout = fromMaybe 60 $ cnfGrpcTimeout optScenarioServiceConfig
@@ -83,10 +83,10 @@ data Handle = Handle
 withSem :: QSemN -> IO a -> IO a
 withSem sem = bracket_ (waitQSemN sem 1) (signalQSemN sem 1)
 
-withScenarioService :: Logger.Handle IO -> ScenarioServiceConfig -> (Handle -> IO a) -> IO a
-withScenarioService loggerH scenarioConfig f = do
+withScenarioService :: LF.Version -> Logger.Handle IO -> ScenarioServiceConfig -> (Handle -> IO a) -> IO a
+withScenarioService ver loggerH scenarioConfig f = do
   hOptions <- getOptions
-  LowLevel.withScenarioService (toLowLevelOpts hOptions) $ \hLowLevelHandle ->
+  LowLevel.withScenarioService (toLowLevelOpts ver hOptions) $ \hLowLevelHandle ->
       bracket
          (either (\err -> fail $ "Failed to start scenario service: " <> show err) pure =<< LowLevel.newCtx hLowLevelHandle)
          (LowLevel.deleteCtx hLowLevelHandle) $ \rootCtxId -> do
@@ -112,12 +112,13 @@ withScenarioService loggerH scenarioConfig f = do
 
 withScenarioService'
     :: EnableScenarioService
+    -> LF.Version
     -> Logger.Handle IO
     -> ScenarioServiceConfig
     -> (Maybe Handle -> IO a)
     -> IO a
-withScenarioService' (EnableScenarioService enable) loggerH conf f
-    | enable = withScenarioService loggerH conf (f . Just)
+withScenarioService' (EnableScenarioService enable) ver loggerH conf f
+    | enable = withScenarioService ver loggerH conf (f . Just)
     | otherwise = f Nothing
 
 data ScenarioServiceConfig = ScenarioServiceConfig
@@ -152,7 +153,6 @@ parseScenarioServiceConfig conf = do
 data Context = Context
   { ctxModules :: MS.Map Hash (LF.ModuleName, BS.ByteString)
   , ctxPackages :: [(LF.PackageId, BS.ByteString)]
-  , ctxDamlLfVersion :: LF.Version
   , ctxSkipValidation :: LowLevel.SkipValidation
   }
 
@@ -175,7 +175,6 @@ getNewCtx Handle{..} Context{..} = withLock hContextLock $ withSem hConcurrencyS
       (S.toList unloadModules)
       loadPackages
       (S.toList unloadPackages)
-      ctxDamlLfVersion
       ctxSkipValidation
   rootCtxId <- readIORef hContextId
   runExceptT $ do

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
@@ -72,6 +72,7 @@ data Options = Options
   , optGrpcMaxMessageSize :: Maybe Int
   , optLogInfo :: String -> IO ()
   , optLogError :: String -> IO ()
+  , optDamlLfVersion :: LF.Version
   }
 
 type TimeoutSeconds = Int
@@ -93,7 +94,6 @@ data ContextUpdate = ContextUpdate
   , updUnloadModules :: ![LF.ModuleName]
   , updLoadPackages :: ![(LF.PackageId, BS.ByteString)]
   , updUnloadPackages :: ![LF.PackageId]
-  , updDamlLfVersion :: LF.Version
   , updSkipValidation :: SkipValidation
   }
 
@@ -252,11 +252,10 @@ withScenarioService opts@Options{..} f = do
 
 newCtx :: Handle -> IO (Either BackendError ContextId)
 newCtx Handle{..} = do
-  res <-
-    performRequest
+  res <- performRequest
       (SS.scenarioServiceNewContext hClient)
       (optRequestTimeout hOptions)
-      SS.NewContextRequest
+      (SS.NewContextRequest $ TL.pack $ LF.renderMinorVersion $ LF.versionMinor $ optDamlLfVersion hOptions)
   pure (ContextId . SS.newContextResponseContextId <$> res)
 
 cloneCtx :: Handle -> ContextId -> IO (Either BackendError ContextId)
@@ -309,9 +308,7 @@ updateCtx Handle{..} (ContextId ctxId) ContextUpdate{..} = do
         (V.fromList (map (TL.fromStrict . LF.unPackageId) updUnloadPackages))
     encodeName = TL.fromStrict . mangleModuleName
     convModule :: (LF.ModuleName, BS.ByteString) -> SS.ScenarioModule
-    convModule (_, bytes) =
-        case updDamlLfVersion of
-            LF.V1 minor -> SS.ScenarioModule bytes (TL.pack $ LF.renderMinorVersion minor)
+    convModule (_, bytes) = SS.ScenarioModule bytes
 
 mangleModuleName :: LF.ModuleName -> T.Text
 mangleModuleName (LF.ModuleName modName) =

diff --git a/compiler/scenario-service/protos/scenario_service.proto b/compiler/scenario-service/protos/scenario_service.proto
@@ -42,6 +42,7 @@ service ScenarioService {
 //
 
 message NewContextRequest {
+  string lf_minor = 1;
 }
 
 message NewContextResponse {
@@ -346,9 +347,6 @@ message GenMap{
 message ScenarioModule {
   // each LF v1 module is wrapped in a proto package
   bytes daml_lf_1 = 2;
-
-  // for daml_lf_dev the minor version is ignored by the scenario service.
-  string minor = 1;
 }
 
 message RunScenarioResponse {

diff --git a/...scenario-service/server/src/main/scala/com/digitalasset/daml/lf/ScenarioServiceMain.scala b/...scenario-service/server/src/main/scala/com/digitalasset/daml/lf/ScenarioServiceMain.scala
@@ -15,6 +15,7 @@ import scalaz.syntax.traverse._
 import com.daml.lf.archive.Decode.ParseError
 import com.daml.lf.data.Ref
 import com.daml.lf.data.Ref.ModuleName
+import com.daml.lf.language.LanguageVersion
 import com.daml.lf.scenario.api.v1.{Map => _, _}
 import io.grpc.stub.StreamObserver
 import io.grpc.{Status, StatusRuntimeException}
@@ -192,7 +193,11 @@ class ScenarioService(
       req: NewContextRequest,
       respObs: StreamObserver[NewContextResponse],
   ): Unit = {
-    val ctx = Context.newContext
+    val lfVersion = LanguageVersion(
+      LanguageVersion.Major.V1,
+      LanguageVersion.Minor.fromProtoIdentifier(req.getLfMinor)
+    )
+    val ctx = Context.newContext(lfVersion)
     contexts += (ctx.contextId -> ctx)
     val response = NewContextResponse.newBuilder.setContextId(ctx.contextId).build
     respObs.onNext(response)

diff --git a/...er/scenario-service/server/src/main/scala/com/digitalasset/daml/lf/scenario/Context.scala b/...er/scenario-service/server/src/main/scala/com/digitalasset/daml/lf/scenario/Context.scala
@@ -49,13 +49,14 @@ object Context {
 
   private val contextCounter = new AtomicLong()
 
-  def newContext: Context = new Context(contextCounter.incrementAndGet())
+  def newContext(lfVerion: LanguageVersion): Context =
+    new Context(contextCounter.incrementAndGet(), lfVerion)
 
   private def assert[X](either: Either[String, X]): X =
     either.fold(e => throw new ParseError(e), identity)
 }
 
-class Context(val contextId: Context.ContextId) {
+class Context(val contextId: Context.ContextId, languageVersion: LanguageVersion) {
 
   import Context._
 
@@ -77,7 +78,7 @@ class Context(val contextId: Context.ContextId) {
   def loadedPackages(): Iterable[PackageId] = extPackages.keys
 
   def cloneContext(): Context = synchronized {
-    val newCtx = Context.newContext
+    val newCtx = Context.newContext(languageVersion)
     newCtx.extPackages = extPackages
     newCtx.extDefns = extDefns
     newCtx.modules = modules
@@ -86,16 +87,13 @@ class Context(val contextId: Context.ContextId) {
     newCtx
   }
 
-  private def decodeModule(
-      major: LanguageVersion.Major,
-      minor: String,
-      bytes: ByteString,
-  ): Ast.Module = {
-    val lfVer = LanguageVersion(major, LanguageVersion.Minor fromProtoIdentifier minor)
-    val dop: Decode.OfPackage[_] = Decode.decoders
-      .lift(lfVer)
-      .getOrElse(throw Context.ContextException(s"No decode support for LF ${lfVer.pretty}"))
-      .decoder
+  private[this] val dop: Decode.OfPackage[_] = Decode.decoders
+    .lift(languageVersion)
+    .getOrElse(
+      throw Context.ContextException(s"No decode support for LF ${languageVersion.pretty}"))
+    .decoder
+
+  private def decodeModule(bytes: ByteString): Ast.Module = {
     val lfScenarioModule = dop.protoScenarioModule(Decode.damlLfCodedInputStream(bytes.newInput))
     dop.decodeScenarioModule(homePackageId, lfScenarioModule)
   }
@@ -109,8 +107,7 @@ class Context(val contextId: Context.ContextId) {
       omitValidation: Boolean,
   ): Unit = synchronized {
 
-    val newModules = loadModules.map(module =>
-      decodeModule(LanguageVersion.Major.V1, module.getMinor, module.getDamlLf1))
+    val newModules = loadModules.map(module => decodeModule(module.getDamlLf1))
     modules --= unloadModules
     newModules.foreach(mod => modules += mod.name -> mod)