Skip to content
Permalink
Browse files

Add trustedZeroCouponBond example.

  • Loading branch information...
nau committed Mar 14, 2019
1 parent 61b27b7 commit bf07e6b4f25422a5082c1283c5eeb9e9674d38a1
Showing with 102 additions and 11 deletions.
  1. +35 −4 marlowe/src/Language/Marlowe/Actus.hs
  2. +65 −6 marlowe/test/Spec/Actus.hs
  3. +2 −1 marlowe/test/Spec/Marlowe.hs
@@ -8,18 +8,49 @@ import Wallet.API (PubKey (..))
but is traded at a deep discount, rendering profit at maturity
when the bond is redeemed for its full face value.
-}
zeroCouponBond :: PubKey -> PubKey -> Int -> Int -> Timeout -> Timeout -> Contract
zeroCouponBond issuer investor notional discount startDate maturityDate =
zeroCouponBond :: PubKey -> PubKey -> Int -> Int -> Timeout -> Timeout -> Timeout -> Contract
zeroCouponBond issuer investor notional discount startDate maturityDate gracePeriod =
-- prepare money for zero-coupon bond, before it could be used
CommitCash (IdentCC 1) investor (Value (notional - discount)) startDate maturityDate
(CommitCash (IdentCC 2) issuer (Value notional) startDate (maturityDate+1000)
(CommitCash (IdentCC 2) issuer (Value notional) startDate (maturityDate + gracePeriod)
(When FalseObs startDate Null
(Pay (IdentPay 1) investor issuer (Committed (IdentCC 1)) maturityDate
(When FalseObs maturityDate Null
(Pay (IdentPay 2) issuer investor (Committed (IdentCC 2)) (maturityDate+1000) Null)
(Pay (IdentPay 2) issuer investor (Committed (IdentCC 2))
(maturityDate + gracePeriod) Null)
)
)
)
Null
)
Null

{-|
A zero-coupon bond is a debt security that doesn't pay interest (a coupon)
but is traded at a @discount@, rendering profit at @maturityDate@
when the bond is redeemed for its full face @notional@ value.
The @issuer@ is not forced to commit before @startDate@, hence it's a trusted bond,
as the final payment can fail.
If an @investor@ does not redeem the bond value during @gracePeriod@ after @maturityDate@
the @issuer@ can keep the value.
-}
trustedZeroCouponBond :: PubKey -> PubKey -> Int -> Int -> Timeout -> Timeout -> Timeout -> Contract
trustedZeroCouponBond issuer investor notional discount startDate maturityDate gracePeriod =
-- prepare money for zero-coupon bond, before it could be used
-- if the issuer won't pull the payment, investor can redeem the commit after maturityDate
CommitCash (IdentCC 1) investor (Value (notional - discount)) startDate maturityDate
(When FalseObs startDate Null -- after startDate
-- issuer can 'pull' the payment before maturityDate
(Pay (IdentPay 1) investor issuer (Committed (IdentCC 1)) maturityDate
-- issuer must commit a bond value before maturityDate
-- issuer can redeem committed value if the inverstor won't 'pull' the payment
-- within gracePeriod after maturityDate
(CommitCash (IdentCC 2) issuer (Value notional) maturityDate (maturityDate + gracePeriod)
(When FalseObs maturityDate Null
(Pay (IdentPay 2) issuer investor (Committed (IdentCC 2))
(maturityDate + gracePeriod) Null))
Null
)
)
)
Null
@@ -73,7 +73,10 @@ emptyBounds = Bounds Map.empty Map.empty


tests :: TestTree
tests = testGroup "Actus" [testCase "zcb" checkZeroCouponBond]
tests = testGroup "Actus"
[ testCase "Safe zero coupon bond" checkZeroCouponBond
, testCase "Trusted zero coupon bond" checkTrustedZeroCouponBond
]


checkZeroCouponBond :: IO ()
@@ -84,8 +87,9 @@ checkZeroCouponBond = do
discount = 80
startDate = 50
maturityDate = 500
gracePeriod = 30240 -- about a week, 20sec * 3 * 60 * 24 * 7
deposit = 12
contract = zeroCouponBond (PubKey 1) (PubKey 2) notional discount startDate maturityDate
contract = zeroCouponBond (PubKey 1) (PubKey 2) notional discount startDate maturityDate gracePeriod
eval = evalContract (PubKey 1)
-- investor commits money for a bond with discount
let (state1, con1, v) = eval (input $ Commit (IdentCC 1) (Signature 2)) (Slot 10)
@@ -101,26 +105,81 @@ checkZeroCouponBond = do
state1
con1
v @?= True
-- issues receives payment for a bond
-- issuer receives payment for a bond
let (state3, con3, v) = eval (input $ Payment (IdentPay 1) (Signature 1)) (Slot 60)
(Ada.fromInt (2*notional - discount + deposit))
(Ada.fromInt (notional + deposit))
state2
con2
v @?= True
putStrLn (show con3)
putStrLn (show state3)
-- investor redeems a bond
let (_, _, v) = eval (input $ Payment (IdentPay 2) (Signature 2)) (Slot 510)
(Ada.fromInt (notional + deposit))
(Ada.fromInt deposit)
state3
con3
v @?= True
-- issues can't receive payment for a bond before start date
-- issuer can't receive payment for a bond before start date
let (_, _, v) = eval (input $ Payment (IdentPay 1) (Signature 1)) (Slot 49)
(Ada.fromInt (2*notional - discount + deposit))
(Ada.fromInt (notional + deposit))
state2
con2
v @?= False


checkTrustedZeroCouponBond :: IO ()
checkTrustedZeroCouponBond = do
let input cmd = Input cmd [] []
state = State [] []
notional = 1000
discount = 80
startDate = 50
maturityDate = 500
gracePeriod = 30240 -- about a week, 20sec * 3 * 60 * 24 * 7
deposit = 12
contract = trustedZeroCouponBond
(PubKey 1)
(PubKey 2)
notional
discount
startDate
maturityDate
gracePeriod
eval = evalContract (PubKey 1)
-- investor commits money for a bond with discount
let (state1, con1, v) = eval (input $ Commit (IdentCC 1) (Signature 2)) (Slot 10)
(Ada.fromInt deposit)
(Ada.fromInt (notional - discount + deposit))
state
contract
v @?= True
-- issuer receives payment for a bond
let (state2, con2, v) = eval (input $ Payment (IdentPay 1) (Signature 1)) (Slot 60)
(Ada.fromInt (notional - discount + deposit))
(Ada.fromInt deposit)
state1
con1
v @?= True
-- issuer commits money for a bond redeem
let (state3, con3, v) = eval (input $ Commit (IdentCC 2) (Signature 1)) (Slot 450)
(Ada.fromInt deposit)
(Ada.fromInt (notional + deposit))
state2
con2
v @?= True

-- investor redeems a bond
let (_, _, v) = eval (input $ Payment (IdentPay 2) (Signature 2)) (Slot 510)
(Ada.fromInt (notional + deposit))
(Ada.fromInt deposit)
state3
con3
v @?= True
-- issuer can't receive payment for a bond before start date
let (_, _, v) = eval (input $ Payment (IdentPay 1) (Signature 1)) (Slot 49)
(Ada.fromInt (2*notional - discount + deposit))
(Ada.fromInt (notional + deposit))
state1
con1
v @?= False
@@ -769,9 +769,10 @@ zeroCouponBondTest = checkMarloweTrace (MarloweScenario {
discount = 80
startDate = 50
maturityDate = 500
gracePeriod = 30240 -- about a week, 20sec * 3 * 60 * 24 * 7
update

let contract = zeroCouponBond (PubKey 1) (PubKey 2) notional discount startDate maturityDate
let contract = zeroCouponBond (PubKey 1) (PubKey 2) notional discount startDate maturityDate gracePeriod

withContract [issuer, investor] contract $ \txOut validator -> do
txOut <- investor `performs` commit'

0 comments on commit bf07e6b

Please sign in to comment.
You can’t perform that action at this time.