week05 Homeworks

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.

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

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