mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-22 06:42:00 +01:00
Merge branch 'solutions' into week05
This commit is contained in:
commit
e7a7e51a2b
2 changed files with 54 additions and 0 deletions
|
@ -15,6 +15,7 @@ library
|
||||||
, Week04.Homework
|
, Week04.Homework
|
||||||
, Week04.Maybe
|
, Week04.Maybe
|
||||||
, Week04.Monad
|
, Week04.Monad
|
||||||
|
, Week04.Solution
|
||||||
, Week04.Trace
|
, Week04.Trace
|
||||||
, Week04.Writer
|
, Week04.Writer
|
||||||
build-depends: aeson
|
build-depends: aeson
|
||||||
|
|
53
code/week04/src/Week04/Solution.hs
Normal file
53
code/week04/src/Week04/Solution.hs
Normal file
|
@ -0,0 +1,53 @@
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE DeriveAnyClass #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
|
||||||
|
module Week04.Solution where
|
||||||
|
|
||||||
|
import Data.Aeson (FromJSON, ToJSON)
|
||||||
|
import Data.Functor (void)
|
||||||
|
import Data.Text (Text, unpack)
|
||||||
|
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 :: PubKeyHash
|
||||||
|
, ppLovelace :: Integer
|
||||||
|
} deriving (Show, Generic, FromJSON, ToJSON)
|
||||||
|
|
||||||
|
type PaySchema = BlockchainActions .\/ Endpoint "pay" PayParams
|
||||||
|
|
||||||
|
payContract :: Contract () PaySchema Text ()
|
||||||
|
payContract = do
|
||||||
|
pp <- endpoint @"pay"
|
||||||
|
let tx = mustPayToPubKey (ppRecipient pp) $ lovelaceValueOf $ ppLovelace pp
|
||||||
|
handleError (\err -> Contract.logInfo $ "caught error: " ++ unpack err) $ void $ submitTx tx
|
||||||
|
payContract
|
||||||
|
|
||||||
|
payTrace :: Integer -> Integer -> EmulatorTrace ()
|
||||||
|
payTrace x y = do
|
||||||
|
h <- activateContractWallet (Wallet 1) payContract
|
||||||
|
callEndpoint @"pay" h $ PayParams
|
||||||
|
{ ppRecipient = pubKeyHash $ walletPubKey $ Wallet 2
|
||||||
|
, ppLovelace = x
|
||||||
|
}
|
||||||
|
void $ Emulator.waitNSlots 1
|
||||||
|
callEndpoint @"pay" h $ PayParams
|
||||||
|
{ ppRecipient = pubKeyHash $ walletPubKey $ Wallet 2
|
||||||
|
, ppLovelace = y
|
||||||
|
}
|
||||||
|
void $ Emulator.waitNSlots 1
|
||||||
|
|
||||||
|
payTest1 :: IO ()
|
||||||
|
payTest1 = runEmulatorTraceIO $ payTrace 1000000 2000000
|
||||||
|
|
||||||
|
payTest2 :: IO ()
|
||||||
|
payTest2 = runEmulatorTraceIO $ payTrace 1000000000 2000000
|
Loading…
Reference in a new issue