scp-2886 - ACTUS future contracts

marlowe-actus/src/Language/Marlowe/ACTUS/Analysis.hs

@@ -103,6 +103,7 @@ genProjectedPayoffs getRiskFactors ct@ContractTermsPoly {..} =
 
     filtersSchedules :: (EventType, ShiftedDay) -> Bool
     filtersSchedules (_, ShiftedDay {..}) | contractType == OPTNS = calculationDay > ct_SD
+    filtersSchedules (_, ShiftedDay {..}) | contractType == FUTUR = calculationDay > ct_SD
     filtersSchedules (_, ShiftedDay {..}) = isNothing ct_TD || Just calculationDay <= ct_TD
 
     filtersStates :: (ContractState, EventType, ShiftedDay) -> Bool

marlowe-actus/src/Language/Marlowe/ACTUS/Definitions/ContractState.hs

@@ -10,7 +10,7 @@ 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
+    tmd   :: Maybe 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

marlowe-actus/src/Language/Marlowe/ACTUS/Definitions/ContractTerms.hs

@@ -319,6 +319,7 @@ data ContractTermsPoly a b = ContractTermsPoly
   , ct_STP            :: Maybe Cycle     -- ^ Settlement Period
   , ct_DS             :: Maybe DS        -- ^ Delivery Settlement
   , ct_XA             :: Maybe a         -- ^ Exercise Amount
+  , ct_PFUT           :: Maybe a         -- ^ Futures Price
 
   -- Penalty
   , ct_PYRT           :: Maybe a         -- ^ Penalty Rate

marlowe-actus/src/Language/Marlowe/ACTUS/Generator.hs

@@ -41,7 +41,7 @@ import           Language.Marlowe.ACTUS.Definitions.ContractTerms           (Ass
                                                                              TermValidationError (..))
 import           Language.Marlowe.ACTUS.Definitions.Schedule                (CashFlow (..), ShiftedDay (..),
                                                                              calculationDay)
-import           Language.Marlowe.ACTUS.MarloweCompat                       (constnt, letval, marloweTime,
+import           Language.Marlowe.ACTUS.MarloweCompat                       (constnt, letval, letval', marloweTime,
                                                                              timeToSlotNumber, toMarloweFixedPoint,
                                                                              useval)
 import           Language.Marlowe.ACTUS.Model.APPLICABILITY.Applicability   (validateTerms)
@@ -134,7 +134,7 @@ genFsContract' ct =
 
             stateToContract :: ContractStateMarlowe -> Contract -> Contract
             stateToContract ContractStatePoly {..} =
-              letval "tmd" i tmd
+              letval' "tmd" i tmd
                 . letval "nt" i nt
                 . letval "ipnr" i ipnr
                 . letval "ipac" i ipac
@@ -144,6 +144,8 @@ genFsContract' ct =
                 . letval "sd" i sd
                 . letval "prnxt" i prnxt
                 . letval "ipcb" i ipcb
+                . letval' "xa" i xa
+                . letval' "xd" i xd
 
             comment :: EventType -> Contract -> Contract
             comment IED = letval "IED" i (constnt 0)
@@ -167,8 +169,10 @@ genFsContract' ct =
                   feac = useval "feac" $ i P.- 1,
                   ipnr = useval "ipnr" $ i P.- 1,
                   ipcb = useval "ipcb" $ i P.- 1,
+                  xa = Just $ useval "xa" $ i P.- 1,
+                  xd = Just $ useval "xd" $ i P.- 1,
                   prnxt = useval "prnxt" $ i P.- 1,
-                  tmd = useval "tmd" i,
+                  tmd = Just $ useval "tmd" i,
                   prf = undefined,
                   sd = useval "sd" (timeToSlotNumber prevDate)
                 }
@@ -236,7 +240,7 @@ genFsContract' ct =
 
     stateInitialisation :: ContractState -> Contract -> Contract
     stateInitialisation ContractStatePoly {..} =
-      letval "tmd" 0 (marloweTime tmd)
+      letval' "tmd" 0 (marloweTime <$> tmd)
         . letval "nt" 0 (constnt nt)
         . letval "ipnr" 0 (constnt ipnr)
         . letval "ipac" 0 (constnt ipac)
