Merge pull request #3981 from input-output-hk/scp-2744-actus-contract…

…s-in-marlowe SCP-2744 - ACTUS contracts in Marlowe
IntersectMBO · Sep 24, 2021 · ee57f39 · ee57f39
2 parents f363c44 + 3563ece
commit ee57f39
Show file tree

Hide file tree

Showing 37 changed files with 2,474 additions and 1,486 deletions.
diff --git a/marlowe-actus/README.md b/marlowe-actus/README.md
@@ -6,30 +6,191 @@ _marlowe-actus_ is a library to generate Marlowe contracts from ACTUS contract t
 
 ACTUS is a foundation that defines the ACTUS taxonomy of financial contracts, see https://www.actusfrf.org/
 
-### Contract types
-
 The following contract types are implemented in Haskell and Marlowe.
 
-#### Amortizing loans
+### Amortizing loans
 
 An amortizing loan is a loan that requires periodic payments where a payment consists of the interest payment and the principal.
 
-##### Principal at maturity (PAM)
+#### Principal at maturity (PAM)
 
 Principal at maturity only defines periodic interest payments, the full principal is due at maturity.
-
-##### Linear Amortizer (LAM)
+A simple illustrative example of such a contract is the following
+
+```
+principal: 10000
+interest rate: 2% p.a.
+annual interest payments
+term: 10 years
+```
+
+This generates yearly cash flows with the interest payment for 10 years and the principal repayment at maturity:
+
+|Year|Balance|Principal|Interest|Payment|
+|----|-------|---------|--------|-------|
+|1|10000|0|200|200|
+|2|10000|0|200|200|
+|3|10000|0|200|200|
+|4|10000|0|200|200|
+|5|10000|0|200|200|
+|6|10000|0|200|200|
+|7|10000|0|200|200|
+|8|10000|0|200|200|
+|9|10000|0|200|200|
+|10|10000|10000|200|10200|
+
+The contract in ACTUS is specified as follows - only the relevant parameters are shown here:
+
+```
+ContractTerms
+  { contractType = PAM
+  , ct_IED       = iso8601ParseM "2020-01-01T00:00:00"
+  , ct_MD        = iso8601ParseM "2030-01-01T00:00:00"
+  , ct_NT        = Just 10000.0
+  , ct_DCC       = Just DCC_E30_360
+  , ct_IPCL      = Just $ Cycle 1 P_Y ShortStub False
+  , ct_IPANX     = iso8601ParseM "2020-01-01T00:00:00"
+  , ct_IPNR      = Just 0.02
+  ...
+  }
+```
+
+#### Linear Amortizer (LAM)
 
 Regular principal repayments over time, the interest payments decrease linearly.
 
-##### Negative Amortizer (NAM)
+```
+principal: 10000
+principal repayment: 1000 p.a.
+interest rate: 2% p.a.
+annual interest payments
+term: 10 years
+```
+
+|Year|Balance|Principal|Interest|Payment|
+|----|-------|---------|--------|-------|
+|1|10000|1000|200|1200|
+|2|9000|1000|180|1180|
+|3|8000|1000|160|1160|
+|4|7000|1000|140|1140|
+|5|6000|1000|120|1120|
+|6|5000|1000|100|1100|
+|7|4000|1000|80|1080|
+|8|3000|1000|60|1060|
+|9|2000|1000|40|1040|
+|10|1000|1000|20|1020|
+
+The contract in ACTUS is specified as follows - only the relevant parameters are shown here:
+
+```
+ContractTerms
+  { contractType = LAM
+  , ct_IED       = iso8601ParseM "2020-01-01T00:00:00"
+  , ct_MD        = iso8601ParseM "2030-01-01T00:00:00"
+  , ct_PRNXT     = Just 1000.0
+  , ct_NT        = Just 10000.0
+  , ct_DCC       = Just DCC_E30_360
+  , ct_IPCL      = Just $ Cycle 1 P_Y ShortStub False
+  , ct_IPANX     = iso8601ParseM "2020-01-01T00:00:00"
+  , ct_IPNR      = Just 0.02
+  , ct_IPAC      = Just 0.0
+  , ct_PRCL      = Just $ Cycle 1 P_Y ShortStub False
+  , ct_PRANX     = iso8601ParseM "2021-01-01T00:00:00"
+  , ct_IPCB      = Just IPCB_NT
+  ...
+  }
+```
+
+#### Negative Amortizer (NAM)
 
 Negative amortization means that the payments per period are smaller than the interest, i.e. the balance of the loan increases over time.
 
