Limit supported input versions in damlc to >= LF 1.8

compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Version.hs

@@ -60,8 +60,7 @@ supportedOutputVersions :: [Version]
 supportedOutputVersions = [version1_14, versionDev]
 
 supportedInputVersions :: [Version]
-supportedInputVersions = [version1_6, version1_7, version1_8, version1_11, version1_12, version1_13] ++ supportedOutputVersions
-
+supportedInputVersions = [version1_8, version1_11, version1_12, version1_13] ++ supportedOutputVersions
 
 data Feature = Feature
     { featureName :: !T.Text

compiler/daml-lf-proto/BUILD.bazel

@@ -47,6 +47,7 @@ da_haskell_library(
     deps = [
         ":daml-lf-util",
         "//compiler/daml-lf-ast",
+        "//compiler/damlc/stable-packages:stable-packages-list",
         "//daml-lf/archive:daml_lf_dev_archive_haskell_proto",
         "//libs-haskell/da-hs-base",
     ],

compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/Archive/Decode.hs

@@ -55,7 +55,7 @@ decodePackage mode packageId payloadBytes = do
             DecodeAsMain -> LF.PRSelf
             DecodeAsDependency -> LF.PRImport packageId
     payload <- over _Left (ProtobufError . show) $ Proto.fromByteString payloadBytes
-    over _Left (ProtobufError. show) $ Decode.decodePayload selfPackageRef payload
+    over _Left (ProtobufError. show) $ Decode.decodePayload packageId selfPackageRef payload
 
 -- | Decode an LF archive header, returning the package-id and the payload
 decodeArchiveHeader :: BS.ByteString -> Either ArchiveError (LF.PackageId, BS.ByteString)

compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/Decode.hs

@@ -7,13 +7,13 @@ module DA.Daml.LF.Proto3.Decode
   ) where
 
 import Com.Daml.DamlLfDev.DamlLf (ArchivePayload(..), ArchivePayloadSum(..))
-import DA.Daml.LF.Ast (Package, PackageRef)
+import DA.Daml.LF.Ast (Package, PackageId, PackageRef)
 import DA.Daml.LF.Proto3.Error
 import qualified DA.Daml.LF.Proto3.DecodeV1 as DecodeV1
 
-decodePayload :: PackageRef -> ArchivePayload -> Either Error Package
-decodePayload selfPackageRef payload = case archivePayloadSum payload of
-    Just (ArchivePayloadSumDamlLf1 package) -> DecodeV1.decodePackage minor selfPackageRef package
+decodePayload :: PackageId -> PackageRef -> ArchivePayload -> Either Error Package
+decodePayload pkgId selfPackageRef payload = case archivePayloadSum payload of
+    Just (ArchivePayloadSumDamlLf1 package) -> DecodeV1.decodePackage (Just pkgId) minor selfPackageRef package
     Nothing -> Left $ ParseError "Empty payload"
     where
         minor = archivePayloadMinor payload

compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeV1.hs

@@ -21,6 +21,7 @@ import Control.Monad.Reader
 import Data.Int
 import Text.Read
 import           Data.List
+import    DA.Daml.StablePackagesList
 import           DA.Daml.LF.Mangling
 import qualified Com.Daml.DamlLfDev.DamlLf1 as LF1
 import qualified Data.NameMap as NM
@@ -170,8 +171,8 @@ decodePackageRef (LF1.PackageRef pref) =
 -- Decodings of everything else
 ------------------------------------------------------------------------
 
-decodeVersion :: T.Text -> Either Error Version
-decodeVersion minorText = do
+decodeVersion :: Maybe LF.PackageId -> T.Text -> Either Error Version
+decodeVersion mbPkgId minorText = do
   let unsupported :: Either Error a
       unsupported = throwError (UnsupportedMinorVersion minorText)
   -- we translate "no version" to minor version 0, since we introduced
@@ -183,16 +184,19 @@ decodeVersion minorText = do
     | Just minor <- LF.parseMinorVersion (T.unpack minorText) -> pure minor
     | otherwise -> unsupported
   let version = V1 minor
-  if version `elem` LF.supportedInputVersions then pure version else unsupported
+  if  isStablePackage || version `elem` LF.supportedInputVersions then pure version else unsupported
+  where
+    isStablePackage = maybe False (`elem` stablePackages) mbPkgId
 
 decodeInternedDottedName :: LF1.InternedDottedName -> Decode ([T.Text], Either String [UnmangledIdentifier])
 decodeInternedDottedName (LF1.InternedDottedName ids) = do
     (mangled, unmangledOrErr) <- unzip <$> mapM lookupString (V.toList ids)
     pure (mangled, sequence unmangledOrErr)
 
-decodePackage :: TL.Text -> LF.PackageRef -> LF1.Package -> Either Error Package
-decodePackage minorText selfPackageRef (LF1.Package mods internedStringsV internedDottedNamesV metadata internedTypesV) = do
-  version <- decodeVersion (decodeString minorText)
+-- The package id is optional since we also call this function from decodeScenarioModule
+decodePackage :: Maybe LF.PackageId -> TL.Text -> LF.PackageRef -> LF1.Package -> Either Error Package
+decodePackage mbPkgId minorText selfPackageRef (LF1.Package mods internedStringsV internedDottedNamesV metadata internedTypesV) = do
+  version <- decodeVersion mbPkgId (decodeString minorText)
   let internedStrings = V.map decodeMangledString internedStringsV
   let internedDottedNames = V.empty
   let internedTypes = V.empty
@@ -213,7 +217,7 @@ decodePackageMetadata LF1.PackageMetadata{..} = do
 
 decodeScenarioModule :: TL.Text -> LF1.Package -> Either Error Module
 decodeScenarioModule minorText protoPkg = do
-    Package { packageModules = modules } <- decodePackage minorText PRSelf protoPkg
+    Package { packageModules = modules } <- decodePackage Nothing minorText PRSelf protoPkg
     pure $ head $ NM.toList modules
 
 decodeModule :: LF1.Module -> Decode Module

compiler/damlc/daml-lf-util/BUILD.bazel

@@ -21,7 +21,6 @@ da_haskell_library(
     visibility = ["//visibility:public"],
     deps = [
         "//compiler/daml-lf-ast",
-        "//compiler/daml-lf-proto",
         "//libs-haskell/da-hs-base",
     ],
 )

compiler/damlc/daml-lf-util/src/DA/Daml/UtilLF.hs

@@ -9,10 +9,8 @@ module DA.Daml.UtilLF (
     ) where
 
 import           DA.Daml.LF.Ast
-import qualified DA.Daml.LF.Proto3.Archive  as Archive
 import           DA.Pretty (renderPretty)
 
-import qualified Data.ByteString.Char8      as BS
 import Data.Maybe
 import qualified Data.NameMap               as NM
 import qualified Data.Text                  as T
@@ -82,10 +80,6 @@ fromTCon t = error $ "fromTCon failed, " ++ show t
 synthesizeVariantRecord :: VariantConName -> TypeConName -> TypeConName
 synthesizeVariantRecord (VariantConName dcon) (TypeConName tcon) = TypeConName (tcon ++ [dcon])
 
-writeFileLf :: FilePath -> Package -> IO ()
-writeFileLf outFile lfPackage = do
-    BS.writeFile outFile $ Archive.encodeArchive lfPackage
-
 -- | Fails if there are any duplicate module names
 buildPackage :: HasCallStack => Maybe PackageName -> Maybe PackageVersion -> Version -> [Module] -> Package
 buildPackage mbPkgName mbPkgVersion version mods =

compiler/damlc/stable-packages/BUILD.bazel

@@ -126,3 +126,28 @@ filegroup(
     ],
     visibility = ["//visibility:public"],
 )
