From d2cea6733187e935fcde473dacf3109ddfa55063 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lars=20Br=C3=BCnjes?= Date: Mon, 26 Jul 2021 13:28:33 +0200 Subject: [PATCH] removed solutions --- .../plutus-pioneer-program-week05.cabal | 2 - code/week05/src/Week05/Solution1.hs | 104 ------------------ code/week05/src/Week05/Solution2.hs | 94 ---------------- 3 files changed, 200 deletions(-) delete mode 100644 code/week05/src/Week05/Solution1.hs delete mode 100644 code/week05/src/Week05/Solution2.hs diff --git a/code/week05/plutus-pioneer-program-week05.cabal b/code/week05/plutus-pioneer-program-week05.cabal index 2857bee..db80e22 100644 --- a/code/week05/plutus-pioneer-program-week05.cabal +++ b/code/week05/plutus-pioneer-program-week05.cabal @@ -15,8 +15,6 @@ library , Week05.Homework2 , Week05.NFT , Week05.Signed - , Week05.Solution1 - , Week05.Solution2 build-depends: aeson , base ^>=4.14.1.0 , containers diff --git a/code/week05/src/Week05/Solution1.hs b/code/week05/src/Week05/Solution1.hs deleted file mode 100644 index 9fc6cf3..0000000 --- a/code/week05/src/Week05/Solution1.hs +++ /dev/null @@ -1,104 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -module Week05.Solution1 where - -import Control.Monad hiding (fmap) -import Data.Aeson (ToJSON, FromJSON) -import Data.Default (Default (..)) -import Data.Text (Text) -import Data.Void (Void) -import GHC.Generics (Generic) -import Plutus.Contract as Contract -import Plutus.Trace.Emulator as Emulator -import qualified PlutusTx -import PlutusTx.Prelude hiding (Semigroup(..), unless) -import Ledger hiding (mint, singleton) -import Ledger.Constraints as Constraints -import Ledger.TimeSlot -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 (IO, Semigroup (..), Show (..), String) -import Text.Printf (printf) -import Wallet.Emulator.Wallet - -{-# INLINABLE mkPolicy #-} -mkPolicy :: PubKeyHash -> POSIXTime -> () -> ScriptContext -> Bool -mkPolicy pkh deadline () ctx = - traceIfFalse "signature missing" (txSignedBy info pkh) && - traceIfFalse "deadline missed" (to deadline `contains` txInfoValidRange info) - where - info = scriptContextTxInfo ctx - -policy :: PubKeyHash -> POSIXTime -> Scripts.MintingPolicy -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 = scriptCurrencySymbol $ policy pkh deadline - -data MintParams = MintParams - { mpTokenName :: !TokenName - , mpDeadline :: !POSIXTime - , mpAmount :: !Integer - } deriving (Generic, ToJSON, FromJSON, ToSchema) - -type SignedSchema = Endpoint "mint" MintParams - -mint :: MintParams -> Contract w SignedSchema Text () -mint mp = do - pkh <- pubKeyHash <$> Contract.ownPubKey - now <- Contract.currentTime - 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.mintingPolicy $ policy pkh deadline - tx = Constraints.mustMintValue val <> Constraints.mustValidateIn (to $ now + 5000) - 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 = slotToBeginPOSIXTime def 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/Solution2.hs b/code/week05/src/Week05/Solution2.hs deleted file mode 100644 index 5610d70..0000000 --- a/code/week05/src/Week05/Solution2.hs +++ /dev/null @@ -1,94 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -module Week05.Solution2 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 -import Plutus.Trace.Emulator as Emulator -import qualified PlutusTx -import PlutusTx.Prelude hiding (Semigroup(..), unless) -import Ledger hiding (mint, 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 (IO, Semigroup (..), Show (..), String) -import Text.Printf (printf) -import Wallet.Emulator.Wallet - -{-# INLINABLE tn #-} -tn :: TokenName -tn = TokenName emptyByteString - -{-# INLINABLE mkPolicy #-} -mkPolicy :: TxOutRef -> () -> ScriptContext -> Bool -mkPolicy oref () ctx = traceIfFalse "UTxO not consumed" hasUTxO && - traceIfFalse "wrong amount minted" checkMintedAmount - where - info :: TxInfo - info = scriptContextTxInfo ctx - - hasUTxO :: Bool - hasUTxO = any (\i -> txInInfoOutRef i == oref) $ txInfoInputs info - - checkMintedAmount :: Bool - checkMintedAmount = case flattenValue (txInfoForge info) of - [(cs, tn', amt)] -> cs == ownCurrencySymbol ctx && tn' == tn && amt == 1 - _ -> False - -policy :: TxOutRef -> Scripts.MintingPolicy -policy oref = mkMintingPolicyScript $ - $$(PlutusTx.compile [|| Scripts.wrapMintingPolicy . mkPolicy ||]) - `PlutusTx.applyCode` - PlutusTx.liftCode oref - -curSymbol :: TxOutRef -> CurrencySymbol -curSymbol = scriptCurrencySymbol . policy - -type NFTSchema = Endpoint "mint" () - -mint :: Contract w NFTSchema Text () -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 - 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