digital-asset/daml
1
1
Fork 0
mirror of https://github.com/digital-asset/daml.git synced 2024-09-20 01:07:18 +03:00
Code Issues Projects Releases Wiki Activity

Make AnyChoice and AnyContractKey take template type into account (#3541)

Browse Source 
* Make AnyChoice and AnyContractKey take template type into account

fixes #3540

* Update template desugaring

* Switch to proper ghc-lib release
This commit is contained in:
Moritz Kiefer 2019-11-20 11:40:14 +01:00 committed by mergify[bot]
parent 917c43a048
commit 1bc4bb76a4
14 changed files with 131 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
WORKSPACE
View File

@ -520,12 +520,12 @@ HASKELL_LSP_HASH = "80a3944306fb455fce36f7b3aafb8f0f8f6096a0bd3c46ed25cc0ff288d6
GRPC_HASKELL_CORE_VERSION = "0.0.0.0"
GHC_LIB_VERSION = "8.8.1.20191111"
GHC_LIB_VERSION = "8.8.1.20191120"
http_archive(
name = "haskell_ghc__lib__parser",
build_file = "//3rdparty/haskell:BUILD.ghc-lib-parser",
sha256 = "2b406c537667e7a802aa1551a9c2b697b47d1b40e3d8d99f9d0711209a6636fd",
sha256 = "89e5e8eadd66a90970b866a0669da28b1cd4fff2511a2dc09151a5b269bc0bc1",
strip_prefix = "ghc-lib-parser-{}".format(GHC_LIB_VERSION),
urls = ["https://digitalassetsdk.bintray.com/ghc-lib/ghc-lib-parser-{}.tar.gz".format(GHC_LIB_VERSION)],
)
@ -598,7 +598,7 @@ hazel_repositories(
# Read [Working on ghc-lib] for ghc-lib update instructions at
# https://github.com/digital-asset/daml/blob/master/ghc-lib/working-on-ghc-lib.md.
hazel_ghclibs(GHC_LIB_VERSION, "0000000000000000000000000000000000000000000000000000000000000000", "89378f66a8283ddb785538e6d94c1a282d27fa2f3658b537ea5d3cee2efa786e") +
hazel_ghclibs(GHC_LIB_VERSION, "0000000000000000000000000000000000000000000000000000000000000000", "2433176141caffd066313876ef756e2fcb34dc96a809d40eec753a4248ba016e") +
hazel_github_external("digital-asset", "hlint", "951fdb6d28d7eed8ea1c7f3be69da29b61fcbe8f", "f5fb4cf98cde3ecf1209857208369a63ba21b04313d570c41dffe9f9139a1d34") +
# Not in stackage
hazel_hackage(

20
compiler/damlc/daml-lf-conversion/src/DA/Daml/LFConversion.hs
View File

@ -357,8 +357,6 @@ convertGenericTemplate env x
let thisField = FieldName "contract"
tupleTyCon <- qDA_Types env $ mkTypeCon ["Tuple2"]
let tupleType = TypeConApp tupleTyCon [TContractId polyType, polyType]
let anyContractKeyTy = TypeConApp (Qualified stdlibRef (mkModName ["DA", "Internal", "LF"]) (mkTypeCon ["AnyContractKey"])) []
let anyContractKeyField = mkField "getAnyContractKey"
let fetchByKey =
ETmLam (mkVar "key", keyType) $
EUpdate $ UBind (Binding (res, TTuple [(selfField, TContractId monoType), (thisField, monoType)]) $ EUpdate $ UFetchByKey $ RetrieveByKey monoTyCon $ EVar $ mkVar "key") $
@ -379,9 +377,9 @@ convertGenericTemplate env x
(mkTypeVar "proxy", KArrow KStar KStar)
(ETmLam
(mkVar "_", TApp (TVar $ mkTypeVar "proxy") polyType)
(ETmLam (mkVar "key", keyType) $ ERecCon anyContractKeyTy [(anyContractKeyField, EToAny keyType $ EVar $ mkVar "key")]))
(ETmLam (mkVar "key", keyType) $ EToAny keyType $ EVar $ mkVar "key"))
else EBuiltin BEError `ETyApp`
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> keyType :-> typeConAppToType anyContractKeyTy) `ETmApp`
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> keyType :-> TUnit) `ETmApp`
EBuiltin (BEText "toAnyContractKey is not supported in this DAML-LF version")
let fromAnyContractKey =
if envLfVersion env `supports` featureAnyType
@ -389,9 +387,9 @@ convertGenericTemplate env x
(mkTypeVar "proxy", KArrow KStar KStar)
(ETmLam
(mkVar "_", TApp (TVar $ mkTypeVar "proxy") polyType)
(ETmLam (mkVar "any", typeConAppToType anyContractKeyTy) $ EFromAny keyType $ ERecProj anyContractKeyTy anyContractKeyField $ EVar $ mkVar "any"))
(ETmLam (mkVar "any", TAny) $ EFromAny keyType $ EVar $ mkVar "any"))
else EBuiltin BEError `ETyApp`
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> typeConAppToType anyContractKeyTy :-> TOptional keyType) `ETmApp`
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> TUnit :-> TOptional keyType) `ETmApp`
EBuiltin (BEText "fromAnyContractKey is not supported in this DAML-LF version")
pure (Just $ TemplateKey keyType (applyThis key) (ETmApp maintainers hasKey), [hasKey, key, maintainers, fetchByKey, lookupByKey, toAnyContractKey, fromAnyContractKey], choices)
choices -> pure (Nothing, [], choices)
@ -427,17 +425,15 @@ convertGenericTemplate env x
let exercise =
mkETmLams [(self, TContractId polyType), (arg, argType)] $
EUpdate $ UExercise monoTyCon chcName (wrapCid $ EVar self) Nothing (EVar arg)
let anyChoiceTy = TypeConApp (Qualified stdlibRef (mkModName ["DA", "Internal", "LF"]) (mkTypeCon ["AnyChoice"])) []
let anyChoiceField = mkField "getAnyChoice"
let toAnyChoice =
if envLfVersion env `supports` featureAnyType
then ETyLam
(mkTypeVar "proxy", KArrow KStar KStar)
(ETmLam
(mkVar "_", TApp (TVar $ mkTypeVar "proxy") polyType)
(ETmLam chcArgBinder $ ERecCon anyChoiceTy [(anyChoiceField, EToAny argType $ EVar arg)]))
(ETmLam chcArgBinder $ EToAny argType $ EVar arg))
else EBuiltin BEError `ETyApp`
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> argType :-> typeConAppToType anyChoiceTy) `ETmApp`
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> argType :-> TUnit) `ETmApp`
EBuiltin (BEText "toAnyChoice is not supported in this DAML-LF version")
let fromAnyChoice =
if envLfVersion env `supports` featureAnyType
@ -445,9 +441,9 @@ convertGenericTemplate env x
(mkTypeVar "proxy", KArrow KStar KStar)
(ETmLam
(mkVar "_", TApp (TVar $ mkTypeVar "proxy") polyType)
(ETmLam (mkVar "any", typeConAppToType anyChoiceTy) $ EFromAny argType $ ERecProj anyChoiceTy anyChoiceField $ EVar $ mkVar "any"))
(ETmLam (mkVar "any", TAny) $ EFromAny argType $ EVar $ mkVar "any"))
else EBuiltin BEError `ETyApp`
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> typeConAppToType anyChoiceTy :-> TOptional argType) `ETmApp`
TForall (mkTypeVar "proxy", KArrow KStar KStar) (TApp (TVar $ mkTypeVar "proxy") polyType :-> TUnit :-> TOptional argType) `ETmApp`
EBuiltin (BEText "fromAnyChoice is not supported in this DAML-LF version")
pure (TemplateChoice{..}, [consumption, controllers, action, exercise, toAnyChoice, fromAnyChoice])
convertGenericChoice es = unhandled "generic choice" es

