From dfbfb3d733dfb8a3f46458381103d4eb627a3685 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lars=20Br=C3=BCnjes?= Date: Tue, 4 May 2021 23:07:19 +0200 Subject: [PATCH] finished week 5 --- .../plutus-pioneer-program-week05.cabal | 2 + code/week05/src/Week05/Free.hs | 33 +++---- code/week05/src/Week05/Homework1.hs | 98 +++++++++++++++++++ code/week05/src/Week05/Homework2.hs | 68 +++++++++++++ code/week05/src/Week05/NFT.hs | 35 +++---- 5 files changed, 200 insertions(+), 36 deletions(-) create mode 100644 code/week05/src/Week05/Homework1.hs create mode 100644 code/week05/src/Week05/Homework2.hs diff --git a/code/week05/plutus-pioneer-program-week05.cabal b/code/week05/plutus-pioneer-program-week05.cabal index 4fdcf12..4151025 100644 --- a/code/week05/plutus-pioneer-program-week05.cabal +++ b/code/week05/plutus-pioneer-program-week05.cabal @@ -11,6 +11,8 @@ License-files: LICENSE library hs-source-dirs: src exposed-modules: Week05.Free + , Week05.Homework1 + , Week05.Homework2 , Week05.NFT , Week05.Signed build-depends: aeson diff --git a/code/week05/src/Week05/Free.hs b/code/week05/src/Week05/Free.hs index 58f2c52..dae6f81 100644 --- a/code/week05/src/Week05/Free.hs +++ b/code/week05/src/Week05/Free.hs @@ -12,24 +12,23 @@ module Week05.Free where -import Control.Monad hiding (fmap) -import Control.Monad.Freer.Extras as Extras -import Data.Aeson (ToJSON, FromJSON) -import Data.Text (Text) -import Data.Void (Void) -import GHC.Generics (Generic) -import Plutus.Contract as Contract hiding (when) -import Plutus.Trace.Emulator as Emulator +import Control.Monad hiding (fmap) +import Data.Aeson (ToJSON, FromJSON) +import Data.Text (Text) +import Data.Void (Void) +import GHC.Generics (Generic) +import Plutus.Contract as Contract hiding (when) +import Plutus.Trace.Emulator as Emulator import qualified PlutusTx -import PlutusTx.Prelude hiding (Semigroup(..), unless) -import Ledger hiding (singleton) -import Ledger.Constraints as Constraints -import qualified Ledger.Typed.Scripts as Scripts -import Ledger.Value as Value -import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema) -import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) -import Playground.Types (KnownCurrency (..)) -import Text.Printf (printf) +import PlutusTx.Prelude hiding (Semigroup(..), unless) +import Ledger hiding (singleton) +import Ledger.Constraints as Constraints +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value as Value +import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema) +import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) +import Playground.Types (KnownCurrency (..)) +import Text.Printf (printf) import Wallet.Emulator.Wallet {-# INLINABLE mkPolicy #-} diff --git a/code/week05/src/Week05/Homework1.hs b/code/week05/src/Week05/Homework1.hs new file mode 100644 index 0000000..441eddc --- /dev/null +++ b/code/week05/src/Week05/Homework1.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Week05.Homework1 where + +import Control.Monad hiding (fmap) +import Control.Monad.Freer.Extras as Extras +import Data.Aeson (ToJSON, FromJSON) +import Data.Text (Text) +import Data.Void (Void) +import GHC.Generics (Generic) +import Plutus.Contract as Contract hiding (when) +import Plutus.Trace.Emulator as Emulator +import qualified PlutusTx +import PlutusTx.Prelude hiding (Semigroup(..), unless) +import Ledger hiding (singleton) +import Ledger.Constraints as Constraints +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value as Value +import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema) +import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) +import Playground.Types (KnownCurrency (..)) +import Prelude (Semigroup (..)) +import Text.Printf (printf) +import Wallet.Emulator.Wallet + +{-# INLINABLE mkPolicy #-} +-- This policy should only allow minting (or burning) of tokens if the owner of the specified PubKeyHash +-- has signed the transaction and if the specified deadline has not passed. +mkPolicy :: PubKeyHash -> Slot -> ScriptContext -> Bool +mkPolicy pkh deadline ctx = True -- FIX ME! + +policy :: PubKeyHash -> Slot -> Scripts.MonetaryPolicy +policy pkh deadline = undefined -- IMPLEMENT ME! + +curSymbol :: PubKeyHash -> Slot -> CurrencySymbol +curSymbol pkh deadline = undefined -- IMPLEMENT ME! + +data MintParams = MintParams + { mpTokenName :: !TokenName + , mpDeadline :: !Slot + , mpAmount :: !Integer + } deriving (Generic, ToJSON, FromJSON, ToSchema) + +type SignedSchema = + BlockchainActions + .\/ Endpoint "mint" MintParams + +mint :: MintParams -> Contract w SignedSchema Text () +mint mp = do + pkh <- pubKeyHash <$> Contract.ownPubKey + now <- Contract.currentSlot + let deadline = mpDeadline mp + if now > deadline + then Contract.logError @String "deadline passed" + else do + let val = Value.singleton (curSymbol pkh deadline) (mpTokenName mp) (mpAmount mp) + lookups = Constraints.monetaryPolicy $ policy pkh deadline + tx = Constraints.mustForgeValue val <> Constraints.mustValidateIn (to deadline) + ledgerTx <- submitTxConstraintsWith @Void lookups tx + void $ awaitTxConfirmed $ txId ledgerTx + Contract.logInfo @String $ printf "forged %s" (show val) + +endpoints :: Contract () SignedSchema Text () +endpoints = mint' >> endpoints + where + mint' = endpoint @"mint" >>= mint + +mkSchemaDefinitions ''SignedSchema + +mkKnownCurrencies [] + +test :: IO () +test = runEmulatorTraceIO $ do + let tn = "ABC" + deadline = 10 + h <- activateContractWallet (Wallet 1) endpoints + callEndpoint @"mint" h $ MintParams + { mpTokenName = tn + , mpDeadline = deadline + , mpAmount = 555 + } + void $ Emulator.waitNSlots 15 + callEndpoint @"mint" h $ MintParams + { mpTokenName = tn + , mpDeadline = deadline + , mpAmount = 555 + } + void $ Emulator.waitNSlots 1 diff --git a/code/week05/src/Week05/Homework2.hs b/code/week05/src/Week05/Homework2.hs new file mode 100644 index 0000000..8c17333 --- /dev/null +++ b/code/week05/src/Week05/Homework2.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Week05.Homework2 where + +import Control.Monad hiding (fmap) +import qualified Data.Map as Map +import Data.Text (Text) +import Data.Void (Void) +import Plutus.Contract as Contract hiding (when) +import Plutus.Trace.Emulator as Emulator +import qualified PlutusTx +import PlutusTx.Prelude hiding (Semigroup(..), unless) +import Ledger hiding (singleton) +import Ledger.Constraints as Constraints +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value as Value +import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema) +import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) +import Playground.Types (KnownCurrency (..)) +import Prelude (Semigroup (..)) +import Text.Printf (printf) +import Wallet.Emulator.Wallet + +{-# INLINABLE mkPolicy #-} +-- Minting policy for an NFT, where the minting transaction must consume the given UTxO as input +-- and where the TokenName will be the empty ByteString. +mkPolicy :: TxOutRef -> ScriptContext -> Bool +mkPolicy oref ctx = True -- FIX ME! + +policy :: TxOutRef -> Scripts.MonetaryPolicy +policy oref = undefined -- IMPLEMENT ME! + +curSymbol :: TxOutRef -> CurrencySymbol +curSymbol = undefined -- IMPLEMENT ME! + +type NFTSchema = + BlockchainActions + .\/ Endpoint "mint" () + +mint :: Contract w NFTSchema Text () +mint = undefined -- IMPLEMENT ME! + +endpoints :: Contract () NFTSchema Text () +endpoints = mint' >> endpoints + where + mint' = endpoint @"mint" >> mint + +mkSchemaDefinitions ''NFTSchema + +mkKnownCurrencies [] + +test :: IO () +test = runEmulatorTraceIO $ do + h1 <- activateContractWallet (Wallet 1) endpoints + h2 <- activateContractWallet (Wallet 2) endpoints + callEndpoint @"mint" h1 () + callEndpoint @"mint" h2 () + void $ Emulator.waitNSlots 1 diff --git a/code/week05/src/Week05/NFT.hs b/code/week05/src/Week05/NFT.hs index 6b3caa8..5f518b4 100644 --- a/code/week05/src/Week05/NFT.hs +++ b/code/week05/src/Week05/NFT.hs @@ -12,26 +12,23 @@ module Week05.NFT where -import Control.Monad hiding (fmap) -import Control.Monad.Freer.Extras as Extras -import Data.Aeson (ToJSON, FromJSON) -import qualified Data.Map as Map -import Data.Text (Text) -import Data.Void (Void) -import GHC.Generics (Generic) -import Plutus.Contract as Contract hiding (when) -import Plutus.Trace.Emulator as Emulator +import Control.Monad hiding (fmap) +import qualified Data.Map as Map +import Data.Text (Text) +import Data.Void (Void) +import Plutus.Contract as Contract hiding (when) +import Plutus.Trace.Emulator as Emulator import qualified PlutusTx -import PlutusTx.Prelude hiding (Semigroup(..), unless) -import Ledger hiding (singleton) -import Ledger.Constraints as Constraints -import qualified Ledger.Typed.Scripts as Scripts -import Ledger.Value as Value -import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema) -import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) -import Playground.Types (KnownCurrency (..)) -import Prelude (Semigroup (..)) -import Text.Printf (printf) +import PlutusTx.Prelude hiding (Semigroup(..), unless) +import Ledger hiding (singleton) +import Ledger.Constraints as Constraints +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value as Value +import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema) +import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) +import Playground.Types (KnownCurrency (..)) +import Prelude (Semigroup (..)) +import Text.Printf (printf) import Wallet.Emulator.Wallet {-# INLINABLE mkPolicy #-}