diff --git a/code/week05/plutus-pioneer-program-week05.cabal b/code/week05/plutus-pioneer-program-week05.cabal index b96677d..a953b99 100644 --- a/code/week05/plutus-pioneer-program-week05.cabal +++ b/code/week05/plutus-pioneer-program-week05.cabal @@ -11,6 +11,7 @@ License-files: LICENSE library hs-source-dirs: src exposed-modules: Week05.Free + , Week05.Signed build-depends: aeson , base ^>=4.14.1.0 , containers diff --git a/code/week05/src/Week05/Free.hs b/code/week05/src/Week05/Free.hs index 4904453..be7a3b9 100644 --- a/code/week05/src/Week05/Free.hs +++ b/code/week05/src/Week05/Free.hs @@ -32,12 +32,12 @@ import Playground.Types (KnownCurrency (..)) import Text.Printf (printf) import Wallet.Emulator.Wallet -{-# INLINABLE mkValidator #-} -mkValidator :: ScriptContext -> Bool -mkValidator _ = True +{-# INLINABLE mkPolicy #-} +mkPolicy :: ScriptContext -> Bool +mkPolicy _ = True policy :: Scripts.MonetaryPolicy -policy = mkMonetaryPolicyScript $$(PlutusTx.compile [|| Scripts.wrapMonetaryPolicy mkValidator ||]) +policy = mkMonetaryPolicyScript $$(PlutusTx.compile [|| Scripts.wrapMonetaryPolicy mkPolicy ||]) curSymbol :: CurrencySymbol curSymbol = scriptCurrencySymbol policy diff --git a/code/week05/src/Week05/Signed.hs b/code/week05/src/Week05/Signed.hs new file mode 100644 index 0000000..0c08d94 --- /dev/null +++ b/code/week05/src/Week05/Signed.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Week05.Signed where + +import Control.Monad hiding (fmap) +import Control.Monad.Freer.Extras as Extras +import Data.Aeson (ToJSON, FromJSON) +import Data.Text (Text) +import Data.Void (Void) +import GHC.Generics (Generic) +import Plutus.Contract as Contract hiding (when) +import Plutus.Trace.Emulator as Emulator +import qualified PlutusTx +import PlutusTx.Prelude hiding (Semigroup(..), unless) +import Ledger hiding (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 Text.Printf (printf) +import Wallet.Emulator.Wallet + +{-# INLINABLE mkPolicy #-} +mkPolicy :: PubKeyHash -> ScriptContext -> Bool +mkPolicy pkh ctx = txSignedBy (scriptContextTxInfo ctx) pkh + +policy :: PubKeyHash -> Scripts.MonetaryPolicy +policy pkh = mkMonetaryPolicyScript $ + $$(PlutusTx.compile [|| Scripts.wrapMonetaryPolicy . mkPolicy ||]) + `PlutusTx.applyCode` + PlutusTx.liftCode pkh + +curSymbol :: PubKeyHash -> CurrencySymbol +curSymbol = scriptCurrencySymbol . policy + +data MintParams = MintParams + { mpTokenName :: !TokenName + , mpAmount :: !Integer + } deriving (Generic, ToJSON, FromJSON, ToSchema) + +type SignedSchema = + BlockchainActions + .\/ Endpoint "mint" MintParams + +mint :: (HasBlockchainActions s, AsContractError e) => MintParams -> Contract w s e () +mint mp = do + pkh <- pubKeyHash <$> Contract.ownPubKey + let val = Value.singleton (curSymbol pkh) (mpTokenName mp) (mpAmount mp) + lookups = Constraints.monetaryPolicy $ policy pkh + tx = Constraints.mustForgeValue val + 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" + h1 <- activateContractWallet (Wallet 1) endpoints + h2 <- activateContractWallet (Wallet 2) endpoints + callEndpoint @"mint" h1 $ MintParams + { mpTokenName = tn + , mpAmount = 555 + } + callEndpoint @"mint" h2 $ MintParams + { mpTokenName = tn + , mpAmount = 444 + } + void $ Emulator.waitNSlots 1 + callEndpoint @"mint" h1 $ MintParams + { mpTokenName = tn + , mpAmount = -222 + } + void $ Emulator.waitNSlots 1