Skip to content

Commit

Permalink
scp-2885 - ACTUS option contracts
Browse files Browse the repository at this point in the history
  • Loading branch information
@yveshauser
yveshauser committed Oct 11, 2021
1 parent fbeaefc commit 871d624
Show file tree
Hide file tree
Showing 12 changed files with 490 additions and 229 deletions.
13 changes: 7 additions & 6 deletions marlowe-actus/src/Language/Marlowe/ACTUS/Analysis.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ import Control.Applicative ((<|
import Control.Monad.Reader (runReader)
import Data.Functor ((<&>))
import qualified Data.List as L (groupBy)
import Data.Maybe (isNothing)
import Data.Maybe (fromMaybe, isNothing)
import Data.Sort (sortOn)
import Data.Time (LocalTime)
import Language.Marlowe.ACTUS.Definitions.BusinessEvents (EventType (..), RiskFactors)
Expand All @@ -40,20 +40,20 @@ genProjectedCashflows ::
(EventType -> LocalTime -> RiskFactors) -- ^ Risk factors as a function of event type and time
-> ContractTerms -- ^ ACTUS contract terms
-> [CashFlow] -- ^ List of projected cash flows
genProjectedCashflows getRiskFactors =
genProjectedCashflows getRiskFactors ct =
let genCashflow ((_, ev, t), am) =
CashFlow
{ tick = 0,
cashContractId = "0",
cashContractId = contractId ct,
cashParty = "party",
cashCounterParty = "counterparty",
cashPaymentDay = paymentDay t,
cashCalculationDay = calculationDay t,
cashEvent = ev,
amount = am,
currency = "ada"
currency = fromMaybe "unknown" (ct_CURS ct)
}
in sortOn cashPaymentDay . fmap genCashflow . genProjectedPayoffs getRiskFactors
in sortOn cashPaymentDay . fmap genCashflow . genProjectedPayoffs getRiskFactors $ ct

genProjectedPayoffs ::
(EventType -> LocalTime -> RiskFactors) -- ^ Risk factors as a function of event type and time
Expand All @@ -66,7 +66,7 @@ genProjectedPayoffs getRiskFactors ct@ContractTermsPoly {..} =
filter filtersSchedules . postProcessSchedule . sortOn (paymentDay . snd) $
concatMap scheduleEvent eventTypes
where
eventTypes = [IED, MD, RR, RRF, IP, PR, PRF, IPCB, IPCI, PRD, TD, SC, DV]
eventTypes = [IED, MD, RR, RRF, IP, PR, PRF, IPCB, IPCI, PRD, TD, SC, DV, XD, STD]
scheduleEvent ev = (ev,) <$> schedule ev ct

-- states
Expand Down Expand Up @@ -102,6 +102,7 @@ genProjectedPayoffs getRiskFactors ct@ContractTermsPoly {..} =
mat = S.maturity ct

filtersSchedules :: (EventType, ShiftedDay) -> Bool
filtersSchedules (_, ShiftedDay {..}) | contractType == OPTNS = calculationDay > ct_SD
filtersSchedules (_, ShiftedDay {..}) = isNothing ct_TD || Just calculationDay <= ct_TD

filtersStates :: (ContractState, EventType, ShiftedDay) -> Bool
Expand Down
24 changes: 13 additions & 11 deletions marlowe-actus/src/Language/Marlowe/ACTUS/Definitions/ContractState.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,17 +10,19 @@ import Language.Marlowe.ACTUS.Definitions.ContractTerms (PRF)
-}
data ContractStatePoly a b = ContractStatePoly
{
tmd :: b -- ^ Maturity Date (MD): The timestamp as per which the contract matures according to the initial terms or as per unscheduled events
, nt :: a -- ^ Notional Principal (NT): The outstanding nominal value
, ipnr :: a -- ^ Nominal Interest Rate (IPNR) : The applicable nominal rate
, ipac :: a -- ^ Accrued Interest (IPAC): The current value of accrued interest
, feac :: a -- ^ Fee Accrued (FEAC): The current value of accrued fees
, nsc :: a -- ^ Notional Scaling Multiplier (SCNT): The multiplier being applied to principal cash flows
, isc :: a -- ^ InterestScalingMultiplier (SCIP): The multiplier being applied to interest cash flows
, prf :: PRF -- ^ Contract Performance (PRF)
, sd :: b -- ^ Status Date (MD): The timestamp as per which the state is captured at any point in time
, prnxt :: a -- ^ Next Principal Redemption Payment (PRNXT): The value at which principal is being repaid
, ipcb :: a -- ^ Interest Calculation Base (IPCB)
tmd :: b -- ^ Maturity Date (MD): The timestamp as per which the contract matures according to the initial terms or as per unscheduled events
, nt :: a -- ^ Notional Principal (NT): The outstanding nominal value
, ipnr :: a -- ^ Nominal Interest Rate (IPNR) : The applicable nominal rate
, ipac :: a -- ^ Accrued Interest (IPAC): The current value of accrued interest
, feac :: a -- ^ Fee Accrued (FEAC): The current value of accrued fees
, nsc :: a -- ^ Notional Scaling Multiplier (SCNT): The multiplier being applied to principal cash flows
, isc :: a -- ^ InterestScalingMultiplier (SCIP): The multiplier being applied to interest cash flows
, prf :: PRF -- ^ Contract Performance (PRF)
, sd :: b -- ^ Status Date (MD): The timestamp as per which the state is captured at any point in time
, prnxt :: a -- ^ Next Principal Redemption Payment (PRNXT): The value at which principal is being repaid
, ipcb :: a -- ^ Interest Calculation Base (IPCB)
, xd :: Maybe b -- ^ Exercise Date (XD)
, xa :: Maybe a -- ^ Exercise Amount (XA)
}
deriving stock (Show, Eq)

Expand Down
219 changes: 150 additions & 69 deletions marlowe-actus/src/Language/Marlowe/ACTUS/Definitions/ContractTerms.hs
View file
Original file line number Diff line number Diff line change
@@ -1,14 +1,18 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Language.Marlowe.ACTUS.Definitions.ContractTerms where

import Data.Aeson.Types (FromJSON, ToJSON)
import Data.Maybe (fromMaybe)
import Data.Time (Day, LocalTime)
import GHC.Generics (Generic)
import Language.Marlowe (Observation, Value)
import qualified Language.Marlowe as Marlowe (Observation, Value)

-- |ContractType
data CT = PAM -- ^ Principal at maturity
Expand Down Expand Up @@ -121,6 +125,26 @@ data PYTP = PYTP_A -- ^ Absolute
deriving stock (Show, Read, Eq, Generic)
deriving anyclass (FromJSON, ToJSON)

-- |Option Type
data OPTP = OPTP_C -- ^ Call Option
| OPTP_P -- ^ Put Option
| OPTP_CP -- ^ Call-Put Option
deriving stock (Show, Read, Eq, Generic)
deriving anyclass (FromJSON, ToJSON)

-- |Option Exercise Type
data OPXT = OPXT_E -- ^ European
| OPXT_B -- ^ Bermudan
| OPXT_A -- ^ American
deriving stock (Show, Read, Eq, Generic)
deriving anyclass (FromJSON, ToJSON)

-- |Settlement
data DS = DS_S -- ^ Cash Settlement
| DS_D -- ^ Physical Settlement
deriving stock (Show, Read, Eq, Generic)
deriving anyclass (FromJSON, ToJSON)

-- |PrepaymentEffect
data PPEF = PPEF_N -- ^ No prepayment
| PPEF_A -- ^ Prepayment allowed, prepayment results in reduction of PRNXT while MD remains
Expand Down Expand Up @@ -190,102 +214,159 @@ data Assertion = NpvAssertionAgainstZeroRiskBond
deriving stock (Show, Generic)
deriving anyclass (FromJSON, ToJSON)

-- |Reference type
data ReferenceType = CNT
| CID
| MOC
| EID
| CST
deriving stock (Eq, Show, Read, Generic)
deriving anyclass (FromJSON, ToJSON)

-- |Reference role
data ReferenceRole = UDL
deriving stock (Eq, Read, Show, Generic)
deriving anyclass (FromJSON, ToJSON)

-- |Market object code
type MarketObjectCode = String

-- |Contract structure
data ContractStructure = ContractStructure
{
marketObjectCode :: MarketObjectCode
, referenceType :: ReferenceType
, referenceRole :: ReferenceRole
}
deriving stock (Show, Generic)
deriving anyclass (FromJSON, ToJSON)

{-| ACTUS contract terms and attributes are defined in
https://github.com/actusfrf/actus-dictionary/blob/master/actus-dictionary-terms.json
-}
data ContractTermsPoly a b = ContractTermsPoly
{ -- General
contractId :: String
, contractType :: CT
, ct_CNTRL :: CR
, ct_CURS :: Maybe String
contractId :: String
, contractType :: CT
, contractStructure :: [ContractStructure]
, ct_CNTRL :: CR
, ct_CURS :: Maybe String

-- Calendar
, ct_IED :: Maybe b -- ^ Initial Exchange Date
, ct_DCC :: Maybe DCC -- ^ Day Count Convention
, scfg :: ScheduleConfig
, ct_IED :: Maybe b -- ^ Initial Exchange Date
, ct_DCC :: Maybe DCC -- ^ Day Count Convention
, scfg :: ScheduleConfig

-- Contract Identification
, ct_SD :: b -- ^ Status Date
, ct_SD :: b -- ^ Status Date

-- Counterparty
, ct_PRF :: Maybe PRF -- ^ Contract Performance
, ct_PRF :: Maybe PRF -- ^ Contract Performance

-- Fees
, ct_FECL :: Maybe Cycle -- ^ Cycle Of Fee
, ct_FEANX :: Maybe b -- ^ Cycle Anchor Date Of Fee
, ct_FEAC :: Maybe a -- ^ Fee Accrued
, ct_FEB :: Maybe FEB -- ^ Fee Basis
, ct_FER :: Maybe a -- ^ Fee Rate
, ct_FECL :: Maybe Cycle -- ^ Cycle Of Fee
, ct_FEANX :: Maybe b -- ^ Cycle Anchor Date Of Fee
, ct_FEAC :: Maybe a -- ^ Fee Accrued
, ct_FEB :: Maybe FEB -- ^ Fee Basis
, ct_FER :: Maybe a -- ^ Fee Rate

-- Interest
, ct_IPANX :: Maybe b -- ^ Cycle Anchor Date Of Interest Payment
, ct_IPCL :: Maybe Cycle -- ^ Cycle Of Interest Payment
, ct_IPAC :: Maybe a -- ^ Accrued Interest
, ct_IPCED :: Maybe b -- ^ Capitalization End Date
, ct_IPCBANX :: Maybe b -- ^ Cycle Anchor Date Of Interest Calculation Base
, ct_IPCBCL :: Maybe Cycle -- ^ Cycle Of Interest Calculation Base
, ct_IPCB :: Maybe IPCB -- ^ Interest Calculation Base
, ct_IPCBA :: Maybe a -- ^ Interest Calculation Base Amount
, ct_IPNR :: Maybe a -- ^ Nominal Interest Rate
, ct_SCIP :: Maybe a -- ^ Interest Scaling Multiplier
, ct_IPANX :: Maybe b -- ^ Cycle Anchor Date Of Interest Payment
, ct_IPCL :: Maybe Cycle -- ^ Cycle Of Interest Payment
, ct_IPAC :: Maybe a -- ^ Accrued Interest
, ct_IPCED :: Maybe b -- ^ Capitalization End Date
, ct_IPCBANX :: Maybe b -- ^ Cycle Anchor Date Of Interest Calculation Base
, ct_IPCBCL :: Maybe Cycle -- ^ Cycle Of Interest Calculation Base
, ct_IPCB :: Maybe IPCB -- ^ Interest Calculation Base
, ct_IPCBA :: Maybe a -- ^ Interest Calculation Base Amount
, ct_IPNR :: Maybe a -- ^ Nominal Interest Rate
, ct_SCIP :: Maybe a -- ^ Interest Scaling Multiplier

-- Dates
, ct_MD :: Maybe b -- ^ Maturity Date
, ct_AD :: Maybe b -- ^ Amortization Date
, ct_XD :: Maybe b -- ^ Exercise Date
-- , ct_STD :: Maybe b -- ^ Settlement Date

-- Notional Principal
, ct_NT :: Maybe a -- ^ Notional Principal
, ct_PDIED :: Maybe a -- ^ Premium Discount At IED
, ct_MD :: Maybe b -- ^ Maturity Date
, ct_AD :: Maybe b -- ^ Amortization Date
, ct_PRANX :: Maybe b -- ^ Cycle Anchor Date Of Principal Redemption
, ct_PRCL :: Maybe Cycle -- ^ Cycle Of Principal Redemption
, ct_PRNXT :: Maybe a -- ^ Next Principal Redemption Payment
, ct_PRD :: Maybe b -- ^ Purchase Date
, ct_PPRD :: Maybe a -- ^ Price At Purchase Date
, ct_TD :: Maybe b -- ^ Termination Date
, ct_PTD :: Maybe a -- ^ Price At Termination Date
, ct_NT :: Maybe a -- ^ Notional Principal
, ct_PDIED :: Maybe a -- ^ Premium Discount At IED
, ct_PRANX :: Maybe b -- ^ Cycle Anchor Date Of Principal Redemption
, ct_PRCL :: Maybe Cycle -- ^ Cycle Of Principal Redemption
, ct_PRNXT :: Maybe a -- ^ Next Principal Redemption Payment
, ct_PRD :: Maybe b -- ^ Purchase Date
, ct_PPRD :: Maybe a -- ^ Price At Purchase Date
, ct_TD :: Maybe b -- ^ Termination Date
, ct_PTD :: Maybe a -- ^ Price At Termination Date

-- Scaling Index
, ct_SCIED :: Maybe a -- ^ Scaling Index At Status Date
, ct_SCANX :: Maybe b -- ^ Cycle Anchor Date Of Scaling Index
, ct_SCCL :: Maybe Cycle -- ^ Cycle Of Scaling Index
, ct_SCEF :: Maybe SCEF -- ^ Scaling Effect
, ct_SCCDD :: Maybe a -- ^ Scaling Index At Contract Deal Date
, ct_SCMO :: Maybe String -- ^ Market Object Code Of Scaling Index
, ct_SCNT :: Maybe a -- ^ Notional Scaling Multiplier
, ct_SCIED :: Maybe a -- ^ Scaling Index At Status Date
, ct_SCANX :: Maybe b -- ^ Cycle Anchor Date Of Scaling Index
, ct_SCCL :: Maybe Cycle -- ^ Cycle Of Scaling Index
, ct_SCEF :: Maybe SCEF -- ^ Scaling Effect
, ct_SCCDD :: Maybe a -- ^ Scaling Index At Contract Deal Date
, ct_SCMO :: Maybe String -- ^ Market Object Code Of Scaling Index
, ct_SCNT :: Maybe a -- ^ Notional Scaling Multiplier

-- Optionality
, ct_OPCL :: Maybe Cycle -- ^ Cycle Of Optionality
, ct_OPANX :: Maybe b -- ^ Cycle Anchor Date Of Optionality
, ct_PYRT :: Maybe a -- ^ Penalty Rate
, ct_PYTP :: Maybe PYTP -- ^ Penalty Type
, ct_PPEF :: Maybe PPEF -- ^ Prepayment Effect
, ct_OPCL :: Maybe Cycle -- ^ Cycle Of Optionality
, ct_OPANX :: Maybe b -- ^ Cycle Anchor Date Of Optionality
, ct_OPTP :: Maybe OPTP -- ^ Option Type
, ct_OPS1 :: Maybe a -- ^ Option Strike 1
, ct_OPXT :: Maybe OPXT -- ^ Option Exercise Type

-- Settlement
, ct_STP :: Maybe Cycle -- ^ Settlement Period
, ct_DS :: Maybe DS -- ^ Delivery Settlement
, ct_XA :: Maybe a -- ^ Exercise Amount

-- Penalty
, ct_PYRT :: Maybe a -- ^ Penalty Rate
, ct_PYTP :: Maybe PYTP -- ^ Penalty Type
, ct_PPEF :: Maybe PPEF -- ^ Prepayment Effect

-- Rate Reset
, ct_RRCL :: Maybe Cycle -- ^ Cycle Of Rate Reset
, ct_RRANX :: Maybe b -- ^ Cycle Anchor Date Of Rate Reset
, ct_RRNXT :: Maybe a -- ^ Next Reset Rate
, ct_RRSP :: Maybe a -- ^ Rate Spread
, ct_RRMLT :: Maybe a -- ^ Rate Multiplier
, ct_RRPF :: Maybe a -- ^ Period Floor
, ct_RRPC :: Maybe a -- ^ Period Cap
, ct_RRLC :: Maybe a -- ^ Life Cap
, ct_RRLF :: Maybe a -- ^ Life Floor
, ct_RRMO :: Maybe String -- ^ Market Object Code Of Rate Reset
, ct_RRCL :: Maybe Cycle -- ^ Cycle Of Rate Reset
, ct_RRANX :: Maybe b -- ^ Cycle Anchor Date Of Rate Reset
, ct_RRNXT :: Maybe a -- ^ Next Reset Rate
, ct_RRSP :: Maybe a -- ^ Rate Spread
, ct_RRMLT :: Maybe a -- ^ Rate Multiplier
, ct_RRPF :: Maybe a -- ^ Period Floor
, ct_RRPC :: Maybe a -- ^ Period Cap
, ct_RRLC :: Maybe a -- ^ Life Cap
, ct_RRLF :: Maybe a -- ^ Life Floor
, ct_RRMO :: Maybe String -- ^ Market Object Code Of Rate Reset

-- Dividend
, ct_DVCL :: Maybe Cycle -- ^ Cycle Of Dividend
, ct_DVANX :: Maybe b -- ^ Cycle Anchor Date Of Dividend
, ct_DVNP :: Maybe a -- ^ Next Dividend Payment Amount
, ct_DVCL :: Maybe Cycle -- ^ Cycle Of Dividend
, ct_DVANX :: Maybe b -- ^ Cycle Anchor Date Of Dividend
, ct_DVNP :: Maybe a -- ^ Next Dividend Payment Amount

-- enable settlement currency
, enableSettlement :: Bool
, constraints :: Maybe Assertions
, collateralAmount :: Integer
, enableSettlement :: Bool
, constraints :: Maybe Assertions
, collateralAmount :: Integer
}
deriving stock (Show, Generic)
deriving anyclass (FromJSON, ToJSON)

{- TODO: SCP-2881
instance FromJSON ContractTerms where
parseJSON (Object v) =
ContractTermsPoly
<$> v .: "contractId"
<*> v .: "contractType"
<*> v .:? "contractStructure"
<*> v .: "contractRole"
<*> v .:? "settlementCurrency"
<*> v .:? "initialExchangeDate"
<*> v .:? "dayCountConvention"
...
-}

type ContractTerms = ContractTermsPoly Double LocalTime
type ContractTermsMarlowe = ContractTermsPoly (Value Observation) (Value Observation)
type ContractTermsMarlowe = ContractTermsPoly (Marlowe.Value Marlowe.Observation) (Marlowe.Value Marlowe.Observation)

setDefaultContractTermValues :: ContractTerms -> ContractTerms
setDefaultContractTermValues ct@ContractTermsPoly{..} =
Expand Down
6 changes: 4 additions & 2 deletions marlowe-actus/src/Language/Marlowe/ACTUS/Model/INIT/StateInitializationModel.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,8 @@ initializeState = reader initializeState'
initializeState' :: CtxSTF Double LocalTime -> ContractState
initializeState' CtxSTF {..} =
ContractStatePoly
{ prnxt = nextPrincipalRedemptionPayment contractTerms,
{ sd = t0,
prnxt = nextPrincipalRedemptionPayment contractTerms,
ipcb = interestPaymentCalculationBase contractTerms,
tmd = contractMaturity maturity,
nt = notionalPrincipal contractTerms,
Expand All @@ -45,7 +46,8 @@ initializeState = reader initializeState'
nsc = notionalScaling contractTerms,
isc = interestScaling contractTerms,
prf = contractPerformance contractTerms,
sd = t0
xd = ct_XD contractTerms,
xa = ct_XA contractTerms
}
where
t0 = ct_SD contractTerms
Expand Down

0 comments on commit 871d624

Please sign in to comment.