mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-27 01:02:00 +01:00
week05 Homeworks
This commit is contained in:
parent
a1ff9ba5ee
commit
86544ad846
3 changed files with 53 additions and 8 deletions
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue