Use decodeArchivePackageId where possible (#4550)

Shouldn’t really make a difference due to laziness but at least it
makes it explicit if we need to decode the archive to the AST or just
need to get the package id.

changelog_begin
changelog_end
This commit is contained in:
Moritz Kiefer 2020-02-18 09:12:35 +01:00 committed by GitHub
parent 558f0d5042
commit ab74291f0a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 12 additions and 9 deletions

View File

@ -6,6 +6,7 @@
module DA.Daml.LF.Proto3.Archive
( decodeArchive
, decodeArchivePayload
, decodeArchivePackageId
, encodeArchive
, encodeArchiveLazy
, encodeArchiveAndHash
@ -78,6 +79,8 @@ decodeArchivePayload bytes = do
let packageId = LF.PackageId archiveHash
pure (packageId, payloadBytes)
decodeArchivePackageId :: BS.ByteString -> Either ArchiveError LF.PackageId
decodeArchivePackageId = fmap fst . decodeArchivePayload
-- | Encode a LFv1 package payload into a DAML-LF archive using the default
-- hash function.

View File

@ -698,10 +698,10 @@ execInspectDar inFile =
[e | e <- ZipArchive.zEntries dar, ".dalf" `isExtensionOf` ZipArchive.eRelativePath e]
forM_ dalfEntries $ \dalfEntry -> do
let dalf = BSL.toStrict $ ZipArchive.fromEntry dalfEntry
(pkgId, _lfPkg) <-
pkgId <-
errorOnLeft
("Cannot decode package " <> ZipArchive.eRelativePath dalfEntry)
(Archive.decodeArchive Archive.DecodeAsMain dalf)
(Archive.decodeArchivePackageId dalf)
putStrLn $
(dropExtension $ takeFileName $ ZipArchive.eRelativePath dalfEntry) <> " " <>
show (LF.unPackageId pkgId)

View File

@ -162,9 +162,9 @@ createProjectPackageDb projectRoot opts thisSdkVer deps dataDeps
-- All transitive packages from DARs specified in `dependencies`. This is only used for unit-id collision checks.
transitiveDependencies <- fmap concat $ forM depsExtracted $ \ExtractedDar{..} -> forM edDalfs $ \zipEntry -> do
let bytes = BSL.toStrict $ ZipArchive.fromEntry zipEntry
(pkgId, _) <- liftIO $
pkgId <- liftIO $
either (fail . DA.Pretty.renderPretty) pure $
Archive.decodeArchivePayload bytes
Archive.decodeArchivePackageId bytes
let unitId = parseUnitId (takeBaseName $ ZipArchive.eRelativePath zipEntry) pkgId
pure (pkgId, stringToUnitId unitId)

View File

@ -655,8 +655,8 @@ darPackageIds :: FilePath -> IO [LF.PackageId]
darPackageIds fp = do
archive <- Zip.toArchive <$> BSL.readFile fp
Dalfs mainDalf dalfDeps <- either fail pure $ readDalfs archive
Right parsedDalfs <- pure $ mapM (LFArchive.decodeArchive LFArchive.DecodeAsMain . BSL.toStrict) $ mainDalf : dalfDeps
pure $ map fst parsedDalfs
Right dalfPkgIds <- pure $ mapM (LFArchive.decodeArchivePackageId . BSL.toStrict) $ mainDalf : dalfDeps
pure dalfPkgIds
numStablePackages :: LF.Version -> Int

View File

@ -9,7 +9,7 @@ import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class(liftIO)
import DA.Bazel.Runfiles
import DA.Daml.LF.Proto3.Archive (DecodingMode(DecodeAsMain), decodeArchive)
import DA.Daml.LF.Proto3.Archive (decodeArchivePackageId)
import DA.Daml.LF.Reader(Dalfs(..),readDalfs)
import DA.Ledger as Ledger
import DA.Ledger.Sandbox (Sandbox,SandboxSpec(..),startSandbox,shutdownSandbox,withSandbox)
@ -726,9 +726,9 @@ mainPackageId :: SandboxSpec -> IO PackageId
mainPackageId SandboxSpec{dar} = do
archive <- Zip.toArchive <$> BSL.readFile dar
Dalfs { mainDalf } <- either fail pure $ readDalfs archive
case decodeArchive DecodeAsMain (BSL.toStrict mainDalf) of
case decodeArchivePackageId (BSL.toStrict mainDalf) of
Left err -> fail $ show err
Right (LF.PackageId pId, _) -> pure (PackageId $ TL.fromStrict pId)
Right (LF.PackageId pId) -> pure (PackageId $ TL.fromStrict pId)
----------------------------------------------------------------------
-- SharedSandbox