mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-24 15:52:00 +01:00
first draft for week #2
This commit is contained in:
parent
a024fb915c
commit
4a09b7e692
10 changed files with 31 additions and 60 deletions
12
README.md
12
README.md
|
@ -12,9 +12,16 @@
|
||||||
- Running an example auction contract on a local Playground.
|
- Running an example auction contract on a local Playground.
|
||||||
- Homework.
|
- Homework.
|
||||||
|
|
||||||
|
- [Lecture #2]()
|
||||||
|
|
||||||
|
- Triggering change.
|
||||||
|
- Low-level, untyped on-chain validation scripts.
|
||||||
|
- High-level, typed on-chain validation scripts.
|
||||||
|
|
||||||
## Code Examples
|
## Code Examples
|
||||||
|
|
||||||
- Lecture #1: [English Auction](code/week01)
|
- Lecture #1: [English Auction](code/week01)
|
||||||
|
- Lecture #2: [Simple validation](code/week02)
|
||||||
|
|
||||||
## Exercises
|
## Exercises
|
||||||
|
|
||||||
|
@ -32,6 +39,11 @@
|
||||||
- Compile.
|
- Compile.
|
||||||
- Simulate various auction scenarios.
|
- 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
|
## 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.
|
- [`Language.Marlowe.Semantics`](https://github.com/input-output-hk/plutus/blob/master/marlowe/src/Language/Marlowe/Semantics.hs), contains Marlowe types and semantics.
|
||||||
|
|
|
@ -8,8 +8,6 @@
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
|
|
||||||
|
|
||||||
module Week02.Burn where
|
module Week02.Burn where
|
||||||
|
|
||||||
import Control.Monad hiding (fmap)
|
import Control.Monad hiding (fmap)
|
||||||
|
@ -27,12 +25,14 @@ import Ledger.Ada as Ada
|
||||||
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
|
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
|
||||||
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
||||||
import Playground.Types (KnownCurrency (..))
|
import Playground.Types (KnownCurrency (..))
|
||||||
import Prelude (Semigroup (..), String)
|
import Prelude (IO, Semigroup (..), String)
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
|
||||||
|
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
|
||||||
|
|
||||||
{-# INLINABLE mkValidator #-}
|
{-# INLINABLE mkValidator #-}
|
||||||
mkValidator :: Data -> Data -> Data -> ()
|
mkValidator :: Data -> Data -> Data -> ()
|
||||||
mkValidator _ _ _ = traceError "NO WAY!"
|
mkValidator _ _ _ = traceError "BURNT!"
|
||||||
|
|
||||||
validator :: Validator
|
validator :: Validator
|
||||||
validator = mkValidatorScript $$(PlutusTx.compile [|| mkValidator ||])
|
validator = mkValidatorScript $$(PlutusTx.compile [|| mkValidator ||])
|
||||||
|
|
|
@ -25,7 +25,7 @@ import Ledger.Ada as Ada
|
||||||
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
|
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
|
||||||
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
||||||
import Playground.Types (KnownCurrency (..))
|
import Playground.Types (KnownCurrency (..))
|
||||||
import Prelude (Semigroup (..), String)
|
import Prelude (IO, Semigroup (..), String)
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
|
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
|
||||||
|
@ -57,13 +57,13 @@ give amount = do
|
||||||
logInfo @String $ printf "made a gift of %d lovelace" amount
|
logInfo @String $ printf "made a gift of %d lovelace" amount
|
||||||
|
|
||||||
grab :: forall w s e. AsContractError e => Integer -> Contract w s e ()
|
grab :: forall w s e. AsContractError e => Integer -> Contract w s e ()
|
||||||
grab r = do
|
grab n = do
|
||||||
utxos <- utxoAt scrAddress
|
utxos <- utxoAt scrAddress
|
||||||
let orefs = fst <$> Map.toList utxos
|
let orefs = fst <$> Map.toList utxos
|
||||||
lookups = Constraints.unspentOutputs utxos <>
|
lookups = Constraints.unspentOutputs utxos <>
|
||||||
Constraints.otherScript validator
|
Constraints.otherScript validator
|
||||||
tx :: TxConstraints Void Void
|
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
|
ledgerTx <- submitTxConstraintsWith @Void lookups tx
|
||||||
void $ awaitTxConfirmed $ txId ledgerTx
|
void $ awaitTxConfirmed $ txId ledgerTx
|
||||||
logInfo @String $ "collected gifts"
|
logInfo @String $ "collected gifts"
|
||||||
|
|
|
@ -24,6 +24,8 @@ import Ledger.Ada as Ada
|
||||||
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
|
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
|
||||||
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
||||||
import Playground.Types (KnownCurrency (..))
|
import Playground.Types (KnownCurrency (..))
|
||||||
|
import Prelude (IO, Semigroup (..), String)
|
||||||
|
import Text.Printf (printf)
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
|
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
|
||||||
|
|
||||||
|
@ -40,46 +42,6 @@ valHash = Scripts.validatorHash validator
|
||||||
scrAddress :: Ledger.Address
|
scrAddress :: Ledger.Address
|
||||||
scrAddress = scriptAddress validator
|
scrAddress = scriptAddress validator
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
{-
|
|
||||||
{-# INLINABLE mkValidator #-}
|
|
||||||
mkValidator :: Data -> Data -> Data -> ()
|
|
||||||
mkValidator _ _ _ = ()
|
|
||||||
|
|
||||||
validator :: Validator
|
|
||||||
validator = mkValidatorScript $$(PlutusTx.compile [|| mkValidator ||])
|
|
||||||
|
|
||||||
type GiftSchema =
|
type GiftSchema =
|
||||||
Endpoint "give" Integer
|
Endpoint "give" Integer
|
||||||
.\/ Endpoint "grab" ()
|
.\/ Endpoint "grab" ()
|
||||||
|
@ -112,4 +74,3 @@ endpoints = (give' `select` grab') >> endpoints
|
||||||
mkSchemaDefinitions ''GiftSchema
|
mkSchemaDefinitions ''GiftSchema
|
||||||
|
|
||||||
mkKnownCurrencies []
|
mkKnownCurrencies []
|
||||||
-}
|
|
||||||
|
|
|
@ -26,7 +26,7 @@ import Ledger.Ada as Ada
|
||||||
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
|
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
|
||||||
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
||||||
import Playground.Types (KnownCurrency (..))
|
import Playground.Types (KnownCurrency (..))
|
||||||
import Prelude (Semigroup (..), String, undefined)
|
import Prelude (IO, Semigroup (..), String, undefined)
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
|
||||||
{-# INLINABLE mkValidator #-}
|
{-# INLINABLE mkValidator #-}
|
||||||
|
|
|
@ -30,7 +30,7 @@ import Ledger.Ada as Ada
|
||||||
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema)
|
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema)
|
||||||
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
||||||
import Playground.Types (KnownCurrency (..))
|
import Playground.Types (KnownCurrency (..))
|
||||||
import Prelude (Semigroup (..), String, undefined)
|
import Prelude (IO, Semigroup (..), String, undefined)
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
|
||||||
data MyRedeemer = MyRedeemer
|
data MyRedeemer = MyRedeemer
|
||||||
|
|
|
@ -17,6 +17,7 @@ import Data.Map as Map
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Void (Void)
|
import Data.Void (Void)
|
||||||
import Plutus.Contract
|
import Plutus.Contract
|
||||||
|
import PlutusTx (Data (..))
|
||||||
import qualified PlutusTx
|
import qualified PlutusTx
|
||||||
import PlutusTx.Prelude hiding (Semigroup(..), unless)
|
import PlutusTx.Prelude hiding (Semigroup(..), unless)
|
||||||
import Ledger hiding (singleton)
|
import Ledger hiding (singleton)
|
||||||
|
@ -26,17 +27,16 @@ import Ledger.Ada as Ada
|
||||||
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
|
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
|
||||||
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
||||||
import Playground.Types (KnownCurrency (..))
|
import Playground.Types (KnownCurrency (..))
|
||||||
import Prelude (Semigroup (..), Show, String)
|
import Prelude (IO, Semigroup (..), String)
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
|
||||||
newtype MySillyRedeemer = MySillyRedeemer Integer
|
newtype MySillyRedeemer = MySillyRedeemer Integer
|
||||||
deriving Show
|
|
||||||
|
|
||||||
PlutusTx.unstableMakeIsData ''MySillyRedeemer
|
PlutusTx.unstableMakeIsData ''MySillyRedeemer
|
||||||
|
|
||||||
{-# INLINABLE mkValidator #-}
|
{-# INLINABLE mkValidator #-}
|
||||||
mkValidator :: () -> MySillyRedeemer -> ScriptContext -> Bool
|
mkValidator :: () -> MySillyRedeemer -> ScriptContext -> Bool
|
||||||
mkValidator () (MySillyRedeemer r) _ = traceIfFalse "wrong redeemer" $ r == 42
|
mkValidator _ (MySillyRedeemer r) _ = traceIfFalse "wrong redeemer" $ r == 42
|
||||||
|
|
||||||
data Typed
|
data Typed
|
||||||
instance Scripts.ValidatorTypes Typed where
|
instance Scripts.ValidatorTypes Typed where
|
||||||
|
@ -77,7 +77,7 @@ grab r = do
|
||||||
lookups = Constraints.unspentOutputs utxos <>
|
lookups = Constraints.unspentOutputs utxos <>
|
||||||
Constraints.otherScript validator
|
Constraints.otherScript validator
|
||||||
tx :: TxConstraints Void Void
|
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
|
ledgerTx <- submitTxConstraintsWith @Void lookups tx
|
||||||
void $ awaitTxConfirmed $ txId ledgerTx
|
void $ awaitTxConfirmed $ txId ledgerTx
|
||||||
logInfo @String $ "collected gifts"
|
logInfo @String $ "collected gifts"
|
||||||
|
|
|
@ -28,7 +28,7 @@ import Ledger.Ada as Ada
|
||||||
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
|
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
|
||||||
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
||||||
import Playground.Types (KnownCurrency (..))
|
import Playground.Types (KnownCurrency (..))
|
||||||
import Prelude (Semigroup (..), String)
|
import Prelude (IO, Semigroup (..), String)
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
|
||||||
{-# INLINABLE mkValidator #-}
|
{-# INLINABLE mkValidator #-}
|
||||||
|
|
|
@ -30,7 +30,7 @@ import Ledger.Ada as Ada
|
||||||
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema)
|
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema)
|
||||||
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
||||||
import Playground.Types (KnownCurrency (..))
|
import Playground.Types (KnownCurrency (..))
|
||||||
import Prelude (Semigroup (..), String)
|
import Prelude (IO, Semigroup (..), String)
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
|
||||||
data MyRedeemer = MyRedeemer
|
data MyRedeemer = MyRedeemer
|
||||||
|
|
|
@ -27,14 +27,12 @@ import Ledger.Ada as Ada
|
||||||
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
|
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
|
||||||
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
||||||
import Playground.Types (KnownCurrency (..))
|
import Playground.Types (KnownCurrency (..))
|
||||||
import Prelude (Semigroup (..), String)
|
import Prelude (IO, Semigroup (..), String)
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
|
||||||
{-# INLINABLE mkValidator #-}
|
{-# INLINABLE mkValidator #-}
|
||||||
mkValidator :: () -> Integer -> ScriptContext -> Bool
|
mkValidator :: () -> Integer -> ScriptContext -> Bool
|
||||||
mkValidator () r _
|
mkValidator _ r _ = traceIfFalse "wrong redeemer" $ r == 42
|
||||||
| r == 42 = True
|
|
||||||
| otherwise = False
|
|
||||||
|
|
||||||
data Typed
|
data Typed
|
||||||
instance Scripts.ValidatorTypes Typed where
|
instance Scripts.ValidatorTypes Typed where
|
||||||
|
|
Loading…
Reference in a new issue