Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Split daml-lf encode/decode Haskell libraries #11906

Merged
merged 2 commits into from
Nov 29, 2021
Merged

Split daml-lf encode/decode Haskell libraries #11906

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
87c7da6
Split daml-lf encode/decode Haskell libraries
cocreature Nov 29, 2021
7f681ad
Fix dependants
cocreature Nov 29, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
93 changes: 85 additions & 8 deletions compiler/daml-lf-proto/BUILD.bazel
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,28 +4,105 @@
load("//bazel_tools:haskell.bzl", "da_haskell_library")

da_haskell_library(
name = "daml-lf-proto",
srcs = glob(["src/**/*.hs"]),
name = "daml-lf-util",
srcs =
[
"src/DA/Daml/LF/Mangling.hs",
"src/DA/Daml/LF/Proto3/Error.hs",
"src/DA/Daml/LF/Proto3/Util.hs",
],
hackage_deps = [
"base",
"bytestring",
"containers",
"cryptonite",
"either",
"text",
],
deps = [
"//compiler/daml-lf-ast",
"//daml-lf/archive:daml_lf_dev_archive_haskell_proto",
],
)

da_haskell_library(
name = "daml-lf-proto-decode",
srcs = [
"src/DA/Daml/LF/Proto3/Archive/Decode.hs",
"src/DA/Daml/LF/Proto3/Decode.hs",
"src/DA/Daml/LF/Proto3/DecodeV1.hs",
],
hackage_deps = [
"base",
"containers",
"lens",
"cryptonite",
"memory",
"bytestring",
"mtl",
"proto3-suite",
"scientific",
"template-haskell",
"text",
"transformers",
"vector",
],
visibility = ["//visibility:public"],
deps = [
":daml-lf-util",
"//compiler/daml-lf-ast",
"//daml-lf/archive:daml_lf_dev_archive_haskell_proto",
"//libs-haskell/da-hs-base",
],
)

da_haskell_library(
name = "daml-lf-proto-encode",
srcs = [
"src/DA/Daml/LF/Proto3/Archive/Encode.hs",
"src/DA/Daml/LF/Proto3/Encode.hs",
"src/DA/Daml/LF/Proto3/EncodeV1.hs",
],
hackage_deps = [
"base",
"bytestring",
"cryptonite",
"memory",
"containers",
"mtl",
"lens",
"text",
"vector",
"proto3-suite",
"unordered-containers",
],
visibility = ["//visibility:public"],
deps = [
":daml-lf-util",
"//compiler/daml-lf-ast",
"//daml-lf/archive:daml_lf_dev_archive_haskell_proto",
"//libs-haskell/da-hs-base",
],
)