2
compiler/damlc/daml-stdlib-src/DA/Internal/Desugar.daml
View File

@ -11,7 +11,7 @@ module DA.Internal.Desugar (
Eq(..), Show(..),
Bool(..), Text, Optional,
concat, magic,
Party, ContractId, Update, AnyTemplate, AnyChoice, AnyContractKey, TemplateTypeRep
Party, ContractId, Update, Any, AnyTemplate, AnyChoice, AnyContractKey, TemplateTypeRep
) where
import DA.Internal.Prelude

15
compiler/damlc/daml-stdlib-src/DA/Internal/LF.daml
View File

@ -39,8 +39,9 @@ module DA.Internal.LF
, unpackPair
, AnyTemplate
, AnyChoice
, AnyContractKey
, AnyChoice(..)
, AnyContractKey(..)
, Any
, TemplateTypeRep
) where
@ -219,10 +220,16 @@ data Any = Any Opaque
newtype AnyTemplate = AnyTemplate { getAnyTemplate : Any }
-- | Existential choice type that can wrap an arbitrary choice.
newtype AnyChoice = AnyChoice { getAnyChoice : Any }
data AnyChoice = AnyChoice
{ getAnyChoice : Any
, getAnyChoiceTemplateTypRep : TemplateTypeRep
}
-- | Existential contract key type that can wrap an arbitrary contract key.
newtype AnyContractKey = AnyContractKey { getAnyContractKey : Any }
data AnyContractKey = AnyContractKey
{ getAnyContractKey : Any
, getanyContractKeyTemplateRep : TemplateTypeRep
}
-- | Value-level representation of a type.
-- We do not expose this directly and instead only expose TemplateTypeRep.