@@ -246,6 +250,8 @@ genFsContract' ct =
         . letval "sd" 0 (marloweTime sd)
         . letval "prnxt" 0 (constnt prnxt)
         . letval "ipcb" 0 (constnt ipcb)
+        . letval' "xa" 0 (constnt <$> xa)
+        . letval' "xd" 0 (marloweTime <$> xd)
 
     postProcess :: Contract -> Contract
     postProcess cont =

marlowe-actus/src/Language/Marlowe/ACTUS/MarloweCompat.hs

@@ -16,6 +16,10 @@ useval name t = UseValue $ ValueId $ fromString $ name ++ "_" ++ show t
 letval :: String -> Integer -> Value Observation -> Contract -> Contract
 letval name t = Let $ ValueId $ fromString $ name ++ "_" ++ show t
 
+letval' :: String -> Integer -> Maybe (Value Observation) -> Contract -> Contract
+letval' name t (Just o) c = Let (ValueId $ fromString $ name ++ "_" ++ show t) o c
+letval' _ _ Nothing c     = c
+
 toMarloweFixedPoint :: Double -> Integer
 toMarloweFixedPoint = round <$> (fromIntegral marloweFixedPoint *)
 

marlowe-actus/src/Language/Marlowe/ACTUS/Model/INIT/StateInitializationModel.hs

@@ -12,8 +12,9 @@ module Language.Marlowe.ACTUS.Model.INIT.StateInitializationModel
   )
 where
 
+import           Control.Applicative                                    ((<|>))
 import           Control.Monad.Reader                                   (Reader, reader)
-import           Data.Maybe                                             (fromMaybe)
+import           Data.Maybe                                             (fromMaybe, maybeToList)
 import           Data.Time.LocalTime                                    (LocalTime)
 import           Language.Marlowe.ACTUS.Definitions.ContractState       (ContractState, ContractStatePoly (..))
 import           Language.Marlowe.ACTUS.Definitions.ContractTerms       (CT (..), ContractTerms, ContractTermsPoly (..),
@@ -38,7 +39,7 @@ initializeState = reader initializeState'
         { sd = t0,
           prnxt = nextPrincipalRedemptionPayment contractTerms,
           ipcb = interestPaymentCalculationBase contractTerms,
-          tmd = contractMaturity maturity,
+          tmd = maturity,
           nt = notionalPrincipal contractTerms,
           ipnr = nominalInterestRate contractTerms,
           ipac = interestAccrued contractTerms,
@@ -47,7 +48,7 @@ initializeState = reader initializeState'
           isc = interestScaling contractTerms,
           prf = contractPerformance contractTerms,
           xd = ct_XD contractTerms,
-          xa = ct_XA contractTerms
+          xa = ct_XA contractTerms <|> ct_PFUT contractTerms
         }
       where
         t0 = ct_SD contractTerms
@@ -155,7 +156,7 @@ initializeState = reader initializeState'
                 frac = annuity ipnr ti
              in frac * scale
             where
-              prDates = prSchedule ++ [contractMaturity maturity]
+              prDates = prSchedule ++ maybeToList maturity
               ti = zipWith (\tn tm -> _y dcc tn tm md) prDates (tail prDates)
         nextPrincipalRedemptionPayment _ = 0.0
 
@@ -206,7 +207,3 @@ initializeState = reader initializeState'
         contractPerformance :: ContractTerms -> PRF
         contractPerformance ContractTermsPoly {ct_PRF = Just prf} = prf
         contractPerformance _                                     = error "PRF is not set in ContractTerms"
-
-        contractMaturity :: Maybe LocalTime -> LocalTime
-        contractMaturity (Just mat) = mat
-        contractMaturity _          = error "Maturity is not specified"

marlowe-actus/src/Language/Marlowe/ACTUS/Model/POF/Payoff.hs

@@ -152,6 +152,16 @@ payoff
     }
   _
   _ = _POF_PRD_STK cntrl pprd