+
+genrule(
+    name = "stable-packages-list-srcs",
+    outs = ["DA/Daml/StablePackagesList.hs"],
+    cmd = """
+    $(location :generate-stable-package) gen-package-list -o $(location DA/Daml/StablePackagesList.hs)
+  """,
+    tools = [":generate-stable-package"],
+)
+
+# We generate this as a library rather than depending on :stable-packages-lib
+# to avoid a cyclical dependency between the daml-lf-proto and :stable-packages-lib
+# and to avoid having to encode the packages at runtime to get their package id.
+da_haskell_library(
+    name = "stable-packages-list",
+    srcs = ["DA/Daml/StablePackagesList.hs"],
+    hackage_deps = [
+        "base",
+        "containers",
+    ],
+    visibility = ["//visibility:public"],
+    deps = [
+        "//compiler/daml-lf-ast",
+    ],
+)

compiler/damlc/stable-packages/lib/DA/Daml/StablePackages.hs

@@ -17,8 +17,10 @@ import DA.Daml.LF.Ast
 import DA.Daml.LF.Proto3.Archive.Encode
 import DA.Daml.UtilLF
 
-allStablePackages :: [Package]
+allStablePackages :: MS.Map PackageId Package
 allStablePackages =
+    MS.fromList $
+    map (\pkg  -> (encodePackageHash pkg, pkg))
     [ ghcTypes
     , ghcPrim
     , ghcTuple
@@ -43,18 +45,18 @@ allStablePackages =
     , daExceptionPreconditionFailed
     ]
 
