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

added trace to example

Browse source
This commit is contained in:
Lars Brünjes 2021-05-03 15:21:52 +02:00
parent eada00234e
commit 048c42f66e
No known key found for this signature in database
GPG key ID: B488B9045DC1A087
1 changed files with 39 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
code/week05/src/Week05/Free.hs
View file

@ -12,22 +12,25 @@
module Week05.Free where
import Control.Monad hiding (fmap)
import Data.Aeson (ToJSON, FromJSON)
import Data.Text (Text)
import Data.Void (Void)
import GHC.Generics (Generic)
import Plutus.Contract hiding (when)
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 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 mkValidator #-}
mkValidator :: ScriptContext -> Bool
@ -55,7 +58,7 @@ mint mp = do
tx = Constraints.mustForgeValue val
ledgerTx <- submitTxConstraintsWith @Void lookups tx
void $ awaitTxConfirmed $ txId ledgerTx
logInfo @String $ printf "forged %s" (show val)
Contract.logInfo @String $ printf "forged %s" (show val)
endpoints :: Contract () FreeSchema Text ()
endpoints = mint' >> endpoints
@ -65,3 +68,23 @@ endpoints = mint' >> endpoints
mkSchemaDefinitions ''FreeSchema
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