+payoff
+  PRD
+  _
+  ContractTermsPoly
+    { contractType = FUTUR,
+      ct_CNTRL = cntrl,
+      ct_PPRD = Just pprd
+    }
+  _
+  _ = _POF_PRD_STK cntrl pprd
 payoff
   PRD
   RiskFactorsPoly {..}
@@ -248,4 +258,14 @@ payoff
   ContractStatePoly
     { xa = Just exerciseAmount}
   _ = _POF_STD_OPTNS cntrl o_rf_CURS exerciseAmount
+payoff
+  STD
+  RiskFactorsPoly {..}
+  ContractTermsPoly
+    { contractType = FUTUR,
+      ct_CNTRL = cntrl
+    }
+  ContractStatePoly
+    { xa = Just exerciseAmount}
+  _ = _POF_STD_OPTNS cntrl o_rf_CURS exerciseAmount
 payoff _ _ _ _ _ = _zero

marlowe-actus/src/Language/Marlowe/ACTUS/Model/SCHED/ContractSchedule.hs

@@ -104,9 +104,9 @@ schedule ev c = schedule' ev c { ct_MD = maturity c }
     schedule' STD  ct@ContractTermsPoly{ contractType = OPTNS } = _SCHED_STD_OPTNS c { ct_MD = ct_MD c <|> ct_MD ct }
 
     schedule' PRD  ct@ContractTermsPoly{ contractType = FUTUR } = _SCHED_PRD_PAM ct
-    schedule' MD   ct@ContractTermsPoly{ contractType = FUTUR } = _SCHED_MD_PAM c { ct_MD = ct_MD c <|> ct_MD ct } -- TODO
     schedule' TD   ct@ContractTermsPoly{ contractType = FUTUR } = _SCHED_TD_PAM ct
-    schedule' XD   ct@ContractTermsPoly{ contractType = FUTUR } = _SCHED_XD_OPTNS ct
+    schedule' MD   ct@ContractTermsPoly{ contractType = FUTUR } = _SCHED_MD_PAM c { ct_MD = ct_MD c <|> ct_MD ct } -- TODO
+    schedule' XD   ct@ContractTermsPoly{ contractType = FUTUR } = _SCHED_XD_OPTNS ct { ct_MD = ct_MD c <|> ct_MD ct }
     schedule' STD  ct@ContractTermsPoly{ contractType = FUTUR } = _SCHED_STD_OPTNS c { ct_MD = ct_MD c <|> ct_MD ct }
 
     schedule' _ _                                               = []

marlowe-actus/src/Language/Marlowe/ACTUS/Model/STF/StateTransition.hs

@@ -84,6 +84,7 @@ stateTransition ev rf t st@ContractStatePoly{..} = reader stateTransition'
           stf SC ContractTermsPoly {contractType = NAM, ct_DCC = Just dcc, ct_MD = md} = _STF_SC_LAM contractTerms st rf t (_y dcc sd t md) (_y dcc tfp_minus t md) (_y dcc tfp_minus tfp_plus md)
           stf SC ContractTermsPoly {contractType = ANN, ct_DCC = Just dcc, ct_MD = md} = _STF_SC_LAM contractTerms st rf t (_y dcc sd t md) (_y dcc tfp_minus t md) (_y dcc tfp_minus tfp_plus md)
           stf XD ContractTermsPoly {contractType = OPTNS} = _STF_XD_OPTNS contractTerms st rf t
+          stf XD ContractTermsPoly {contractType = FUTUR} = _STF_XD_FUTUR contractTerms st rf t
           stf CE ContractTermsPoly {ct_DCC = Just dcc, ct_MD = md} = _STF_CE_PAM st t (_y dcc sd t md)
           stf _ _ = st
 

marlowe-actus/src/Language/Marlowe/ACTUS/Model/STF/StateTransitionModel.hs

@@ -675,3 +675,17 @@ _STF_XD_OPTNS _ st _ t =
   st
     { sd = t
     }
