From e45ab4a6c4ad0dfb5e0e16d5cb566470cbafcf01 Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Thu, 18 Jan 2024 10:40:33 +0100 Subject: [PATCH 01/25] add files for new AutoCallable instrument --- .../AutoCallable/Factory.daml | 73 +++++++ .../AutoCallable/Instrument.daml | 162 ++++++++++++++++ .../AutoCallable/Factory.daml | 41 ++++ .../AutoCallable/Instrument.daml | 34 ++++ .../StructuredProduct/AutoCallable/Types.daml | 52 +++++ .../StructuredProduct/Test/AutoCallable.daml | 179 ++++++++++++++++++ 6 files changed, 541 insertions(+) create mode 100644 src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml create mode 100644 src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml create mode 100644 src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml create mode 100644 src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml create mode 100644 src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml create mode 100644 src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml new file mode 100644 index 000000000..58effb7b4 --- /dev/null +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -0,0 +1,73 @@ +-- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module Daml.Finance.Instrument.StructuredProduct.AutoCallable.Factory where + +import DA.Set (singleton) +import Daml.Finance.Instrument.StructuredProduct.BarrierReverseConvertible.Instrument qualified as BarrierReverseConvertible (Instrument(..)) +import Daml.Finance.Interface.Claims.Claim qualified as Claim (GetClaims(..), I, getClaims) +import Daml.Finance.Interface.Instrument.Base.Instrument qualified as BaseInstrument (createReference) +import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Factory qualified as BarrierReverseConvertibleFactory (Create(..), I, View(..)) +import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Types (BarrierReverseConvertible(..)) +import Daml.Finance.Interface.Types.Common.Types (PartiesMap) +import Daml.Finance.Interface.Util.Disclosure qualified as Disclosure (I, View(..), flattenObservers) +import Daml.Finance.Util.Disclosure (addObserversImpl, removeObserversImpl, setObserversImpl) + +-- | Type synonym for `Factory`. +type T = Factory + +-- | Factory template for instrument creation. +template Factory + with + provider : Party + -- ^ The factory's provider. + observers : PartiesMap + -- ^ The factory's observers. + where + signatory provider + observer Disclosure.flattenObservers observers + + interface instance BarrierReverseConvertibleFactory.I for Factory where + view = BarrierReverseConvertibleFactory.View with provider + create' BarrierReverseConvertibleFactory.Create{ + barrierReverseConvertible = BarrierReverseConvertible{instrument; description; + referenceAssetId; strike; barrier; barrierStartDate; expiryDate; currency; + lastEventTimestamp; couponRate; periodicSchedule; holidayCalendarIds; + calendarDataProvider; dayCountConvention; notional; prevEvents}; + observers} = do + let + brcInstrument = BarrierReverseConvertible.Instrument with + depository = instrument.depository + issuer = instrument.issuer + id = instrument.id + version = instrument.version + holdingStandard = instrument.holdingStandard + description + referenceAssetId + strike + barrier + barrierStartDate + expiryDate + couponRate + periodicSchedule + holidayCalendarIds + calendarDataProvider + dayCountConvention + currency + notional + lastEventTimestamp + observers + prevEvents + cid <- toInterfaceContractId <$> create brcInstrument + BaseInstrument.createReference instrument.depository $ toInterfaceContractId cid + -- Get the claims in order to run the associated checks (e.g. verify that the schedules + -- are valid). + Claim.getClaims (toInterface @Claim.I brcInstrument) $ + Claim.GetClaims with actor = instrument.issuer + pure cid + + interface instance Disclosure.I for Factory where + view = Disclosure.View with disclosureControllers = singleton provider; observers + setObservers = setObserversImpl @Factory @Disclosure.I this None + addObservers = addObserversImpl @Factory @Disclosure.I this None + removeObservers = removeObserversImpl @Factory @Disclosure.I this None diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml new file mode 100644 index 000000000..2c9417064 --- /dev/null +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -0,0 +1,162 @@ +-- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module Daml.Finance.Instrument.StructuredProduct.AutoCallable.Instrument where + +import DA.Date (daysSinceEpochToDate) +import DA.Set (singleton) +import Daml.Finance.Claims.Util.Builders (createBarrierEuropeanCashClaim, createFixRatePaymentClaims, createFxAdjustedPrincipalClaim) +import Daml.Finance.Data.Reference.HolidayCalendar (getHolidayCalendars, rollSchedule) +import Daml.Finance.Data.Time.DateClock (dateToDateClockTime) +import Daml.Finance.Interface.Claims.Claim qualified as Claim (GetClaims(..), I, View(..)) +import Daml.Finance.Interface.Claims.Dynamic.Instrument qualified as DynamicInstrument (CreateNewVersion(..), I, View(..)) +import Daml.Finance.Interface.Claims.Types (EventData) +import Daml.Finance.Interface.Instrument.Base.Instrument qualified as BaseInstrument (I, View(..), createReference, disclosureUpdateReference, instrumentKey) +import Daml.Finance.Interface.Instrument.Option.Types (BarrierTypeEnum(..), OptionTypeEnum(..)) +import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Instrument qualified as BarrierReverseConvertible (I, View(..)) +import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Types (BarrierReverseConvertible(..)) +import Daml.Finance.Interface.Types.Common.Types (HoldingStandard(..), Id(..), InstrumentKey(..), PartiesMap) +import Daml.Finance.Interface.Types.Date.DayCount (DayCountConventionEnum) +import Daml.Finance.Interface.Types.Date.Schedule (PeriodicSchedule(..)) +import Daml.Finance.Interface.Util.Disclosure qualified as Disclosure (I, View(..), flattenObservers) +import Daml.Finance.Util.Disclosure (addObserversImpl, removeObserversImpl, setObserversImpl) + +-- | Type synonym for `Instrument`. +type T = Instrument + +-- | This template models a Barrier Reverse Convertible (BRC) instrument. +-- It can be seen as a long fixed coupon bond and a short Down-And-In put option. +template Instrument + with + depository : Party + -- ^ The depository of the instrument. + issuer : Party + -- ^ The issuer of the instrument. + id : Id + -- ^ An identifier of the instrument. + version : Text + -- ^ The instrument's version. + holdingStandard : HoldingStandard + -- ^ The holding standard for holdings referencing this instrument. + description : Text + -- ^ A description of the instrument. + referenceAssetId : Text + -- ^ The reference asset ID. For example, in case of an option on AAPL this should be a valid + -- reference to the AAPL fixings to be used for the payoff calculation. + strike : Decimal + -- ^ The strike price of the option. + barrier : Decimal + -- ^ The barrier level of the option. + barrierStartDate : Date + -- ^ The start date for barrier observations. + expiryDate : Date + -- ^ The expiry date of the instrument. + couponRate : Decimal + -- ^ The fixed coupon rate, per annum. For example, in case of a "3.5% p.a coupon" this should + -- be 0.035. + periodicSchedule : PeriodicSchedule + -- ^ The schedule for the periodic coupon payments. + holidayCalendarIds : [Text] + -- ^ The identifiers of the holiday calendars to be used for the coupon schedule. + calendarDataProvider : Party + -- ^ The reference data provider to use for the holiday calendar. + dayCountConvention : DayCountConventionEnum + -- ^ The day count convention used to calculate day count fractions. For example: Act360. + currency : InstrumentKey + -- ^ The currency of the product. For example, if the product pays in USD this should be a USD + -- cash instrument. + notional : Decimal + -- ^ The notional of the product. This is the face value corresponding to one unit of the + -- product. For example, if one product unit corresponds to 1000 USD, this should be 1000.0. + observers : PartiesMap + -- ^ The observers of the instrument. + lastEventTimestamp : Time + -- ^ (Market) time of the last recorded lifecycle event. If no event has occurred yet, the + -- time of creation should be used. + prevEvents : [EventData] + -- ^ A list of previous events that have been lifecycled on this instrument so far. + where + signatory depository, issuer + observer Disclosure.flattenObservers observers + + interface instance Claim.I for Instrument where + view = Claim.View with acquisitionTime = dateToDateClockTime $ daysSinceEpochToDate 0 + getClaims Claim.GetClaims{actor} = do + -- get the initial claims tree (as of the instrument's acquisition time) + + assertMsg "option expiry date must match last coupon date" $ + expiryDate == periodicSchedule.terminationDate + + -- Calculate option claim + let + ownerReceives = False + optionType = Put + barrierType = DownAndIn + referenceLevel = Some strike + call = optionType == Call + (down, out) = case barrierType of + UpAndOut -> (False, True) + DownAndOut -> (True, True) + UpAndIn -> (False, False) + DownAndIn -> (True, False) + optionsClaim = createBarrierEuropeanCashClaim dateToDateClockTime ownerReceives strike + referenceAssetId currency expiryDate call barrier barrierStartDate down out + referenceLevel notional + getCalendars = getHolidayCalendars actor calendarDataProvider + + -- Calculate bond claim + (schedule, _) <- rollSchedule getCalendars periodicSchedule holidayCalendarIds + let + useAdjustedDatesForDcf = True + ownerReceives = True + fxAdjustment = 1.0 + couponClaims = createFixRatePaymentClaims dateToDateClockTime schedule periodicSchedule + useAdjustedDatesForDcf couponRate ownerReceives dayCountConvention notional currency + redemptionClaim = createFxAdjustedPrincipalClaim dateToDateClockTime ownerReceives + fxAdjustment notional currency periodicSchedule.terminationDate + + -- Return BRC claim as option + bond claim + pure [optionsClaim, couponClaims, redemptionClaim] + + interface instance BaseInstrument.I for Instrument where + view = BaseInstrument.View with + depository; issuer; id; version; holdingStandard; description + validAsOf = lastEventTimestamp + getKey = BaseInstrument.instrumentKey this + + interface instance BarrierReverseConvertible.I for Instrument where + view = BarrierReverseConvertible.View with + barrierReverseConvertible = BarrierReverseConvertible with + instrument = BaseInstrument.instrumentKey this + description + referenceAssetId + strike + barrier + barrierStartDate + expiryDate + couponRate + periodicSchedule + holidayCalendarIds + calendarDataProvider + dayCountConvention + currency + notional + lastEventTimestamp + prevEvents + + interface instance DynamicInstrument.I for Instrument where + view = DynamicInstrument.View with lifecycler = issuer; lastEventTimestamp; prevEvents + createNewVersion DynamicInstrument.CreateNewVersion{version; lastEventTimestamp; + prevEvents} = do + cid <- create this with version; lastEventTimestamp; prevEvents + BaseInstrument.createReference issuer $ toInterfaceContractId cid + pure $ toInterfaceContractId cid + + interface instance Disclosure.I for Instrument where + view = Disclosure.View with disclosureControllers = singleton issuer; observers + setObservers = setObserversImpl @Instrument this $ + Some . BaseInstrument.disclosureUpdateReference $ BaseInstrument.instrumentKey this + addObservers = addObserversImpl @Instrument this $ + Some . BaseInstrument.disclosureUpdateReference $ BaseInstrument.instrumentKey this + removeObservers = removeObserversImpl this . + Some . BaseInstrument.disclosureUpdateReference $ BaseInstrument.instrumentKey this diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml new file mode 100644 index 000000000..d7bf38d70 --- /dev/null +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -0,0 +1,41 @@ +-- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Factory where + +import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Instrument qualified as Instrument (I) +import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Types (BarrierReverseConvertible) +import Daml.Finance.Interface.Types.Common.Types (PartiesMap) +import Daml.Finance.Interface.Util.Disclosure qualified as Disclosure (I) + +-- | Type synonym for `Factory`. +type I = Factory + +-- | Type synonym for `View`. +type V = View + +-- | View of `Factory`. +data View = View + with + provider : Party + -- ^ The provider of the `Factory`. + deriving (Eq, Show) + +-- | Factory interface to instantiate BRCs. +interface Factory requires Disclosure.I where + viewtype V + + create' : Create -> Update (ContractId Instrument.I) + -- ^ Implementation of `Create` choice. + + nonconsuming choice Create : ContractId Instrument.I + -- ^ Create a new instrument. + with + barrierReverseConvertible : BarrierReverseConvertible + -- ^ Attributes to create a BRC. + observers : PartiesMap + -- ^ The instrument's observers. + controller + barrierReverseConvertible.instrument.depository, barrierReverseConvertible.instrument.issuer + do + create' this arg diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml new file mode 100644 index 000000000..b2042646f --- /dev/null +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -0,0 +1,34 @@ +-- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Instrument where + +import Daml.Finance.Interface.Instrument.Base.Instrument qualified as BaseInstrument (I) +import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Types (BarrierReverseConvertible) +import Daml.Finance.Interface.Util.Disclosure qualified as Disclosure (I) + +-- | Type synonym for `Instrument`. +type I = Instrument + +-- | Type synonym for `View`. +type V = View + +-- | View of `Instrument`. +data View = View + with + barrierReverseConvertible : BarrierReverseConvertible + -- ^ Attributes of a BRC. + deriving (Eq, Show) + +-- | Instrument interface representing a BRC. +interface Instrument requires BaseInstrument.I, Disclosure.I where + viewtype V + + nonconsuming choice GetView : V + -- ^ Retrieves the interface view. + with + viewer : Party + -- ^ The party retrieving the view. + controller viewer + do + pure $ view this diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml new file mode 100644 index 000000000..21b44065b --- /dev/null +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml @@ -0,0 +1,52 @@ +-- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Types where + +import Daml.Finance.Interface.Claims.Types (EventData) +import Daml.Finance.Interface.Types.Common.Types (InstrumentKey(..)) +import Daml.Finance.Interface.Types.Date.DayCount (DayCountConventionEnum) +import Daml.Finance.Interface.Types.Date.Schedule (PeriodicSchedule(..)) + +-- | Describes the attributes of a Barrier Reverse Convertible (BRC) instrument. +-- It can be seen as a long fixed coupon bond and a short Down-And-In put option. +data BarrierReverseConvertible = BarrierReverseConvertible + with + instrument : InstrumentKey + -- ^ The instrument's key. + description : Text + -- ^ The description of the option. + referenceAssetId : Text + -- ^ The reference asset ID. For example, in case of an option on AAPL this should be a valid + -- reference to the AAPL fixings to be used for the payoff calculation. + strike : Decimal + -- ^ The strike price of the option. + barrier : Decimal + -- ^ The barrier level of the option. + barrierStartDate : Date + -- ^ The start date for barrier observations. + expiryDate : Date + -- ^ The expiry date of the instrument. + couponRate : Decimal + -- ^ The fixed coupon rate, per annum. For example, in case of a "3.5% p.a coupon" this should + -- be 0.035. + periodicSchedule : PeriodicSchedule + -- ^ The schedule for the periodic coupon payments. + holidayCalendarIds : [Text] + -- ^ The identifiers of the holiday calendars to be used for the coupon schedule. + calendarDataProvider : Party + -- ^ The reference data provider to use for the holiday calendar. + dayCountConvention : DayCountConventionEnum + -- ^ The day count convention used to calculate day count fractions. For example: Act360. + currency : InstrumentKey + -- ^ The currency of the product. For example, if the product pays in USD this should be a USD + -- cash instrument. + notional : Decimal + -- ^ The notional of the product. This is the face value corresponding to one unit of the + -- product. For example, if one product unit corresponds to 1000 USD, this should be 1000.0. + lastEventTimestamp : Time + -- ^ (Market) time of the last recorded lifecycle event. If no event has occurred yet, the + -- time of creation should be used. + prevEvents : [EventData] + -- ^ A list of previous events that have been lifecycled on this instrument so far. + deriving (Eq, Show) diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml new file mode 100644 index 000000000..a2cde1684 --- /dev/null +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml @@ -0,0 +1,179 @@ +-- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module Daml.Finance.Instrument.StructuredProduct.Test.AutoCallable where + +import DA.Date (DayOfWeek(..), Month(..), date) +import DA.Map qualified as Map (fromList) +import DA.Set qualified as Set (singleton) +import Daml.Finance.Data.Numeric.Observation (Observation(..)) +import Daml.Finance.Data.Reference.HolidayCalendar (HolidayCalendar(..)) +import Daml.Finance.Data.Time.DateClock (dateToDateClockTime) +import Daml.Finance.Instrument.StructuredProduct.Test.Util (originateBarrierReverseConvertible) +import Daml.Finance.Interface.Types.Common.Types (HoldingStandard(..), Id(..)) +import Daml.Finance.Interface.Types.Date.Calendar (BusinessDayConventionEnum(..), HolidayCalendarData(..)) +import Daml.Finance.Interface.Types.Date.DayCount (DayCountConventionEnum(..)) +import Daml.Finance.Interface.Types.Date.RollConvention (PeriodEnum(..)) +import Daml.Finance.Interface.Util.Common (qty) +import Daml.Finance.Test.Util.Common (createParties) +import Daml.Finance.Test.Util.Instrument (originate) +import Daml.Finance.Test.Util.Lifecycle (lifecycleAndVerifyPaymentEffects, verifyNoLifecycleEffects) +import Daml.Finance.Test.Util.Time (createPaymentPeriodicSchedule) +import Daml.Script + +-- Define and lifecycle a barrier reverse convertible (BRC). +run : Script () +run = script do + [custodian, issuer, calendarDataProvider, publicParty] <- + createParties ["Custodian", "Issuer", "Calendar Data Provider", "PublicParty"] + + -- Account and holding factory + let pp = [("FactoryProvider", Set.singleton publicParty)] + + -- Distribute commercial-bank cash + now <- getTime + let observers = [("PublicParty", Set.singleton publicParty)] + cashInstrument <- originate custodian issuer "USD" TransferableFungible "US Dollars" observers now + + -- Create and distribute option + let + barrierLow = 20.0 + strikeLow = 35.0 + -- CREATE_BARRIER_REVERSE_CONVERTIBLE_VARIABLES_BEGIN + barrier = 30.0 + barrierStartDate = date 2019 Jan 16 + strike = 40.0 + expiryDate = date 2019 May 15 + referenceAssetId = "AAPL-CLOSE" + couponRate = 0.05 + issueDate = date 2019 Jan 16 + firstCouponDate = date 2019 Feb 15 + maturityDate = date 2019 May 15 + -- CREATE_BARRIER_REVERSE_CONVERTIBLE_VARIABLES_END + businessDayConvention = Following + couponPeriod = M + couponPeriodMultiplier = 3 + dayCountConvention = Act360 + holidayCalendarIds = ["USD"] + calendar = + HolidayCalendarData with + id = "USD" + weekend = [Saturday, Sunday] + holidays = [] + couponSchedule = createPaymentPeriodicSchedule firstCouponDate holidayCalendarIds + businessDayConvention couponPeriod couponPeriodMultiplier issueDate maturityDate + notional = 1.0 + + -- CREATE_BARRIER_REVERSE_CONVERTIBLE_OBSERVATIONS_BEGIN + let + observations = Map.fromList + [ (dateToDateClockTime $ date 2019 Feb 13, 28.78) + , (dateToDateClockTime $ date 2019 Feb 15, 39.78) + , (dateToDateClockTime $ date 2019 May 15, 38.78) + , (dateToDateClockTime $ date 2019 May 16, 18.78) + , (dateToDateClockTime $ date 2019 May 17, 38.78) + ] + observableCid <- toInterfaceContractId <$> submit issuer do + createCmd Observation with + provider = issuer; id = Id referenceAssetId; observations; observers = mempty + -- CREATE_BARRIER_REVERSE_CONVERTIBLE_OBSERVATIONS_END + + -- A reference data provider publishes the holiday calendar on the ledger + calendarCid <- submit calendarDataProvider do + createCmd HolidayCalendar with + provider = calendarDataProvider + calendar + observers = Map.fromList pp + + -------------------------------- + -- 1. BRC with barrier event -- + -------------------------------- + + -- Test option with barrier hit (on Feb 13). Option expires in the money. + brcInstrument <- originateBarrierReverseConvertible issuer issuer "BRC" TransferableFungible + "Option" observers now expiryDate strike barrier barrierStartDate cashInstrument + referenceAssetId couponRate couponSchedule holidayCalendarIds dayCountConvention notional + calendarDataProvider publicParty + + let + expectedConsumed = [] + expectedProduced = [] + Some brcInstrumentAfterBarrierHit <- lifecycleAndVerifyPaymentEffects [publicParty] + (date 2019 Feb 13) brcInstrument issuer [observableCid] expectedConsumed expectedProduced + + let + expectedConsumed = [] + expectedProduced = [qty 0.0041666667 cashInstrument] + Some brcInstrumentAfterCouponPayment <- lifecycleAndVerifyPaymentEffects [publicParty] + firstCouponDate brcInstrumentAfterBarrierHit issuer [observableCid] expectedConsumed + expectedProduced + + let + expectedConsumed = [qty 0.0305 cashInstrument] + expectedProduced = [(qty 0.0123611111 cashInstrument), (qty 1.0 cashInstrument)] + lifecycleAndVerifyPaymentEffects [publicParty] expiryDate brcInstrumentAfterCouponPayment issuer + [observableCid] expectedConsumed expectedProduced + + -- Test option with barrier hit (on Feb 13). Option expires out of the money. + + brcLowStrikeInstrument <- originateBarrierReverseConvertible issuer issuer "BRCLowStrike" + TransferableFungible "Option" observers now expiryDate strikeLow barrier barrierStartDate + cashInstrument referenceAssetId couponRate couponSchedule holidayCalendarIds dayCountConvention + notional calendarDataProvider publicParty + + let + expectedConsumed = [] + expectedProduced = [] + Some brcInstrumentAfterBarrierHit <- lifecycleAndVerifyPaymentEffects [publicParty] + (date 2019 Feb 13) brcLowStrikeInstrument issuer [observableCid] expectedConsumed + expectedProduced + + let + expectedConsumed = [] + expectedProduced = [qty 0.0041666667 cashInstrument] + Some brcInstrumentAfterCouponPayment <- lifecycleAndVerifyPaymentEffects [publicParty] + firstCouponDate brcInstrumentAfterBarrierHit issuer [observableCid] expectedConsumed + expectedProduced + + let + expectedConsumed = [] + expectedProduced = [(qty 0.0123611111 cashInstrument), (qty 1.0 cashInstrument)] + lifecycleAndVerifyPaymentEffects [publicParty] expiryDate brcInstrumentAfterCouponPayment issuer + [observableCid] expectedConsumed expectedProduced + + -------------------------------------------------- + -- 2. BRC without barrier event (before expiry) -- + -------------------------------------------------- + + -- Test option without barrier hit. Also test a barrier hit after expiry. + brcLowBarrierInstrument <- originateBarrierReverseConvertible issuer issuer "DownAndInLow" + TransferableFungible "Option" observers now expiryDate strike barrierLow barrierStartDate + cashInstrument referenceAssetId couponRate couponSchedule holidayCalendarIds dayCountConvention + notional calendarDataProvider publicParty + + verifyNoLifecycleEffects [publicParty] (date 2019 Feb 13) brcLowBarrierInstrument + issuer [observableCid] + + let + expectedConsumed = [] + expectedProduced = [qty 0.0041666667 cashInstrument] + Some brcInstrumentAfterCouponPayment <- lifecycleAndVerifyPaymentEffects [publicParty] + firstCouponDate brcLowBarrierInstrument issuer [observableCid] expectedConsumed expectedProduced + + let + expectedConsumed = [] + expectedProduced = [(qty 0.0123611111 cashInstrument), (qty 1.0 cashInstrument)] + Some brcInstrumentAfterExpiry <- lifecycleAndVerifyPaymentEffects [publicParty] expiryDate + brcInstrumentAfterCouponPayment issuer [observableCid] expectedConsumed expectedProduced + + let + expectedConsumed = [] + expectedProduced = [] + Some brcInstrumentAfterBarrierHit <- lifecycleAndVerifyPaymentEffects [publicParty] + (date 2019 May 16) brcInstrumentAfterExpiry issuer [observableCid] expectedConsumed + expectedProduced + + verifyNoLifecycleEffects [publicParty] (date 2019 May 17) brcInstrumentAfterBarrierHit + issuer [observableCid] + + pure () From 09872d06771fb5fd2c2d7c67fa84dbd67a94b38e Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Thu, 18 Jan 2024 10:45:44 +0100 Subject: [PATCH 02/25] run packell --- .../daml/Daml.Finance.Instrument.StructuredProduct/daml.yaml | 2 +- .../daml.yaml | 2 +- .../Daml.Finance.Instrument.StructuredProduct.Test/daml.yaml | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/package/main/daml/Daml.Finance.Instrument.StructuredProduct/daml.yaml b/package/main/daml/Daml.Finance.Instrument.StructuredProduct/daml.yaml index b92f3a0d4..c417207c2 100644 --- a/package/main/daml/Daml.Finance.Instrument.StructuredProduct/daml.yaml +++ b/package/main/daml/Daml.Finance.Instrument.StructuredProduct/daml.yaml @@ -14,7 +14,7 @@ data-dependencies: - .lib/daml-finance/Daml.Finance.Interface.Claims/3.0.0/daml-finance-interface-claims-3.0.0.dar - .lib/daml-finance/Daml.Finance.Interface.Instrument.Base/3.0.0/daml-finance-interface-instrument-base-3.0.0.dar - .lib/daml-finance/Daml.Finance.Interface.Instrument.Option/0.3.0/daml-finance-interface-instrument-option-0.3.0.dar - - .lib/daml-finance/Daml.Finance.Interface.Instrument.StructuredProduct/0.1.0/daml-finance-interface-instrument-structuredproduct-0.1.0.dar + - .lib/daml-finance/Daml.Finance.Interface.Instrument.StructuredProduct/0.1.1/daml-finance-interface-instrument-structuredproduct-0.1.1.dar - .lib/daml-finance/Daml.Finance.Interface.Types.Common/2.0.0/daml-finance-interface-types-common-2.0.0.dar - .lib/daml-finance/Daml.Finance.Interface.Types.Date/2.1.0/daml-finance-interface-types-date-2.1.0.dar - .lib/daml-finance/Daml.Finance.Interface.Util/2.1.0/daml-finance-interface-util-2.1.0.dar diff --git a/package/main/daml/Daml.Finance.Interface.Instrument.StructuredProduct/daml.yaml b/package/main/daml/Daml.Finance.Interface.Instrument.StructuredProduct/daml.yaml index 8c50acff9..7c3e450ac 100644 --- a/package/main/daml/Daml.Finance.Interface.Instrument.StructuredProduct/daml.yaml +++ b/package/main/daml/Daml.Finance.Interface.Instrument.StructuredProduct/daml.yaml @@ -4,7 +4,7 @@ sdk-version: 2.8.0 name: daml-finance-interface-instrument-structuredproduct source: daml -version: 0.1.0 +version: 0.1.1 dependencies: - daml-prim - daml-stdlib diff --git a/package/test/daml/Daml.Finance.Instrument.StructuredProduct.Test/daml.yaml b/package/test/daml/Daml.Finance.Instrument.StructuredProduct.Test/daml.yaml index 1b57ec644..38f2f742c 100644 --- a/package/test/daml/Daml.Finance.Instrument.StructuredProduct.Test/daml.yaml +++ b/package/test/daml/Daml.Finance.Instrument.StructuredProduct.Test/daml.yaml @@ -12,7 +12,7 @@ dependencies: data-dependencies: - .lib/daml-finance/Daml.Finance.Data/3.0.1/daml-finance-data-3.0.1.dar - .lib/daml-finance/Daml.Finance.Instrument.StructuredProduct/0.1.1/daml-finance-instrument-structuredproduct-0.1.1.dar - - .lib/daml-finance/Daml.Finance.Interface.Instrument.StructuredProduct/0.1.0/daml-finance-interface-instrument-structuredproduct-0.1.0.dar + - .lib/daml-finance/Daml.Finance.Interface.Instrument.StructuredProduct/0.1.1/daml-finance-interface-instrument-structuredproduct-0.1.1.dar - .lib/daml-finance/Daml.Finance.Interface.Types.Common/2.0.0/daml-finance-interface-types-common-2.0.0.dar - .lib/daml-finance/Daml.Finance.Interface.Types.Date/2.1.0/daml-finance-interface-types-date-2.1.0.dar - .lib/daml-finance/Daml.Finance.Interface.Util/2.1.0/daml-finance-interface-util-2.1.0.dar From f19da56e8ae883d3868f9b7837f5e9c30c4437ab Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Thu, 18 Jan 2024 10:46:07 +0100 Subject: [PATCH 03/25] update instrument name --- .../StructuredProduct/AutoCallable/Factory.daml | 10 +++++----- .../StructuredProduct/AutoCallable/Instrument.daml | 10 +++++----- .../StructuredProduct/AutoCallable/Factory.daml | 6 +++--- .../StructuredProduct/AutoCallable/Instrument.daml | 4 ++-- .../StructuredProduct/AutoCallable/Types.daml | 2 +- 5 files changed, 16 insertions(+), 16 deletions(-) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml index 58effb7b4..f14308072 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -4,11 +4,11 @@ module Daml.Finance.Instrument.StructuredProduct.AutoCallable.Factory where import DA.Set (singleton) -import Daml.Finance.Instrument.StructuredProduct.BarrierReverseConvertible.Instrument qualified as BarrierReverseConvertible (Instrument(..)) +import Daml.Finance.Instrument.StructuredProduct.AutoCallable.Instrument qualified as AutoCallable (Instrument(..)) import Daml.Finance.Interface.Claims.Claim qualified as Claim (GetClaims(..), I, getClaims) import Daml.Finance.Interface.Instrument.Base.Instrument qualified as BaseInstrument (createReference) -import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Factory qualified as BarrierReverseConvertibleFactory (Create(..), I, View(..)) -import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Types (BarrierReverseConvertible(..)) +import Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Factory qualified as BarrierReverseConvertibleFactory (Create(..), I, View(..)) +import Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Types (AutoCallable(..)) import Daml.Finance.Interface.Types.Common.Types (PartiesMap) import Daml.Finance.Interface.Util.Disclosure qualified as Disclosure (I, View(..), flattenObservers) import Daml.Finance.Util.Disclosure (addObserversImpl, removeObserversImpl, setObserversImpl) @@ -30,13 +30,13 @@ template Factory interface instance BarrierReverseConvertibleFactory.I for Factory where view = BarrierReverseConvertibleFactory.View with provider create' BarrierReverseConvertibleFactory.Create{ - barrierReverseConvertible = BarrierReverseConvertible{instrument; description; + barrierReverseConvertible = AutoCallable{instrument; description; referenceAssetId; strike; barrier; barrierStartDate; expiryDate; currency; lastEventTimestamp; couponRate; periodicSchedule; holidayCalendarIds; calendarDataProvider; dayCountConvention; notional; prevEvents}; observers} = do let - brcInstrument = BarrierReverseConvertible.Instrument with + brcInstrument = AutoCallable.Instrument with depository = instrument.depository issuer = instrument.issuer id = instrument.id diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index 2c9417064..cf0d72de3 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -13,8 +13,8 @@ import Daml.Finance.Interface.Claims.Dynamic.Instrument qualified as DynamicInst import Daml.Finance.Interface.Claims.Types (EventData) import Daml.Finance.Interface.Instrument.Base.Instrument qualified as BaseInstrument (I, View(..), createReference, disclosureUpdateReference, instrumentKey) import Daml.Finance.Interface.Instrument.Option.Types (BarrierTypeEnum(..), OptionTypeEnum(..)) -import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Instrument qualified as BarrierReverseConvertible (I, View(..)) -import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Types (BarrierReverseConvertible(..)) +import Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Instrument qualified as AutoCallable (I, View(..)) +import Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Types (AutoCallable(..)) import Daml.Finance.Interface.Types.Common.Types (HoldingStandard(..), Id(..), InstrumentKey(..), PartiesMap) import Daml.Finance.Interface.Types.Date.DayCount (DayCountConventionEnum) import Daml.Finance.Interface.Types.Date.Schedule (PeriodicSchedule(..)) @@ -124,9 +124,9 @@ template Instrument validAsOf = lastEventTimestamp getKey = BaseInstrument.instrumentKey this - interface instance BarrierReverseConvertible.I for Instrument where - view = BarrierReverseConvertible.View with - barrierReverseConvertible = BarrierReverseConvertible with + interface instance AutoCallable.I for Instrument where + view = AutoCallable.View with + barrierReverseConvertible = AutoCallable with instrument = BaseInstrument.instrumentKey this description referenceAssetId diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml index d7bf38d70..22a40e2e4 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -3,8 +3,8 @@ module Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Factory where -import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Instrument qualified as Instrument (I) -import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Types (BarrierReverseConvertible) +import Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Instrument qualified as Instrument (I) +import Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Types (AutoCallable) import Daml.Finance.Interface.Types.Common.Types (PartiesMap) import Daml.Finance.Interface.Util.Disclosure qualified as Disclosure (I) @@ -31,7 +31,7 @@ interface Factory requires Disclosure.I where nonconsuming choice Create : ContractId Instrument.I -- ^ Create a new instrument. with - barrierReverseConvertible : BarrierReverseConvertible + barrierReverseConvertible : AutoCallable -- ^ Attributes to create a BRC. observers : PartiesMap -- ^ The instrument's observers. diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml index b2042646f..a8255a624 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -4,7 +4,7 @@ module Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Instrument where import Daml.Finance.Interface.Instrument.Base.Instrument qualified as BaseInstrument (I) -import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Types (BarrierReverseConvertible) +import Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Types (AutoCallable) import Daml.Finance.Interface.Util.Disclosure qualified as Disclosure (I) -- | Type synonym for `Instrument`. @@ -16,7 +16,7 @@ type V = View -- | View of `Instrument`. data View = View with - barrierReverseConvertible : BarrierReverseConvertible + barrierReverseConvertible : AutoCallable -- ^ Attributes of a BRC. deriving (Eq, Show) diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml index 21b44065b..6c833dcdf 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml @@ -10,7 +10,7 @@ import Daml.Finance.Interface.Types.Date.Schedule (PeriodicSchedule(..)) -- | Describes the attributes of a Barrier Reverse Convertible (BRC) instrument. -- It can be seen as a long fixed coupon bond and a short Down-And-In put option. -data BarrierReverseConvertible = BarrierReverseConvertible +data AutoCallable = AutoCallable with instrument : InstrumentKey -- ^ The instrument's key. From f9ff96442f668e9816a3235497007d2b5b20b46e Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Thu, 18 Jan 2024 11:18:10 +0100 Subject: [PATCH 04/25] update variable names and comments --- .../StructuredProduct/AutoCallable/Factory.daml | 10 +++++----- .../StructuredProduct/AutoCallable/Instrument.daml | 5 ++--- .../StructuredProduct/AutoCallable/Factory.daml | 4 ++-- .../StructuredProduct/AutoCallable/Instrument.daml | 2 +- .../StructuredProduct/AutoCallable/Types.daml | 3 +-- 5 files changed, 11 insertions(+), 13 deletions(-) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml index f14308072..1ee044b85 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -7,7 +7,7 @@ import DA.Set (singleton) import Daml.Finance.Instrument.StructuredProduct.AutoCallable.Instrument qualified as AutoCallable (Instrument(..)) import Daml.Finance.Interface.Claims.Claim qualified as Claim (GetClaims(..), I, getClaims) import Daml.Finance.Interface.Instrument.Base.Instrument qualified as BaseInstrument (createReference) -import Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Factory qualified as BarrierReverseConvertibleFactory (Create(..), I, View(..)) +import Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Factory qualified as AutoCallableFactory (Create(..), I, View(..)) import Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Types (AutoCallable(..)) import Daml.Finance.Interface.Types.Common.Types (PartiesMap) import Daml.Finance.Interface.Util.Disclosure qualified as Disclosure (I, View(..), flattenObservers) @@ -27,10 +27,10 @@ template Factory signatory provider observer Disclosure.flattenObservers observers - interface instance BarrierReverseConvertibleFactory.I for Factory where - view = BarrierReverseConvertibleFactory.View with provider - create' BarrierReverseConvertibleFactory.Create{ - barrierReverseConvertible = AutoCallable{instrument; description; + interface instance AutoCallableFactory.I for Factory where + view = AutoCallableFactory.View with provider + create' AutoCallableFactory.Create{ + autoCallable = AutoCallable{instrument; description; referenceAssetId; strike; barrier; barrierStartDate; expiryDate; currency; lastEventTimestamp; couponRate; periodicSchedule; holidayCalendarIds; calendarDataProvider; dayCountConvention; notional; prevEvents}; diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index cf0d72de3..e6ff46a7c 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -24,8 +24,7 @@ import Daml.Finance.Util.Disclosure (addObserversImpl, removeObserversImpl, setO -- | Type synonym for `Instrument`. type T = Instrument --- | This template models a Barrier Reverse Convertible (BRC) instrument. --- It can be seen as a long fixed coupon bond and a short Down-And-In put option. +-- | This template models an AutoCallable instrument that pays a coupon. template Instrument with depository : Party @@ -126,7 +125,7 @@ template Instrument interface instance AutoCallable.I for Instrument where view = AutoCallable.View with - barrierReverseConvertible = AutoCallable with + autoCallable = AutoCallable with instrument = BaseInstrument.instrumentKey this description referenceAssetId diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml index 22a40e2e4..ecec5ccf8 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -31,11 +31,11 @@ interface Factory requires Disclosure.I where nonconsuming choice Create : ContractId Instrument.I -- ^ Create a new instrument. with - barrierReverseConvertible : AutoCallable + autoCallable : AutoCallable -- ^ Attributes to create a BRC. observers : PartiesMap -- ^ The instrument's observers. controller - barrierReverseConvertible.instrument.depository, barrierReverseConvertible.instrument.issuer + autoCallable.instrument.depository, autoCallable.instrument.issuer do create' this arg diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml index a8255a624..aea686bd9 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -16,7 +16,7 @@ type V = View -- | View of `Instrument`. data View = View with - barrierReverseConvertible : AutoCallable + autoCallable : AutoCallable -- ^ Attributes of a BRC. deriving (Eq, Show) diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml index 6c833dcdf..1802defe9 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml @@ -8,8 +8,7 @@ import Daml.Finance.Interface.Types.Common.Types (InstrumentKey(..)) import Daml.Finance.Interface.Types.Date.DayCount (DayCountConventionEnum) import Daml.Finance.Interface.Types.Date.Schedule (PeriodicSchedule(..)) --- | Describes the attributes of a Barrier Reverse Convertible (BRC) instrument. --- It can be seen as a long fixed coupon bond and a short Down-And-In put option. +-- | Describes the attributes of an AutoCallable instrument. data AutoCallable = AutoCallable with instrument : InstrumentKey From f231ad8b991a8b3f396ab6bdd7d6759192f8e08e Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Thu, 18 Jan 2024 11:31:09 +0100 Subject: [PATCH 05/25] link to new instrument in test --- .../StructuredProduct/Test/AutoCallable.daml | 30 ++++++------ .../StructuredProduct/Test/Util.daml | 47 +++++++++++++++++++ 2 files changed, 62 insertions(+), 15 deletions(-) diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml index a2cde1684..65c827d92 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml @@ -9,7 +9,7 @@ import DA.Set qualified as Set (singleton) import Daml.Finance.Data.Numeric.Observation (Observation(..)) import Daml.Finance.Data.Reference.HolidayCalendar (HolidayCalendar(..)) import Daml.Finance.Data.Time.DateClock (dateToDateClockTime) -import Daml.Finance.Instrument.StructuredProduct.Test.Util (originateBarrierReverseConvertible) +import Daml.Finance.Instrument.StructuredProduct.Test.Util (originateAutoCallable) import Daml.Finance.Interface.Types.Common.Types (HoldingStandard(..), Id(..)) import Daml.Finance.Interface.Types.Date.Calendar (BusinessDayConventionEnum(..), HolidayCalendarData(..)) import Daml.Finance.Interface.Types.Date.DayCount (DayCountConventionEnum(..)) @@ -21,7 +21,7 @@ import Daml.Finance.Test.Util.Lifecycle (lifecycleAndVerifyPaymentEffects, verif import Daml.Finance.Test.Util.Time (createPaymentPeriodicSchedule) import Daml.Script --- Define and lifecycle a barrier reverse convertible (BRC). +-- Define and lifecycle an AutoCallable Yield Note. run : Script () run = script do [custodian, issuer, calendarDataProvider, publicParty] <- @@ -39,7 +39,7 @@ run = script do let barrierLow = 20.0 strikeLow = 35.0 - -- CREATE_BARRIER_REVERSE_CONVERTIBLE_VARIABLES_BEGIN + -- CREATE_AUTO_CALLABLE_VARIABLES_BEGIN barrier = 30.0 barrierStartDate = date 2019 Jan 16 strike = 40.0 @@ -49,7 +49,7 @@ run = script do issueDate = date 2019 Jan 16 firstCouponDate = date 2019 Feb 15 maturityDate = date 2019 May 15 - -- CREATE_BARRIER_REVERSE_CONVERTIBLE_VARIABLES_END + -- CREATE_AUTO_CALLABLE_VARIABLES_END businessDayConvention = Following couponPeriod = M couponPeriodMultiplier = 3 @@ -64,7 +64,7 @@ run = script do businessDayConvention couponPeriod couponPeriodMultiplier issueDate maturityDate notional = 1.0 - -- CREATE_BARRIER_REVERSE_CONVERTIBLE_OBSERVATIONS_BEGIN + -- CREATE_AUTO_CALLABLE_OBSERVATIONS_BEGIN let observations = Map.fromList [ (dateToDateClockTime $ date 2019 Feb 13, 28.78) @@ -76,7 +76,7 @@ run = script do observableCid <- toInterfaceContractId <$> submit issuer do createCmd Observation with provider = issuer; id = Id referenceAssetId; observations; observers = mempty - -- CREATE_BARRIER_REVERSE_CONVERTIBLE_OBSERVATIONS_END + -- CREATE_AUTO_CALLABLE_OBSERVATIONS_END -- A reference data provider publishes the holiday calendar on the ledger calendarCid <- submit calendarDataProvider do @@ -85,12 +85,12 @@ run = script do calendar observers = Map.fromList pp - -------------------------------- - -- 1. BRC with barrier event -- - -------------------------------- + ----------------------------------------- + -- 1. AutoCallable with barrier event -- + ----------------------------------------- -- Test option with barrier hit (on Feb 13). Option expires in the money. - brcInstrument <- originateBarrierReverseConvertible issuer issuer "BRC" TransferableFungible + brcInstrument <- originateAutoCallable issuer issuer "BRC" TransferableFungible "Option" observers now expiryDate strike barrier barrierStartDate cashInstrument referenceAssetId couponRate couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty @@ -116,7 +116,7 @@ run = script do -- Test option with barrier hit (on Feb 13). Option expires out of the money. - brcLowStrikeInstrument <- originateBarrierReverseConvertible issuer issuer "BRCLowStrike" + brcLowStrikeInstrument <- originateAutoCallable issuer issuer "BRCLowStrike" TransferableFungible "Option" observers now expiryDate strikeLow barrier barrierStartDate cashInstrument referenceAssetId couponRate couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty @@ -141,12 +141,12 @@ run = script do lifecycleAndVerifyPaymentEffects [publicParty] expiryDate brcInstrumentAfterCouponPayment issuer [observableCid] expectedConsumed expectedProduced - -------------------------------------------------- - -- 2. BRC without barrier event (before expiry) -- - -------------------------------------------------- + ----------------------------------------------------------- + -- 2. AutoCallable without barrier event (before expiry) -- + ----------------------------------------------------------- -- Test option without barrier hit. Also test a barrier hit after expiry. - brcLowBarrierInstrument <- originateBarrierReverseConvertible issuer issuer "DownAndInLow" + brcLowBarrierInstrument <- originateAutoCallable issuer issuer "DownAndInLow" TransferableFungible "Option" observers now expiryDate strike barrierLow barrierStartDate cashInstrument referenceAssetId couponRate couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml index cb12ccb74..2841f6b3d 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml @@ -58,3 +58,50 @@ originateBarrierReverseConvertible depository issuer label holdingStandard descr observers = Map.fromList observers -- CREATE_BARRIER_REVERSE_CONVERTIBLE_INSTRUMENT_END pure instrument + +-- | Originate a AutoCallable instrument. +originateAutoCallable : Party -> Party -> Text -> HoldingStandard -> Text -> + [(Text, Parties)] -> Time -> Date -> Decimal -> Decimal -> Date -> InstrumentKey -> Text + -> Decimal -> PeriodicSchedule -> [Text] -> DayCountConventionEnum -> Decimal + -> Party -> Party -> Script InstrumentKey +originateAutoCallable depository issuer label holdingStandard description + observers lastEventTimestamp expiryDate strike barrier barrierStartDate currency referenceAssetId + couponRate periodicSchedule holidayCalendarIds dayCountConvention notional + calendarDataProvider publicParty = do + -- Create an AutoCallable factory + factoryCid <- toInterfaceContractId @BarrierReverseConvertibleFactory.I <$> submit issuer do + createCmd BarrierReverseConvertible.Factory with + provider = issuer + observers = mempty + + -- CREATE_AUTO_CALLABLE_INSTRUMENT_BEGIN + let + instrument = InstrumentKey with + issuer + depository + id = Id label + version = "0" + holdingStandard + + cid <- submitMulti [issuer] [publicParty] do + exerciseCmd factoryCid BarrierReverseConvertibleFactory.Create with + barrierReverseConvertible = BarrierReverseConvertible with + instrument + description + expiryDate + strike + barrier + barrierStartDate + referenceAssetId + couponRate + periodicSchedule + holidayCalendarIds + calendarDataProvider + dayCountConvention + notional + currency + lastEventTimestamp + prevEvents = [] + observers = Map.fromList observers + -- CREATE_AUTO_CALLABLE_INSTRUMENT_END + pure instrument From b77112b444f9f786b53a642ef10d8abb5940573e Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Fri, 19 Jan 2024 13:09:44 +0100 Subject: [PATCH 06/25] implement payoff --- .../daml.yaml | 2 + .../AutoCallable/Factory.daml | 8 +- .../AutoCallable/Instrument.daml | 36 ++++- .../Instrument/StructuredProduct/Util.daml | 82 ++++++++++ .../StructuredProduct/AutoCallable/Types.daml | 8 +- .../StructuredProduct/Test/AutoCallable.daml | 152 +++++++++--------- .../StructuredProduct/Test/Util.daml | 23 +-- 7 files changed, 219 insertions(+), 92 deletions(-) create mode 100644 src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml diff --git a/package/main/daml/Daml.Finance.Instrument.StructuredProduct/daml.yaml b/package/main/daml/Daml.Finance.Instrument.StructuredProduct/daml.yaml index c417207c2..c09a52084 100644 --- a/package/main/daml/Daml.Finance.Instrument.StructuredProduct/daml.yaml +++ b/package/main/daml/Daml.Finance.Instrument.StructuredProduct/daml.yaml @@ -9,12 +9,14 @@ dependencies: - daml-prim - daml-stdlib data-dependencies: + - .lib/daml-finance/ContingentClaims.Core/2.0.1/contingent-claims-core-2.0.1.dar - .lib/daml-finance/Daml.Finance.Claims/2.1.1/daml-finance-claims-2.1.1.dar - .lib/daml-finance/Daml.Finance.Data/3.0.1/daml-finance-data-3.0.1.dar - .lib/daml-finance/Daml.Finance.Interface.Claims/3.0.0/daml-finance-interface-claims-3.0.0.dar - .lib/daml-finance/Daml.Finance.Interface.Instrument.Base/3.0.0/daml-finance-interface-instrument-base-3.0.0.dar - .lib/daml-finance/Daml.Finance.Interface.Instrument.Option/0.3.0/daml-finance-interface-instrument-option-0.3.0.dar - .lib/daml-finance/Daml.Finance.Interface.Instrument.StructuredProduct/0.1.1/daml-finance-interface-instrument-structuredproduct-0.1.1.dar + - .lib/daml-finance/Daml.Finance.Interface.Instrument.Types/1.0.0/daml-finance-interface-instrument-types-1.0.0.dar - .lib/daml-finance/Daml.Finance.Interface.Types.Common/2.0.0/daml-finance-interface-types-common-2.0.0.dar - .lib/daml-finance/Daml.Finance.Interface.Types.Date/2.1.0/daml-finance-interface-types-date-2.1.0.dar - .lib/daml-finance/Daml.Finance.Interface.Util/2.1.0/daml-finance-interface-util-2.1.0.dar diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml index 1ee044b85..fc5814cc8 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -31,8 +31,8 @@ template Factory view = AutoCallableFactory.View with provider create' AutoCallableFactory.Create{ autoCallable = AutoCallable{instrument; description; - referenceAssetId; strike; barrier; barrierStartDate; expiryDate; currency; - lastEventTimestamp; couponRate; periodicSchedule; holidayCalendarIds; + referenceAssetId; strike; barrier; callBarrier; finalBarrier; expiryDate; currency; + lastEventTimestamp; couponRate; observationSchedule; periodicSchedule; holidayCalendarIds; calendarDataProvider; dayCountConvention; notional; prevEvents}; observers} = do let @@ -46,9 +46,11 @@ template Factory referenceAssetId strike barrier - barrierStartDate + callBarrier + finalBarrier expiryDate couponRate + observationSchedule periodicSchedule holidayCalendarIds calendarDataProvider diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index e6ff46a7c..2dc353d95 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -8,6 +8,7 @@ import DA.Set (singleton) import Daml.Finance.Claims.Util.Builders (createBarrierEuropeanCashClaim, createFixRatePaymentClaims, createFxAdjustedPrincipalClaim) import Daml.Finance.Data.Reference.HolidayCalendar (getHolidayCalendars, rollSchedule) import Daml.Finance.Data.Time.DateClock (dateToDateClockTime) +import Daml.Finance.Instrument.StructuredProduct.Util (createAutoCallableClaims) import Daml.Finance.Interface.Claims.Claim qualified as Claim (GetClaims(..), I, View(..)) import Daml.Finance.Interface.Claims.Dynamic.Instrument qualified as DynamicInstrument (CreateNewVersion(..), I, View(..)) import Daml.Finance.Interface.Claims.Types (EventData) @@ -19,6 +20,7 @@ import Daml.Finance.Interface.Types.Common.Types (HoldingStandard(..), Id(..), I import Daml.Finance.Interface.Types.Date.DayCount (DayCountConventionEnum) import Daml.Finance.Interface.Types.Date.Schedule (PeriodicSchedule(..)) import Daml.Finance.Interface.Util.Disclosure qualified as Disclosure (I, View(..), flattenObservers) +import Daml.Finance.Util.Date.Calendar (merge) import Daml.Finance.Util.Disclosure (addObserversImpl, removeObserversImpl, setObserversImpl) -- | Type synonym for `Instrument`. @@ -46,13 +48,17 @@ template Instrument -- ^ The strike price of the option. barrier : Decimal -- ^ The barrier level of the option. - barrierStartDate : Date - -- ^ The start date for barrier observations. + callBarrier : Decimal + -- ^ The barrier used to auto-call. + finalBarrier : Decimal + -- ^ The barrier used to determine the final redemption amount. expiryDate : Date -- ^ The expiry date of the instrument. couponRate : Decimal -- ^ The fixed coupon rate, per annum. For example, in case of a "3.5% p.a coupon" this should -- be 0.035. + observationSchedule : PeriodicSchedule + -- ^ The schedule for the observation dates. periodicSchedule : PeriodicSchedule -- ^ The schedule for the periodic coupon payments. holidayCalendarIds : [Text] @@ -83,9 +89,10 @@ template Instrument getClaims Claim.GetClaims{actor} = do -- get the initial claims tree (as of the instrument's acquisition time) +{- TODO: Replace this check assertMsg "option expiry date must match last coupon date" $ expiryDate == periodicSchedule.terminationDate - + -} -- Calculate option claim let ownerReceives = False @@ -93,6 +100,7 @@ template Instrument barrierType = DownAndIn referenceLevel = Some strike call = optionType == Call + {- (down, out) = case barrierType of UpAndOut -> (False, True) DownAndOut -> (True, True) @@ -101,10 +109,21 @@ template Instrument optionsClaim = createBarrierEuropeanCashClaim dateToDateClockTime ownerReceives strike referenceAssetId currency expiryDate call barrier barrierStartDate down out referenceLevel notional + -} getCalendars = getHolidayCalendars actor calendarDataProvider + floatingRate = None + capRate = None + floorRate = None + fixingBusinessCenters = case floatingRate of + None -> [] + Some fr -> error "floating rate not yet supported" + fixingCals <- getHolidayCalendars issuer calendarDataProvider fixingBusinessCenters -- Calculate bond claim (schedule, _) <- rollSchedule getCalendars periodicSchedule holidayCalendarIds + debug schedule + (callableSchedule, _) <- rollSchedule getCalendars observationSchedule holidayCalendarIds + debug callableSchedule let useAdjustedDatesForDcf = True ownerReceives = True @@ -113,9 +132,14 @@ template Instrument useAdjustedDatesForDcf couponRate ownerReceives dayCountConvention notional currency redemptionClaim = createFxAdjustedPrincipalClaim dateToDateClockTime ownerReceives fxAdjustment notional currency periodicSchedule.terminationDate + callableClaims = createAutoCallableClaims dateToDateClockTime schedule callableSchedule + periodicSchedule useAdjustedDatesForDcf couponRate dayCountConvention notional currency + floatingRate capRate floorRate referenceAssetId barrier callBarrier finalBarrier strike $ merge fixingCals -- Return BRC claim as option + bond claim - pure [optionsClaim, couponClaims, redemptionClaim] + --pure [optionsClaim, couponClaims, redemptionClaim] + pure [callableClaims] + interface instance BaseInstrument.I for Instrument where view = BaseInstrument.View with @@ -131,9 +155,11 @@ template Instrument referenceAssetId strike barrier - barrierStartDate + callBarrier + finalBarrier expiryDate couponRate + observationSchedule periodicSchedule holidayCalendarIds calendarDataProvider diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml new file mode 100644 index 000000000..d755b7ed8 --- /dev/null +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml @@ -0,0 +1,82 @@ +-- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module Daml.Finance.Instrument.StructuredProduct.Util where + +import ContingentClaims.Core.Claim (Claim, Inequality(..), and, at, cond, one, scale, when, zero) +import ContingentClaims.Core.Observation (Observation(..)) +import DA.List (last) +import DA.Optional (isSome) +import Daml.Finance.Claims.Util.Builders (calculateRatePayment, prepareAndTagClaims) +import Daml.Finance.Interface.Claims.Types (Deliverable, Observable, TaggedClaim(..)) +import Daml.Finance.Interface.Instrument.Types.FloatingRate (FloatingRate) +import Daml.Finance.Interface.Types.Date.Calendar (HolidayCalendarData) +import Daml.Finance.Interface.Types.Date.DayCount (DayCountConventionEnum) +import Daml.Finance.Interface.Types.Date.Schedule (PeriodicSchedule(..), Schedule) +import Prelude hiding (and, or, (<=)) +import Prelude qualified as P (and) + +type O = Observation Date Decimal Observable +type C = Claim Date Decimal Deliverable Observable + +-- | Find out which schedule periods of scheduleA exist in scheduleB. +includes : Schedule -> Schedule -> [Bool] +includes scheduleA scheduleB = + map (\a -> isSome $ find (\b -> b.adjustedEndDate == a.adjustedEndDate) scheduleB) scheduleA + +-- | Calculate the claims for a an auto-callable with a fixed and/or floating coupon on each payment +-- date and a redemption amount at the end (unless auto-called previously). +createAutoCallableClaims : (Date -> Time) -> Schedule -> Schedule -> PeriodicSchedule + -> Bool -> Decimal -> DayCountConventionEnum -> Decimal -> Deliverable -> Optional FloatingRate + -> Optional Decimal -> Optional Decimal -> Text -> Decimal -> Decimal -> Decimal -> Decimal -> HolidayCalendarData + -> TaggedClaim +createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSchedule + useAdjustedDatesForDcf couponRate dayCountConvention notional cashInstrument floatingRate + capRate floorRate spot couponBarrier callBarrier finalBarrier initialFixing fixingCalendars = + let + notionalAmount = scale (Const notional) $ one cashInstrument + + principal = notionalAmount +{- + -- Find out on which coupon dates it is possible to call the bond. + callPossibleInit = includes schedule callableSchedule + + -- Also search in the other direction, to ensure that no intended call dates are ignored. + potentialCallDatesFound = includes callableSchedule schedule + + callPossible = if P.and potentialCallDatesFound then callPossibleInit + else error "All dates in the call schedule must exist in the coupon schedule" + -} + -- TODO: verify that callableSchedule has same length as periodicSchedule + -- TODO: verify that callableSchedule dates are before periodicSchedule dates + + combineTagClaim (couponPeriod, callPeriod) notCalledClaim = + let + cpn = calculateRatePayment couponPeriod dayCountConvention useAdjustedDatesForDcf periodicSchedule + floatingRate couponRate notionalAmount fixingCalendars capRate floorRate + callDate = callPeriod.adjustedEndDate + spotOnObservationDate = ObserveAt spot callDate + couponBarrierHit = Lte (spotOnObservationDate, Const couponBarrier) + coupon = cond couponBarrierHit zero cpn + called = when (at couponPeriod.adjustedEndDate) $ and coupon principal + notCalled = when (at couponPeriod.adjustedEndDate) $ and coupon notCalledClaim + autoExerciseCondition = Lte (Const callBarrier, spotOnObservationDate) + tailClaim = when (at callDate) $ cond autoExerciseCondition called notCalled + in + tailClaim + + finalCouponDate = (.adjustedEndDate) $ last paymentSchedule + finalObservationDate = (.adjustedEndDate) $ last callableSchedule + spotOnObservationDate = ObserveAt spot finalObservationDate + barrierHit = Lte (spotOnObservationDate, Const finalBarrier) + perf = spotOnObservationDate / Const initialFixing + scaledNotionalAmount = scale perf notionalAmount + redemptionPayment = cond barrierHit scaledNotionalAmount principal + notCalledFinal = when (at finalCouponDate) redemptionPayment + -- TODO: do not fold over the last period in paymentSchedule, has short ki put (no 100% guarantee) + claimAmount = foldr (\p acc -> combineTagClaim p acc) notCalledFinal $ zip paymentSchedule callableSchedule + + claims = claimAmount + + in + prepareAndTagClaims dateToTime [claims] "Callable bond payment" diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml index 1802defe9..71ee6b49b 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml @@ -22,13 +22,17 @@ data AutoCallable = AutoCallable -- ^ The strike price of the option. barrier : Decimal -- ^ The barrier level of the option. - barrierStartDate : Date - -- ^ The start date for barrier observations. + callBarrier : Decimal + -- ^ The barrier used to auto-call. + finalBarrier : Decimal + -- ^ The barrier used to determine the final redemption amount. expiryDate : Date -- ^ The expiry date of the instrument. couponRate : Decimal -- ^ The fixed coupon rate, per annum. For example, in case of a "3.5% p.a coupon" this should -- be 0.035. + observationSchedule : PeriodicSchedule + -- ^ The schedule for the observation dates. periodicSchedule : PeriodicSchedule -- ^ The schedule for the periodic coupon payments. holidayCalendarIds : [Text] diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml index 65c827d92..afce33c67 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml @@ -37,23 +37,30 @@ run = script do -- Create and distribute option let - barrierLow = 20.0 - strikeLow = 35.0 + barrierHigh : Decimal = 30.0 + strikeLow : Decimal = 35.0 + callBarrierLow : Decimal = 38.0 + finalBarrierHigh : Decimal = 40.0 -- CREATE_AUTO_CALLABLE_VARIABLES_BEGIN - barrier = 30.0 - barrierStartDate = date 2019 Jan 16 - strike = 40.0 - expiryDate = date 2019 May 15 + barrier : Decimal = 26.0 -- TODO: separate into couponBarrier and finalBarrier + callBarrier = 40.0 + strike : Decimal = 40.0 -- TODO: separate into initialValue and callValue + finalBarrier : Decimal = 35.0 + expiryDate = date 2024 Sep 28 + --barrierStartDate = expiryDate referenceAssetId = "AAPL-CLOSE" - couponRate = 0.05 - issueDate = date 2019 Jan 16 - firstCouponDate = date 2019 Feb 15 - maturityDate = date 2019 May 15 + couponRate : Decimal = 0.05 + initialValuationDate = date 2024 Jan 10 + issueDate = date 2024 Jan 16 + firstRegularObervationDate = date 2024 Mar 28 + firstCouponDate = date 2024 Apr 2 + secondCouponDate = date 2024 Jul 2 + maturityDate = date 2024 Oct 2 -- CREATE_AUTO_CALLABLE_VARIABLES_END businessDayConvention = Following couponPeriod = M couponPeriodMultiplier = 3 - dayCountConvention = Act360 + dayCountConvention = Basis1 holidayCalendarIds = ["USD"] calendar = HolidayCalendarData with @@ -62,16 +69,19 @@ run = script do holidays = [] couponSchedule = createPaymentPeriodicSchedule firstCouponDate holidayCalendarIds businessDayConvention couponPeriod couponPeriodMultiplier issueDate maturityDate - notional = 1.0 + observationSchedule = createPaymentPeriodicSchedule firstRegularObervationDate holidayCalendarIds + businessDayConvention couponPeriod couponPeriodMultiplier initialValuationDate expiryDate + notional : Decimal = 1.0 + + debug couponSchedule + debug observationSchedule -- CREATE_AUTO_CALLABLE_OBSERVATIONS_BEGIN let observations = Map.fromList - [ (dateToDateClockTime $ date 2019 Feb 13, 28.78) - , (dateToDateClockTime $ date 2019 Feb 15, 39.78) - , (dateToDateClockTime $ date 2019 May 15, 38.78) - , (dateToDateClockTime $ date 2019 May 16, 18.78) - , (dateToDateClockTime $ date 2019 May 17, 38.78) + [ (dateToDateClockTime $ date 2024 Mar 28, 28.78) + , (dateToDateClockTime $ date 2024 Jun 28, 39.78) + , (dateToDateClockTime $ date 2024 Sep 30, 36.0) ] observableCid <- toInterfaceContractId <$> submit issuer do createCmd Observation with @@ -85,95 +95,91 @@ run = script do calendar observers = Map.fromList pp - ----------------------------------------- - -- 1. AutoCallable with barrier event -- - ----------------------------------------- + ----------------------------------------------------------------------- + -- 1. AutoCallable without barrier events (and no early redemption) -- + ----------------------------------------------------------------------- - -- Test option with barrier hit (on Feb 13). Option expires in the money. - brcInstrument <- originateAutoCallable issuer issuer "BRC" TransferableFungible - "Option" observers now expiryDate strike barrier barrierStartDate cashInstrument - referenceAssetId couponRate couponSchedule holidayCalendarIds dayCountConvention notional + brcInstrument <- originateAutoCallable issuer issuer "AC" TransferableFungible + "Option" observers now expiryDate strike barrier callBarrier finalBarrier cashInstrument + referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty let expectedConsumed = [] - expectedProduced = [] - Some brcInstrumentAfterBarrierHit <- lifecycleAndVerifyPaymentEffects [publicParty] - (date 2019 Feb 13) brcInstrument issuer [observableCid] expectedConsumed expectedProduced + expectedProduced = [qty 0.05 cashInstrument] + Some brcInstrumentAfterCouponDate1 <- lifecycleAndVerifyPaymentEffects [publicParty] + firstCouponDate brcInstrument issuer [observableCid] expectedConsumed + expectedProduced let expectedConsumed = [] - expectedProduced = [qty 0.0041666667 cashInstrument] - Some brcInstrumentAfterCouponPayment <- lifecycleAndVerifyPaymentEffects [publicParty] - firstCouponDate brcInstrumentAfterBarrierHit issuer [observableCid] expectedConsumed - expectedProduced + expectedProduced = [qty 0.05 cashInstrument] + Some brcInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] secondCouponDate brcInstrumentAfterCouponDate1 issuer + [observableCid] expectedConsumed expectedProduced let - expectedConsumed = [qty 0.0305 cashInstrument] - expectedProduced = [(qty 0.0123611111 cashInstrument), (qty 1.0 cashInstrument)] - lifecycleAndVerifyPaymentEffects [publicParty] expiryDate brcInstrumentAfterCouponPayment issuer + expectedConsumed = [] + expectedProduced = [qty 1.05 cashInstrument] + lifecycleAndVerifyPaymentEffects [publicParty] maturityDate brcInstrumentAfterCouponDate2 issuer [observableCid] expectedConsumed expectedProduced - -- Test option with barrier hit (on Feb 13). Option expires out of the money. + -------------------------------------------------------------------- + -- 2. AutoCallable with barrier events (and no early redemption) -- + -------------------------------------------------------------------- - brcLowStrikeInstrument <- originateAutoCallable issuer issuer "BRCLowStrike" - TransferableFungible "Option" observers now expiryDate strikeLow barrier barrierStartDate - cashInstrument referenceAssetId couponRate couponSchedule holidayCalendarIds dayCountConvention - notional calendarDataProvider publicParty + brcInstrument <- originateAutoCallable issuer issuer "AC2" TransferableFungible + "Option" observers now expiryDate strike barrierHigh callBarrier finalBarrierHigh cashInstrument + referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional + calendarDataProvider publicParty + -- The first coupon is not paid because the coupon barrier is hit let expectedConsumed = [] expectedProduced = [] - Some brcInstrumentAfterBarrierHit <- lifecycleAndVerifyPaymentEffects [publicParty] - (date 2019 Feb 13) brcLowStrikeInstrument issuer [observableCid] expectedConsumed + Some brcInstrumentAfterCouponDate1 <- lifecycleAndVerifyPaymentEffects [publicParty] + firstCouponDate brcInstrument issuer [observableCid] expectedConsumed expectedProduced + -- The second coupon is paid (no barrier hit) let expectedConsumed = [] - expectedProduced = [qty 0.0041666667 cashInstrument] - Some brcInstrumentAfterCouponPayment <- lifecycleAndVerifyPaymentEffects [publicParty] - firstCouponDate brcInstrumentAfterBarrierHit issuer [observableCid] expectedConsumed - expectedProduced + expectedProduced = [qty 0.05 cashInstrument] + Some brcInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] secondCouponDate brcInstrumentAfterCouponDate1 issuer + [observableCid] expectedConsumed expectedProduced + -- Redemption amount is less than principal because the final barrier is hit let expectedConsumed = [] - expectedProduced = [(qty 0.0123611111 cashInstrument), (qty 1.0 cashInstrument)] - lifecycleAndVerifyPaymentEffects [publicParty] expiryDate brcInstrumentAfterCouponPayment issuer + expectedProduced = [qty 0.95 cashInstrument] + lifecycleAndVerifyPaymentEffects [publicParty] maturityDate brcInstrumentAfterCouponDate2 issuer [observableCid] expectedConsumed expectedProduced - ----------------------------------------------------------- - -- 2. AutoCallable without barrier event (before expiry) -- - ----------------------------------------------------------- - - -- Test option without barrier hit. Also test a barrier hit after expiry. - brcLowBarrierInstrument <- originateAutoCallable issuer issuer "DownAndInLow" - TransferableFungible "Option" observers now expiryDate strike barrierLow barrierStartDate - cashInstrument referenceAssetId couponRate couponSchedule holidayCalendarIds dayCountConvention - notional calendarDataProvider publicParty + -------------------------------------------- + -- 3. AutoCallable with early redemption -- + -------------------------------------------- - verifyNoLifecycleEffects [publicParty] (date 2019 Feb 13) brcLowBarrierInstrument - issuer [observableCid] - - let - expectedConsumed = [] - expectedProduced = [qty 0.0041666667 cashInstrument] - Some brcInstrumentAfterCouponPayment <- lifecycleAndVerifyPaymentEffects [publicParty] - firstCouponDate brcLowBarrierInstrument issuer [observableCid] expectedConsumed expectedProduced + brcInstrument <- originateAutoCallable issuer issuer "AC3" TransferableFungible + "Option" observers now expiryDate strike barrierHigh callBarrierLow finalBarrier cashInstrument + referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional + calendarDataProvider publicParty + -- The first coupon is not paid because the coupon barrier is hit let expectedConsumed = [] - expectedProduced = [(qty 0.0123611111 cashInstrument), (qty 1.0 cashInstrument)] - Some brcInstrumentAfterExpiry <- lifecycleAndVerifyPaymentEffects [publicParty] expiryDate - brcInstrumentAfterCouponPayment issuer [observableCid] expectedConsumed expectedProduced + expectedProduced = [] + Some brcInstrumentAfterCouponDate1 <- lifecycleAndVerifyPaymentEffects [publicParty] + firstCouponDate brcInstrument issuer [observableCid] expectedConsumed + expectedProduced + -- Auto-call on the second coupon date let expectedConsumed = [] - expectedProduced = [] - Some brcInstrumentAfterBarrierHit <- lifecycleAndVerifyPaymentEffects [publicParty] - (date 2019 May 16) brcInstrumentAfterExpiry issuer [observableCid] expectedConsumed - expectedProduced + expectedProduced = [qty 1.05 cashInstrument] + Some brcInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] secondCouponDate brcInstrumentAfterCouponDate1 issuer + [observableCid] expectedConsumed expectedProduced - verifyNoLifecycleEffects [publicParty] (date 2019 May 17) brcInstrumentAfterBarrierHit - issuer [observableCid] + -- Ensure no lifecycle effects on a called instrument + verifyNoLifecycleEffects [publicParty] maturityDate brcInstrumentAfterCouponDate2 issuer + [observableCid] pure () diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml index 2841f6b3d..327a5e3ba 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml @@ -4,7 +4,10 @@ module Daml.Finance.Instrument.StructuredProduct.Test.Util where import DA.Map qualified as Map (fromList) +import Daml.Finance.Instrument.StructuredProduct.AutoCallable.Factory qualified as AutoCallable (Factory(..)) import Daml.Finance.Instrument.StructuredProduct.BarrierReverseConvertible.Factory qualified as BarrierReverseConvertible (Factory(..)) +import Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Factory qualified as AutoCallableFactory (Create(..), I(..)) +import Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Types (AutoCallable(..)) import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Factory qualified as BarrierReverseConvertibleFactory (Create(..), I(..)) import Daml.Finance.Interface.Instrument.StructuredProduct.BarrierReverseConvertible.Types (BarrierReverseConvertible(..)) import Daml.Finance.Interface.Types.Common.Types (HoldingStandard(..), Id(..), InstrumentKey(..), Parties) @@ -61,16 +64,16 @@ originateBarrierReverseConvertible depository issuer label holdingStandard descr -- | Originate a AutoCallable instrument. originateAutoCallable : Party -> Party -> Text -> HoldingStandard -> Text -> - [(Text, Parties)] -> Time -> Date -> Decimal -> Decimal -> Date -> InstrumentKey -> Text - -> Decimal -> PeriodicSchedule -> [Text] -> DayCountConventionEnum -> Decimal + [(Text, Parties)] -> Time -> Date -> Decimal -> Decimal -> Decimal -> Decimal -> InstrumentKey -> Text + -> Decimal -> PeriodicSchedule -> PeriodicSchedule -> [Text] -> DayCountConventionEnum -> Decimal -> Party -> Party -> Script InstrumentKey originateAutoCallable depository issuer label holdingStandard description - observers lastEventTimestamp expiryDate strike barrier barrierStartDate currency referenceAssetId - couponRate periodicSchedule holidayCalendarIds dayCountConvention notional + observers lastEventTimestamp expiryDate strike barrier callBarrier finalBarrier currency referenceAssetId + couponRate observationSchedule periodicSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty = do -- Create an AutoCallable factory - factoryCid <- toInterfaceContractId @BarrierReverseConvertibleFactory.I <$> submit issuer do - createCmd BarrierReverseConvertible.Factory with + factoryCid <- toInterfaceContractId @AutoCallableFactory.I <$> submit issuer do + createCmd AutoCallable.Factory with provider = issuer observers = mempty @@ -84,16 +87,18 @@ originateAutoCallable depository issuer label holdingStandard description holdingStandard cid <- submitMulti [issuer] [publicParty] do - exerciseCmd factoryCid BarrierReverseConvertibleFactory.Create with - barrierReverseConvertible = BarrierReverseConvertible with + exerciseCmd factoryCid AutoCallableFactory.Create with + autoCallable = AutoCallable with instrument description expiryDate strike barrier - barrierStartDate + callBarrier + finalBarrier referenceAssetId couponRate + observationSchedule periodicSchedule holidayCalendarIds calendarDataProvider From 1150b7118cd39fb451d7d428236d9e3ca79334f6 Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Fri, 19 Jan 2024 13:39:37 +0100 Subject: [PATCH 07/25] remove unusued code --- .../AutoCallable/Instrument.daml | 30 ------------------- .../Instrument/StructuredProduct/Util.daml | 10 ++----- .../StructuredProduct/Test/AutoCallable.daml | 26 +++++++--------- 3 files changed, 14 insertions(+), 52 deletions(-) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index 2dc353d95..c511e4d9d 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -5,7 +5,6 @@ module Daml.Finance.Instrument.StructuredProduct.AutoCallable.Instrument where import DA.Date (daysSinceEpochToDate) import DA.Set (singleton) -import Daml.Finance.Claims.Util.Builders (createBarrierEuropeanCashClaim, createFixRatePaymentClaims, createFxAdjustedPrincipalClaim) import Daml.Finance.Data.Reference.HolidayCalendar (getHolidayCalendars, rollSchedule) import Daml.Finance.Data.Time.DateClock (dateToDateClockTime) import Daml.Finance.Instrument.StructuredProduct.Util (createAutoCallableClaims) @@ -13,7 +12,6 @@ import Daml.Finance.Interface.Claims.Claim qualified as Claim (GetClaims(..), I, import Daml.Finance.Interface.Claims.Dynamic.Instrument qualified as DynamicInstrument (CreateNewVersion(..), I, View(..)) import Daml.Finance.Interface.Claims.Types (EventData) import Daml.Finance.Interface.Instrument.Base.Instrument qualified as BaseInstrument (I, View(..), createReference, disclosureUpdateReference, instrumentKey) -import Daml.Finance.Interface.Instrument.Option.Types (BarrierTypeEnum(..), OptionTypeEnum(..)) import Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Instrument qualified as AutoCallable (I, View(..)) import Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Types (AutoCallable(..)) import Daml.Finance.Interface.Types.Common.Types (HoldingStandard(..), Id(..), InstrumentKey(..), PartiesMap) @@ -93,23 +91,7 @@ template Instrument assertMsg "option expiry date must match last coupon date" $ expiryDate == periodicSchedule.terminationDate -} - -- Calculate option claim let - ownerReceives = False - optionType = Put - barrierType = DownAndIn - referenceLevel = Some strike - call = optionType == Call - {- - (down, out) = case barrierType of - UpAndOut -> (False, True) - DownAndOut -> (True, True) - UpAndIn -> (False, False) - DownAndIn -> (True, False) - optionsClaim = createBarrierEuropeanCashClaim dateToDateClockTime ownerReceives strike - referenceAssetId currency expiryDate call barrier barrierStartDate down out - referenceLevel notional - -} getCalendars = getHolidayCalendars actor calendarDataProvider floatingRate = None capRate = None @@ -119,28 +101,16 @@ template Instrument Some fr -> error "floating rate not yet supported" fixingCals <- getHolidayCalendars issuer calendarDataProvider fixingBusinessCenters - -- Calculate bond claim (schedule, _) <- rollSchedule getCalendars periodicSchedule holidayCalendarIds - debug schedule (callableSchedule, _) <- rollSchedule getCalendars observationSchedule holidayCalendarIds - debug callableSchedule let useAdjustedDatesForDcf = True - ownerReceives = True - fxAdjustment = 1.0 - couponClaims = createFixRatePaymentClaims dateToDateClockTime schedule periodicSchedule - useAdjustedDatesForDcf couponRate ownerReceives dayCountConvention notional currency - redemptionClaim = createFxAdjustedPrincipalClaim dateToDateClockTime ownerReceives - fxAdjustment notional currency periodicSchedule.terminationDate callableClaims = createAutoCallableClaims dateToDateClockTime schedule callableSchedule periodicSchedule useAdjustedDatesForDcf couponRate dayCountConvention notional currency floatingRate capRate floorRate referenceAssetId barrier callBarrier finalBarrier strike $ merge fixingCals - -- Return BRC claim as option + bond claim - --pure [optionsClaim, couponClaims, redemptionClaim] pure [callableClaims] - interface instance BaseInstrument.I for Instrument where view = BaseInstrument.View with depository; issuer; id; version; holdingStandard; description diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml index d755b7ed8..f8be700a9 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml @@ -14,7 +14,6 @@ import Daml.Finance.Interface.Types.Date.Calendar (HolidayCalendarData) import Daml.Finance.Interface.Types.Date.DayCount (DayCountConventionEnum) import Daml.Finance.Interface.Types.Date.Schedule (PeriodicSchedule(..), Schedule) import Prelude hiding (and, or, (<=)) -import Prelude qualified as P (and) type O = Observation Date Decimal Observable type C = Claim Date Decimal Deliverable Observable @@ -70,13 +69,10 @@ createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSch spotOnObservationDate = ObserveAt spot finalObservationDate barrierHit = Lte (spotOnObservationDate, Const finalBarrier) perf = spotOnObservationDate / Const initialFixing - scaledNotionalAmount = scale perf notionalAmount - redemptionPayment = cond barrierHit scaledNotionalAmount principal + perfomanceScaledPrincipal = scale perf notionalAmount + redemptionPayment = cond barrierHit perfomanceScaledPrincipal principal notCalledFinal = when (at finalCouponDate) redemptionPayment - -- TODO: do not fold over the last period in paymentSchedule, has short ki put (no 100% guarantee) - claimAmount = foldr (\p acc -> combineTagClaim p acc) notCalledFinal $ zip paymentSchedule callableSchedule - - claims = claimAmount + claims = foldr (\p acc -> combineTagClaim p acc) notCalledFinal $ zip paymentSchedule callableSchedule in prepareAndTagClaims dateToTime [claims] "Callable bond payment" diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml index afce33c67..a393e7ecb 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml @@ -37,19 +37,18 @@ run = script do -- Create and distribute option let - barrierHigh : Decimal = 30.0 - strikeLow : Decimal = 35.0 - callBarrierLow : Decimal = 38.0 - finalBarrierHigh : Decimal = 40.0 + barrierHigh = 30.0 + callBarrierLow = 38.0 + finalBarrierHigh = 40.0 -- CREATE_AUTO_CALLABLE_VARIABLES_BEGIN - barrier : Decimal = 26.0 -- TODO: separate into couponBarrier and finalBarrier + barrier = 26.0 -- TODO: separate into couponBarrier and finalBarrier callBarrier = 40.0 - strike : Decimal = 40.0 -- TODO: separate into initialValue and callValue - finalBarrier : Decimal = 35.0 + strike = 40.0 -- TODO: separate into initialValue and callValue + finalBarrier = 35.0 expiryDate = date 2024 Sep 28 --barrierStartDate = expiryDate referenceAssetId = "AAPL-CLOSE" - couponRate : Decimal = 0.05 + couponRate = 0.05 initialValuationDate = date 2024 Jan 10 issueDate = date 2024 Jan 16 firstRegularObervationDate = date 2024 Mar 28 @@ -71,10 +70,7 @@ run = script do businessDayConvention couponPeriod couponPeriodMultiplier issueDate maturityDate observationSchedule = createPaymentPeriodicSchedule firstRegularObervationDate holidayCalendarIds businessDayConvention couponPeriod couponPeriodMultiplier initialValuationDate expiryDate - notional : Decimal = 1.0 - - debug couponSchedule - debug observationSchedule + notional = 1.0 -- CREATE_AUTO_CALLABLE_OBSERVATIONS_BEGIN let @@ -100,7 +96,7 @@ run = script do ----------------------------------------------------------------------- brcInstrument <- originateAutoCallable issuer issuer "AC" TransferableFungible - "Option" observers now expiryDate strike barrier callBarrier finalBarrier cashInstrument + "AutoCallable" observers now expiryDate strike barrier callBarrier finalBarrier cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty @@ -128,7 +124,7 @@ run = script do -------------------------------------------------------------------- brcInstrument <- originateAutoCallable issuer issuer "AC2" TransferableFungible - "Option" observers now expiryDate strike barrierHigh callBarrier finalBarrierHigh cashInstrument + "AutoCallable" observers now expiryDate strike barrierHigh callBarrier finalBarrierHigh cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty @@ -159,7 +155,7 @@ run = script do -------------------------------------------- brcInstrument <- originateAutoCallable issuer issuer "AC3" TransferableFungible - "Option" observers now expiryDate strike barrierHigh callBarrierLow finalBarrier cashInstrument + "AutoCallable" observers now expiryDate strike barrierHigh callBarrierLow finalBarrier cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty From 3538096f75078f3f2d1b9794ea4a342ca81cf936 Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Fri, 19 Jan 2024 13:48:49 +0100 Subject: [PATCH 08/25] remove unused instrument variables --- .../Instrument/StructuredProduct/AutoCallable/Factory.daml | 3 +-- .../StructuredProduct/AutoCallable/Instrument.daml | 3 --- .../Instrument/StructuredProduct/AutoCallable/Types.daml | 2 -- .../Instrument/StructuredProduct/Test/AutoCallable.daml | 6 +++--- .../Finance/Instrument/StructuredProduct/Test/Util.daml | 5 ++--- 5 files changed, 6 insertions(+), 13 deletions(-) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml index fc5814cc8..651d28a76 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -31,7 +31,7 @@ template Factory view = AutoCallableFactory.View with provider create' AutoCallableFactory.Create{ autoCallable = AutoCallable{instrument; description; - referenceAssetId; strike; barrier; callBarrier; finalBarrier; expiryDate; currency; + referenceAssetId; strike; barrier; callBarrier; finalBarrier; currency; lastEventTimestamp; couponRate; observationSchedule; periodicSchedule; holidayCalendarIds; calendarDataProvider; dayCountConvention; notional; prevEvents}; observers} = do @@ -48,7 +48,6 @@ template Factory barrier callBarrier finalBarrier - expiryDate couponRate observationSchedule periodicSchedule diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index c511e4d9d..35cb143ea 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -50,8 +50,6 @@ template Instrument -- ^ The barrier used to auto-call. finalBarrier : Decimal -- ^ The barrier used to determine the final redemption amount. - expiryDate : Date - -- ^ The expiry date of the instrument. couponRate : Decimal -- ^ The fixed coupon rate, per annum. For example, in case of a "3.5% p.a coupon" this should -- be 0.035. @@ -127,7 +125,6 @@ template Instrument barrier callBarrier finalBarrier - expiryDate couponRate observationSchedule periodicSchedule diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml index 71ee6b49b..527546983 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml @@ -26,8 +26,6 @@ data AutoCallable = AutoCallable -- ^ The barrier used to auto-call. finalBarrier : Decimal -- ^ The barrier used to determine the final redemption amount. - expiryDate : Date - -- ^ The expiry date of the instrument. couponRate : Decimal -- ^ The fixed coupon rate, per annum. For example, in case of a "3.5% p.a coupon" this should -- be 0.035. diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml index a393e7ecb..61cd1f375 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml @@ -96,7 +96,7 @@ run = script do ----------------------------------------------------------------------- brcInstrument <- originateAutoCallable issuer issuer "AC" TransferableFungible - "AutoCallable" observers now expiryDate strike barrier callBarrier finalBarrier cashInstrument + "AutoCallable" observers now strike barrier callBarrier finalBarrier cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty @@ -124,7 +124,7 @@ run = script do -------------------------------------------------------------------- brcInstrument <- originateAutoCallable issuer issuer "AC2" TransferableFungible - "AutoCallable" observers now expiryDate strike barrierHigh callBarrier finalBarrierHigh cashInstrument + "AutoCallable" observers now strike barrierHigh callBarrier finalBarrierHigh cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty @@ -155,7 +155,7 @@ run = script do -------------------------------------------- brcInstrument <- originateAutoCallable issuer issuer "AC3" TransferableFungible - "AutoCallable" observers now expiryDate strike barrierHigh callBarrierLow finalBarrier cashInstrument + "AutoCallable" observers now strike barrierHigh callBarrierLow finalBarrier cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml index 327a5e3ba..4c1ea33b9 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml @@ -64,11 +64,11 @@ originateBarrierReverseConvertible depository issuer label holdingStandard descr -- | Originate a AutoCallable instrument. originateAutoCallable : Party -> Party -> Text -> HoldingStandard -> Text -> - [(Text, Parties)] -> Time -> Date -> Decimal -> Decimal -> Decimal -> Decimal -> InstrumentKey -> Text + [(Text, Parties)] -> Time -> Decimal -> Decimal -> Decimal -> Decimal -> InstrumentKey -> Text -> Decimal -> PeriodicSchedule -> PeriodicSchedule -> [Text] -> DayCountConventionEnum -> Decimal -> Party -> Party -> Script InstrumentKey originateAutoCallable depository issuer label holdingStandard description - observers lastEventTimestamp expiryDate strike barrier callBarrier finalBarrier currency referenceAssetId + observers lastEventTimestamp strike barrier callBarrier finalBarrier currency referenceAssetId couponRate observationSchedule periodicSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty = do -- Create an AutoCallable factory @@ -91,7 +91,6 @@ originateAutoCallable depository issuer label holdingStandard description autoCallable = AutoCallable with instrument description - expiryDate strike barrier callBarrier From ea0bc94cbc3ea3b8f405739738e78e079c4bf769 Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Fri, 19 Jan 2024 13:52:37 +0100 Subject: [PATCH 09/25] update changelog and run packell --- CHANGELOG.md | 3 +++ .../daml/Daml.Finance.Instrument.StructuredProduct/daml.yaml | 4 ++-- .../daml.yaml | 2 +- .../Daml.Finance.Instrument.StructuredProduct.Test/daml.yaml | 4 ++-- 4 files changed, 8 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 53786c972..304531bf3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -90,6 +90,7 @@ Dependency update (patch). ### Daml.Finance.Instrument.StructuredProduct Dependency update (patch). +Add new AutoCallable instrument (minor). ### Daml.Finance.Instrument.Swap @@ -119,6 +120,8 @@ Dependency update (patch). ### Daml.Finance.Interface.Instrument.StructuredProduct +Add new AutoCallable instrument (minor). + ### Daml.Finance.Interface.Instrument.Swap ### Daml.Finance.Interface.Instrument.Token diff --git a/package/main/daml/Daml.Finance.Instrument.StructuredProduct/daml.yaml b/package/main/daml/Daml.Finance.Instrument.StructuredProduct/daml.yaml index c09a52084..df7958ebd 100644 --- a/package/main/daml/Daml.Finance.Instrument.StructuredProduct/daml.yaml +++ b/package/main/daml/Daml.Finance.Instrument.StructuredProduct/daml.yaml @@ -4,7 +4,7 @@ sdk-version: 2.8.0 name: daml-finance-instrument-structuredproduct source: daml -version: 0.1.1 +version: 0.2.0 dependencies: - daml-prim - daml-stdlib @@ -15,7 +15,7 @@ data-dependencies: - .lib/daml-finance/Daml.Finance.Interface.Claims/3.0.0/daml-finance-interface-claims-3.0.0.dar - .lib/daml-finance/Daml.Finance.Interface.Instrument.Base/3.0.0/daml-finance-interface-instrument-base-3.0.0.dar - .lib/daml-finance/Daml.Finance.Interface.Instrument.Option/0.3.0/daml-finance-interface-instrument-option-0.3.0.dar - - .lib/daml-finance/Daml.Finance.Interface.Instrument.StructuredProduct/0.1.1/daml-finance-interface-instrument-structuredproduct-0.1.1.dar + - .lib/daml-finance/Daml.Finance.Interface.Instrument.StructuredProduct/0.2.0/daml-finance-interface-instrument-structuredproduct-0.2.0.dar - .lib/daml-finance/Daml.Finance.Interface.Instrument.Types/1.0.0/daml-finance-interface-instrument-types-1.0.0.dar - .lib/daml-finance/Daml.Finance.Interface.Types.Common/2.0.0/daml-finance-interface-types-common-2.0.0.dar - .lib/daml-finance/Daml.Finance.Interface.Types.Date/2.1.0/daml-finance-interface-types-date-2.1.0.dar diff --git a/package/main/daml/Daml.Finance.Interface.Instrument.StructuredProduct/daml.yaml b/package/main/daml/Daml.Finance.Interface.Instrument.StructuredProduct/daml.yaml index 7c3e450ac..7108fc1fe 100644 --- a/package/main/daml/Daml.Finance.Interface.Instrument.StructuredProduct/daml.yaml +++ b/package/main/daml/Daml.Finance.Interface.Instrument.StructuredProduct/daml.yaml @@ -4,7 +4,7 @@ sdk-version: 2.8.0 name: daml-finance-interface-instrument-structuredproduct source: daml -version: 0.1.1 +version: 0.2.0 dependencies: - daml-prim - daml-stdlib diff --git a/package/test/daml/Daml.Finance.Instrument.StructuredProduct.Test/daml.yaml b/package/test/daml/Daml.Finance.Instrument.StructuredProduct.Test/daml.yaml index 38f2f742c..03c44c7bf 100644 --- a/package/test/daml/Daml.Finance.Instrument.StructuredProduct.Test/daml.yaml +++ b/package/test/daml/Daml.Finance.Instrument.StructuredProduct.Test/daml.yaml @@ -11,8 +11,8 @@ dependencies: - daml-script data-dependencies: - .lib/daml-finance/Daml.Finance.Data/3.0.1/daml-finance-data-3.0.1.dar - - .lib/daml-finance/Daml.Finance.Instrument.StructuredProduct/0.1.1/daml-finance-instrument-structuredproduct-0.1.1.dar - - .lib/daml-finance/Daml.Finance.Interface.Instrument.StructuredProduct/0.1.1/daml-finance-interface-instrument-structuredproduct-0.1.1.dar + - .lib/daml-finance/Daml.Finance.Instrument.StructuredProduct/0.2.0/daml-finance-instrument-structuredproduct-0.2.0.dar + - .lib/daml-finance/Daml.Finance.Interface.Instrument.StructuredProduct/0.2.0/daml-finance-interface-instrument-structuredproduct-0.2.0.dar - .lib/daml-finance/Daml.Finance.Interface.Types.Common/2.0.0/daml-finance-interface-types-common-2.0.0.dar - .lib/daml-finance/Daml.Finance.Interface.Types.Date/2.1.0/daml-finance-interface-types-date-2.1.0.dar - .lib/daml-finance/Daml.Finance.Interface.Util/2.1.0/daml-finance-interface-util-2.1.0.dar From 63058ea4cf92750e37497b8201abfaed82fddf1c Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Fri, 19 Jan 2024 14:05:44 +0100 Subject: [PATCH 10/25] add sanity checks --- .../AutoCallable/Instrument.daml | 6 ++---- .../Instrument/StructuredProduct/Util.daml | 20 +++++-------------- .../StructuredProduct/Test/AutoCallable.daml | 4 ++-- 3 files changed, 9 insertions(+), 21 deletions(-) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index 35cb143ea..78473ca4f 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -85,10 +85,6 @@ template Instrument getClaims Claim.GetClaims{actor} = do -- get the initial claims tree (as of the instrument's acquisition time) -{- TODO: Replace this check - assertMsg "option expiry date must match last coupon date" $ - expiryDate == periodicSchedule.terminationDate - -} let getCalendars = getHolidayCalendars actor calendarDataProvider floatingRate = None @@ -101,6 +97,8 @@ template Instrument fixingCals <- getHolidayCalendars issuer calendarDataProvider fixingBusinessCenters (schedule, _) <- rollSchedule getCalendars periodicSchedule holidayCalendarIds (callableSchedule, _) <- rollSchedule getCalendars observationSchedule holidayCalendarIds + assertMsg "The callable schedule must have the same length as the coupon schedule" $ + length schedule == length callableSchedule let useAdjustedDatesForDcf = True callableClaims = createAutoCallableClaims dateToDateClockTime schedule callableSchedule diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml index f8be700a9..82b040153 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml @@ -36,29 +36,19 @@ createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSch notionalAmount = scale (Const notional) $ one cashInstrument principal = notionalAmount -{- - -- Find out on which coupon dates it is possible to call the bond. - callPossibleInit = includes schedule callableSchedule - - -- Also search in the other direction, to ensure that no intended call dates are ignored. - potentialCallDatesFound = includes callableSchedule schedule - - callPossible = if P.and potentialCallDatesFound then callPossibleInit - else error "All dates in the call schedule must exist in the coupon schedule" - -} - -- TODO: verify that callableSchedule has same length as periodicSchedule - -- TODO: verify that callableSchedule dates are before periodicSchedule dates combineTagClaim (couponPeriod, callPeriod) notCalledClaim = let cpn = calculateRatePayment couponPeriod dayCountConvention useAdjustedDatesForDcf periodicSchedule floatingRate couponRate notionalAmount fixingCalendars capRate floorRate - callDate = callPeriod.adjustedEndDate + (callDate, paymentDate) = if callPeriod.adjustedEndDate < couponPeriod.adjustedEndDate + then (callPeriod.adjustedEndDate, couponPeriod.adjustedEndDate) + else error "call date must be before payment date" spotOnObservationDate = ObserveAt spot callDate couponBarrierHit = Lte (spotOnObservationDate, Const couponBarrier) coupon = cond couponBarrierHit zero cpn - called = when (at couponPeriod.adjustedEndDate) $ and coupon principal - notCalled = when (at couponPeriod.adjustedEndDate) $ and coupon notCalledClaim + called = when (at paymentDate) $ and coupon principal + notCalled = when (at paymentDate) $ and coupon notCalledClaim autoExerciseCondition = Lte (Const callBarrier, spotOnObservationDate) tailClaim = when (at callDate) $ cond autoExerciseCondition called notCalled in diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml index 61cd1f375..e237f8e0e 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml @@ -41,9 +41,9 @@ run = script do callBarrierLow = 38.0 finalBarrierHigh = 40.0 -- CREATE_AUTO_CALLABLE_VARIABLES_BEGIN - barrier = 26.0 -- TODO: separate into couponBarrier and finalBarrier + barrier = 26.0 callBarrier = 40.0 - strike = 40.0 -- TODO: separate into initialValue and callValue + strike = 40.0 finalBarrier = 35.0 expiryDate = date 2024 Sep 28 --barrierStartDate = expiryDate From 2a1942a03886255967cfb1a7a190659d0c29fcdd Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Fri, 19 Jan 2024 16:16:34 +0100 Subject: [PATCH 11/25] improve comments / descriptions --- .../AutoCallable/Factory.daml | 6 ++-- .../AutoCallable/Instrument.daml | 18 ++++++----- .../Instrument/StructuredProduct/Util.daml | 12 ++++---- .../AutoCallable/Factory.daml | 4 +-- .../AutoCallable/Instrument.daml | 4 +-- .../StructuredProduct/AutoCallable/Types.daml | 18 ++++++----- .../StructuredProduct/Test/AutoCallable.daml | 30 +++++++++---------- 7 files changed, 48 insertions(+), 44 deletions(-) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml index 651d28a76..4c2eb7205 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -36,7 +36,7 @@ template Factory calendarDataProvider; dayCountConvention; notional; prevEvents}; observers} = do let - brcInstrument = AutoCallable.Instrument with + acInstrument = AutoCallable.Instrument with depository = instrument.depository issuer = instrument.issuer id = instrument.id @@ -59,11 +59,11 @@ template Factory lastEventTimestamp observers prevEvents - cid <- toInterfaceContractId <$> create brcInstrument + cid <- toInterfaceContractId <$> create acInstrument BaseInstrument.createReference instrument.depository $ toInterfaceContractId cid -- Get the claims in order to run the associated checks (e.g. verify that the schedules -- are valid). - Claim.getClaims (toInterface @Claim.I brcInstrument) $ + Claim.getClaims (toInterface @Claim.I acInstrument) $ Claim.GetClaims with actor = instrument.issuer pure cid diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index 78473ca4f..e7fa3eab8 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -24,7 +24,7 @@ import Daml.Finance.Util.Disclosure (addObserversImpl, removeObserversImpl, setO -- | Type synonym for `Instrument`. type T = Instrument --- | This template models an AutoCallable instrument that pays a coupon. +-- | This template models an AutoCallable instrument that pays a conditional coupon. template Instrument with depository : Party @@ -40,21 +40,23 @@ template Instrument description : Text -- ^ A description of the instrument. referenceAssetId : Text - -- ^ The reference asset ID. For example, in case of an option on AAPL this should be a valid + -- ^ The reference asset ID. For example, in case of an AAPL underlying this should be a valid -- reference to the AAPL fixings to be used for the payoff calculation. strike : Decimal - -- ^ The strike price of the option. + -- ^ The initial fixing of the underlying. barrier : Decimal - -- ^ The barrier level of the option. + -- ^ The coupon barrier level. callBarrier : Decimal - -- ^ The barrier used to auto-call. + -- ^ The barrier used to automatically call the instrument. finalBarrier : Decimal -- ^ The barrier used to determine the final redemption amount. couponRate : Decimal - -- ^ The fixed coupon rate, per annum. For example, in case of a "3.5% p.a coupon" this should - -- be 0.035. + -- ^ The fixed coupon rate, either per annum or per coupon period (depending on the + -- dayCountConvention below). observationSchedule : PeriodicSchedule - -- ^ The schedule for the observation dates. + -- ^ The schedule for the observation dates. These are used to observe the barrier, determine + -- whether the instrument is automatically called and to determine the final redemption + -- amount. periodicSchedule : PeriodicSchedule -- ^ The schedule for the periodic coupon payments. holidayCalendarIds : [Text] diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml index 82b040153..504310093 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml @@ -23,8 +23,8 @@ includes : Schedule -> Schedule -> [Bool] includes scheduleA scheduleB = map (\a -> isSome $ find (\b -> b.adjustedEndDate == a.adjustedEndDate) scheduleB) scheduleA --- | Calculate the claims for a an auto-callable with a fixed and/or floating coupon on each payment --- date and a redemption amount at the end (unless auto-called previously). +-- | Calculate the claims for a an auto-callable with a contingent coupon on each payment date +-- and a redemption amount at maturity (unless auto-called previously). createAutoCallableClaims : (Date -> Time) -> Schedule -> Schedule -> PeriodicSchedule -> Bool -> Decimal -> DayCountConventionEnum -> Decimal -> Deliverable -> Optional FloatingRate -> Optional Decimal -> Optional Decimal -> Text -> Decimal -> Decimal -> Decimal -> Decimal -> HolidayCalendarData @@ -41,9 +41,9 @@ createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSch let cpn = calculateRatePayment couponPeriod dayCountConvention useAdjustedDatesForDcf periodicSchedule floatingRate couponRate notionalAmount fixingCalendars capRate floorRate - (callDate, paymentDate) = if callPeriod.adjustedEndDate < couponPeriod.adjustedEndDate - then (callPeriod.adjustedEndDate, couponPeriod.adjustedEndDate) - else error "call date must be before payment date" + (callDate, paymentDate) = if callPeriod.adjustedEndDate > couponPeriod.adjustedEndDate + then error "each call date must be before or at the corresponding payment date" + else (callPeriod.adjustedEndDate, couponPeriod.adjustedEndDate) spotOnObservationDate = ObserveAt spot callDate couponBarrierHit = Lte (spotOnObservationDate, Const couponBarrier) coupon = cond couponBarrierHit zero cpn @@ -65,4 +65,4 @@ createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSch claims = foldr (\p acc -> combineTagClaim p acc) notCalledFinal $ zip paymentSchedule callableSchedule in - prepareAndTagClaims dateToTime [claims] "Callable bond payment" + prepareAndTagClaims dateToTime [claims] "AutoCallable payment" diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml index ecec5ccf8..da5cd3656 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -21,7 +21,7 @@ data View = View -- ^ The provider of the `Factory`. deriving (Eq, Show) --- | Factory interface to instantiate BRCs. +-- | Factory interface to instantiate AutoCallable instruments. interface Factory requires Disclosure.I where viewtype V @@ -32,7 +32,7 @@ interface Factory requires Disclosure.I where -- ^ Create a new instrument. with autoCallable : AutoCallable - -- ^ Attributes to create a BRC. + -- ^ Attributes to create an AutoCallable. observers : PartiesMap -- ^ The instrument's observers. controller diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml index aea686bd9..21fb84f10 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -17,10 +17,10 @@ type V = View data View = View with autoCallable : AutoCallable - -- ^ Attributes of a BRC. + -- ^ Attributes of an AutoCallable. deriving (Eq, Show) --- | Instrument interface representing a BRC. +-- | Instrument interface representing an AutoCallable. interface Instrument requires BaseInstrument.I, Disclosure.I where viewtype V diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml index 527546983..f6fc61295 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml @@ -8,7 +8,7 @@ import Daml.Finance.Interface.Types.Common.Types (InstrumentKey(..)) import Daml.Finance.Interface.Types.Date.DayCount (DayCountConventionEnum) import Daml.Finance.Interface.Types.Date.Schedule (PeriodicSchedule(..)) --- | Describes the attributes of an AutoCallable instrument. +-- | Describes the attributes of an AutoCallable instrument that pays a conditional coupon. data AutoCallable = AutoCallable with instrument : InstrumentKey @@ -16,21 +16,23 @@ data AutoCallable = AutoCallable description : Text -- ^ The description of the option. referenceAssetId : Text - -- ^ The reference asset ID. For example, in case of an option on AAPL this should be a valid + -- ^ The reference asset ID. For example, in case of an AAPL underlying this should be a valid -- reference to the AAPL fixings to be used for the payoff calculation. strike : Decimal - -- ^ The strike price of the option. + -- ^ The initial fixing of the underlying. barrier : Decimal - -- ^ The barrier level of the option. + -- ^ The coupon barrier level. callBarrier : Decimal - -- ^ The barrier used to auto-call. + -- ^ The barrier used to automatically call the instrument. finalBarrier : Decimal -- ^ The barrier used to determine the final redemption amount. couponRate : Decimal - -- ^ The fixed coupon rate, per annum. For example, in case of a "3.5% p.a coupon" this should - -- be 0.035. + -- ^ The fixed coupon rate, either per annum or per coupon period (depending on the + -- dayCountConvention below). observationSchedule : PeriodicSchedule - -- ^ The schedule for the observation dates. + -- ^ The schedule for the observation dates. These are used to observe the barrier, determine + -- whether the instrument is automatically called and to determine the final redemption + -- amount. periodicSchedule : PeriodicSchedule -- ^ The schedule for the periodic coupon payments. holidayCalendarIds : [Text] diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml index e237f8e0e..45ad5a4a4 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml @@ -95,7 +95,7 @@ run = script do -- 1. AutoCallable without barrier events (and no early redemption) -- ----------------------------------------------------------------------- - brcInstrument <- originateAutoCallable issuer issuer "AC" TransferableFungible + acInstrument <- originateAutoCallable issuer issuer "AC" TransferableFungible "AutoCallable" observers now strike barrier callBarrier finalBarrier cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty @@ -103,27 +103,27 @@ run = script do let expectedConsumed = [] expectedProduced = [qty 0.05 cashInstrument] - Some brcInstrumentAfterCouponDate1 <- lifecycleAndVerifyPaymentEffects [publicParty] - firstCouponDate brcInstrument issuer [observableCid] expectedConsumed + Some acInstrumentAfterCouponDate1 <- lifecycleAndVerifyPaymentEffects [publicParty] + firstCouponDate acInstrument issuer [observableCid] expectedConsumed expectedProduced let expectedConsumed = [] expectedProduced = [qty 0.05 cashInstrument] - Some brcInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] secondCouponDate brcInstrumentAfterCouponDate1 issuer + Some acInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] secondCouponDate acInstrumentAfterCouponDate1 issuer [observableCid] expectedConsumed expectedProduced let expectedConsumed = [] expectedProduced = [qty 1.05 cashInstrument] - lifecycleAndVerifyPaymentEffects [publicParty] maturityDate brcInstrumentAfterCouponDate2 issuer + lifecycleAndVerifyPaymentEffects [publicParty] maturityDate acInstrumentAfterCouponDate2 issuer [observableCid] expectedConsumed expectedProduced -------------------------------------------------------------------- -- 2. AutoCallable with barrier events (and no early redemption) -- -------------------------------------------------------------------- - brcInstrument <- originateAutoCallable issuer issuer "AC2" TransferableFungible + acInstrument <- originateAutoCallable issuer issuer "AC2" TransferableFungible "AutoCallable" observers now strike barrierHigh callBarrier finalBarrierHigh cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty @@ -132,29 +132,29 @@ run = script do let expectedConsumed = [] expectedProduced = [] - Some brcInstrumentAfterCouponDate1 <- lifecycleAndVerifyPaymentEffects [publicParty] - firstCouponDate brcInstrument issuer [observableCid] expectedConsumed + Some acInstrumentAfterCouponDate1 <- lifecycleAndVerifyPaymentEffects [publicParty] + firstCouponDate acInstrument issuer [observableCid] expectedConsumed expectedProduced -- The second coupon is paid (no barrier hit) let expectedConsumed = [] expectedProduced = [qty 0.05 cashInstrument] - Some brcInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] secondCouponDate brcInstrumentAfterCouponDate1 issuer + Some acInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] secondCouponDate acInstrumentAfterCouponDate1 issuer [observableCid] expectedConsumed expectedProduced -- Redemption amount is less than principal because the final barrier is hit let expectedConsumed = [] expectedProduced = [qty 0.95 cashInstrument] - lifecycleAndVerifyPaymentEffects [publicParty] maturityDate brcInstrumentAfterCouponDate2 issuer + lifecycleAndVerifyPaymentEffects [publicParty] maturityDate acInstrumentAfterCouponDate2 issuer [observableCid] expectedConsumed expectedProduced -------------------------------------------- -- 3. AutoCallable with early redemption -- -------------------------------------------- - brcInstrument <- originateAutoCallable issuer issuer "AC3" TransferableFungible + acInstrument <- originateAutoCallable issuer issuer "AC3" TransferableFungible "AutoCallable" observers now strike barrierHigh callBarrierLow finalBarrier cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty @@ -163,19 +163,19 @@ run = script do let expectedConsumed = [] expectedProduced = [] - Some brcInstrumentAfterCouponDate1 <- lifecycleAndVerifyPaymentEffects [publicParty] - firstCouponDate brcInstrument issuer [observableCid] expectedConsumed + Some acInstrumentAfterCouponDate1 <- lifecycleAndVerifyPaymentEffects [publicParty] + firstCouponDate acInstrument issuer [observableCid] expectedConsumed expectedProduced -- Auto-call on the second coupon date let expectedConsumed = [] expectedProduced = [qty 1.05 cashInstrument] - Some brcInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] secondCouponDate brcInstrumentAfterCouponDate1 issuer + Some acInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] secondCouponDate acInstrumentAfterCouponDate1 issuer [observableCid] expectedConsumed expectedProduced -- Ensure no lifecycle effects on a called instrument - verifyNoLifecycleEffects [publicParty] maturityDate brcInstrumentAfterCouponDate2 issuer + verifyNoLifecycleEffects [publicParty] maturityDate acInstrumentAfterCouponDate2 issuer [observableCid] pure () From f07bdcc0bb3209a6dbffae2f22ecc9ee642fc031 Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Fri, 19 Jan 2024 16:27:11 +0100 Subject: [PATCH 12/25] rename some instrument variables --- .../StructuredProduct/AutoCallable/Factory.daml | 6 +++--- .../StructuredProduct/AutoCallable/Instrument.daml | 10 +++++----- .../StructuredProduct/AutoCallable/Types.daml | 4 ++-- .../StructuredProduct/Test/AutoCallable.daml | 12 ++++++------ .../Instrument/StructuredProduct/Test/Util.daml | 6 +++--- 5 files changed, 19 insertions(+), 19 deletions(-) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml index 4c2eb7205..03fd24a93 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -31,7 +31,7 @@ template Factory view = AutoCallableFactory.View with provider create' AutoCallableFactory.Create{ autoCallable = AutoCallable{instrument; description; - referenceAssetId; strike; barrier; callBarrier; finalBarrier; currency; + referenceAssetId; initialFixing; couponBarrier; callBarrier; finalBarrier; currency; lastEventTimestamp; couponRate; observationSchedule; periodicSchedule; holidayCalendarIds; calendarDataProvider; dayCountConvention; notional; prevEvents}; observers} = do @@ -44,8 +44,8 @@ template Factory holdingStandard = instrument.holdingStandard description referenceAssetId - strike - barrier + initialFixing + couponBarrier callBarrier finalBarrier couponRate diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index e7fa3eab8..e529da3c9 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -42,9 +42,9 @@ template Instrument referenceAssetId : Text -- ^ The reference asset ID. For example, in case of an AAPL underlying this should be a valid -- reference to the AAPL fixings to be used for the payoff calculation. - strike : Decimal + initialFixing : Decimal -- ^ The initial fixing of the underlying. - barrier : Decimal + couponBarrier : Decimal -- ^ The coupon barrier level. callBarrier : Decimal -- ^ The barrier used to automatically call the instrument. @@ -105,7 +105,7 @@ template Instrument useAdjustedDatesForDcf = True callableClaims = createAutoCallableClaims dateToDateClockTime schedule callableSchedule periodicSchedule useAdjustedDatesForDcf couponRate dayCountConvention notional currency - floatingRate capRate floorRate referenceAssetId barrier callBarrier finalBarrier strike $ merge fixingCals + floatingRate capRate floorRate referenceAssetId couponBarrier callBarrier finalBarrier initialFixing $ merge fixingCals pure [callableClaims] @@ -121,8 +121,8 @@ template Instrument instrument = BaseInstrument.instrumentKey this description referenceAssetId - strike - barrier + initialFixing + couponBarrier callBarrier finalBarrier couponRate diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml index f6fc61295..21a860fdc 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml @@ -18,9 +18,9 @@ data AutoCallable = AutoCallable referenceAssetId : Text -- ^ The reference asset ID. For example, in case of an AAPL underlying this should be a valid -- reference to the AAPL fixings to be used for the payoff calculation. - strike : Decimal + initialFixing : Decimal -- ^ The initial fixing of the underlying. - barrier : Decimal + couponBarrier : Decimal -- ^ The coupon barrier level. callBarrier : Decimal -- ^ The barrier used to automatically call the instrument. diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml index 45ad5a4a4..c20cb4060 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml @@ -37,13 +37,13 @@ run = script do -- Create and distribute option let - barrierHigh = 30.0 + couponBarrierHigh = 30.0 callBarrierLow = 38.0 finalBarrierHigh = 40.0 -- CREATE_AUTO_CALLABLE_VARIABLES_BEGIN - barrier = 26.0 + initialFixing = 40.0 + couponBarrier = 26.0 callBarrier = 40.0 - strike = 40.0 finalBarrier = 35.0 expiryDate = date 2024 Sep 28 --barrierStartDate = expiryDate @@ -96,7 +96,7 @@ run = script do ----------------------------------------------------------------------- acInstrument <- originateAutoCallable issuer issuer "AC" TransferableFungible - "AutoCallable" observers now strike barrier callBarrier finalBarrier cashInstrument + "AutoCallable" observers now initialFixing couponBarrier callBarrier finalBarrier cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty @@ -124,7 +124,7 @@ run = script do -------------------------------------------------------------------- acInstrument <- originateAutoCallable issuer issuer "AC2" TransferableFungible - "AutoCallable" observers now strike barrierHigh callBarrier finalBarrierHigh cashInstrument + "AutoCallable" observers now initialFixing couponBarrierHigh callBarrier finalBarrierHigh cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty @@ -155,7 +155,7 @@ run = script do -------------------------------------------- acInstrument <- originateAutoCallable issuer issuer "AC3" TransferableFungible - "AutoCallable" observers now strike barrierHigh callBarrierLow finalBarrier cashInstrument + "AutoCallable" observers now initialFixing couponBarrierHigh callBarrierLow finalBarrier cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml index 4c1ea33b9..846f49c07 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml @@ -68,7 +68,7 @@ originateAutoCallable : Party -> Party -> Text -> HoldingStandard -> Text -> -> Decimal -> PeriodicSchedule -> PeriodicSchedule -> [Text] -> DayCountConventionEnum -> Decimal -> Party -> Party -> Script InstrumentKey originateAutoCallable depository issuer label holdingStandard description - observers lastEventTimestamp strike barrier callBarrier finalBarrier currency referenceAssetId + observers lastEventTimestamp initialFixing couponBarrier callBarrier finalBarrier currency referenceAssetId couponRate observationSchedule periodicSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty = do -- Create an AutoCallable factory @@ -91,8 +91,8 @@ originateAutoCallable depository issuer label holdingStandard description autoCallable = AutoCallable with instrument description - strike - barrier + initialFixing + couponBarrier callBarrier finalBarrier referenceAssetId From 756cb116fe4b9bdab9363649fee293d13e0267cf Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Fri, 19 Jan 2024 16:38:30 +0100 Subject: [PATCH 13/25] fix line width --- .../AutoCallable/Factory.daml | 8 ++-- .../AutoCallable/Instrument.daml | 3 +- .../Instrument/StructuredProduct/Util.daml | 14 +++--- .../StructuredProduct/Test/AutoCallable.daml | 44 ++++++++++--------- .../StructuredProduct/Test/Util.daml | 8 ++-- 5 files changed, 42 insertions(+), 35 deletions(-) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml index 03fd24a93..73c8f08d3 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -30,10 +30,10 @@ template Factory interface instance AutoCallableFactory.I for Factory where view = AutoCallableFactory.View with provider create' AutoCallableFactory.Create{ - autoCallable = AutoCallable{instrument; description; - referenceAssetId; initialFixing; couponBarrier; callBarrier; finalBarrier; currency; - lastEventTimestamp; couponRate; observationSchedule; periodicSchedule; holidayCalendarIds; - calendarDataProvider; dayCountConvention; notional; prevEvents}; + autoCallable = AutoCallable{instrument; description; referenceAssetId; initialFixing; + couponBarrier; callBarrier; finalBarrier; currency; lastEventTimestamp; couponRate; + observationSchedule; periodicSchedule; holidayCalendarIds; calendarDataProvider; + dayCountConvention; notional; prevEvents}; observers} = do let acInstrument = AutoCallable.Instrument with diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index e529da3c9..60266a5e1 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -105,7 +105,8 @@ template Instrument useAdjustedDatesForDcf = True callableClaims = createAutoCallableClaims dateToDateClockTime schedule callableSchedule periodicSchedule useAdjustedDatesForDcf couponRate dayCountConvention notional currency - floatingRate capRate floorRate referenceAssetId couponBarrier callBarrier finalBarrier initialFixing $ merge fixingCals + floatingRate capRate floorRate referenceAssetId couponBarrier callBarrier finalBarrier + initialFixing $ merge fixingCals pure [callableClaims] diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml index 504310093..21f911329 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml @@ -27,11 +27,12 @@ includes scheduleA scheduleB = -- and a redemption amount at maturity (unless auto-called previously). createAutoCallableClaims : (Date -> Time) -> Schedule -> Schedule -> PeriodicSchedule -> Bool -> Decimal -> DayCountConventionEnum -> Decimal -> Deliverable -> Optional FloatingRate - -> Optional Decimal -> Optional Decimal -> Text -> Decimal -> Decimal -> Decimal -> Decimal -> HolidayCalendarData - -> TaggedClaim + -> Optional Decimal -> Optional Decimal -> Text -> Decimal -> Decimal -> Decimal -> Decimal + -> HolidayCalendarData -> TaggedClaim createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSchedule useAdjustedDatesForDcf couponRate dayCountConvention notional cashInstrument floatingRate - capRate floorRate spot couponBarrier callBarrier finalBarrier initialFixing fixingCalendars = + capRate floorRate spot couponBarrier callBarrier finalBarrier initialFixing + fixingCalendars = let notionalAmount = scale (Const notional) $ one cashInstrument @@ -39,8 +40,8 @@ createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSch combineTagClaim (couponPeriod, callPeriod) notCalledClaim = let - cpn = calculateRatePayment couponPeriod dayCountConvention useAdjustedDatesForDcf periodicSchedule - floatingRate couponRate notionalAmount fixingCalendars capRate floorRate + cpn = calculateRatePayment couponPeriod dayCountConvention useAdjustedDatesForDcf + periodicSchedule floatingRate couponRate notionalAmount fixingCalendars capRate floorRate (callDate, paymentDate) = if callPeriod.adjustedEndDate > couponPeriod.adjustedEndDate then error "each call date must be before or at the corresponding payment date" else (callPeriod.adjustedEndDate, couponPeriod.adjustedEndDate) @@ -62,7 +63,8 @@ createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSch perfomanceScaledPrincipal = scale perf notionalAmount redemptionPayment = cond barrierHit perfomanceScaledPrincipal principal notCalledFinal = when (at finalCouponDate) redemptionPayment - claims = foldr (\p acc -> combineTagClaim p acc) notCalledFinal $ zip paymentSchedule callableSchedule + claims = foldr (\p acc -> combineTagClaim p acc) notCalledFinal $ + zip paymentSchedule callableSchedule in prepareAndTagClaims dateToTime [claims] "AutoCallable payment" diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml index c20cb4060..2fb50efa2 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml @@ -68,8 +68,9 @@ run = script do holidays = [] couponSchedule = createPaymentPeriodicSchedule firstCouponDate holidayCalendarIds businessDayConvention couponPeriod couponPeriodMultiplier issueDate maturityDate - observationSchedule = createPaymentPeriodicSchedule firstRegularObervationDate holidayCalendarIds - businessDayConvention couponPeriod couponPeriodMultiplier initialValuationDate expiryDate + observationSchedule = createPaymentPeriodicSchedule firstRegularObervationDate + holidayCalendarIds businessDayConvention couponPeriod couponPeriodMultiplier + initialValuationDate expiryDate notional = 1.0 -- CREATE_AUTO_CALLABLE_OBSERVATIONS_BEGIN @@ -95,10 +96,10 @@ run = script do -- 1. AutoCallable without barrier events (and no early redemption) -- ----------------------------------------------------------------------- - acInstrument <- originateAutoCallable issuer issuer "AC" TransferableFungible - "AutoCallable" observers now initialFixing couponBarrier callBarrier finalBarrier cashInstrument - referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional - calendarDataProvider publicParty + acInstrument <- originateAutoCallable issuer issuer "AC" TransferableFungible "AutoCallable" + observers now initialFixing couponBarrier callBarrier finalBarrier cashInstrument + referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds + dayCountConvention notional calendarDataProvider publicParty let expectedConsumed = [] @@ -110,8 +111,9 @@ run = script do let expectedConsumed = [] expectedProduced = [qty 0.05 cashInstrument] - Some acInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] secondCouponDate acInstrumentAfterCouponDate1 issuer - [observableCid] expectedConsumed expectedProduced + Some acInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] + secondCouponDate acInstrumentAfterCouponDate1 issuer [observableCid] expectedConsumed + expectedProduced let expectedConsumed = [] @@ -123,10 +125,10 @@ run = script do -- 2. AutoCallable with barrier events (and no early redemption) -- -------------------------------------------------------------------- - acInstrument <- originateAutoCallable issuer issuer "AC2" TransferableFungible - "AutoCallable" observers now initialFixing couponBarrierHigh callBarrier finalBarrierHigh cashInstrument - referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional - calendarDataProvider publicParty + acInstrument <- originateAutoCallable issuer issuer "AC2" TransferableFungible "AutoCallable" + observers now initialFixing couponBarrierHigh callBarrier finalBarrierHigh cashInstrument + referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds + dayCountConvention notional calendarDataProvider publicParty -- The first coupon is not paid because the coupon barrier is hit let @@ -140,8 +142,9 @@ run = script do let expectedConsumed = [] expectedProduced = [qty 0.05 cashInstrument] - Some acInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] secondCouponDate acInstrumentAfterCouponDate1 issuer - [observableCid] expectedConsumed expectedProduced + Some acInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] + secondCouponDate acInstrumentAfterCouponDate1 issuer [observableCid] expectedConsumed + expectedProduced -- Redemption amount is less than principal because the final barrier is hit let @@ -154,10 +157,10 @@ run = script do -- 3. AutoCallable with early redemption -- -------------------------------------------- - acInstrument <- originateAutoCallable issuer issuer "AC3" TransferableFungible - "AutoCallable" observers now initialFixing couponBarrierHigh callBarrierLow finalBarrier cashInstrument - referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional - calendarDataProvider publicParty + acInstrument <- originateAutoCallable issuer issuer "AC3" TransferableFungible "AutoCallable" + observers now initialFixing couponBarrierHigh callBarrierLow finalBarrier cashInstrument + referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds + dayCountConvention notional calendarDataProvider publicParty -- The first coupon is not paid because the coupon barrier is hit let @@ -171,8 +174,9 @@ run = script do let expectedConsumed = [] expectedProduced = [qty 1.05 cashInstrument] - Some acInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] secondCouponDate acInstrumentAfterCouponDate1 issuer - [observableCid] expectedConsumed expectedProduced + Some acInstrumentAfterCouponDate2 <- lifecycleAndVerifyPaymentEffects [publicParty] + secondCouponDate acInstrumentAfterCouponDate1 issuer [observableCid] expectedConsumed + expectedProduced -- Ensure no lifecycle effects on a called instrument verifyNoLifecycleEffects [publicParty] maturityDate acInstrumentAfterCouponDate2 issuer diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml index 846f49c07..5420919b6 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml @@ -63,12 +63,12 @@ originateBarrierReverseConvertible depository issuer label holdingStandard descr pure instrument -- | Originate a AutoCallable instrument. -originateAutoCallable : Party -> Party -> Text -> HoldingStandard -> Text -> - [(Text, Parties)] -> Time -> Decimal -> Decimal -> Decimal -> Decimal -> InstrumentKey -> Text +originateAutoCallable : Party -> Party -> Text -> HoldingStandard -> Text -> [(Text, Parties)] + -> Time -> Decimal -> Decimal -> Decimal -> Decimal -> InstrumentKey -> Text -> Decimal -> PeriodicSchedule -> PeriodicSchedule -> [Text] -> DayCountConventionEnum -> Decimal -> Party -> Party -> Script InstrumentKey -originateAutoCallable depository issuer label holdingStandard description - observers lastEventTimestamp initialFixing couponBarrier callBarrier finalBarrier currency referenceAssetId +originateAutoCallable depository issuer label holdingStandard description observers + lastEventTimestamp initialFixing couponBarrier callBarrier finalBarrier currency referenceAssetId couponRate observationSchedule periodicSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty = do -- Create an AutoCallable factory From 1d9e71da75aca089943350d45a9bd9699fbd22d7 Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Mon, 22 Jan 2024 06:27:54 +0100 Subject: [PATCH 14/25] bump version for docs --- daml.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/daml.yaml b/daml.yaml index 6963ad39f..ba48226d9 100644 --- a/daml.yaml +++ b/daml.yaml @@ -10,7 +10,7 @@ sdk-version: 2.8.0 daml-version: 2.8.0 name: daml-finance source: src/test/daml -version: 1.4.0 +version: 1.4.1 dependencies: - daml-prim - daml-stdlib From 1242da329c1060149e8d51901f19b84958a5b37e Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Mon, 22 Jan 2024 07:10:53 +0100 Subject: [PATCH 15/25] reorder variables in test and clarify Basis1 --- .../StructuredProduct/Test/AutoCallable.daml | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml index 2fb50efa2..c6a0e3679 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml @@ -45,21 +45,20 @@ run = script do couponBarrier = 26.0 callBarrier = 40.0 finalBarrier = 35.0 - expiryDate = date 2024 Sep 28 - --barrierStartDate = expiryDate referenceAssetId = "AAPL-CLOSE" couponRate = 0.05 + dayCountConvention = Basis1 -- coupon rate is paid each period, not per annum. + businessDayConvention = Following + couponPeriod = M + couponPeriodMultiplier = 3 initialValuationDate = date 2024 Jan 10 issueDate = date 2024 Jan 16 firstRegularObervationDate = date 2024 Mar 28 firstCouponDate = date 2024 Apr 2 secondCouponDate = date 2024 Jul 2 + expiryDate = date 2024 Sep 28 maturityDate = date 2024 Oct 2 -- CREATE_AUTO_CALLABLE_VARIABLES_END - businessDayConvention = Following - couponPeriod = M - couponPeriodMultiplier = 3 - dayCountConvention = Basis1 holidayCalendarIds = ["USD"] calendar = HolidayCalendarData with From 5e22219e56cfa4d2c70a3d50870286a54a79faff Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Mon, 22 Jan 2024 10:22:29 +0100 Subject: [PATCH 16/25] specify initial level and barriers as percentage of underlying close on initial fixing date --- .../AutoCallable/Instrument.daml | 12 +++++++---- .../Instrument/StructuredProduct/Util.daml | 17 +++++++++------ .../StructuredProduct/Test/AutoCallable.daml | 21 ++++++++++--------- 3 files changed, 30 insertions(+), 20 deletions(-) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index 60266a5e1..9a25f3ae4 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -43,13 +43,17 @@ template Instrument -- ^ The reference asset ID. For example, in case of an AAPL underlying this should be a valid -- reference to the AAPL fixings to be used for the payoff calculation. initialFixing : Decimal - -- ^ The initial fixing of the underlying. + -- ^ The initial fixing (as a percentage of the underlying closing price on the first + -- observation date). couponBarrier : Decimal - -- ^ The coupon barrier level. + -- ^ The coupon barrier (as a percentage of the underlying closing price on the first + -- observation date). callBarrier : Decimal - -- ^ The barrier used to automatically call the instrument. + -- ^ The barrier used to automatically call the instrument (as a percentage of the underlying + -- closing price on the first observation date). finalBarrier : Decimal - -- ^ The barrier used to determine the final redemption amount. + -- ^ The barrier used to determine the final redemption amount (as a percentage of the + -- underlying closing price on the first observation date). couponRate : Decimal -- ^ The fixed coupon rate, either per annum or per coupon period (depending on the -- dayCountConvention below). diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml index 21f911329..ed2c313cd 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml @@ -5,7 +5,7 @@ module Daml.Finance.Instrument.StructuredProduct.Util where import ContingentClaims.Core.Claim (Claim, Inequality(..), and, at, cond, one, scale, when, zero) import ContingentClaims.Core.Observation (Observation(..)) -import DA.List (last) +import DA.List (head, last) import DA.Optional (isSome) import Daml.Finance.Claims.Util.Builders (calculateRatePayment, prepareAndTagClaims) import Daml.Finance.Interface.Claims.Types (Deliverable, Observable, TaggedClaim(..)) @@ -31,12 +31,13 @@ createAutoCallableClaims : (Date -> Time) -> Schedule -> Schedule -> PeriodicSch -> HolidayCalendarData -> TaggedClaim createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSchedule useAdjustedDatesForDcf couponRate dayCountConvention notional cashInstrument floatingRate - capRate floorRate spot couponBarrier callBarrier finalBarrier initialFixing + capRate floorRate spot couponBarrier callBarrier finalBarrier initialFixingPercentage fixingCalendars = let notionalAmount = scale (Const notional) $ one cashInstrument principal = notionalAmount + initialObservationDate = (.adjustedStartDate) $ head callableSchedule combineTagClaim (couponPeriod, callPeriod) notCalledClaim = let @@ -46,11 +47,13 @@ createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSch then error "each call date must be before or at the corresponding payment date" else (callPeriod.adjustedEndDate, couponPeriod.adjustedEndDate) spotOnObservationDate = ObserveAt spot callDate - couponBarrierHit = Lte (spotOnObservationDate, Const couponBarrier) + couponBarrierLevel = Const couponBarrier * ObserveAt spot initialObservationDate + couponBarrierHit = Lte (spotOnObservationDate, couponBarrierLevel) coupon = cond couponBarrierHit zero cpn called = when (at paymentDate) $ and coupon principal notCalled = when (at paymentDate) $ and coupon notCalledClaim - autoExerciseCondition = Lte (Const callBarrier, spotOnObservationDate) + callBarrierLevel = Const callBarrier * ObserveAt spot initialObservationDate + autoExerciseCondition = Lte (callBarrierLevel, spotOnObservationDate) tailClaim = when (at callDate) $ cond autoExerciseCondition called notCalled in tailClaim @@ -58,8 +61,10 @@ createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSch finalCouponDate = (.adjustedEndDate) $ last paymentSchedule finalObservationDate = (.adjustedEndDate) $ last callableSchedule spotOnObservationDate = ObserveAt spot finalObservationDate - barrierHit = Lte (spotOnObservationDate, Const finalBarrier) - perf = spotOnObservationDate / Const initialFixing + finalBarrierLevel = Const finalBarrier * ObserveAt spot initialObservationDate + barrierHit = Lte (spotOnObservationDate, finalBarrierLevel) + initialFixing = Const initialFixingPercentage * ObserveAt spot initialObservationDate + perf = spotOnObservationDate / initialFixing perfomanceScaledPrincipal = scale perf notionalAmount redemptionPayment = cond barrierHit perfomanceScaledPrincipal principal notCalledFinal = when (at finalCouponDate) redemptionPayment diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml index c6a0e3679..4ae57ddeb 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml @@ -37,21 +37,21 @@ run = script do -- Create and distribute option let - couponBarrierHigh = 30.0 - callBarrierLow = 38.0 - finalBarrierHigh = 40.0 + couponBarrierHigh = 0.75 + callBarrierLow = 0.95 + finalBarrierHigh = 1.00 -- CREATE_AUTO_CALLABLE_VARIABLES_BEGIN - initialFixing = 40.0 - couponBarrier = 26.0 - callBarrier = 40.0 - finalBarrier = 35.0 + initialFixing = 1.00 -- 100% of the underlying closing price on the initial fixing date + couponBarrier = 0.65 -- 65% of the underlying closing price on the initial fixing date + callBarrier = 1.00 + finalBarrier = 0.875 referenceAssetId = "AAPL-CLOSE" couponRate = 0.05 dayCountConvention = Basis1 -- coupon rate is paid each period, not per annum. businessDayConvention = Following couponPeriod = M couponPeriodMultiplier = 3 - initialValuationDate = date 2024 Jan 10 + initialFixingDate = date 2024 Jan 10 issueDate = date 2024 Jan 16 firstRegularObervationDate = date 2024 Mar 28 firstCouponDate = date 2024 Apr 2 @@ -69,13 +69,14 @@ run = script do businessDayConvention couponPeriod couponPeriodMultiplier issueDate maturityDate observationSchedule = createPaymentPeriodicSchedule firstRegularObervationDate holidayCalendarIds businessDayConvention couponPeriod couponPeriodMultiplier - initialValuationDate expiryDate + initialFixingDate expiryDate notional = 1.0 -- CREATE_AUTO_CALLABLE_OBSERVATIONS_BEGIN let observations = Map.fromList - [ (dateToDateClockTime $ date 2024 Mar 28, 28.78) + [ (dateToDateClockTime $ date 2024 Jan 10, 40.0) + , (dateToDateClockTime $ date 2024 Mar 28, 28.78) , (dateToDateClockTime $ date 2024 Jun 28, 39.78) , (dateToDateClockTime $ date 2024 Sep 30, 36.0) ] From 8639539fba9540bfb3cf3bea0722343c59004c8f Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Mon, 22 Jan 2024 10:23:27 +0100 Subject: [PATCH 17/25] simplify fixingBusinessCenters --- .../Instrument/StructuredProduct/AutoCallable/Instrument.daml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index 9a25f3ae4..400a76a51 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -96,9 +96,7 @@ template Instrument floatingRate = None capRate = None floorRate = None - fixingBusinessCenters = case floatingRate of - None -> [] - Some fr -> error "floating rate not yet supported" + fixingBusinessCenters = [] fixingCals <- getHolidayCalendars issuer calendarDataProvider fixingBusinessCenters (schedule, _) <- rollSchedule getCalendars periodicSchedule holidayCalendarIds From 1e22cf4dd9f1de9ed005fb4e506a6841bf9b7e13 Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Mon, 22 Jan 2024 10:49:42 +0100 Subject: [PATCH 18/25] improve comments --- .../StructuredProduct/AutoCallable/Instrument.daml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index 400a76a51..10817269c 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -25,6 +25,12 @@ import Daml.Finance.Util.Disclosure (addObserversImpl, removeObserversImpl, setO type T = Instrument -- | This template models an AutoCallable instrument that pays a conditional coupon. +-- It is an AutoCallable Barrier Reverse Convertible where the KI barrier is observed at maturity. +-- It is a single-underlying product. +-- The instrument is automatically called (redeemed early) if the call barrier is hit. +-- The conditional coupon is paid in each coupon period unless the coupon barrier has been hit. +-- Both the call barrier and the coupon barrier are observed only on the last observation date of +-- each period. template Instrument with depository : Party From 90593f38277099f9241f24fca6695b7725e36369 Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Mon, 22 Jan 2024 11:57:56 +0100 Subject: [PATCH 19/25] rename initialFixing to putStrike --- .../StructuredProduct/AutoCallable/Factory.daml | 4 ++-- .../StructuredProduct/AutoCallable/Instrument.daml | 8 ++++---- .../Finance/Instrument/StructuredProduct/Util.daml | 6 +++--- .../StructuredProduct/AutoCallable/Types.daml | 14 +++++++++----- .../StructuredProduct/Test/AutoCallable.daml | 8 ++++---- .../Instrument/StructuredProduct/Test/Util.daml | 4 ++-- 6 files changed, 24 insertions(+), 20 deletions(-) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml index 73c8f08d3..ca3743105 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -30,7 +30,7 @@ template Factory interface instance AutoCallableFactory.I for Factory where view = AutoCallableFactory.View with provider create' AutoCallableFactory.Create{ - autoCallable = AutoCallable{instrument; description; referenceAssetId; initialFixing; + autoCallable = AutoCallable{instrument; description; referenceAssetId; putStrike; couponBarrier; callBarrier; finalBarrier; currency; lastEventTimestamp; couponRate; observationSchedule; periodicSchedule; holidayCalendarIds; calendarDataProvider; dayCountConvention; notional; prevEvents}; @@ -44,7 +44,7 @@ template Factory holdingStandard = instrument.holdingStandard description referenceAssetId - initialFixing + putStrike couponBarrier callBarrier finalBarrier diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index 10817269c..a320c71b5 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -48,8 +48,8 @@ template Instrument referenceAssetId : Text -- ^ The reference asset ID. For example, in case of an AAPL underlying this should be a valid -- reference to the AAPL fixings to be used for the payoff calculation. - initialFixing : Decimal - -- ^ The initial fixing (as a percentage of the underlying closing price on the first + putStrike : Decimal + -- ^ The strike of the put (as a percentage of the underlying closing price on the first -- observation date). couponBarrier : Decimal -- ^ The coupon barrier (as a percentage of the underlying closing price on the first @@ -114,7 +114,7 @@ template Instrument callableClaims = createAutoCallableClaims dateToDateClockTime schedule callableSchedule periodicSchedule useAdjustedDatesForDcf couponRate dayCountConvention notional currency floatingRate capRate floorRate referenceAssetId couponBarrier callBarrier finalBarrier - initialFixing $ merge fixingCals + putStrike $ merge fixingCals pure [callableClaims] @@ -130,7 +130,7 @@ template Instrument instrument = BaseInstrument.instrumentKey this description referenceAssetId - initialFixing + putStrike couponBarrier callBarrier finalBarrier diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml index ed2c313cd..fc287f07c 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml @@ -31,7 +31,7 @@ createAutoCallableClaims : (Date -> Time) -> Schedule -> Schedule -> PeriodicSch -> HolidayCalendarData -> TaggedClaim createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSchedule useAdjustedDatesForDcf couponRate dayCountConvention notional cashInstrument floatingRate - capRate floorRate spot couponBarrier callBarrier finalBarrier initialFixingPercentage + capRate floorRate spot couponBarrier callBarrier finalBarrier putStrike fixingCalendars = let notionalAmount = scale (Const notional) $ one cashInstrument @@ -63,8 +63,8 @@ createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSch spotOnObservationDate = ObserveAt spot finalObservationDate finalBarrierLevel = Const finalBarrier * ObserveAt spot initialObservationDate barrierHit = Lte (spotOnObservationDate, finalBarrierLevel) - initialFixing = Const initialFixingPercentage * ObserveAt spot initialObservationDate - perf = spotOnObservationDate / initialFixing + putStrikeLevel = Const putStrike * ObserveAt spot initialObservationDate + perf = spotOnObservationDate / putStrikeLevel perfomanceScaledPrincipal = scale perf notionalAmount redemptionPayment = cond barrierHit perfomanceScaledPrincipal principal notCalledFinal = when (at finalCouponDate) redemptionPayment diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml index 21a860fdc..575524669 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml @@ -18,14 +18,18 @@ data AutoCallable = AutoCallable referenceAssetId : Text -- ^ The reference asset ID. For example, in case of an AAPL underlying this should be a valid -- reference to the AAPL fixings to be used for the payoff calculation. - initialFixing : Decimal - -- ^ The initial fixing of the underlying. + putStrike : Decimal + -- ^ The strike of the put (as a percentage of the underlying closing price on the first + -- observation date). couponBarrier : Decimal - -- ^ The coupon barrier level. + -- ^ The coupon barrier (as a percentage of the underlying closing price on the first + -- observation date). callBarrier : Decimal - -- ^ The barrier used to automatically call the instrument. + -- ^ The barrier used to automatically call the instrument (as a percentage of the underlying + -- closing price on the first observation date). finalBarrier : Decimal - -- ^ The barrier used to determine the final redemption amount. + -- ^ The barrier used to determine the final redemption amount (as a percentage of the + -- underlying closing price on the first observation date). couponRate : Decimal -- ^ The fixed coupon rate, either per annum or per coupon period (depending on the -- dayCountConvention below). diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml index 4ae57ddeb..c66430f34 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml @@ -41,7 +41,7 @@ run = script do callBarrierLow = 0.95 finalBarrierHigh = 1.00 -- CREATE_AUTO_CALLABLE_VARIABLES_BEGIN - initialFixing = 1.00 -- 100% of the underlying closing price on the initial fixing date + putStrike = 1.00 -- 100% of the underlying closing price on the initial fixing date couponBarrier = 0.65 -- 65% of the underlying closing price on the initial fixing date callBarrier = 1.00 finalBarrier = 0.875 @@ -97,7 +97,7 @@ run = script do ----------------------------------------------------------------------- acInstrument <- originateAutoCallable issuer issuer "AC" TransferableFungible "AutoCallable" - observers now initialFixing couponBarrier callBarrier finalBarrier cashInstrument + observers now putStrike couponBarrier callBarrier finalBarrier cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty @@ -126,7 +126,7 @@ run = script do -------------------------------------------------------------------- acInstrument <- originateAutoCallable issuer issuer "AC2" TransferableFungible "AutoCallable" - observers now initialFixing couponBarrierHigh callBarrier finalBarrierHigh cashInstrument + observers now putStrike couponBarrierHigh callBarrier finalBarrierHigh cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty @@ -158,7 +158,7 @@ run = script do -------------------------------------------- acInstrument <- originateAutoCallable issuer issuer "AC3" TransferableFungible "AutoCallable" - observers now initialFixing couponBarrierHigh callBarrierLow finalBarrier cashInstrument + observers now putStrike couponBarrierHigh callBarrierLow finalBarrier cashInstrument referenceAssetId couponRate observationSchedule couponSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml index 5420919b6..52c78b96b 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml @@ -68,7 +68,7 @@ originateAutoCallable : Party -> Party -> Text -> HoldingStandard -> Text -> [(T -> Decimal -> PeriodicSchedule -> PeriodicSchedule -> [Text] -> DayCountConventionEnum -> Decimal -> Party -> Party -> Script InstrumentKey originateAutoCallable depository issuer label holdingStandard description observers - lastEventTimestamp initialFixing couponBarrier callBarrier finalBarrier currency referenceAssetId + lastEventTimestamp putStrike couponBarrier callBarrier finalBarrier currency referenceAssetId couponRate observationSchedule periodicSchedule holidayCalendarIds dayCountConvention notional calendarDataProvider publicParty = do -- Create an AutoCallable factory @@ -91,7 +91,7 @@ originateAutoCallable depository issuer label holdingStandard description observ autoCallable = AutoCallable with instrument description - initialFixing + putStrike couponBarrier callBarrier finalBarrier From cbaf6c95e52f2e63a2f9703636d6a8ebfde7ae3e Mon Sep 17 00:00:00 2001 From: markus-da <103116047+markus-da@users.noreply.github.com> Date: Mon, 22 Jan 2024 12:07:52 +0100 Subject: [PATCH 20/25] Update src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml Co-authored-by: Matteo Limberto --- .../Daml/Finance/Instrument/StructuredProduct/Test/Util.daml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml index 52c78b96b..daa75c4da 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/Util.daml @@ -62,7 +62,7 @@ originateBarrierReverseConvertible depository issuer label holdingStandard descr -- CREATE_BARRIER_REVERSE_CONVERTIBLE_INSTRUMENT_END pure instrument --- | Originate a AutoCallable instrument. +-- | Originate an AutoCallable instrument. originateAutoCallable : Party -> Party -> Text -> HoldingStandard -> Text -> [(Text, Parties)] -> Time -> Decimal -> Decimal -> Decimal -> Decimal -> InstrumentKey -> Text -> Decimal -> PeriodicSchedule -> PeriodicSchedule -> [Text] -> DayCountConventionEnum -> Decimal From 69f131e39db3b2c83da759b1144ce13444ac44ac Mon Sep 17 00:00:00 2001 From: markus-da <103116047+markus-da@users.noreply.github.com> Date: Mon, 22 Jan 2024 12:09:10 +0100 Subject: [PATCH 21/25] Update src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml Co-authored-by: Matteo Limberto --- .../daml/Daml/Finance/Instrument/StructuredProduct/Util.daml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml index fc287f07c..9fd25a4af 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml @@ -23,7 +23,7 @@ includes : Schedule -> Schedule -> [Bool] includes scheduleA scheduleB = map (\a -> isSome $ find (\b -> b.adjustedEndDate == a.adjustedEndDate) scheduleB) scheduleA --- | Calculate the claims for a an auto-callable with a contingent coupon on each payment date +-- | Calculate the claims for an auto-callable with a contingent coupon on each payment date -- and a redemption amount at maturity (unless auto-called previously). createAutoCallableClaims : (Date -> Time) -> Schedule -> Schedule -> PeriodicSchedule -> Bool -> Decimal -> DayCountConventionEnum -> Decimal -> Deliverable -> Optional FloatingRate From 82e11fdb0990026e4a6345562d2a4813b1e79390 Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Mon, 22 Jan 2024 13:02:02 +0100 Subject: [PATCH 22/25] check callableSchedule --- .../daml/Daml/Finance/Instrument/StructuredProduct/Util.daml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml index fc287f07c..9f35e9000 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml @@ -37,7 +37,8 @@ createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSch notionalAmount = scale (Const notional) $ one cashInstrument principal = notionalAmount - initialObservationDate = (.adjustedStartDate) $ head callableSchedule + initialObservationDate = (.adjustedStartDate) $ + if null callableSchedule then error "empty callableSchedule" else head callableSchedule combineTagClaim (couponPeriod, callPeriod) notCalledClaim = let From 49f232698a272c672bd9e0b13250c654832c1902 Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Mon, 22 Jan 2024 13:04:41 +0100 Subject: [PATCH 23/25] add putStrike check --- .../Instrument/StructuredProduct/AutoCallable/Instrument.daml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index a320c71b5..2b4673e4b 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -104,6 +104,7 @@ template Instrument floorRate = None fixingBusinessCenters = [] + assertMsg "Currently only put strike of 100% supported" $ putStrike == 1.00 fixingCals <- getHolidayCalendars issuer calendarDataProvider fixingBusinessCenters (schedule, _) <- rollSchedule getCalendars periodicSchedule holidayCalendarIds (callableSchedule, _) <- rollSchedule getCalendars observationSchedule holidayCalendarIds From 346a887158178b3cdd8d6e034338b45b35bebf89 Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Tue, 23 Jan 2024 10:01:07 +0100 Subject: [PATCH 24/25] add comment --- .../daml/Daml/Finance/Instrument/StructuredProduct/Util.daml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml index 8f77240d0..dbc8ce101 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml @@ -65,6 +65,7 @@ createAutoCallableClaims dateToTime paymentSchedule callableSchedule periodicSch finalBarrierLevel = Const finalBarrier * ObserveAt spot initialObservationDate barrierHit = Lte (spotOnObservationDate, finalBarrierLevel) putStrikeLevel = Const putStrike * ObserveAt spot initialObservationDate + -- This currently only works for strike = initialFixing (100%) perf = spotOnObservationDate / putStrikeLevel perfomanceScaledPrincipal = scale perf notionalAmount redemptionPayment = cond barrierHit perfomanceScaledPrincipal principal From 363db1d5f8db11f31eacd09f99aec05e0ebfcda6 Mon Sep 17 00:00:00 2001 From: Markus Friberg Date: Tue, 23 Jan 2024 10:31:11 +0100 Subject: [PATCH 25/25] run packell --- .../Instrument/StructuredProduct/AutoCallable/Factory.daml | 2 +- .../Instrument/StructuredProduct/AutoCallable/Instrument.daml | 2 +- .../daml/Daml/Finance/Instrument/StructuredProduct/Util.daml | 2 +- .../Instrument/StructuredProduct/AutoCallable/Factory.daml | 2 +- .../Instrument/StructuredProduct/AutoCallable/Instrument.daml | 2 +- .../Instrument/StructuredProduct/AutoCallable/Types.daml | 2 +- .../Finance/Instrument/StructuredProduct/Test/AutoCallable.daml | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml index ca3743105..376145942 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -1,4 +1,4 @@ --- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 module Daml.Finance.Instrument.StructuredProduct.AutoCallable.Factory where diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml index 2b4673e4b..4fee0f6f1 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -1,4 +1,4 @@ --- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 module Daml.Finance.Instrument.StructuredProduct.AutoCallable.Instrument where diff --git a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml index dbc8ce101..0bf5b5b05 100644 --- a/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml +++ b/src/main/daml/Daml/Finance/Instrument/StructuredProduct/Util.daml @@ -1,4 +1,4 @@ --- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 module Daml.Finance.Instrument.StructuredProduct.Util where diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml index da5cd3656..a2cadb8d6 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Factory.daml @@ -1,4 +1,4 @@ --- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 module Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Factory where diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml index 21fb84f10..c75cce3c6 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Instrument.daml @@ -1,4 +1,4 @@ --- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 module Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Instrument where diff --git a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml index 575524669..c3d682467 100644 --- a/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml +++ b/src/main/daml/Daml/Finance/Interface/Instrument/StructuredProduct/AutoCallable/Types.daml @@ -1,4 +1,4 @@ --- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 module Daml.Finance.Interface.Instrument.StructuredProduct.AutoCallable.Types where diff --git a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml index c66430f34..c6fb21c8b 100644 --- a/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml +++ b/src/test/daml/Daml/Finance/Instrument/StructuredProduct/Test/AutoCallable.daml @@ -1,4 +1,4 @@ --- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 module Daml.Finance.Instrument.StructuredProduct.Test.AutoCallable where