28
compiler/damlc/daml-stdlib-src/DA/Internal/Template.daml
View File

@ -58,14 +58,20 @@ stakeholder t = signatory t ++ observer t
class Template t => Choice t c r | t c -> r where
-- | Exercise a choice on the contract with the given contract ID.
exercise : ContractId t -> c -> Update r
_toAnyChoice : proxy t -> c -> AnyChoice
_fromAnyChoice : proxy t -> AnyChoice -> Optional c
_toAnyChoice : proxy t -> c -> Any
_fromAnyChoice : proxy t -> Any -> Optional c
toAnyChoice : forall t c r. Choice t c r => c -> AnyChoice
toAnyChoice = _toAnyChoice ([] : [t])
toAnyChoice c =
AnyChoice
(_toAnyChoice ([] : [t]) c)
(templateTypeRep @t)
fromAnyChoice : forall t c r. Choice t c r => AnyChoice -> Optional c
fromAnyChoice = _fromAnyChoice ([] : [t])
fromAnyChoice (AnyChoice any typeRep)
| Some c <- _fromAnyChoice ([] : [t]) any
, templateTypeRep @t == typeRep = Some c
| otherwise = None
class Template t => TemplateKey t k | t -> k where
-- | The key of a contract.
@ -101,14 +107,20 @@ class Template t => TemplateKey t k | t -> k where
-- | The list of maintainers of a contract key.
maintainer : k -> [Party]
_toAnyContractKey : proxy t -> k -> AnyContractKey
_fromAnyContractKey : proxy t -> AnyContractKey -> Optional k
_toAnyContractKey : proxy t -> k -> Any
_fromAnyContractKey : proxy t -> Any -> Optional k
toAnyContractKey : forall t k. TemplateKey t k => k -> AnyContractKey
toAnyContractKey = _toAnyContractKey ([] : [t])
toAnyContractKey k =
AnyContractKey
(_toAnyContractKey ([] : [t]) k)
(templateTypeRep @t)
fromAnyContractKey : forall t k. TemplateKey t k => AnyContractKey -> Optional k
fromAnyContractKey = _fromAnyContractKey ([] : [t])
fromAnyContractKey (AnyContractKey any rep)
| Some k <- _fromAnyContractKey ([] : [t]) any
, templateTypeRep @t == rep = Some k
| otherwise = None
-- | Exercise a choice on the contract associated with the given key.
--