+
+_STF_XD_FUTUR :: ActusNum a => ContractTermsPoly a b -> ContractStatePoly a b -> RiskFactorsPoly a -> b -> ContractStatePoly a b
+_STF_XD_FUTUR
+  ContractTermsPoly
+    { ct_PFUT = Just futuresPrice
+    }
+  st
+  RiskFactorsPoly {..}
+  t = st
+    { xa = Just $ pp_payoff - futuresPrice,
+      sd = t
+    }
+_STF_XD_FUTUR _ _ _ _ = undefined
+

marlowe-actus/test/Spec.hs

@@ -22,7 +22,7 @@ main = do
       $ p ++ "actus-tests-ann.json"
   stkTests <- testCasesFromFile [] $ p ++ "actus-tests-stk.json"
   optnsTests <- testCasesFromFile [] $ p ++ "actus-tests-optns.json"
-  -- futurTests <- testCasesFromFile [] $ p ++ "actus-tests-futur.json"
+  futurTests <- testCasesFromFile [] $ p ++ "actus-tests-futur.json"
 
   defaultMain $
     testGroup
@@ -35,7 +35,7 @@ main = do
           , Spec.Marlowe.ACTUS.TestFramework.tests "ANN" annTests
           , Spec.Marlowe.ACTUS.TestFramework.tests "STK" stkTests
           , Spec.Marlowe.ACTUS.TestFramework.tests "OPTNS" optnsTests
-          -- , Spec.Marlowe.ACTUS.TestFramework.tests "FUTUR" futurTests
+          , Spec.Marlowe.ACTUS.TestFramework.tests "FUTUR" futurTests
           ],
         testGroup
           "ACTUS examples"

marlowe-actus/test/Spec/Marlowe/ACTUS/Examples.hs