-allStablePackagesForVersion :: Version -> [Package]
+allStablePackagesForVersion :: Version -> MS.Map PackageId Package
 allStablePackagesForVersion v =
-    filter (\p -> packageLfVersion p <= v) allStablePackages
+    MS.filter (\p -> packageLfVersion p <= v) allStablePackages
 
 numStablePackagesForVersion :: Version -> Int
-numStablePackagesForVersion v = length (allStablePackagesForVersion v)
+numStablePackagesForVersion v = MS.size (allStablePackagesForVersion v)
 
 stablePackageByModuleName :: MS.Map ModuleName Package
 stablePackageByModuleName = MS.fromListWithKey
     (\k -> error $ "Duplicate module among stable packages: " <> show k)
     [ (moduleName m, p)
-    | p <- allStablePackages
+    | p <- MS.elems allStablePackages
     , m <- NM.toList (packageModules p) ]
 
 ghcTypes :: Package

compiler/damlc/stable-packages/src/GenerateStablePackage.hs

@@ -9,12 +9,21 @@ import qualified Data.ByteString as BS
 import qualified Data.Map.Strict as MS
 import Options.Applicative
 import qualified Data.Text as T
+import Data.Text.Extended (writeFileUtf8)
 
 import DA.Daml.LF.Ast
 import DA.Daml.LF.Proto3.Archive.Encode
 import DA.Daml.StablePackages
 
-data Opts = Opts
+data Opts
+    = PackageListCmd GenPackageListOpts
+    | PackageCmd GenPackageOpts
+
+data GenPackageListOpts = GenPackageListOpts
+  { optListOutputPath :: FilePath
+  }
+
+data GenPackageOpts = GenPackageOpts
   { optModule :: ModuleName
   -- ^ The module that we generate as a standalone package
   , optModuleDeps :: [ModuleDep]
@@ -31,9 +40,18 @@ data ModuleDep = ModuleDep
   , depPackageId :: PackageId
   } deriving Show
 
-optParser :: Parser Opts
-optParser =
-  Opts
+packageListOptsParser :: Parser GenPackageListOpts
+packageListOptsParser =
+    subparser $
+    command "gen-package-list" $
+    info parser mempty
+  where
+    parser = GenPackageListOpts <$> option str (short 'o')
+
+
+packageOptsParser :: Parser GenPackageOpts
+packageOptsParser =
+  GenPackageOpts
     <$> option modNameReader (long "module")
     <*> many (option modDepReader (long "module-dep" <> help "Module.Name:packageid"))
     <*> option str (short 'o')
@@ -47,14 +65,28 @@ optParser =
           }
         _ -> Nothing
 
+optParser :: Parser Opts
+optParser =
+    PackageListCmd <$> packageListOptsParser <|> PackageCmd <$> packageOptsParser
+
 main :: IO ()
 main = do
