Skip to content

Commit

Permalink
Add trustedZeroCouponBond example.
Browse files Browse the repository at this point in the history
  • Loading branch information
@nau
nau committed Mar 14, 2019
1 parent 61b27b7 commit bf07e6b
Show file tree
Hide file tree
Showing 3 changed files with 102 additions and 11 deletions.
39 changes: 35 additions & 4 deletions marlowe/src/Language/Marlowe/Actus.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
71 changes: 65 additions & 6 deletions marlowe/test/Spec/Actus.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()
Expand All @@ -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)
Expand All @@ -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
3 changes: 2 additions & 1 deletion marlowe/test/Spec/Marlowe.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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'
Expand Down

0 comments on commit bf07e6b

Please sign in to comment.