da_haskell_library(
name = "daml-lf-proto",
srcs = [
"src/DA/Daml/LF/Proto3/Archive.hs",
],
hackage_deps = [
"base",
"containers",
"cryptonite",
"memory",
"bytestring",
"mtl",
"lens",
"text",
"vector",
"proto3-suite",
"unordered-containers",
],
src_strip_prefix = "src",
visibility = ["//visibility:public"],
deps = [
":daml-lf-proto-decode",
":daml-lf-proto-encode",
":daml-lf-util",
"//compiler/daml-lf-ast",
"//daml-lf/archive:daml_lf_dev_archive_haskell_proto",
"//libs-haskell/da-hs-base",
Expand Down
133 changes: 4 additions & 129 deletions compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/Archive.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,136 +1,11 @@
-- Copyright (c) 2021 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0


-- | Utilities for working with DAML-LF protobuf archives
module DA.Daml.LF.Proto3.Archive
( decodeArchive
, decodeArchivePackageId
, decodePackage
, encodeArchive
, encodeArchiveLazy
, encodeArchiveAndHash
, encodePackageHash
, ArchiveError(..)
, DecodingMode(..)
( module DA.Daml.LF.Proto3.Archive.Decode
, module DA.Daml.LF.Proto3.Archive.Encode
) where

import Control.Lens (over, _Left)
import qualified "cryptonite" Crypto.Hash as Crypto
import qualified Com.Daml.DamlLfDev.DamlLf as ProtoLF
import Control.Monad
import Data.List
import DA.Pretty
import qualified DA.Daml.LF.Ast as LF
import qualified DA.Daml.LF.Proto3.Decode as Decode
import qualified DA.Daml.LF.Proto3.Encode as Encode
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Int
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Numeric
import qualified Proto3.Suite as Proto

data ArchiveError
= ProtobufError !String
| UnknownHashFunction !Int32
| HashMismatch !T.Text !T.Text
deriving (Eq, Show)

-- | Mode in which to decode the DALF. Currently, this only decides whether
-- to rewrite occurrences of `PRSelf` with `PRImport packageId`.
data DecodingMode
= DecodeAsMain
-- ^ Keep occurrences of `PRSelf` as is.
| DecodeAsDependency
-- ^ Replace `PRSelf` with `PRImport packageId`, where `packageId` is
-- the id of the package being decoded.
deriving (Eq, Show)

-- | Decode an LF archive, returning the package-id and the package
decodeArchive :: DecodingMode -> BS.ByteString -> Either ArchiveError (LF.PackageId, LF.Package)
decodeArchive mode bytes = do
(packageId, payloadBytes) <- decodeArchiveHeader bytes
package <- decodePackage mode packageId payloadBytes
return (packageId, package)

-- | Decode an LF archive payload, returning the package
-- Used to decode a BS returned from the PackageService ledger API
decodePackage :: DecodingMode -> LF.PackageId -> BS.ByteString -> Either ArchiveError LF.Package
decodePackage mode packageId payloadBytes = do
let selfPackageRef = case mode of
DecodeAsMain -> LF.PRSelf
DecodeAsDependency -> LF.PRImport packageId
payload <- over _Left (ProtobufError . show) $ Proto.fromByteString payloadBytes
over _Left (ProtobufError. show) $ Decode.decodePayload selfPackageRef payload

-- | Decode an LF archive header, returning the package-id and the payload
decodeArchiveHeader :: BS.ByteString -> Either ArchiveError (LF.PackageId, BS.ByteString)
decodeArchiveHeader bytes = do
archive <- over _Left (ProtobufError . show) $ Proto.fromByteString bytes
let payloadBytes = ProtoLF.archivePayload archive
let archiveHash = TL.toStrict (ProtoLF.archiveHash archive)

computedHash <- case ProtoLF.archiveHashFunction archive of
Proto.Enumerated (Right ProtoLF.HashFunctionSHA256) ->
Right $ encodeHash (BA.convert (Crypto.hash @_ @Crypto.SHA256 payloadBytes) :: BS.ByteString)
Proto.Enumerated (Left idx) ->
Left (UnknownHashFunction idx)

when (computedHash /= archiveHash) $
Left (HashMismatch archiveHash computedHash)
let packageId = LF.PackageId archiveHash
pure (packageId, payloadBytes)

-- | Decode an LF archive, returning the package-id
decodeArchivePackageId :: BS.ByteString -> Either ArchiveError LF.PackageId
decodeArchivePackageId = fmap fst . decodeArchiveHeader

-- | Encode a LFv1 package payload into a DAML-LF archive using the default
-- hash function.
encodeArchiveLazy :: LF.Package -> BSL.ByteString
encodeArchiveLazy = fst . encodeArchiveAndHash

encodePackageHash :: LF.Package -> LF.PackageId
encodePackageHash = snd . encodeArchiveAndHash

encodeArchiveAndHash :: LF.Package -> (BSL.ByteString, LF.PackageId)
encodeArchiveAndHash package =
let payload = BSL.toStrict $ Proto.toLazyByteString $ Encode.encodePayload package
hash = encodeHash (BA.convert (Crypto.hash @_ @Crypto.SHA256 payload) :: BS.ByteString)
archive =
ProtoLF.Archive
{ ProtoLF.archivePayload = payload
, ProtoLF.archiveHash = TL.fromStrict hash
, ProtoLF.archiveHashFunction = Proto.Enumerated (Right ProtoLF.HashFunctionSHA256)
}
in (Proto.toLazyByteString archive, LF.PackageId hash)

encodeArchive :: LF.Package -> BS.ByteString
encodeArchive = BSL.toStrict . encodeArchiveLazy

-- | Encode the hash bytes of the payload in the canonical
-- lower-case ascii7 hex presentation.
encodeHash :: BS.ByteString -> T.Text
encodeHash = T.pack . reverse . foldl' toHex [] . BS.unpack
where
toHex xs c =
case Numeric.showHex c "" of
[n1, n2] -> n2 : n1 : xs
[n2] -> n2 : '0' : xs
_ -> error "impossible: showHex returned [] on Word8"

instance Pretty ArchiveError where
pPrint =
\case
ProtobufError e -> "Protobuf error: " <> pretty e
UnknownHashFunction i ->
"Unknown hash function with identifier " <> pretty i
HashMismatch h1 h2 ->
vsep
[ "Computed package hash doesn't match with given package hash: "
, label_ "Package hash: " $ pretty h1
, label_ "Computed hash: " $ pretty h2
]
import DA.Daml.LF.Proto3.Archive.Decode
import DA.Daml.LF.Proto3.Archive.Encode
93 changes: 93 additions & 0 deletions compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/Archive/Decode.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,93 @@
-- Copyright (c) 2021 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

module DA.Daml.LF.Proto3.Archive.Decode
( decodeArchive
, decodeArchivePackageId
, decodePackage
, ArchiveError(..)
, DecodingMode(..)
) where

import Control.Lens (over, _Left)
import qualified "cryptonite" Crypto.Hash as Crypto
import qualified Com.Daml.DamlLfDev.DamlLf as ProtoLF
import Control.Monad
import DA.Pretty
import qualified DA.Daml.LF.Ast as LF
import qualified DA.Daml.LF.Proto3.Decode as Decode
import DA.Daml.LF.Proto3.Util (encodeHash)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import Data.Int
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Proto3.Suite as Proto

data ArchiveError
= ProtobufError !String
| UnknownHashFunction !Int32
| HashMismatch !T.Text !T.Text
deriving (Eq, Show)

-- | Mode in which to decode the DALF. Currently, this only decides whether
-- to rewrite occurrences of `PRSelf` with `PRImport packageId`.
data DecodingMode
= DecodeAsMain
-- ^ Keep occurrences of `PRSelf` as is.
| DecodeAsDependency
-- ^ Replace `PRSelf` with `PRImport packageId`, where `packageId` is
-- the id of the package being decoded.
deriving (Eq, Show)

-- | Decode an LF archive, returning the package-id and the package
decodeArchive :: DecodingMode -> BS.ByteString -> Either ArchiveError (LF.PackageId, LF.Package)
decodeArchive mode bytes = do
(packageId, payloadBytes) <- decodeArchiveHeader bytes
package <- decodePackage mode packageId payloadBytes
return (packageId, package)

-- | Decode an LF archive payload, returning the package
-- Used to decode a BS returned from the PackageService ledger API
decodePackage :: DecodingMode -> LF.PackageId -> BS.ByteString -> Either ArchiveError LF.Package
decodePackage mode packageId payloadBytes = do
let selfPackageRef = case mode of
DecodeAsMain -> LF.PRSelf
DecodeAsDependency -> LF.PRImport packageId
payload <- over _Left (ProtobufError . show) $ Proto.fromByteString payloadBytes
over _Left (ProtobufError. show) $ Decode.decodePayload selfPackageRef payload

-- | Decode an LF archive header, returning the package-id and the payload
decodeArchiveHeader :: BS.ByteString -> Either ArchiveError (LF.PackageId, BS.ByteString)
decodeArchiveHeader bytes = do
archive <- over _Left (ProtobufError . show) $ Proto.fromByteString bytes
let payloadBytes = ProtoLF.archivePayload archive
let archiveHash = TL.toStrict (ProtoLF.archiveHash archive)

computedHash <- case ProtoLF.archiveHashFunction archive of
Proto.Enumerated (Right ProtoLF.HashFunctionSHA256) ->
Right $ encodeHash (BA.convert (Crypto.hash @_ @Crypto.SHA256 payloadBytes) :: BS.ByteString)
Proto.Enumerated (Left idx) ->
Left (UnknownHashFunction idx)

when (computedHash /= archiveHash) $
Left (HashMismatch archiveHash computedHash)
let packageId = LF.PackageId archiveHash
pure (packageId, payloadBytes)

-- | Decode an LF archive, returning the package-id
decodeArchivePackageId :: BS.ByteString -> Either ArchiveError LF.PackageId
decodeArchivePackageId = fmap fst . decodeArchiveHeader

instance Pretty ArchiveError where
pPrint =
\case
ProtobufError e -> "Protobuf error: " <> pretty e
UnknownHashFunction i ->
"Unknown hash function with identifier " <> pretty i
HashMismatch h1 h2 ->
vsep
[ "Computed package hash doesn't match with given package hash: "
, label_ "Package hash: " $ pretty h1
, label_ "Computed hash: " $ pretty h2
]
43 changes: 43 additions & 0 deletions compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/Archive/Encode.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,43 @@
-- Copyright (c) 2021 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

module DA.Daml.LF.Proto3.Archive.Encode
( encodeArchive
, encodeArchiveLazy
, encodeArchiveAndHash
, encodePackageHash
) where

import qualified "cryptonite" Crypto.Hash as Crypto
import qualified Com.Daml.DamlLfDev.DamlLf as ProtoLF
import qualified DA.Daml.LF.Ast as LF
import qualified DA.Daml.LF.Proto3.Encode as Encode
import DA.Daml.LF.Proto3.Util (encodeHash)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text.Lazy as TL
import qualified Proto3.Suite as Proto

-- | Encode a LFv1 package payload into a DAML-LF archive using the default
-- hash function.
encodeArchiveLazy :: LF.Package -> BSL.ByteString
encodeArchiveLazy = fst . encodeArchiveAndHash

encodePackageHash :: LF.Package -> LF.PackageId
encodePackageHash = snd . encodeArchiveAndHash

encodeArchiveAndHash :: LF.Package -> (BSL.ByteString, LF.PackageId)
encodeArchiveAndHash package =
let payload = BSL.toStrict $ Proto.toLazyByteString $ Encode.encodePayload package
hash = encodeHash (BA.convert (Crypto.hash @_ @Crypto.SHA256 payload) :: BS.ByteString)
archive =
ProtoLF.Archive
{ ProtoLF.archivePayload = payload
, ProtoLF.archiveHash = TL.fromStrict hash
, ProtoLF.archiveHashFunction = Proto.Enumerated (Right ProtoLF.HashFunctionSHA256)
}
in (Proto.toLazyByteString archive, LF.PackageId hash)

encodeArchive :: LF.Package -> BS.ByteString
encodeArchive = BSL.toStrict . encodeArchiveLazy
Loading