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

removed solutions

Browse source
This commit is contained in:
Lars Brünjes 2021-07-26 13:28:33 +02:00
parent 9ceb857686
commit d2cea67331
No known key found for this signature in database
GPG key ID: B488B9045DC1A087
3 changed files with 0 additions and 200 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

@ -15,8 +15,6 @@ library
, Week05.Homework2 , Week05.Homework2
, Week05.NFT , Week05.NFT
, Week05.Signed , Week05.Signed
, Week05.Solution1
, Week05.Solution2
build-depends: aeson build-depends: aeson
, base ^>=4.14.1.0 , base ^>=4.14.1.0
, containers , containers

104
code/week05/src/Week05/Solution1.hs
View file

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

94
code/week05/src/Week05/Solution2.hs
View file

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