mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-14 02:42:35 +01:00
added trace to example
This commit is contained in:
parent
eada00234e
commit
048c42f66e
1 changed files with 39 additions and 16 deletions
|
@ -12,22 +12,25 @@
|
||||||
|
|
||||||
module Week05.Free where
|
module Week05.Free where
|
||||||
|
|
||||||
import Control.Monad hiding (fmap)
|
import Control.Monad hiding (fmap)
|
||||||
import Data.Aeson (ToJSON, FromJSON)
|
import Control.Monad.Freer.Extras as Extras
|
||||||
import Data.Text (Text)
|
import Data.Aeson (ToJSON, FromJSON)
|
||||||
import Data.Void (Void)
|
import Data.Text (Text)
|
||||||
import GHC.Generics (Generic)
|
import Data.Void (Void)
|
||||||
import Plutus.Contract hiding (when)
|
import GHC.Generics (Generic)
|
||||||
|
import Plutus.Contract as Contract hiding (when)
|
||||||
|
import Plutus.Trace.Emulator as Emulator
|
||||||
import qualified PlutusTx
|
import qualified PlutusTx
|
||||||
import PlutusTx.Prelude hiding (Semigroup(..), unless)
|
import PlutusTx.Prelude hiding (Semigroup(..), unless)
|
||||||
import Ledger hiding (singleton)
|
import Ledger hiding (singleton)
|
||||||
import Ledger.Constraints as Constraints
|
import Ledger.Constraints as Constraints
|
||||||
import qualified Ledger.Typed.Scripts as Scripts
|
import qualified Ledger.Typed.Scripts as Scripts
|
||||||
import Ledger.Value as Value
|
import Ledger.Value as Value
|
||||||
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema)
|
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema)
|
||||||
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
|
||||||
import Playground.Types (KnownCurrency (..))
|
import Playground.Types (KnownCurrency (..))
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
import Wallet.Emulator.Wallet
|
||||||
|
|
||||||
{-# INLINABLE mkValidator #-}
|
{-# INLINABLE mkValidator #-}
|
||||||
mkValidator :: ScriptContext -> Bool
|
mkValidator :: ScriptContext -> Bool
|
||||||
|
@ -55,7 +58,7 @@ mint mp = do
|
||||||
tx = Constraints.mustForgeValue val
|
tx = Constraints.mustForgeValue val
|
||||||
ledgerTx <- submitTxConstraintsWith @Void lookups tx
|
ledgerTx <- submitTxConstraintsWith @Void lookups tx
|
||||||
void $ awaitTxConfirmed $ txId ledgerTx
|
void $ awaitTxConfirmed $ txId ledgerTx
|
||||||
logInfo @String $ printf "forged %s" (show val)
|
Contract.logInfo @String $ printf "forged %s" (show val)
|
||||||
|
|
||||||
endpoints :: Contract () FreeSchema Text ()
|
endpoints :: Contract () FreeSchema Text ()
|
||||||
endpoints = mint' >> endpoints
|
endpoints = mint' >> endpoints
|
||||||
|
@ -65,3 +68,23 @@ endpoints = mint' >> endpoints
|
||||||
mkSchemaDefinitions ''FreeSchema
|
mkSchemaDefinitions ''FreeSchema
|
||||||
|
|
||||||
mkKnownCurrencies []
|
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