From c0b411f2f8e7cbb666baa799b52f935c00abac92 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Lars=20Br=C3=BCnjes?= <brunjlar@gmail.com>
Date: Tue, 27 Apr 2021 09:33:44 +0200
Subject: [PATCH] sample solutions for week 4 homework

---
 .../plutus-pioneer-program-week04.cabal       |  1 +
 code/week04/src/Week04/Solution.hs            | 53 +++++++++++++++++++
 2 files changed, 54 insertions(+)
 create mode 100644 code/week04/src/Week04/Solution.hs

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