From 86544ad8467cfa49929d6b21a607f3f7b389674a Mon Sep 17 00:00:00 2001 From: Claudio Maradonna Date: Sat, 31 Jul 2021 18:18:04 +0200 Subject: [PATCH] week05 Homeworks --- code/week05/cabal.project | 2 +- code/week05/src/Week05/Homework1.hs | 21 +++++++++++++--- code/week05/src/Week05/Homework2.hs | 38 ++++++++++++++++++++++++++--- 3 files changed, 53 insertions(+), 8 deletions(-) diff --git a/code/week05/cabal.project b/code/week05/cabal.project index edb0757..a5b9faf 100644 --- a/code/week05/cabal.project +++ b/code/week05/cabal.project @@ -25,7 +25,7 @@ source-repository-package prettyprinter-configurable quickcheck-dynamic word-array - tag: 8f1a47674a99ac9bc2aba3231375d8d6de0641d2 + tag: 8a20664f00d8f396920385947903761a9a897fe0 -- The following sections are copied from the 'plutus' repository cabal.project at the revision -- given above. diff --git a/code/week05/src/Week05/Homework1.hs b/code/week05/src/Week05/Homework1.hs index c391be6..d8acc17 100644 --- a/code/week05/src/Week05/Homework1.hs +++ b/code/week05/src/Week05/Homework1.hs @@ -39,13 +39,28 @@ import Wallet.Emulator.Wallet -- 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 -> POSIXTime -> () -> ScriptContext -> Bool -mkPolicy pkh deadline () ctx = True -- FIX ME! +mkPolicy pkh deadline () ctx = traceIfFalse "not signed the transaction" txSigned && + traceIfFalse "deadline has passed" deadlineValid + where + info :: TxInfo + info = scriptContextTxInfo ctx + + txSigned :: Bool + txSigned = txSignedBy info pkh + + deadlineValid :: Bool + deadlineValid = contains (to $ deadline) $ txInfoValidRange info policy :: PubKeyHash -> POSIXTime -> Scripts.MintingPolicy -policy pkh deadline = undefined -- IMPLEMENT ME! +policy pkh deadline = mkMintingPolicyScript $ + $$(PlutusTx.compile [|| \pkh' deadline' -> Scripts.wrapMintingPolicy $ mkPolicy pkh' deadline' ||]) + `PlutusTx.applyCode` + (PlutusTx.liftCode pkh) + `PlutusTx.applyCode` + (PlutusTx.liftCode deadline) curSymbol :: PubKeyHash -> POSIXTime -> CurrencySymbol -curSymbol pkh deadline = undefined -- IMPLEMENT ME! +curSymbol pkh deadline = scriptCurrencySymbol $ policy pkh deadline data MintParams = MintParams { mpTokenName :: !TokenName diff --git a/code/week05/src/Week05/Homework2.hs b/code/week05/src/Week05/Homework2.hs index fbbd61b..8f5e918 100644 --- a/code/week05/src/Week05/Homework2.hs +++ b/code/week05/src/Week05/Homework2.hs @@ -31,22 +31,52 @@ import Prelude (IO, Semigroup (..), Show (..), String, import Text.Printf (printf) import Wallet.Emulator.Wallet +{-# INLINABLE tn #-} +tn :: TokenName +tn = TokenName emptyByteString + {-# 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! +mkPolicy oref () ctx = traceIfFalse "UTxO not consumed" utxoConsumed && + traceIfFalse "minted amount is wrong" checkAmount + where + info :: TxInfo + info = scriptContextTxInfo ctx + + utxoConsumed :: Bool + utxoConsumed = any (\i -> txInInfoOutRef i == oref) $ txInfoInputs info + + checkAmount :: Bool + checkAmount = case flattenValue (txInfoForge info) of + [(cs, tn', amt)] -> cs == ownCurrencySymbol ctx && tn' == tn && amt == 1 + _ -> False policy :: TxOutRef -> Scripts.MintingPolicy -policy oref = undefined -- IMPLEMENT ME! +policy oref = mkMintingPolicyScript $ + $$(PlutusTx.compile [|| \oref' -> Scripts.wrapMintingPolicy $ mkPolicy oref' ||]) + `PlutusTx.applyCode` + PlutusTx.liftCode oref curSymbol :: TxOutRef -> CurrencySymbol -curSymbol = undefined -- IMPLEMENT ME! +curSymbol = scriptCurrencySymbol . policy type NFTSchema = Endpoint "mint" () mint :: Contract w NFTSchema Text () -mint = undefined -- IMPLEMENT ME! +mint = do + pk <- Contract.ownPubKey + utxos <- utxoAt (pubKeyAddress pk) + case Map.keys utxos of + [] -> Contract.logError @String "no utxo found" + oref : _ -> do + let val = Value.singleton (curSymbol oref) tn 1 + lookups = Constraints.mintingPolicy (policy oref) <> Constraints.unspentOutputs utxos + tx = Constraints.mustMintValue val <> Constraints.mustSpendPubKeyOutput oref + ledgerTx <- submitTxConstraintsWith @Void lookups tx + void $ awaitTxConfirmed $ txId ledgerTx + Contract.logInfo @String $ printf "forged %s" (show val) endpoints :: Contract () NFTSchema Text () endpoints = mint' >> endpoints