2
compiler/damlc/daml-stdlib-src/Prelude.daml
View File

@ -7,7 +7,7 @@ daml 1.2
module Prelude (module X) where
import DA.Internal.Prelude as X hiding (magic)
import DA.Internal.LF as X hiding (Pair(..), TextMap, unpackPair)
import DA.Internal.LF as X hiding (Pair(..), TextMap, unpackPair, Any)
-- Template desugaring uses fromAnyTemplate and toAnyTemplate so we
-- can’t remove them from the typeclass for older LF versions
-- but we can hide them.

2
compiler/damlc/tests/daml-test-files/AnyChoice.daml
View File

@ -58,3 +58,5 @@ main = scenario do
fromAnyChoice @GT2 @(CT T2) (toAnyChoice @GT1 ct1) === None
fromAnyChoice @GT2 @(CT T2) (toAnyChoice @GT2 ct2) === Some ct2
fromAnyChoice @GT1 @(CT T1) (toAnyChoice @GT2 ct2) === None
fromAnyChoice @T1 @Archive (toAnyChoice @T2 Archive) === None
fromAnyChoice @T2 @Archive (toAnyChoice @T2 Archive) === Some Archive

10
compiler/damlc/tests/daml-test-files/AnyContractKey.daml
View File

@ -15,6 +15,15 @@ template T1
key p : Party
maintainer key
template T1'
with
x : Int
p : Party
where
signatory p
key p : Party
maintainer key
template T2
with
y : Text
@ -39,6 +48,7 @@ template instance GT2 = GenericT T2
main = scenario do
p <- getParty "alice"
fromAnyContractKey @T1 (toAnyContractKey @T1 p) === Some p
fromAnyContractKey @T1' (toAnyContractKey @T1 p) === None
fromAnyContractKey @T2 (toAnyContractKey @T2 (p, "foobar")) === Some (p, "foobar")
fromAnyContractKey @T2 (toAnyContractKey @T1 p) === None

21
compiler/damlc/tests/daml-test-files/ProposalDesugared.daml
View File

