[WIP] Initial implementation

Author: roger-bosman-da

sdk/compatibility/versions/UpdateVersions.hs

@@ -51,13 +51,13 @@ renderVersionsFile versions =
           , "# Update versions/UpdateVersions.hs instead."
           ]
         , [ "sdk_versions = [" ]
-        , map renderVersion (Map.keys versions <> [headVersion])
+        , map renderTodoVersion (Map.keys versions <> [headVersion])
         , [ "]"]
         , [ "platform_versions = [" ]
-        , map renderVersion (Map.keys versions <> [headVersion])
+        , map renderTodoVersion (Map.keys versions <> [headVersion])
         , [ "]" ]
         , [ "stable_versions = [" ]
-        , map renderVersion (Map.keys stableVersions <> [headVersion])
+        , map renderTodoVersion (Map.keys stableVersions <> [headVersion])
         , [ "]" ]
         , [ "latest_stable_version = \"" <> SemVer.toText latestVersion <> "\"" ]
         , [ "version_sha256s = {"]
@@ -79,7 +79,7 @@ renderVersionsFile versions =
       , [ "    }," ]
       ]
     renderDigest digest = T.pack $ show (convertToBase Base16 digest :: ByteString)
-    renderVersion ver = "    \"" <> SemVer.toText ver <> "\","
+    renderTodoVersion ver = "    \"" <> SemVer.toText ver <> "\","
     stableVersions = Map.filterWithKey (const . null . view SemVer.release) versions
     firstVersion = SemVer.version 3 3 0 [fromJust $ SemVer.textual "snapshot", SemVer.numeric 20250930, SemVer.numeric 0] []
     latestVersion = if Map.null versions then firstVersion else fst $ Map.findMax versions

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

@@ -21,10 +21,13 @@ import           GHC.Generics
 import qualified DA.Daml.LF.Ast.Range as R
 import           DA.Pretty
 
+type Patch = Int
+
 -- | Daml-LF version of an archive payload.
-data Version = Version
+data Version = VersionP
     { versionMajor :: MajorVersion
     , versionMinor :: MinorVersion
+    , patch        :: Patch
     }
     deriving (Eq, Data, Generic, NFData, Show, Ord, Aeson.FromJSON, Aeson.ToJSON)
 
@@ -81,16 +84,28 @@ renderMinorVersion = \case
   PointStaging minor -> show minor
   PointDev -> "dev"
 
-renderVersion :: Version -> String
-renderVersion (Version major minor) =
+renderPatch :: Patch -> String
+renderPatch = show
+
+renderVersionWithPatch :: Version -> String
+renderVersionWithPatch (VersionP major minor patch) =
+    renderMajorVersion major <> "." <> renderMinorVersion minor <> "." <> renderPatch patch
+
+--TODO: convert usages of toBeDecidedRenderVersion to renderVersion
+--wherever we can, or (back to) renderTodoVersion everywhere else
+renderVersionWithoutPatch :: Version -> String
+renderVersionWithoutPatch (VersionP major minor _) =
     renderMajorVersion major <> "." <> renderMinorVersion minor
 
+renderTodoVersion :: Version -> String
+renderTodoVersion = renderVersionWithoutPatch
+
 -- | A datatype describing a set of language versions. Used in the definition of
 -- 'Feature' below.
 type VersionReq = R.Range Version
 
 instance Pretty Version where
