mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-14 02:42:35 +01:00
added 'Signed'
This commit is contained in:
parent
e7a7e51a2b
commit
63476046a2
3 changed files with 99 additions and 4 deletions
|
@ -11,6 +11,7 @@ License-files: LICENSE
|
||||||
library
|
library
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
exposed-modules: Week05.Free
|
exposed-modules: Week05.Free
|
||||||
|
, Week05.Signed
|
||||||
build-depends: aeson
|
build-depends: aeson
|
||||||
, base ^>=4.14.1.0
|
, base ^>=4.14.1.0
|
||||||
, containers
|
, containers
|
||||||
|
|
|
@ -32,12 +32,12 @@ import Playground.Types (KnownCurrency (..))
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
import Wallet.Emulator.Wallet
|
import Wallet.Emulator.Wallet
|
||||||
|
|
||||||
{-# INLINABLE mkValidator #-}
|
{-# INLINABLE mkPolicy #-}
|
||||||
mkValidator :: ScriptContext -> Bool
|
mkPolicy :: ScriptContext -> Bool
|
||||||
mkValidator _ = True
|
mkPolicy _ = True
|
||||||
|
|
||||||
policy :: Scripts.MonetaryPolicy
|
policy :: Scripts.MonetaryPolicy
|
||||||
policy = mkMonetaryPolicyScript $$(PlutusTx.compile [|| Scripts.wrapMonetaryPolicy mkValidator ||])
|
policy = mkMonetaryPolicyScript $$(PlutusTx.compile [|| Scripts.wrapMonetaryPolicy mkPolicy ||])
|
||||||
|
|
||||||
curSymbol :: CurrencySymbol
|
curSymbol :: CurrencySymbol
|
||||||
curSymbol = scriptCurrencySymbol policy
|
curSymbol = scriptCurrencySymbol policy
|
||||||
|
|
94
code/week05/src/Week05/Signed.hs
Normal file
94
code/week05/src/Week05/Signed.hs
Normal file
|
@ -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
|
Loading…
Reference in a new issue