From 4a09b7e6925131cf2015268948355012caafbb26 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lars=20Br=C3=BCnjes?= Date: Wed, 7 Jul 2021 23:29:58 +0200 Subject: [PATCH] first draft for week #2 --- README.md | 12 ++++++++ code/week02/src/Week02/Burn.hs | 8 +++--- code/week02/src/Week02/FortyTwo.hs | 6 ++-- code/week02/src/Week02/Gift.hs | 43 ++--------------------------- code/week02/src/Week02/Homework1.hs | 2 +- code/week02/src/Week02/Homework2.hs | 2 +- code/week02/src/Week02/IsData.hs | 8 +++--- code/week02/src/Week02/Solution1.hs | 2 +- code/week02/src/Week02/Solution2.hs | 2 +- code/week02/src/Week02/Typed.hs | 6 ++-- 10 files changed, 31 insertions(+), 60 deletions(-) diff --git a/README.md b/README.md index 5bc432f..2037c53 100644 --- a/README.md +++ b/README.md @@ -12,9 +12,16 @@ - Running an example auction contract on a local Playground. - Homework. +- [Lecture #2]() + + - Triggering change. + - Low-level, untyped on-chain validation scripts. + - High-level, typed on-chain validation scripts. + ## Code Examples - Lecture #1: [English Auction](code/week01) +- Lecture #2: [Simple validation](code/week02) ## Exercises @@ -32,6 +39,11 @@ - Compile. - Simulate various auction scenarios. +- Week #2 + + - Fix and complete the code in the [Homework1](code/week02/src/Week02/Homework1.hs) module. + - Fix and complete the code in the [Homework2](code/week02/src/Week02/Homework2.hs) module. + ## Some Plutus Modules - [`Language.Marlowe.Semantics`](https://github.com/input-output-hk/plutus/blob/master/marlowe/src/Language/Marlowe/Semantics.hs), contains Marlowe types and semantics. diff --git a/code/week02/src/Week02/Burn.hs b/code/week02/src/Week02/Burn.hs index 8a91a17..d3e9717 100644 --- a/code/week02/src/Week02/Burn.hs +++ b/code/week02/src/Week02/Burn.hs @@ -8,8 +8,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-unused-imports #-} - module Week02.Burn where import Control.Monad hiding (fmap) @@ -27,12 +25,14 @@ import Ledger.Ada as Ada import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage) import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) import Playground.Types (KnownCurrency (..)) -import Prelude (Semigroup (..), String) +import Prelude (IO, Semigroup (..), String) import Text.Printf (printf) +{-# OPTIONS_GHC -fno-warn-unused-imports #-} + {-# INLINABLE mkValidator #-} mkValidator :: Data -> Data -> Data -> () -mkValidator _ _ _ = traceError "NO WAY!" +mkValidator _ _ _ = traceError "BURNT!" validator :: Validator validator = mkValidatorScript $$(PlutusTx.compile [|| mkValidator ||]) diff --git a/code/week02/src/Week02/FortyTwo.hs b/code/week02/src/Week02/FortyTwo.hs index e3084a8..d481208 100644 --- a/code/week02/src/Week02/FortyTwo.hs +++ b/code/week02/src/Week02/FortyTwo.hs @@ -25,7 +25,7 @@ import Ledger.Ada as Ada import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage) import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) import Playground.Types (KnownCurrency (..)) -import Prelude (Semigroup (..), String) +import Prelude (IO, Semigroup (..), String) import Text.Printf (printf) {-# OPTIONS_GHC -fno-warn-unused-imports #-} @@ -57,13 +57,13 @@ give amount = do logInfo @String $ printf "made a gift of %d lovelace" amount grab :: forall w s e. AsContractError e => Integer -> Contract w s e () -grab r = do +grab n = do utxos <- utxoAt scrAddress let orefs = fst <$> Map.toList utxos lookups = Constraints.unspentOutputs utxos <> Constraints.otherScript validator tx :: TxConstraints Void Void - tx = mconcat [mustSpendScriptOutput oref $ Redeemer $ I r | oref <- orefs] + tx = mconcat [mustSpendScriptOutput oref $ Redeemer $ I n | oref <- orefs] ledgerTx <- submitTxConstraintsWith @Void lookups tx void $ awaitTxConfirmed $ txId ledgerTx logInfo @String $ "collected gifts" diff --git a/code/week02/src/Week02/Gift.hs b/code/week02/src/Week02/Gift.hs index c03d3ab..ba76947 100644 --- a/code/week02/src/Week02/Gift.hs +++ b/code/week02/src/Week02/Gift.hs @@ -24,6 +24,8 @@ import Ledger.Ada as Ada import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage) import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) import Playground.Types (KnownCurrency (..)) +import Prelude (IO, Semigroup (..), String) +import Text.Printf (printf) {-# OPTIONS_GHC -fno-warn-unused-imports #-} @@ -40,46 +42,6 @@ valHash = Scripts.validatorHash validator scrAddress :: Ledger.Address scrAddress = scriptAddress validator - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -{- -{-# INLINABLE mkValidator #-} -mkValidator :: Data -> Data -> Data -> () -mkValidator _ _ _ = () - -validator :: Validator -validator = mkValidatorScript $$(PlutusTx.compile [|| mkValidator ||]) - type GiftSchema = Endpoint "give" Integer .\/ Endpoint "grab" () @@ -112,4 +74,3 @@ endpoints = (give' `select` grab') >> endpoints mkSchemaDefinitions ''GiftSchema mkKnownCurrencies [] --} diff --git a/code/week02/src/Week02/Homework1.hs b/code/week02/src/Week02/Homework1.hs index 8a5ac8b..d5a3acf 100644 --- a/code/week02/src/Week02/Homework1.hs +++ b/code/week02/src/Week02/Homework1.hs @@ -26,7 +26,7 @@ import Ledger.Ada as Ada import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage) import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) import Playground.Types (KnownCurrency (..)) -import Prelude (Semigroup (..), String, undefined) +import Prelude (IO, Semigroup (..), String, undefined) import Text.Printf (printf) {-# INLINABLE mkValidator #-} diff --git a/code/week02/src/Week02/Homework2.hs b/code/week02/src/Week02/Homework2.hs index 0e24a99..454376b 100644 --- a/code/week02/src/Week02/Homework2.hs +++ b/code/week02/src/Week02/Homework2.hs @@ -30,7 +30,7 @@ import Ledger.Ada as Ada import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema) import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) import Playground.Types (KnownCurrency (..)) -import Prelude (Semigroup (..), String, undefined) +import Prelude (IO, Semigroup (..), String, undefined) import Text.Printf (printf) data MyRedeemer = MyRedeemer diff --git a/code/week02/src/Week02/IsData.hs b/code/week02/src/Week02/IsData.hs index dd94d82..0842f5d 100644 --- a/code/week02/src/Week02/IsData.hs +++ b/code/week02/src/Week02/IsData.hs @@ -17,6 +17,7 @@ import Data.Map as Map import Data.Text (Text) import Data.Void (Void) import Plutus.Contract +import PlutusTx (Data (..)) import qualified PlutusTx import PlutusTx.Prelude hiding (Semigroup(..), unless) import Ledger hiding (singleton) @@ -26,17 +27,16 @@ import Ledger.Ada as Ada import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage) import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) import Playground.Types (KnownCurrency (..)) -import Prelude (Semigroup (..), Show, String) +import Prelude (IO, Semigroup (..), String) import Text.Printf (printf) newtype MySillyRedeemer = MySillyRedeemer Integer - deriving Show PlutusTx.unstableMakeIsData ''MySillyRedeemer {-# INLINABLE mkValidator #-} mkValidator :: () -> MySillyRedeemer -> ScriptContext -> Bool -mkValidator () (MySillyRedeemer r) _ = traceIfFalse "wrong redeemer" $ r == 42 +mkValidator _ (MySillyRedeemer r) _ = traceIfFalse "wrong redeemer" $ r == 42 data Typed instance Scripts.ValidatorTypes Typed where @@ -77,7 +77,7 @@ grab r = do lookups = Constraints.unspentOutputs utxos <> Constraints.otherScript validator tx :: TxConstraints Void Void - tx = mconcat [mustSpendScriptOutput oref $ Redeemer $ PlutusTx.toData $ MySillyRedeemer r | oref <- orefs] + tx = mconcat [mustSpendScriptOutput oref $ Redeemer $ PlutusTx.toData (MySillyRedeemer r) | oref <- orefs] ledgerTx <- submitTxConstraintsWith @Void lookups tx void $ awaitTxConfirmed $ txId ledgerTx logInfo @String $ "collected gifts" diff --git a/code/week02/src/Week02/Solution1.hs b/code/week02/src/Week02/Solution1.hs index cbd44a5..06be1c1 100644 --- a/code/week02/src/Week02/Solution1.hs +++ b/code/week02/src/Week02/Solution1.hs @@ -28,7 +28,7 @@ import Ledger.Ada as Ada import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage) import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) import Playground.Types (KnownCurrency (..)) -import Prelude (Semigroup (..), String) +import Prelude (IO, Semigroup (..), String) import Text.Printf (printf) {-# INLINABLE mkValidator #-} diff --git a/code/week02/src/Week02/Solution2.hs b/code/week02/src/Week02/Solution2.hs index c520dbe..f9d1762 100644 --- a/code/week02/src/Week02/Solution2.hs +++ b/code/week02/src/Week02/Solution2.hs @@ -30,7 +30,7 @@ import Ledger.Ada as Ada import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema) import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) import Playground.Types (KnownCurrency (..)) -import Prelude (Semigroup (..), String) +import Prelude (IO, Semigroup (..), String) import Text.Printf (printf) data MyRedeemer = MyRedeemer diff --git a/code/week02/src/Week02/Typed.hs b/code/week02/src/Week02/Typed.hs index 43060cd..f25db58 100644 --- a/code/week02/src/Week02/Typed.hs +++ b/code/week02/src/Week02/Typed.hs @@ -27,14 +27,12 @@ import Ledger.Ada as Ada import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage) import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) import Playground.Types (KnownCurrency (..)) -import Prelude (Semigroup (..), String) +import Prelude (IO, Semigroup (..), String) import Text.Printf (printf) {-# INLINABLE mkValidator #-} mkValidator :: () -> Integer -> ScriptContext -> Bool -mkValidator () r _ - | r == 42 = True - | otherwise = False +mkValidator _ r _ = traceIfFalse "wrong redeemer" $ r == 42 data Typed instance Scripts.ValidatorTypes Typed where