@@ -47,10 +47,12 @@ example01 =
         ContractTermsPoly
           { contractId = "0",
             contractType = PAM,
+            contractStructure = [],
             ct_IED = iso8601ParseM "2020-01-01T00:00:00",
             ct_SD = fromJust $ iso8601ParseM "2019-12-31T00:00:00",
             ct_MD = iso8601ParseM "2030-01-01T00:00:00",
             ct_AD = Nothing,
+            ct_XD = Nothing,
             ct_TD = Nothing,
             ct_PRNXT = Nothing,
             ct_PRD = Nothing,
@@ -71,9 +73,6 @@ example01 =
             -- Penalties
             ct_PYRT = Nothing,
             ct_PYTP = Just PYTP_O, -- no penalty
-            -- Optionality
-            ct_OPCL = Nothing,
-            ct_OPANX = Nothing,
             -- Scaling
             ct_SCIP = Nothing,
             ct_SCIED = Nothing,
@@ -83,6 +82,17 @@ example01 =
             ct_SCNT = Nothing,
             ct_SCCL = Nothing,
             ct_SCANX = Nothing,
+            -- Optionality
+            ct_OPCL = Nothing,
+            ct_OPANX = Nothing,
+            ct_OPTP = Nothing,
+            ct_OPS1 = Nothing,
+            ct_OPXT = Nothing,
+            -- Settlement
+            ct_STP = Nothing,
+            ct_DS = Nothing,
+            ct_XA = Nothing,
+            ct_PFUT = Nothing,
             -- Rate Reset
             ct_RRCL = Nothing,
             ct_RRANX = Nothing,
@@ -113,6 +123,10 @@ example01 =
             ct_FEB = Nothing,
             ct_FER = Nothing,
             ct_CURS = Nothing,
+            -- Dividend
+            ct_DVCL = Nothing,
+            ct_DVANX = Nothing,
+            ct_DVNP = Nothing,
             enableSettlement = False,
             constraints = Nothing,
             collateralAmount = 0
@@ -178,10 +192,12 @@ example02 =
         ContractTermsPoly
           { contractId = "0",
             contractType = LAM,
+            contractStructure = [],
             ct_IED = iso8601ParseM "2020-01-01T00:00:00",
             ct_SD = fromJust $ iso8601ParseM "2019-12-31T00:00:00",
             ct_MD = iso8601ParseM "2030-01-01T00:00:00",
             ct_AD = Nothing,
+            ct_XD = Nothing,
             ct_TD = Nothing,
             ct_PRNXT = Just 1000.0,
             ct_PRD = Nothing,
@@ -205,6 +221,14 @@ example02 =
             -- Optionality
             ct_OPCL = Nothing,
             ct_OPANX = Nothing,
+            ct_OPTP = Nothing,
+            ct_OPS1 = Nothing,
+            ct_OPXT = Nothing,
+            -- Settlement
+            ct_STP = Nothing,
+            ct_DS = Nothing,
+            ct_XA = Nothing,
+            ct_PFUT = Nothing,
             -- Scaling
             ct_SCIP = Nothing,
             ct_SCIED = Nothing,
@@ -244,6 +268,10 @@ example02 =
             ct_FEB = Nothing,
             ct_FER = Nothing,
             ct_CURS = Nothing,
+            -- Dividend
+            ct_DVCL = Nothing,
+            ct_DVANX = Nothing,
+            ct_DVNP = Nothing,
             enableSettlement = False,
             constraints = Nothing,
             collateralAmount = 0
@@ -309,10 +337,12 @@ example03 =
         ContractTermsPoly
           { contractId = "0",
             contractType = NAM,
+            contractStructure = [],
             ct_IED = iso8601ParseM "2020-01-01T00:00:00",
             ct_SD = fromJust $ iso8601ParseM "2019-12-31T00:00:00",
             ct_MD = iso8601ParseM "2030-01-01T00:00:00",
             ct_AD = Nothing,
+            ct_XD = Nothing,
             ct_TD = Nothing,
             ct_PRNXT = Just 1000.0,
             ct_PRD = Nothing,
@@ -336,6 +366,14 @@ example03 =
             -- Optionality
             ct_OPCL = Nothing,
             ct_OPANX = Nothing,
+            ct_OPTP = Nothing,
+            ct_OPS1 = Nothing,
+            ct_OPXT = Nothing,
+            -- Settlement
+            ct_STP = Nothing,
+            ct_DS = Nothing,
+            ct_XA = Nothing,
+            ct_PFUT = Nothing,
             -- Scaling
             ct_SCIP = Nothing,
             ct_SCIED = Nothing,
@@ -375,6 +413,10 @@ example03 =
             ct_FEB = Nothing,
             ct_FER = Nothing,
             ct_CURS = Nothing,
+            -- Dividend
+            ct_DVCL = Nothing,
+            ct_DVANX = Nothing,
+            ct_DVNP = Nothing,
             enableSettlement = False,
             constraints = Nothing,
             collateralAmount = 0
@@ -440,10 +482,12 @@ example04 =
         ContractTermsPoly
           { contractId = "0",
             contractType = ANN,
+            contractStructure = [],
             ct_IED = iso8601ParseM "2020-01-01T00:00:00",
             ct_SD = fromJust $ iso8601ParseM "2019-12-31T00:00:00",
             ct_MD = iso8601ParseM "2030-01-01T00:00:00",
             ct_AD = Nothing,
+            ct_XD = Nothing,
             ct_TD = Nothing,
             ct_PRNXT = Just 1000,
             ct_PRD = Nothing,
@@ -467,6 +511,14 @@ example04 =
             -- Optionality
             ct_OPCL = Nothing,
             ct_OPANX = Nothing,
+            ct_OPTP = Nothing,
+            ct_OPS1 = Nothing,
+            ct_OPXT = Nothing,
+            -- Settlement
+            ct_STP = Nothing,
+            ct_DS = Nothing,
+            ct_XA = Nothing,
+            ct_PFUT = Nothing,
             -- Scaling
             ct_SCIP = Nothing,
             ct_SCIED = Nothing,
@@ -506,6 +558,10 @@ example04 =
             ct_FEB = Nothing,
             ct_FER = Nothing,
             ct_CURS = Nothing,
+            -- Dividend
+            ct_DVCL = Nothing,
+            ct_DVANX = Nothing,
+            ct_DVNP = Nothing,
             enableSettlement = False,
             constraints = Nothing,
             collateralAmount = 0