-  pPrint = string . renderVersion
+  pPrint = string . renderTodoVersion
 
 data Feature = Feature
     { featureName :: !T.Text

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

@@ -11,20 +11,27 @@ import           Data.Char (isDigit)
 import qualified DA.Daml.LF.Ast.Range as R
 import qualified Data.Text as T
 import           Safe (headMay)
-import           Text.ParserCombinators.ReadP (ReadP, pfail, readP_to_S, (+++), munch1)
+import           Text.ParserCombinators.ReadP (ReadP, pfail, readP_to_S, (+++), (<++), eof, munch1)
 import qualified Text.ParserCombinators.ReadP as ReadP
 import qualified Data.Map.Strict as MS
+import qualified Data.Map        as M
 
 import Control.Lens (Getting, view)
 import Control.Monad.Reader.Class
 
 import DA.Daml.LF.Ast.Version.VersionType
+import DA.Daml.LF.Ast.Version.GeneratedVersions
 import DA.Daml.LF.Ast.Version.GeneratedFeatures
 
+validatePatch :: Version -> Bool
+validatePatch (VersionP _ PointDev _) = True
+validatePatch (VersionP _ minor patch) =
+  maybe False (\patches -> patch `elem` patches) (M.lookup minor allowedPatchMap)
+
 -- | x `canDependOn` y if dars compiled to version x can depend on dars compiled
 -- to version y.
 canDependOn :: Version -> Version -> Bool
-canDependOn (Version major1 minor1) (Version major2 minor2) =
+canDependOn (VersionP major1 minor1 _) (VersionP major2 minor2 _) =
   major1 == major2 && minor1 >= minor2
 
 isDevVersion :: Version -> Bool
@@ -107,6 +114,9 @@ readMinorVersion = readStable +++ readDev
     readStable = PointStable <$> readSimpleInt
     readDev = PointDev <$ ReadP.string "dev"
 
+readPatch :: ReadP Patch
+readPatch = readSimpleInt
+
 -- >>> parseMinorVersion "14"
 -- Just (PointStable 14)
 -- >>> parseMinorVersion "dev"
@@ -117,20 +127,32 @@ parseMinorVersion :: String -> Maybe MinorVersion
 parseMinorVersion = headMay . map fst . readP_to_S readMinorVersion
 
 readVersion :: ReadP Version
-readVersion = do
-  major <- readMajorVersion
-  _ <- ReadP.char '.'
-  minor <- readMinorVersion
-  pure (Version major minor)
+readVersion = readPatchfull <++ readPatchless
+  where
+    readPatchfull = do
+      major <- readMajorVersion
+      _ <- ReadP.char '.'
+      minor <- readMinorVersion
+      _ <- ReadP.char '.'
+      patch <- readPatch
+      pure (VersionP major minor patch)
+
+    readPatchless = do
+      major <- readMajorVersion
+      _ <- ReadP.char '.'
+      minor <- readMinorVersion
+      pure (Version major minor)
 
 -- >>> parseVersion "2.dev"
--- Just (Version {versionMajor = V2, versionMinor = PointDev})
+-- Just (VersionP {versionMajor = V2, versionMinor = PointDev, patch = 0})
 -- >>> parseVersion "2.15"
--- Just (Version {versionMajor = V2, versionMinor = PointStable 15})
+-- Just (VersionP {versionMajor = V2, versionMinor = PointStable 15, patch = 0})
+-- >>> parseVersion "2.2.0"
+-- Just (VersionP {versionMajor = V2, versionMinor = PointStable 2, patch = 0})
 -- >>> parseVersion "2.garbage"
 -- Nothing
 parseVersion :: String -> Maybe Version
-parseVersion = headMay . map fst . readP_to_S readVersion
+parseVersion = headMay . map fst . readP_to_S (readVersion <* eof)
 
 -- The extended implementation
 ifVersionWith :: MonadReader r m

sdk/compiler/daml-lf-ast/test/DA/Daml/LF/Ast/Tests.hs

@@ -296,7 +296,7 @@ substitutionTests = testGroup "substitution"
 typeSynTests :: TestTree
 typeSynTests =
   testGroup "type synonyms" $
-  [ testGroup (renderVersion version)
+  [ testGroup (renderTodoVersion version)
     [ testGroup "happy" (map (mkHappyTestcase version) happyExamples)
     , testGroup "sad" (map (mkSadTestcase version) sadExamples)
     , testGroup "bad" (map (mkBadTestcase version) badDefSets)

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

@@ -20,6 +20,7 @@ import qualified DA.Daml.LF.Proto3.DecodeV2 as DecodeV2
 import qualified DA.Daml.LF.Ast             as LF
 import           DA.Daml.StablePackages (allStablePackageIds)
 
+import           Control.Monad        (when)
 import           Control.Monad.Except (throwError)
 import           Control.Lens         (over, _Left)
 import Data.Int (Int32)
@@ -35,8 +36,8 @@ decodeLfVersion major pkgId minorText patchInt = do
   minor <- if
     | Just minor <- LF.parseMinorVersion (T.unpack minorText) -> pure minor
     | otherwise -> unsupportedMinor
-  _ <- if patchInt == 0 then pure () else unsupportedPatch minor patchInt
-  let version = LF.Version major minor
+  let version = LF.VersionP major minor (fromIntegral patchInt)
+  when (not $ LF.validatePatch version) $ unsupportedPatch minor patchInt
   if pkgId `elem` allStablePackageIds || version `elem` LF.compilerInputLfVersions
       then pure version
       else unsupportedMinor

sdk/compiler/daml-lf-proto-encode/src/DA/Daml/LF/Proto3/Encode.hs

@@ -16,6 +16,6 @@ import qualified Data.ByteString.Lazy     as BSL
 
 encodePayload :: Package -> ArchivePayload
 encodePayload package = case packageLfVersion package of
-    (Version V2 minor) ->
+    (VersionP V2 minor patch) ->
         let payload = ArchivePayloadSumDamlLf2 $ BSL.toStrict $ Proto.toLazyByteString (EncodeV2.encodePackage package)
-        in ArchivePayload (TL.pack $ renderMinorVersion minor) 0 (Just payload)
+        in ArchivePayload (TL.pack $ renderMinorVersion minor) (fromIntegral patch) (Just payload)

sdk/compiler/daml-lf-tools/tests/DA/Daml/LF/Simplifier/Tests.hs

@@ -25,7 +25,7 @@ main = defaultMain $ testGroup "DA.Daml.LF.Simplifier"
 -- flags. The simplifier may thus behave differently based on the version of LF
 -- and thus we may need to test different LF versions as they diverge over time.
 constantLiftingTests :: Version -> TestTree
-constantLiftingTests version = testGroup ("Constant Lifting " <> renderVersion version)
+constantLiftingTests version = testGroup ("Constant Lifting " <> renderTodoVersion version)
     [ mkTestCase "empty module" [] []
     , mkTestCase "closed value"
         [ dval "foo" TInt64 (EBuiltinFun (BEInt64 10)) ]

sdk/compiler/damlc/daml-ide-core/src/Development/IDE/Core/Rules/Daml.hs

@@ -546,18 +546,18 @@ getUpgradedPackageErrs opts file mainPkg
         Just $
           ideErrorPretty file $ mconcat
             [ mainPackage <> " LF Version ("
-            , T.pack $ LF.renderVersion $ LF.packageLfVersion mainPkg
+            , T.pack $ LF.renderTodoVersion $ LF.packageLfVersion mainPkg
             , ") must have the same major LF version as " <> upgradedPackage <> " LF Version ("
-            , T.pack $ LF.renderVersion $ optDamlLfVersion opts
+            , T.pack $ LF.renderTodoVersion $ optDamlLfVersion opts
             , ")"
             ]
       else
         justIf (optDamlLfVersion opts `lfVersionMinorLt` LF.packageLfVersion mainPkg) $
           ideErrorPretty file $ mconcat
             [ mainPackage <> " LF Version ("
-            , T.pack $ LF.renderVersion $ optDamlLfVersion opts
+            , T.pack $ LF.renderTodoVersion $ optDamlLfVersion opts
             , ") cannot be lower than the " <> upgradedPackage <> " LF Version ("
-            , T.pack $ LF.renderVersion $ LF.packageLfVersion mainPkg
+            , T.pack $ LF.renderTodoVersion $ LF.packageLfVersion mainPkg
             , ")"
             ]
   , justIf (optMbPackageName opts /= Just (LF.packageName $ LF.packageMetadata mainPkg)) $

sdk/compiler/damlc/daml-opts/daml-opts/DA/Daml/Options.hs

@@ -560,7 +560,7 @@ expandSdkPackages logger lfVersion dars = do
     mapM (expand mbSdkPath) (nubOrd dars)
   where
     isSdkPackage fp = takeExtension fp `notElem` [".dar", ".dalf"]
-    sdkSuffix = "-" <> LF.renderVersion lfVersion
+    sdkSuffix = "-" <> LF.renderTodoVersion lfVersion
     expand mbSdkPath fp
       | fp `elem` basePackages = pure fp
       | isSdkPackage fp = case mbSdkPath of

sdk/compiler/damlc/daml-resolution-config/src/DA/Daml/Resolution/Config.hs

@@ -56,7 +56,7 @@ instance ToJSON DalfInfoCacheEntry where
   toJSON DalfInfoCacheEntry{..} = object
     [ "package_name" .= diPackageName
     , "package_version" .= diPackageVersion
-    , "lf_version" .= LF.renderVersion diLfVersion
+    , "lf_version" .= LF.renderTodoVersion diLfVersion
     , "timestamp" .= diTimestamp
     ]
 instance FromJSON DalfInfoCacheEntry where
@@ -174,8 +174,11 @@ findDarInDarInfos darInfos rawName lfVersion = do
   case availableVersions of
     [] -> do
       let allPackageNames = T.intercalate "," . nubOrd $ LF.unPackageName . diPackageName <$> Map.elems darInfos
+      let allPackageVersions = T.intercalate "," $ T.pack . show . diLfVersion <$> Map.elems darInfos
       Left $ "Package " <> rawName <> " could not be found, available packages are:\n"
         <> allPackageNames <> "\nIf your package is shown, it may not be compatible with your LF version."
+        <> "\nThis Lf version: " <> (T.pack . show) lfVersion
+        <> "\nAllPackageVersion: " <> (T.pack . show) allPackageVersions
     [_] ->
       -- Major LF versions aren't cross compatible, so all will be same major here due to canDependOn check above
       -- as such, we take maximum by minor version