claudiomaradonna/plutus-pioneer-program
1
0
Fork 0
mirror of https://github.com/FiloSpaTeam/plutus-pioneer-program.git synced 2024-11-14 02:42:35 +01:00
Code Issues Projects Releases Packages Wiki Activity

finished week 5

Browse source
This commit is contained in:
Lars Brünjes 2021-05-04 23:07:19 +02:00
parent 86c61c3592
commit dfbfb3d733
No known key found for this signature in database
GPG key ID: B488B9045DC1A087
5 changed files with 200 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
code/week05/plutus-pioneer-program-week05.cabal
View file

@ -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

1
code/week05/src/Week05/Free.hs
View file

@ -13,7 +13,6 @@
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)

98
code/week05/src/Week05/Homework1.hs Normal file
View file

@ -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

68
code/week05/src/Week05/Homework2.hs Normal file
View file

@ -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

3
code/week05/src/Week05/NFT.hs
View file

@ -13,12 +13,9 @@
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 qualified PlutusTx