-    Opts{..} <- execParser (info optParser idm)
-    case MS.lookup optModule stablePackageByModuleName of
-        Nothing ->
-            fail $ "Unknown module: " <> show optModule
-        Just pkg ->
-            writePackage pkg optOutputPath
+    opts <- execParser (info optParser idm)
+    case opts of
+        PackageCmd GenPackageOpts{..} -> case MS.lookup optModule stablePackageByModuleName of
+            Nothing ->
+                fail $ "Unknown module: " <> show optModule
+            Just pkg ->
+                writePackage pkg optOutputPath
+        PackageListCmd GenPackageListOpts{..} ->
+            writeFileUtf8 optListOutputPath $ T.unlines
+              [ "module DA.Daml.StablePackagesList (stablePackages) where"
+              , "import DA.Daml.LF.Ast (PackageId(..))"
+              , "import qualified Data.Set as Set"
+              , "stablePackages :: Set.Set PackageId"
+              , "stablePackages = Set.fromList"
+              , "  [" <> T.intercalate ", " (map (T.pack . show) $ MS.keys allStablePackages) <> "]"
+              ]
 
 writePackage :: Package -> FilePath -> IO ()
 writePackage pkg path = do

compiler/damlc/tests/src/DA/Test/DamlcIntegration.hs

@@ -11,7 +11,6 @@ module DA.Test.DamlcIntegration
 import           DA.Bazel.Runfiles
 import           DA.Daml.Options
 import           DA.Daml.Options.Types
-import           DA.Daml.UtilLF
 import           DA.Test.Util (standardizeQuotes)
 
 import           DA.Daml.LF.Ast as LF hiding (IsTest)
@@ -24,6 +23,7 @@ import           Control.Exception.Extra
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           DA.Daml.LF.Proto3.EncodeV1
+import qualified DA.Daml.LF.Proto3.Archive.Encode as Archive
 import           DA.Pretty hiding (first)
 import qualified DA.Daml.LF.ScenarioServiceClient as SS
 import qualified DA.Service.Logger as Logger
@@ -34,6 +34,7 @@ import Development.IDE.Core.Shake (ShakeLspEnv(..), NotificationHandler(..))
 import qualified Development.IDE.Types.Logger as IdeLogger
 import Development.IDE.Types.Location
 import qualified Data.Aeson.Encode.Pretty as A
+import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy.Char8 as BSL
 import           Data.Char
 import qualified Data.DList as DList
@@ -383,7 +384,7 @@ mainProj service outdir log file = do
     -- NOTE (MK): For some reason ghcide’s `prettyPrint` seems to fall over on Windows with `commitBuffer: invalid argument`.
     -- With `fakeDynFlags` things seem to work out fine.
     let corePrettyPrint = timed log "Core pretty-printing" . liftIO . writeFile (outdir </> proj <.> "core") . showSDoc fakeDynFlags . ppr
-    let lfSave = timed log "LF saving" . liftIO . writeFileLf (outdir </> proj <.> "dalf")
+    let lfSave = timed log "LF saving" . liftIO . BS.writeFile (outdir </> proj <.> "dalf") . Archive.encodeArchive
     let lfPrettyPrint = timed log "LF pretty-printing" . liftIO . writeFile (outdir </> proj <.> "pdalf") . renderPretty
     let jsonSave pkg =
             let json = A.encodePretty $ JSONPB.toJSONPB (encodePackage pkg) JSONPB.jsonPBOptions

rules_daml/daml.bzl

@@ -231,18 +231,24 @@ $$DAMLC validate-dar $$(canonicalize_rlocation $(rootpath {dar}))
         **kwargs
     )
 
-def _inspect_dar(base):
+def _inspect_dar(base, damlc):
     name = base + "-inspect"
     dar = base + ".dar"
     pp = base + ".dar.pp"
     native.genrule(
         name = name,
         srcs = [
             dar,
-            "//compiler/damlc:damlc-compile-only",
+            damlc,
         ],
         outs = [pp],
-        cmd = "$(location //compiler/damlc:damlc-compile-only) inspect $(location :" + dar + ") > $@",
+        cmd = """
+set -eou pipefail
+# For some reason the sh_binary resolves to two locations,
+# we just take the first one.
+LOCS=($(locations {damlc}))
+DAMLC=$${{LOCS[0]}}
+$$DAMLC inspect $(location :{dar}) > $@""".format(damlc = damlc, dar = dar),
     )
 
 _default_project_version = "1.0.0"
@@ -287,6 +293,7 @@ def daml_compile(
     )
     _inspect_dar(
         base = name,
+        damlc = damlc_for_target(target),
     )
 
 def daml_compile_with_dalf(