@ -10,6 +10,7 @@ module ProposalDesugared
( main
) where
import DA.Internal.Desugar
import DA.Assert
import DA.List
import DA.Text
@ -92,9 +93,9 @@ class Template t => ProposalInstance t where
_fetchByKeyProposal = error "code will be injected by the compiler"
_lookupByKeyProposal : ([Party], Text) -> Update (Optional (ContractId (Proposal t)))
_lookupByKeyProposal = error "code will be injected by the compiler"
_toAnyContractKeyProposal : proxy (Proposal t) -> ([Party], Text) -> AnyContractKey
_toAnyContractKeyProposal : proxy (Proposal t) -> ([Party], Text) -> Any
_toAnyContractKeyProposal = error "code will be injected by the compiler"
_fromAnyContractKeyProposal : proxy (Proposal t) -> AnyContractKey -> Optional ([Party], Text)
_fromAnyContractKeyProposal : proxy (Proposal t) -> Any -> Optional ([Party], Text)
_fromAnyContractKeyProposal = error "code will be injected by the compiler"
_consumptionProposalArchive : PreConsuming (Proposal t)
@ -106,9 +107,9 @@ class Template t => ProposalInstance t where
pure ()
_exerciseProposalArchive : ContractId (Proposal t) -> Archive -> Update ()
_exerciseProposalArchive = error "code will be injected by the compiler"
_toAnyChoiceProposalArchive : proxy (Proposal t) -> Archive -> AnyChoice
_toAnyChoiceProposalArchive : proxy (Proposal t) -> Archive -> Any
_toAnyChoiceProposalArchive = error "code will be injected by the compiler"
_fromAnyChoiceProposalArchive : proxy (Proposal t) -> AnyChoice -> Optional Archive
_fromAnyChoiceProposalArchive : proxy (Proposal t) -> Any -> Optional Archive
_fromAnyChoiceProposalArchive = error "code will be injected by the compiler"
_consumptionProposalAccept : PreConsuming (Proposal t)
@ -120,9 +121,9 @@ class Template t => ProposalInstance t where
create asset
_exerciseProposalAccept : ContractId (Proposal t) -> Accept -> Update (ContractId t)
_exerciseProposalAccept = error "code will be injected by the compiler"
_toAnyChoiceProposalAccept : proxy (Proposal t) -> Accept -> AnyChoice
_toAnyChoiceProposalAccept : proxy (Proposal t) -> Accept -> Any
_toAnyChoiceProposalAccept = error "code will be injected by the compiler"
_fromAnyChoiceProposalAccept : proxy (Proposal t) -> AnyChoice -> Optional Accept
_fromAnyChoiceProposalAccept : proxy (Proposal t) -> Any -> Optional Accept
_fromAnyChoiceProposalAccept = error "code will be injected by the compiler"
@ -190,9 +191,9 @@ class IouInstance where
pure ()
_exerciseIouArchive : ContractId Iou -> Archive -> Update ()
_exerciseIouArchive = error "code will be injected by the compiler"
_toAnyChoiceIouArchive : proxy Iou -> Archive -> AnyChoice
_toAnyChoiceIouArchive : proxy Iou -> Archive -> Any
_toAnyChoiceIouArchive = error "code will be injected by the compiler"
_fromAnyChoiceIouArchive : proxy Iou -> AnyChoice -> Optional Archive
_fromAnyChoiceIouArchive : proxy Iou -> Any -> Optional Archive
_fromAnyChoiceIouArchive = error "code will be injected by the compiler"
_consumptionIouBurn : PreConsuming Iou
@ -204,9 +205,9 @@ class IouInstance where
pure ()
_exerciseIouBurn : ContractId Iou -> Burn -> Update ()
_exerciseIouBurn = error "code will be injected by the compiler"
_toAnyChoiceIouBurn : proxy Iou -> Burn -> AnyChoice
_toAnyChoiceIouBurn : proxy Iou -> Burn -> Any
_toAnyChoiceIouBurn = error "code will be injected by the compiler"
_fromAnyChoiceIouBurn : proxy Iou -> AnyChoice -> Optional Burn
_fromAnyChoiceIouBurn : proxy Iou -> Any -> Optional Burn
_fromAnyChoiceIouBurn = error "code will be injected by the compiler"
instance IouInstance where

16
compiler/damlc/tests/src/DA/Test/DamlcIntegration.hs
View File

