-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathHomework.hs
73 lines (61 loc) · 2.47 KB
/
Homework.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Week04.Homework where
import Data.Aeson (FromJSON, ToJSON)
import Data.Functor (void)
import Data.Text (Text)
import GHC.Generics (Generic)
import Ledger
import Ledger.Ada as Ada
import Ledger.Constraints as Constraints
import Plutus.Contract as Contract
import Plutus.Trace.Emulator as Emulator
import Wallet.Emulator.Wallet
data PayParams = PayParams
{ ppRecipient :: PaymentPubKeyHash
, ppLovelace :: Integer
} deriving (Show, Generic, FromJSON, ToJSON)
type PaySchema = Endpoint "pay" PayParams
payContract :: Contract () PaySchema Text ()
payContract = do
pp <- awaitPromise $ endpoint @"pay" return
let tx = mustPayToPubKey (ppRecipient pp) $ lovelaceValueOf $ ppLovelace pp
Contract.handleError (Contract.logError @Text) (void $ submitTx tx)
payContract
-- payContract :: Contract () PaySchema Text ()
-- payContract = do
-- pp <- awaitPromise $ endpoint @"pay" return
-- let tx = mustPayToPubKey (ppRecipient pp) $ lovelaceValueOf $ ppLovelace pp
-- Contract.handleError errorHandler (void $ submitTx tx)
-- payContract
-- errorHandler :: Text -> Contract () PaySchema e ()
-- errorHandler = Contract.logError
-- A trace that invokes the pay endpoint of payContract on Wallet 1 twice, each time with Wallet 2 as
-- recipient, but with amounts given by the two arguments. There should be a delay of one slot
-- after each endpoint call.
payTrace :: Integer -> Integer -> EmulatorTrace ()
payTrace v1 v2 = do
hdl <- activateContractWallet w1 payContract
callEndpoint @"pay" hdl PayParams
{ ppRecipient = mockWalletPaymentPubKeyHash w2
, ppLovelace = v1
}
void $ Emulator.waitNSlots 1
callEndpoint @"pay" hdl PayParams
{ ppRecipient = mockWalletPaymentPubKeyHash w2
, ppLovelace = v2
}
void $ Emulator.waitNSlots 1
w1 :: Wallet
w1 = knownWallet 1
w2 :: Wallet
w2 = knownWallet 2
payTest1 :: IO ()
payTest1 = runEmulatorTraceIO $ payTrace 10_000_000 20_000_000
payTest2 :: IO ()
payTest2 = runEmulatorTraceIO $ payTrace 1000_000_000 20_000_000