From 86f6bb058bbd8da293489b47b2dcf1df4978f8c4 Mon Sep 17 00:00:00 2001 From: Judy Wu Date: Mon, 22 Aug 2022 18:01:02 +0800 Subject: [PATCH] added lifecycle test example for IbericoPig --- .../Daml/Finance/Asset/Test/IbericoPig.daml | 147 ++++++++++++++++++ .../Asset/Test/IbericoPigLifeCycle.daml | 134 ++++++++++++++++ 2 files changed, 281 insertions(+) create mode 100644 src/test/daml/Daml/Finance/Asset/Test/IbericoPig.daml create mode 100644 src/test/daml/Daml/Finance/Asset/Test/IbericoPigLifeCycle.daml diff --git a/src/test/daml/Daml/Finance/Asset/Test/IbericoPig.daml b/src/test/daml/Daml/Finance/Asset/Test/IbericoPig.daml new file mode 100644 index 000000000..a166ba582 --- /dev/null +++ b/src/test/daml/Daml/Finance/Asset/Test/IbericoPig.daml @@ -0,0 +1,147 @@ +module Daml.Finance.Asset.Test.IbericoPig where + + +import ContingentClaims.Claim (Claim(..), one, scale) +import ContingentClaims.Observation (Observation(..)) +import Daml.Finance.Interface.Asset.Instrument qualified as Instrument (I, View(..), disclosureUpdateReference) +import Daml.Finance.Interface.Asset.Types (Id(..), InstrumentKey(..)) +import Daml.Finance.Interface.Common.Classes (toUTCTime) +import Daml.Finance.Interface.Common.Disclosure qualified as Disclosure (I, SetObservers(..), View(..)) +import Daml.Finance.Interface.Common.Types (Observers) +import Daml.Finance.Interface.Derivative.Types (Deliverable, TaggedClaim, C, taggedClaim) +import Daml.Finance.Interface.Common.Util (flattenObservers) +import Daml.Finance.Interface.Lifecycle.Lifecyclable qualified as Lifecyclable (I, Lifecycle(..), View(..)) +import Daml.Finance.RefData.Time.DateClock (Unit(..)) +import Daml.Finance.Interface.Derivative.Util.Claims.Lifecycle qualified as Lifecycle (lifecycle, splitPending, timeEvent) +import Daml.Finance.Interface.Derivative.Util.Claims(toTime') +import Daml.Finance.Interface.Derivative.HasClaims qualified as HasClaims (I, View(..)) +import Daml.Finance.Lifecycle.Effect (Effect(..)) +import Daml.Finance.Interface.Lifecycle.Event qualified as Event (I, View(..), getEventTime) +import DA.Set (singleton) +import DA.Text (sha256) +import DA.Date (toDateUTC) + +data State = Pig + | Butchered + | Salted + | Aged -- todo add age with int different int will have diff price + | Restaurant + | Eaten + deriving (Show, Eq) + +template StateTransitionEvent + with + currentOwner: Party + newOwner: Party + eventTime: Time + currentState: State + where + signatory currentOwner, newOwner + + implements Event.I where + view = Event.View with eventTime + + +template IbericoPig + with + farmer: Party + -- ^ The farmer that raised the pig + id: Id + -- ^ An identifier of the pig as an instrument + -- (version will be the hash of the state that this pig is currently in + observers: Observers + -- ^ observers of the Iberico Pig, visible to public + state: State + -- ^ Current state of the pig, need to be in sequence + + matureDate: Date + -- ^ Date that the farmer deemed the the pig has mature + + cashInstrumentCid : Deliverable + -- ^ The cash instrument used to pay for one unit of pig. + + where + signatory farmer -- for simplicity we will use single signatory in this example + observer flattenObservers observers + + let + instrumentKey = InstrumentKey with depository = farmer; issuer = farmer; id + + getClaimFromState: State -> Claim Date Decimal Deliverable Text -- todo I don't really need time/date + getClaimFromState targetState = + scale (Observe (show targetState)) $ one cashInstrumentCid -- todo as it turn out I cannot put target as Observable + + -- getRemainingClaims: [Claim Date Decimal Deliverable Text] -- todo how have all claims for remaining state in pig + -- getRemainingClaims = + -- let remainingStates = case state of + -- Pig -> [Pig, Butchered, Aged, Restaurant] + -- Butchered -> [Aged, Restaurant] + -- Salted -> [Aged, Restaurant] + -- Aged -> [Restaurant] + -- Restaurant -> [Restaurant] + -- _ -> [] in + -- map getClaimFromState remainingStates + nextState: State + nextState = + case state of + Pig -> Butchered + Butchered -> Salted + Salted -> Aged + Aged -> Restaurant + Restaurant -> Eaten + Eaten -> Eaten -- way to abort and remove this + + implements HasClaims.I where + view = HasClaims.View with acquisitionTime = (toUTCTime . Unit) matureDate + getClaims = do + prepareAndTagClaims [getClaimFromState state] (show state) + + implements Instrument.I where + asDisclosure = toInterface @Disclosure.I this + view = Instrument.View with issuer = farmer; depository = farmer; id; validAsOf = (toUTCTime . Unit) matureDate + getKey = instrumentKey + + implements Lifecyclable.I where + view = Lifecyclable.View with lifecycler = farmer -- should not be farmer + lifecycle Lifecyclable.Lifecycle{ruleName; settler; eventCid; clockCid; observableCids} self = do + t <- Event.getEventTime <$> fetch eventCid + let + claimPig = toInterface @HasClaims.I this + (remaining, pending) <- Lifecycle.lifecycle observableCids claimPig [Lifecycle.timeEvent t] + let + (consumed, produced) = Lifecycle.splitPending pending + newKey = instrumentKey with id.version = sha256 $ show remaining + Some event <- fromInterface @StateTransitionEvent <$> fetch eventCid + newInstrumentCid <- create this with id = newKey.id; state = nextState + let + settlementDate = toDateUTC event.eventTime + effectCid <- toInterfaceContractId <$> create Effect with + provider = farmer + settler + targetInstrument = instrumentKey + producedInstrument = Some newKey + consumed + produced + settlementDate + id = id.label <> "-" <> show settlementDate + observers = (.observers) . _view $ toInterface @Disclosure.I this + pure (toInterfaceContractId newInstrumentCid, [effectCid]) + + implements Disclosure.I where + view = Disclosure.View with disclosureControllers = singleton $ singleton farmer; observers + setObservers Disclosure.SetObservers{newObservers} = do + cid <- toInterfaceContractId <$> create this with observers = newObservers + Instrument.disclosureUpdateReference newObservers instrumentKey cid + archive' self = archive (coerceContractId self : ContractId IbericoPig) + + +prepareAndTagClaims : Applicative f => [Claim Date Decimal Deliverable Text] -> Text -> f [TaggedClaim] +prepareAndTagClaims claim tag = do + let + claims = mapClaimToUTCTime $ mconcat claim + pure [taggedClaim tag claims] + + +mapClaimToUTCTime : Claim Date Decimal Deliverable Text -> C +mapClaimToUTCTime = -- todo can I get rid of this time conversion, don't think i need this + let dateToTime = toUTCTime . Unit in toTime' dateToTime \ No newline at end of file diff --git a/src/test/daml/Daml/Finance/Asset/Test/IbericoPigLifeCycle.daml b/src/test/daml/Daml/Finance/Asset/Test/IbericoPigLifeCycle.daml new file mode 100644 index 000000000..547a3b661 --- /dev/null +++ b/src/test/daml/Daml/Finance/Asset/Test/IbericoPigLifeCycle.daml @@ -0,0 +1,134 @@ +module Daml.Finance.Asset.Test.IbericoPigLifeCycle where + +import Daml.Finance.Interface.Asset.Instrument qualified as Instrument (I) +import Daml.Finance.Asset.Test.Util.Account qualified as Account +import Daml.Finance.Asset.Fungible as Fungible +import Daml.Finance.Interface.Asset.Holding qualified as Holding (I) +import Daml.Finance.Asset.Test.Util.Instrument qualified as Instrument (originate, createReference, submitExerciseInterfaceByKeyCmd) +import Daml.Finance.Interface.Asset.Transferable qualified as Transferable (I) +import Daml.Finance.Interface.Lifecycle.Lifecyclable qualified as Lifecyclable (I, Lifecycle(..)) +import Daml.Finance.Interface.Settlement.Settleable qualified as Settleable (Settle(..)) +import Daml.Finance.Interface.Settlement.Instruction qualified as Instruction +import Daml.Finance.Test.Util.Common (createParties) +import Daml.Finance.Asset.Test.IbericoPig +import Daml.Finance.Bond.Util(dateToDateClockTime) -- todo can this be move to a more general place) +import Daml.Finance.Interface.Asset.Types (Id(..)) +import Daml.Finance.RefData.Observation (Observation(..)) +import Daml.Finance.RefData.Time.DateClock +import Daml.Finance.Settlement.Batch +import Daml.Finance.Lifecycle.Rule.Settlement +import Daml.Finance.Interface.Lifecycle.SettlementRule qualified as SettlementRule +import Daml.Script +import DA.Date +import DA.Time +import DA.Set qualified as S +import DA.Text (sha256) +import DA.Map qualified as M +{- +pig (pig farmer) -> butchering (butcher) -> salting -> aging (food processor) -> ship to restaurant (shop owner, shipping company) -> tasting (me) +1. pig farmer sell pig to butcher, effect: target pig -> produced unprocessed ham, produced cash to farmer) +2. butcher sell unprocessed ham to food processor, effect: target unprocessed ham -> unprocessed ham in factory, produced cash to butcher +3. food processor done salting, effect: target unprocessed ham in factory -> produced salted non-aged ham +4. food processor done aging, effect: target salted non-aged ham -> produced aged ham +5. restaurant bought aged ham from food processor, effect: target aged ham -> produced aged ham in restauarant, produced cash to food processor and shipping company) +6. I order and eat aged ham in the restaurant, effect: target aged ham in restaurant, produced aged ham eaten/archived, produced cash to restaurant +-} + + +{- Implementation steps +1. setup: create parties, account/holding factory, create accounts, credit cash to butcher, food processor, restaurant, me +2. create "Instrument" IbericoPig (version will be presented using status hash) template +3. orignate IbericoPig and credit it into pig farmer's account +4. implement steps 1-6 +-} + +ibericoHamLifeCycle: Script () +ibericoHamLifeCycle = do +-- allocate parties +parties@[farmer, butcher, foodProcessor, shippingCompany, restaurant, judy, public, bank] <- + createParties ["Pig Farmer", "Butcher", "Food Processor", "Shipping Company", "Restaurant", "Judy", "Public", "Bank"] + +-- create account/holding factory +let publicObserver = [("factoryProvider", S.singleton $ S.singleton public)] +accountFactoryCid <- toInterfaceContractId <$> Account.createFactory bank publicObserver +holdingFactoryCid <- toInterfaceContractId <$> submit bank do + createCmd Fungible.Factory with provider = bank; observers = M.fromList publicObserver + +-- create accounts +[farmerAccount, butcherAccount, foodProcessorAccount, shippingCompanyAccount, restaurantAccount, judyAccount, _, bankAccount] <- + mapA (Account.createAccount [public] accountFactoryCid holdingFactoryCid [] bank) parties + +-- originate cash +now <- getTime +cashInstrumentCid <- Instrument.originate bank bank "EUR" publicObserver now + +-- originate IbericoPig and add to farmers account +let + pigInKg:Decimal = 100.0 + state = Pig + id = Id with label = "IbericoPig"; version = sha256 $ show state + observers = M.fromList publicObserver + matureDate = date 2020 Jun 15 + +ibericoPigCid <- toInterfaceContractId @Instrument.I <$> submit farmer do createCmd IbericoPig with farmer; id; observers; state; matureDate; cashInstrumentCid +ibericoPigKey <- Instrument.createReference ibericoPigCid farmer farmer publicObserver +-- need to read as public as we need holding factory to create new holdings +transferableIbericoPig: ContractId Transferable.I <- Account.credit [public] ibericoPigKey pigInKg farmerAccount + +-- lifecycle ibericoPig for step 1, create pig price observable and pig sold event +let + settler = bank + eventTime = time (matureDate) 12 30 00 + observations = M.fromList [(dateToDateClockTime (matureDate), 1.0)] + lifecycleObserver = [("PigLifecycler", S.singleton $ S.singleton farmer)] + +pigPriceOnMatureDateCid <- toInterfaceContractId <$> submit butcher do + createCmd Observation with provider = butcher; obsKey = show Pig; observations; observers = M.fromList lifecycleObserver +-- butcherPigPriceOnMatureDateCid <- toInterfaceContractId <$> submit foodProcessor do createCmd Observation with provider = foodProcessor; obsKey = show Butchered; observations; observers = M.fromList lifecycleObserver +-- agedHamPriceOnMatureDateCid <- toInterfaceContractId <$> submit restaurant do createCmd Observation with provider = restaurant; obsKey = show Aged; observations; observers = M.fromList lifecycleObserver +-- restaurantHamPriceOnMatureDateCid <- toInterfaceContractId <$> submit restaurant do createCmd Observation with provider = restaurant; obsKey = show Restaurant; observations; observers = M.fromList lifecycleObserver + +pigSoldEventCid <- toInterfaceContractId <$> submitMulti [farmer, butcher] [] do + createCmd StateTransitionEvent with currentOwner = farmer; newOwner = butcher; eventTime; currentState = state + +-- create clock with mature to declare that current time is mature date +clockCid <- toInterfaceContractId <$> submit farmer do + createCmd DateClock with u = Unit matureDate; id = show matureDate; provider = farmer; observers = M.empty +(soldPigCid , [effectCid]) <- Instrument.submitExerciseInterfaceByKeyCmd @Lifecyclable.I [farmer] [public] ibericoPigKey + Lifecyclable.Lifecycle with settler; eventCid = pigSoldEventCid; + observableCids = [pigPriceOnMatureDateCid]; + ruleName = show state; clockCid + +-- Settlement, create settlement factory, settlement rule and get claim result +factoryCid <- submit farmer do createCmd BatchFactory with provider = farmer; observers = S.empty + +settlementRuleCid <- submitMulti [bank, farmer] [] do + createCmd Rule + with + custodian = bank + owner = farmer + claimers = S.singleton farmer -- Can I make new instrument go into butcher's account? No, not in the current rule implementation + settler + instructableCid = toInterfaceContractId factoryCid + +result <- submitMulti [farmer] [public] do + exerciseCmd settlementRuleCid SettlementRule.Claim with + claimer = farmer + holdingCids = [toInterfaceContractId @Holding.I transferableIbericoPig] + effectCid +let + Some [soldPigHoldingsCid] = result.newInstrumentHoldingCids + [paymentForPigInstructionCid] = result.instructionCids + paymentBatchForPigCid = result.containerCid + +-- can we setup instruction for butcher to pay farmer not for bank to pay farmer? No, not in the current rule implementation +-- Allocate Cash +cashForPigPayment <- Account.credit [public] cashInstrumentCid 100.0 bankAccount +paymentForPigInstructionCid <- submit bank do exerciseCmd paymentForPigInstructionCid Instruction.Allocate with transferableCid = cashForPigPayment + +-- Approve Instruction with receiver account +submit farmer do exerciseCmd paymentForPigInstructionCid Instruction.Approve with receiverAccount = farmerAccount + +-- Settle the payment +submit bank do exerciseCmd paymentBatchForPigCid Settleable.Settle +pure () \ No newline at end of file