-##### Annuity (ANN)
+```
+principal: 10000
+interest rate: 2% p.a.
+annual interest payments
+term: 10 years
+```
+
+|Year|Balance|Principal|Interest|Payment|
+|----|-------|---------|--------|-------|
+|1|10000|1000|200|1000|
+|2|9200|1000|184|1000|
+|3|8384|1000|168|1000|
+|4|7552|1000|151|1000|
+|5|6703|1000|134|1000|
+|6|5837|1000|117|1000|
+|7|4954|1000|99|1000|
+|8|4053|1000|81|1000|
+|9|3134|1000|63|1000|
+|10|2196|1000|44|1000|
+
+The contract in ACTUS is specified as follows - only the relevant parameters are shown here:
+
+```
+ContractTerms
+  { contractType = NAM
+  , ct_IED       = iso8601ParseM "2020-01-01T00:00:00"
+  , ct_MD        = iso8601ParseM "2030-01-01T00:00:00"
+  , ct_PRNXT     = Just 1000.0
+  , ct_NT        = Just 10000.0
+  , ct_DCC       = Just DCC_E30_360
+  , ct_IPCL      = Just $ Cycle 1 P_Y ShortStub False
+  , ct_IPANX     = iso8601ParseM "2020-01-01T00:00:00"
+  , ct_IPNR      = Just 0.02
+  , ct_IPAC      = Just 0.0
+  , ct_PRCL      = Just $ Cycle 1 P_Y ShortStub False
+  , ct_PRANX     = iso8601ParseM "2021-01-01T00:00:00"
+  , ct_IPCB      = Just IPCB_NT
+  ...
+  }
+```
+
+#### Annuity (ANN)
 
 The annuity amortization consists of regular payments of equal amounts over the lifetime of the loan.
 
+```
+principal: 10000
+interest rate: 2% p.a.
+annual interest payments
+term: 10 years
+```
+
+|Year|Balance|Principal|Interest|Payment|
+|----|-------|---------|--------|-------|
+|1|10000|800|200|1000|
+|2|9200|816|184|1000|
+|3|8384|832|168|1000|
+|4|7552|849|151|1000|
+|5|6703|866|134|1000|
+|6|5837|883|117|1000|
+|7|4954|901|99|1000|
+|8|4053|919|81|1000|
+|9|3134|937|63|1000|
+|10|2196|956|44|1000|
+
+The contract in ACTUS is specified as follows - only the relevant parameters are shown here:
+
+```
+ContractTerms
+  { contractType = ANN
+  , ct_IED       = iso8601ParseM "2020-01-01T00:00:00"
+  , ct_MD        = iso8601ParseM "2030-01-01T00:00:00"
+  , ct_PRNXT     = Just 1000.0
+  , ct_NT        = Just 10000.0
+  , ct_DCC       = Just DCC_E30_360
+  , ct_IPCL      = Just $ Cycle 1 P_Y ShortStub False
+  , ct_IPANX     = iso8601ParseM "2020-01-01T00:00:00"
+  , ct_IPNR      = Just 0.02
+  , ct_IPAC      = Just 0.0
+  , ct_PRCL      = Just $ Cycle 1 P_Y ShortStub False
+  , ct_PRANX     = iso8601ParseM "2021-01-01T00:00:00"
+  , ct_IPCB      = Just IPCB_NT
+  ...
+  }
+```
+
 ## Test cases
 
 For the contract types mentioned above the implementation is tested with the test cases provided by ACTUS: https://github.com/actusfrf/actus-tests
diff --git a/marlowe-actus/app/Main.hs b/marlowe-actus/app/Main.hs
@@ -7,16 +7,15 @@ module Main where
 import           Data.Aeson                                        (decode)
 import           Data.Int                                          (Int32)
 import           Data.String                                       (IsString (fromString))
