added lifecycle test example for IbericoPig

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

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 ()