diff --git a/code/week04/plutus-pioneer-program-week04.cabal b/code/week04/plutus-pioneer-program-week04.cabal index 692cd49..7b2ca8e 100644 --- a/code/week04/plutus-pioneer-program-week04.cabal +++ b/code/week04/plutus-pioneer-program-week04.cabal @@ -15,6 +15,7 @@ library , Week04.Homework , Week04.Maybe , Week04.Monad + , Week04.Solution , Week04.Trace , Week04.Writer build-depends: aeson diff --git a/code/week04/src/Week04/Solution.hs b/code/week04/src/Week04/Solution.hs new file mode 100644 index 0000000..620fab4 --- /dev/null +++ b/code/week04/src/Week04/Solution.hs @@ -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