-import           Data.Time                                         (Day)
-import           Data.Time.Calendar                                (showGregorian)
+import           Data.Time                                         (LocalTime)
 import           Language.Marlowe.ACTUS.Analysis                   (genProjectedCashflows)
 import           Language.Marlowe.ACTUS.Definitions.BusinessEvents
 import           Language.Marlowe.ACTUS.Definitions.Schedule       (CashFlow (..))
 import           Language.R                                        (R)
 import qualified Language.R                                        as R
 import           Language.R.QQ
 
-riskFactors :: EventType -> Day -> RiskFactors
+riskFactors :: EventType -> LocalTime -> RiskFactors
 riskFactors _ _ =
     RiskFactorsPoly
         { o_rf_CURS = 1.0,
@@ -29,7 +28,7 @@ get_dates :: String -> R s [String]
 get_dates terms = return $ case (decode $ fromString terms) of
     Just terms' -> let
           cfs = genProjectedCashflows riskFactors terms'
-          date = showGregorian <$> cashCalculationDay <$> cfs
+          date = show <$> cashCalculationDay <$> cfs
           event = show <$> cashEvent <$> cfs
       in (\(d, e) -> d ++ " " ++ e) <$> (zip date event)
     Nothing -> []

diff --git a/marlowe-actus/marlowe-actus.cabal b/marlowe-actus/marlowe-actus.cabal
@@ -41,6 +41,7 @@ library
     text,
     vector,
     marlowe -any,
+    mtl -any,
     time -any,
     sort -any,
     validation -any
@@ -53,6 +54,7 @@ library
     Language.Marlowe.ACTUS.MarloweCompat
     Language.Marlowe.ACTUS.Generator
     Language.Marlowe.ACTUS.Analysis
+    Language.Marlowe.ACTUS.Ops
     Language.Marlowe.ACTUS.Definitions.BusinessEvents
     Language.Marlowe.ACTUS.Definitions.ContractTerms
     Language.Marlowe.ACTUS.Definitions.ContractState
@@ -72,9 +74,6 @@ library
     Language.Marlowe.ACTUS.Model.Utility.DateShift
     Language.Marlowe.ACTUS.Model.Utility.ScheduleGenerator
     Language.Marlowe.ACTUS.Model.Utility.YearFraction
-    Language.Marlowe.ACTUS.Model.Utility.ContractRoleSign
-  other-modules:
-    Language.Marlowe.ACTUS.Ops
   ghc-options:
     -Wall -Wnoncanonical-monad-instances -Wunused-packages
     -Wincomplete-uni-patterns -Wincomplete-record-updates
@@ -105,7 +104,6 @@ executable marlowe-shiny
       Language.Marlowe.ACTUS.Model.Utility.DateShift
       Language.Marlowe.ACTUS.Model.Utility.ScheduleGenerator
       Language.Marlowe.ACTUS.Model.Utility.YearFraction
-      Language.Marlowe.ACTUS.Model.Utility.ContractRoleSign
       Language.Marlowe.ACTUS.Ops
     hs-source-dirs: app src
     default-language: Haskell2010
@@ -161,7 +159,6 @@ executable marlowe-actus-test-kit
       Language.Marlowe.ACTUS.Model.Utility.DateShift
       Language.Marlowe.ACTUS.Model.Utility.ScheduleGenerator
       Language.Marlowe.ACTUS.Model.Utility.YearFraction
-      Language.Marlowe.ACTUS.Model.Utility.ContractRoleSign
       Language.Marlowe.ACTUS.Ops
     hs-source-dirs: testkit src
     default-language: Haskell2010
@@ -196,8 +193,8 @@ test-suite marlowe-actus-test
     type: exitcode-stdio-1.0
     main-is: Spec.hs
     other-modules:
-        Spec.Marlowe.Util
-        Spec.Marlowe.Actus
+        Spec.Marlowe.ACTUS.Examples
+        Spec.Marlowe.ACTUS.TestFramework
     build-depends:
         vector -any,
         unordered-containers -any,