@ -120,6 +120,7 @@ getIntegrationTests registerTODO scenarioService version = do
-- only run Test.daml (see https://github.com/digital-asset/daml/issues/726)
bondTradingLocation <- locateRunfiles $ mainWorkspace </> "compiler/damlc/tests/bond-trading"
let allTestFiles = damlTestFiles ++ [("bond-trading/Test.daml", bondTradingLocation </> "Test.daml")]
let (generatedFiles, nongeneratedFiles) = partition (\(f, _) -> takeFileName f == "ProposalDesugared.daml") allTestFiles
let outdir = "compiler/damlc/output"
createDirectoryIfMissing True outdir
@ -134,12 +135,17 @@ getIntegrationTests registerTODO scenarioService version = do
-- initialise the compiler service
vfs <- makeVFSHandle
damlEnv <- mkDamlEnv opts (Just scenarioService)
-- We use a separate service for generated files so that we can test files containing internal imports.
pure $
withResource
(initialise (mainRule opts) (pure $ LSP.IdInt 0) (const $ pure ()) IdeLogger.noLogging damlEnv (toCompileOpts opts (IdeReportProgress False)) vfs)
shutdown $ \service ->
withTestArguments $ \args -> testGroup ("Tests for DAML-LF " ++ renderPretty version) $
map (testCase args version service outdir registerTODO) allTestFiles
withResource
(initialise (mainRule opts) (pure $ LSP.IdInt 0) (const $ pure ()) IdeLogger.noLogging damlEnv (toCompileOpts opts (IdeReportProgress False)) vfs)
shutdown $ \service ->
withResource
(initialise (mainRule opts) (pure $ LSP.IdInt 0) (const $ pure ()) IdeLogger.noLogging damlEnv (toCompileOpts opts { optIsGenerated = True } (IdeReportProgress False)) vfs)
shutdown $ \serviceGenerated ->
withTestArguments $ \args -> testGroup ("Tests for DAML-LF " ++ renderPretty version) $
map (testCase args version service outdir registerTODO) nongeneratedFiles <>
map (testCase args version serviceGenerated outdir registerTODO) generatedFiles
newtype TestCase = TestCase ((String -> IO ()) -> IO Result)

2
daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/Converter.scala
View File

@ -83,7 +83,7 @@ object Converter {
def toAnyChoice(v: SValue): Either[String, AnyChoice] = {
v match {
case SRecord(_, _, vals) if vals.size == 1 => {
case SRecord(_, _, vals) if vals.size == 2 => {
vals.get(0) match {
case SAny(_, choiceVal @ SRecord(_, _, _)) =>
Right(AnyChoice(choiceVal.id.qualifiedName.name.toString, choiceVal))

30
ghc-lib/template-desugaring.md
View File

@ -98,9 +98,9 @@ class IouInstance where
_actionIouArchive self this@Iou{..} arg@Archive = pure ()
_exerciseIouArchive : ContractId Iou -> Archive -> Update ()
_exerciseIouArchive = magic @"archive"
_toAnyChoiceIouArchive : proxy Iou -> Archive -> AnyChoice
_toAnyChoiceIouArchive : proxy Iou -> Archive -> Any
_toAnyChoiceIouArchive = magic @"toAnyChoice"
_fromAnyChoiceIouArchive : proxy Iou -> AnyChoice -> Optional Archive
_fromAnyChoiceIouArchive : proxy Iou -> Any -> Optional Archive
_fromAnyChoiceIouArchive = magic @"fromAnyChoice"
_consumptionIouTransfer : PreConsuming Iou
@ -111,9 +111,9 @@ class IouInstance where
_actionIouTransfer self this@Iou{..} arg@Transfer{..} = create this with owner = newOwner
_exerciseIouTransfer : ContractId Iou -> Transfer -> Update (ContractId Iou)
_exerciseIouTransfer = magic @"exercise"
_toAnyChoiceIouTransfer : proxy Iou -> Transfer -> AnyChoice
_toAnyChoiceIouTransfer : proxy Iou -> Transfer -> Any
_toAnyChoiceIouTransfer = magic @"toAnyChoice"
_fromAnyChoiceIouTransfer : proxy Iou -> AnyChoice -> Optional Transfer
_fromAnyChoiceIouTransfer : proxy Iou -> Any -> Optional Transfer
_fromAnyChoiceIouTransfer = magic @"fromAnyChoice"
```
@ -138,8 +138,8 @@ When a type `t` is a `Template` instance, `class Choice` (defined by the DAML st
```haskell
class Template t => Choice t c r | t c -> r where
exercise : ContractId t -> c -> Update r
_toAnyChoice : proxy t -> c -> AnyChoice
_fromAnyChoice : proxy t -> AnyChoice -> Optional c
_toAnyChoice : proxy t -> c -> Any
_fromAnyChoice : proxy t -> Any -> Optional c
```
In this example, `c` is identified with `Transfer` and `r` with `ContractId Iou`.
@ -163,6 +163,8 @@ class Template t => TemplateKey t k | t -> k where
key : t -> k
fetchByKey : k -> Update (ContractId t, t)
lookupByKey : k -> Update (Optional (ContractId t))
_toAnyContractKey : proxy t -> k -> Any
_fromAnyContractKey : proxy t -> Any -> Optional ks
```
In the following `Enrollment` contract, there are no choices but there are declarations of `key` and `maintainer`.
@ -237,9 +239,9 @@ class EnrollmentInstance where
_actionEnrollmentArchive self this@Enrollment{..} arg@Archive = pure ()
_exerciseEnrollmentArchive : ContractId Enrollment -> Archive -> Update ()
_exerciseEnrollmentArchive = magic @"archive"
_toAnyChoiceEnrollmentArchive : proxy Enrollment -> Archive -> AnyChoice
_toAnyChoiceEnrollmentArchive : proxy Enrollment -> Archive -> Any
_toAnyChoiceEnrollmentArchive = magic @"toAnyChoice"
_fromAnyChoiceEnrollmentArchive : proxy Enrollment -> AnyChoice -> Optional Archive
_fromAnyChoiceEnrollmentArchive : proxy Enrollment -> Any -> Optional Archive
_fromAnyChoiceEnrollmentArchive = magic @"fromAnyChoice"
instance EnrollmentInstance
@ -260,6 +262,8 @@ instance TemplateKey Enrollment Registration where
fetchByKey = _fetchByKeyEnrollment
lookupByKey = _lookupByKeyEnrollment
maintainer = _maintainerEnrollment (_hasKeyEnrollment : HasKey Enrollment)
_fromAnyContractKey = _fromAnyContractKeyEnrollment
_toAnyContractKey = _toAnyContractKeyEnrollment
```
### Example (3)
@ -335,9 +339,9 @@ class Template t => ProposalInstance t where
_actionProposalArchive self this@Proposal{..} arg@Archive = pure ()
_exerciseProposalArchive : ContractId (Proposal t) -> Archive -> Update ()
_exerciseProposalArchive = magic @"archive"
_toAnyChoiceProposalArchive : proxy (Proposal t) -> Archive -> AnyChoice
_toAnyChoiceProposalArchive : proxy (Proposal t) -> Archive -> Any
_toAnyChoiceProposalArchive = magic @"toAnyChoice"
_fromAnyChoiceProposalArchive : proxy (Proposal t) -> AnyChoice -> Optional Archive
_fromAnyChoiceProposalArchive : proxy (Proposal t) -> Any -> Optional Archive
_fromAnyChoiceProposalArchive = magic @"fromAnyChoice"
_consumptionProposalAccept : PreConsuming (Proposal t)
@ -349,9 +353,9 @@ class Template t => ProposalInstance t where
create asset
_exerciseProposalAccept : ContractId (Proposal t) -> Accept -> Update (ContractId t)
_exerciseProposalAccept = magic @"exercise"
_toAnyChoiceProposalAccept : proxy (Proposal t) -> Accept -> AnyChoice
_toAnyChoiceProposalAccept : proxy (Proposal t) -> Accept -> Any
_toAnyChoiceProposalAccept = magic @"toAnyChoice"
_fromAnyChoiceProposalAccept : proxy (Proposal t) -> AnyChoice -> Optional Accept
_fromAnyChoiceProposalAccept : proxy (Proposal t) -> Any -> Optional Accept
_fromAnyChoiceProposalAccept = magic @"fromAnyChoice"
instance ProposalInstance t => Template (Proposal t) where
@ -369,6 +373,8 @@ instance ProposalInstance t => TemplateKey (Proposal t) ([Party], Text) where
key = _keyProposal
fetchByKey = _fetchByKeyProposal
lookupByKey = _lookupByKeyProposal
_toAnyContractKey = _toAnyContractKeyProposal
_fromAnyContractKey = _fromAnyContractKeyProposal
instance ProposalInstance t => Choice (Proposal t) Accept (ContractId t) where
exercise = _exerciseProposalAccept

38
triggers/runner/src/main/scala/com/digitalasset/daml/lf/engine/trigger/Converter.scala
View File

@ -359,15 +359,39 @@ object Converter {
}
}
// Extract the value from a newtype wrapper around Any, e.g., AnyChoice or AnyContractKey
private def toAnyWrapper(wrapper: String, v: SValue): Either[String, SValue] = {
private def toAnyTemplate(v: SValue): Either[String, SValue] = {
v match {
case SRecord(_, _, vals) if vals.size == 1 =>
vals.get(0) match {
case SAny(_, v) => Right(v)
case v => Left(s"Expected Any but got $v")
}
case _ => Left(s"Expected $wrapper but got $v")
case _ => Left(s"Expected AnyTemplate but got $v")
}
}
// toAnyChoice and toAnyContractKey are identical right now
// but there is no resaon why they have to be, so we
// use two different methods.
private def toAnyChoice(v: SValue): Either[String, SValue] = {
v match {
case SRecord(_, _, vals) if vals.size == 2 =>
vals.get(0) match {
case SAny(_, v) => Right(v)
case v => Left(s"Expected Any but got $v")
}
case _ => Left(s"Expected AnyChoice but got $v")
}
}
private def toAnyContractKey(v: SValue): Either[String, SValue] = {
v match {
case SRecord(_, _, vals) if vals.size == 2 =>
vals.get(0) match {
case SAny(_, v) => Right(v)
case v => Left(s"Expected Any but got $v")
}
case _ => Left(s"Expected AnyContractKey but got $v")
}
}
@ -384,7 +408,7 @@ object Converter {
v match {
case SRecord(_, _, vals) if vals.size == 1 => {
for {
tpl <- toAnyWrapper("AnyTemplate", vals.get(0))
tpl <- toAnyTemplate(vals.get(0))
templateId <- extractTemplateId(tpl)
templateArg <- toLedgerRecord(tpl)
} yield CreateCommand(Some(toApiIdentifier(templateId)), Some(templateArg))
@ -398,7 +422,7 @@ object Converter {
case SRecord(_, _, vals) if vals.size == 2 => {
for {
anyContractId <- toAnyContractId(vals.get(0))
choiceVal <- toAnyWrapper("AnyChoice", vals.get(1))
choiceVal <- toAnyChoice(vals.get(1))
choiceName <- extractChoiceName(choiceVal)
choiceArg <- toLedgerValue(choiceVal)
} yield {
@ -420,9 +444,9 @@ object Converter {
case SRecord(_, _, vals) if vals.size == 3 => {
for {
tplId <- toTemplateTypeRep(vals.get(0))
keyVal <- toAnyWrapper("AnyContractKey", vals.get(1))
keyVal <- toAnyContractKey(vals.get(1))
keyArg <- toLedgerValue(keyVal)
choiceVal <- toAnyWrapper("AnyChoice", vals.get(2))
choiceVal <- toAnyChoice(vals.get(2))
choiceName <- extractChoiceName(choiceVal)
choiceArg <- toLedgerValue(choiceVal)
} yield {

3
unreleased.rst
View File

@ -47,3 +47,6 @@ HEAD — ongoing
See `issue #3461 <https://github.com/digital-asset/daml/pull/3461>`_.
- [JSON API - Experimental] Terminate process immediately after creating schema. See issue #3386.
- [DAML Stdlib] ``fromAnyChoice`` and ``fromAnyContractKey`` now take
the template type into account.