diff --git a/doc/plutus/tutorials/BasicApps.hs b/doc/plutus/tutorials/BasicApps.hs index 39480ddee1..53ff3abe90 100644 --- a/doc/plutus/tutorials/BasicApps.hs +++ b/doc/plutus/tutorials/BasicApps.hs @@ -20,23 +20,25 @@ import Control.Monad (void) import Data.Aeson (FromJSON, ToJSON) import Data.Text qualified as T import GHC.Generics (Generic) -import Ledger +import Ledger (Ada, PaymentPubKeyHash (unPaymentPubKeyHash), ScriptContext (ScriptContext, scriptContextTxInfo), + valuePaidTo) import Ledger.Ada qualified as Ada import Ledger.Constraints qualified as Constraints import Ledger.Typed.Scripts qualified as Scripts -import Plutus.Contract -import PlutusTx qualified as PlutusTx -import PlutusTx.Prelude +import Plutus.Contract (Contract, Endpoint, Promise, collectFromScript, endpoint, logInfo, selectList, + submitTxConstraints, submitTxConstraintsSpending, type (.\/), utxosAt) +import PlutusTx qualified +import PlutusTx.Prelude (Bool, Semigroup ((<>)), ($), (&&), (-), (.), (>=)) import Prelude qualified as Haskell -import Schema -import Wallet.Emulator.Wallet +import Schema (ToSchema) +import Wallet.Emulator.Wallet (Wallet, mockWalletPaymentPubKeyHash) -- BLOCK1 data SplitData = SplitData - { recipient1 :: PubKeyHash -- ^ First recipient of the funds - , recipient2 :: PubKeyHash -- ^ Second recipient of the funds + { recipient1 :: PaymentPubKeyHash -- ^ First recipient of the funds + , recipient2 :: PaymentPubKeyHash -- ^ Second recipient of the funds , amount :: Ada -- ^ How much Ada we want to lock } deriving stock (Haskell.Show, Generic) @@ -50,8 +52,8 @@ PlutusTx.makeLift ''SplitData validateSplit :: SplitData -> () -> ScriptContext -> Bool validateSplit SplitData{recipient1, recipient2, amount} _ ScriptContext{scriptContextTxInfo} = let half = Ada.divide amount 2 in - Ada.fromValue (valuePaidTo scriptContextTxInfo recipient1) >= half && - Ada.fromValue (valuePaidTo scriptContextTxInfo recipient2) >= (amount - half) + Ada.fromValue (valuePaidTo scriptContextTxInfo (unPaymentPubKeyHash recipient1)) >= half && + Ada.fromValue (valuePaidTo scriptContextTxInfo (unPaymentPubKeyHash recipient2)) >= (amount - half) -- BLOCK3 @@ -94,8 +96,8 @@ unlock = endpoint @"unlock" (unlockFunds . mkSplitData) mkSplitData :: LockArgs -> SplitData mkSplitData LockArgs{recipient1Wallet, recipient2Wallet, totalAda} = SplitData - { recipient1 = walletPubKeyHash recipient1Wallet - , recipient2 = walletPubKeyHash recipient2Wallet + { recipient1 = mockWalletPaymentPubKeyHash recipient1Wallet + , recipient2 = mockWalletPaymentPubKeyHash recipient2Wallet , amount = totalAda } diff --git a/doc/plutus/tutorials/basic-apps.rst b/doc/plutus/tutorials/basic-apps.rst index e15a849db0..fc0a7b6fb7 100644 --- a/doc/plutus/tutorials/basic-apps.rst +++ b/doc/plutus/tutorials/basic-apps.rst @@ -114,7 +114,7 @@ Next you need to turn the two ``Wallet`` values into their public key hashes so :start-after: BLOCK6 :end-before: BLOCK7 -Note that the :hsobj:`Wallet.Emulator.Wallet.walletPubKeyHash` function and the :hsobj:`Wallet.Emulator.Wallet.Wallet` type are only available in the simulated environment used by the Plutus playground and by Plutus tests. +Note that the :hsobj:`Wallet.Emulator.Wallet.mockWalletPaymentPubKeyHash` function and the :hsobj:`Wallet.Emulator.Wallet.Wallet` type are only available in the simulated environment used by the Plutus playground and by Plutus tests. A real Plutus app would use the metadata server or a custom lookup function for such conversions. Locking the funds diff --git a/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-ledger.nix b/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-ledger.nix index ebead08cfc..054513b942 100644 --- a/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-ledger.nix +++ b/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-ledger.nix @@ -110,23 +110,21 @@ tests = { "plutus-ledger-test" = { depends = [ + (hsPkgs."aeson" or (errorHandler.buildDepError "aeson")) (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."cardano-api" or (errorHandler.buildDepError "cardano-api")) + (hsPkgs."cardano-api".components.sublibs.gen or (errorHandler.buildDepError "cardano-api:gen")) (hsPkgs."containers" or (errorHandler.buildDepError "containers")) - (hsPkgs."data-default" or (errorHandler.buildDepError "data-default")) (hsPkgs."hedgehog" or (errorHandler.buildDepError "hedgehog")) + (hsPkgs."plutus-ledger" or (errorHandler.buildDepError "plutus-ledger")) + (hsPkgs."plutus-tx" or (errorHandler.buildDepError "plutus-tx")) (hsPkgs."tasty" or (errorHandler.buildDepError "tasty")) (hsPkgs."tasty-hedgehog" or (errorHandler.buildDepError "tasty-hedgehog")) (hsPkgs."tasty-hunit" or (errorHandler.buildDepError "tasty-hunit")) - (hsPkgs."transformers" or (errorHandler.buildDepError "transformers")) - (hsPkgs."plutus-ledger" or (errorHandler.buildDepError "plutus-ledger")) - (hsPkgs."plutus-tx" or (errorHandler.buildDepError "plutus-tx")) - (hsPkgs."lens" or (errorHandler.buildDepError "lens")) - (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) - (hsPkgs."aeson" or (errorHandler.buildDepError "aeson")) - (hsPkgs."plutus-core" or (errorHandler.buildDepError "plutus-core")) - (hsPkgs."plutus-tx-plugin" or (errorHandler.buildDepError "plutus-tx-plugin")) ]; buildable = true; + modules = [ "Ledger/Tx/CardanoAPISpec" ]; hsSourceDirs = [ "test" ]; mainPath = [ "Spec.hs" ]; }; diff --git a/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-ledger.nix b/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-ledger.nix index ebead08cfc..054513b942 100644 --- a/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-ledger.nix +++ b/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-ledger.nix @@ -110,23 +110,21 @@ tests = { "plutus-ledger-test" = { depends = [ + (hsPkgs."aeson" or (errorHandler.buildDepError "aeson")) (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."cardano-api" or (errorHandler.buildDepError "cardano-api")) + (hsPkgs."cardano-api".components.sublibs.gen or (errorHandler.buildDepError "cardano-api:gen")) (hsPkgs."containers" or (errorHandler.buildDepError "containers")) - (hsPkgs."data-default" or (errorHandler.buildDepError "data-default")) (hsPkgs."hedgehog" or (errorHandler.buildDepError "hedgehog")) + (hsPkgs."plutus-ledger" or (errorHandler.buildDepError "plutus-ledger")) + (hsPkgs."plutus-tx" or (errorHandler.buildDepError "plutus-tx")) (hsPkgs."tasty" or (errorHandler.buildDepError "tasty")) (hsPkgs."tasty-hedgehog" or (errorHandler.buildDepError "tasty-hedgehog")) (hsPkgs."tasty-hunit" or (errorHandler.buildDepError "tasty-hunit")) - (hsPkgs."transformers" or (errorHandler.buildDepError "transformers")) - (hsPkgs."plutus-ledger" or (errorHandler.buildDepError "plutus-ledger")) - (hsPkgs."plutus-tx" or (errorHandler.buildDepError "plutus-tx")) - (hsPkgs."lens" or (errorHandler.buildDepError "lens")) - (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) - (hsPkgs."aeson" or (errorHandler.buildDepError "aeson")) - (hsPkgs."plutus-core" or (errorHandler.buildDepError "plutus-core")) - (hsPkgs."plutus-tx-plugin" or (errorHandler.buildDepError "plutus-tx-plugin")) ]; buildable = true; + modules = [ "Ledger/Tx/CardanoAPISpec" ]; hsSourceDirs = [ "test" ]; mainPath = [ "Spec.hs" ]; }; diff --git a/nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-ledger.nix b/nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-ledger.nix index ebead08cfc..054513b942 100644 --- a/nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-ledger.nix +++ b/nix/pkgs/haskell/materialized-windows/.plan.nix/plutus-ledger.nix @@ -110,23 +110,21 @@ tests = { "plutus-ledger-test" = { depends = [ + (hsPkgs."aeson" or (errorHandler.buildDepError "aeson")) (hsPkgs."base" or (errorHandler.buildDepError "base")) + (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) + (hsPkgs."cardano-api" or (errorHandler.buildDepError "cardano-api")) + (hsPkgs."cardano-api".components.sublibs.gen or (errorHandler.buildDepError "cardano-api:gen")) (hsPkgs."containers" or (errorHandler.buildDepError "containers")) - (hsPkgs."data-default" or (errorHandler.buildDepError "data-default")) (hsPkgs."hedgehog" or (errorHandler.buildDepError "hedgehog")) + (hsPkgs."plutus-ledger" or (errorHandler.buildDepError "plutus-ledger")) + (hsPkgs."plutus-tx" or (errorHandler.buildDepError "plutus-tx")) (hsPkgs."tasty" or (errorHandler.buildDepError "tasty")) (hsPkgs."tasty-hedgehog" or (errorHandler.buildDepError "tasty-hedgehog")) (hsPkgs."tasty-hunit" or (errorHandler.buildDepError "tasty-hunit")) - (hsPkgs."transformers" or (errorHandler.buildDepError "transformers")) - (hsPkgs."plutus-ledger" or (errorHandler.buildDepError "plutus-ledger")) - (hsPkgs."plutus-tx" or (errorHandler.buildDepError "plutus-tx")) - (hsPkgs."lens" or (errorHandler.buildDepError "lens")) - (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) - (hsPkgs."aeson" or (errorHandler.buildDepError "aeson")) - (hsPkgs."plutus-core" or (errorHandler.buildDepError "plutus-core")) - (hsPkgs."plutus-tx-plugin" or (errorHandler.buildDepError "plutus-tx-plugin")) ]; buildable = true; + modules = [ "Ledger/Tx/CardanoAPISpec" ]; hsSourceDirs = [ "test" ]; mainPath = [ "Spec.hs" ]; }; diff --git a/playground-common/src/PSGenerator/Common.hs b/playground-common/src/PSGenerator/Common.hs index f7c1285a8e..7cd0d5f2b8 100644 --- a/playground-common/src/PSGenerator/Common.hs +++ b/playground-common/src/PSGenerator/Common.hs @@ -18,9 +18,9 @@ import Language.PureScript.Bridge (BridgePart, Language (Haskell), PSType, SumTy import Language.PureScript.Bridge.Builder (BridgeData) import Language.PureScript.Bridge.PSTypes (psInt, psNumber, psString) import Language.PureScript.Bridge.TypeParameters (A) -import Ledger (Address, BlockId, ChainIndexTxOut, DatumHash, MintingPolicy, OnChainTx, PubKey, PubKeyHash, RedeemerPtr, - ScriptTag, Signature, StakeValidator, Tx, TxId, TxIn, TxInType, TxOut, TxOutRef, TxOutTx, UtxoIndex, - ValidationPhase, Validator) +import Ledger (Address, BlockId, ChainIndexTxOut, DatumHash, MintingPolicy, OnChainTx, PaymentPubKey, PaymentPubKeyHash, + PubKey, PubKeyHash, RedeemerPtr, ScriptTag, Signature, StakePubKey, StakePubKeyHash, StakeValidator, Tx, + TxId, TxIn, TxInType, TxOut, TxOutRef, TxOutTx, UtxoIndex, ValidationPhase, Validator) import Ledger.Ada (Ada) import Ledger.Constraints.OffChain (MkTxError, ScriptOutput, UnbalancedTx) import Ledger.Credential (Credential, StakingCredential) @@ -322,6 +322,10 @@ ledgerTypes = , order . genericShow . argonaut $ mkSumType @DatumHash , order . genericShow . argonaut $ mkSumType @PubKey , order . genericShow . argonaut $ mkSumType @PubKeyHash + , order . genericShow . argonaut $ mkSumType @PaymentPubKey + , order . genericShow . argonaut $ mkSumType @PaymentPubKeyHash + , order . genericShow . argonaut $ mkSumType @StakePubKey + , order . genericShow . argonaut $ mkSumType @StakePubKeyHash , order . genericShow . argonaut $ mkSumType @Credential , order . genericShow . argonaut $ mkSumType @StakingCredential , order . genericShow . argonaut $ mkSumType @DCert diff --git a/playground-common/src/Playground/Contract.hs b/playground-common/src/Playground/Contract.hs index b9d1d79123..1f10bed6e2 100644 --- a/playground-common/src/Playground/Contract.hs +++ b/playground-common/src/Playground/Contract.hs @@ -41,7 +41,7 @@ module Playground.Contract , TraceError(..) , type (.\/) , interval - , ownPubKeyHash + , ownPaymentPubKeyHash , awaitSlot , modifiesUtxoSet , utxosAt @@ -66,8 +66,8 @@ import Playground.Interpreter.Util import Playground.Schema (endpointsToSchemas) import Playground.TH (ensureKnownCurrencies, mkFunction, mkFunctions, mkKnownCurrencies, mkSchemaDefinitions) import Playground.Types (Expression, FunctionSchema, KnownCurrency (KnownCurrency), adaCurrency) -import Plutus.Contract (AsContractError, Contract, Endpoint, awaitSlot, endpoint, ownPubKeyHash, submitTx, type (.\/), - utxosAt, watchAddressUntilSlot) +import Plutus.Contract (AsContractError, Contract, Endpoint, awaitSlot, endpoint, ownPaymentPubKeyHash, submitTx, + type (.\/), utxosAt, watchAddressUntilSlot) import Plutus.Contract.Trace (TraceError (..)) import Schema (FormSchema, ToArgument, ToSchema) import Wallet.Emulator.Types (Wallet (..)) diff --git a/playground-common/src/Playground/Interpreter/Util.hs b/playground-common/src/Playground/Interpreter/Util.hs index 9fe651c74a..56c740e0ca 100644 --- a/playground-common/src/Playground/Interpreter/Util.hs +++ b/playground-common/src/Playground/Interpreter/Util.hs @@ -52,7 +52,7 @@ import Wallet.Emulator.Folds (EmulatorEventFoldM) import Wallet.Emulator.Folds qualified as Folds import Wallet.Emulator.MultiAgent (EmulatorEvent, chainEvent, eteEvent, instanceEvent) import Wallet.Emulator.Stream (foldEmulatorStreamM) -import Wallet.Emulator.Types (Wallet, WalletNumber, fromWalletNumber, walletPubKeyHash) +import Wallet.Emulator.Types (Wallet, WalletNumber, fromWalletNumber, mockWalletPaymentPubKeyHash) import Wallet.Types (EndpointDescription (getEndpointDescription)) -- | Unfortunately any uncaught errors in the interpreter kill the @@ -94,7 +94,7 @@ isInteresting x = evaluationResultFold :: [WalletNumber] -> EmulatorEventFoldM effs EvaluationResult evaluationResultFold wallets = - let pkh wallet = (walletPubKeyHash $ fromWalletNumber wallet, wallet) + let pkh wallet = (mockWalletPaymentPubKeyHash $ fromWalletNumber wallet, wallet) in Playground.Types.EvaluationResult <$> L.generalize (reverse <$> Folds.annotatedBlockchain) <*> L.generalize (filter isInteresting <$> Folds.emulatorLog) diff --git a/playground-common/src/Playground/Types.hs b/playground-common/src/Playground/Types.hs index f24545ef4d..cdfa5e24ca 100644 --- a/playground-common/src/Playground/Types.hs +++ b/playground-common/src/Playground/Types.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveLift #-} {-# LANGUAGE DeriveTraversable #-} @@ -26,7 +25,7 @@ import Data.Text (Text) import GHC.Generics (Generic) import Language.Haskell.Interpreter (CompilationError, SourceCode) import Language.Haskell.Interpreter qualified as HI -import Ledger (PubKeyHash, fromSymbol) +import Ledger (PaymentPubKeyHash, fromSymbol) import Ledger.Ada qualified as Ada import Ledger.CardanoWallet qualified as CW import Ledger.Scripts (ValidatorHash) @@ -135,8 +134,8 @@ data Evaluation = } deriving (Generic, ToJSON, FromJSON) -pubKeys :: Evaluation -> [PubKeyHash] -pubKeys Evaluation {wallets} = CW.pubKeyHash . CW.fromWalletNumber . simulatorWalletWallet <$> wallets +pubKeys :: Evaluation -> [PaymentPubKeyHash] +pubKeys Evaluation {wallets} = CW.paymentPubKeyHash . CW.fromWalletNumber . simulatorWalletWallet <$> wallets data EvaluationResult = EvaluationResult @@ -145,7 +144,7 @@ data EvaluationResult = , emulatorTrace :: Text , fundsDistribution :: [SimulatorWallet] , feesDistribution :: [SimulatorWallet] - , walletKeys :: [(PubKeyHash, WalletNumber)] + , walletKeys :: [(PaymentPubKeyHash, WalletNumber)] } deriving (Show, Generic, ToJSON, FromJSON) diff --git a/playground-common/src/Schema.hs b/playground-common/src/Schema.hs index a8b476be5c..ff0c801247 100644 --- a/playground-common/src/Schema.hs +++ b/playground-common/src/Schema.hs @@ -57,8 +57,9 @@ import Data.Text qualified as Text import Data.UUID (UUID) import GHC.Generics (C1, Constructor, D1, Generic, K1 (K1), M1 (M1), Rec0, Rep, S1, Selector, U1, conIsRecord, conName, from, selName, (:*:) ((:*:)), (:+:) (L1, R1)) -import Ledger (Ada, AssetClass, CurrencySymbol, DatumHash, Interval, POSIXTime, POSIXTimeRange, PubKey, PubKeyHash, - RedeemerHash, Signature, Slot, TokenName, TxId, TxOutRef, ValidatorHash, Value) +import Ledger (Ada, AssetClass, CurrencySymbol, DatumHash, Interval, POSIXTime, POSIXTimeRange, PaymentPubKey, + PaymentPubKeyHash, PubKey, PubKeyHash, RedeemerHash, Signature, Slot, StakePubKey, StakePubKeyHash, + TokenName, TxId, TxOutRef, ValidatorHash, Value) import Ledger.Bytes (LedgerBytes) import Ledger.CardanoWallet (WalletNumber) import Plutus.Contract.Secrets (SecretArgument (EndpointSide, UserSide)) @@ -397,6 +398,14 @@ deriving anyclass instance ToSchema PubKey deriving anyclass instance ToSchema PubKeyHash +deriving anyclass instance ToSchema PaymentPubKey + +deriving anyclass instance ToSchema PaymentPubKeyHash + +deriving anyclass instance ToSchema StakePubKey + +deriving anyclass instance ToSchema StakePubKeyHash + deriving anyclass instance ToSchema RedeemerHash deriving anyclass instance ToSchema Slot diff --git a/plutus-chain-index-core/test/Generators.hs b/plutus-chain-index-core/test/Generators.hs index 602a15ea6a..d890e30100 100644 --- a/plutus-chain-index-core/test/Generators.hs +++ b/plutus-chain-index-core/test/Generators.hs @@ -47,19 +47,20 @@ import Hedgehog (MonadGen) import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range import Ledger.Ada qualified as Ada -import Ledger.Address (pubKeyAddress) +import Ledger.Address (PaymentPubKey (PaymentPubKey), pubKeyAddress) import Ledger.Generators qualified as Gen import Ledger.Interval qualified as Interval -import Ledger.Slot (Slot (..)) -import Ledger.Tx (Address, TxIn (..), TxOut (..), TxOutRef (..)) -import Ledger.TxId (TxId (..)) +import Ledger.Slot (Slot (Slot)) +import Ledger.Tx (Address, TxIn (TxIn), TxOut (TxOut), TxOutRef (TxOutRef)) +import Ledger.TxId (TxId (TxId)) import Ledger.Value (Value) import Ledger.Value qualified as Value -import Plutus.ChainIndex.Tx (ChainIndexTx (..), ChainIndexTxOutputs (..), txOutRefs) +import Plutus.ChainIndex.Tx (ChainIndexTx (ChainIndexTx), ChainIndexTxOutputs (ValidTx), txOutRefs) import Plutus.ChainIndex.TxIdState qualified as TxIdState import Plutus.ChainIndex.TxOutBalance qualified as TxOutBalance import Plutus.ChainIndex.TxUtxoBalance qualified as TxUtxoBalance -import Plutus.ChainIndex.Types (BlockId (..), BlockNumber (..), Tip (..), TxIdState, TxOutBalance, TxUtxoBalance (..)) +import Plutus.ChainIndex.Types (BlockId (BlockId), BlockNumber (BlockNumber), + Tip (Tip, tipBlockId, tipBlockNo, tipSlot), TxIdState, TxOutBalance, TxUtxoBalance) import PlutusTx.Prelude qualified as PlutusTx -- | Generate a random tx id @@ -90,7 +91,9 @@ genSlot = Slot <$> Gen.integral (Range.linear 0 100000000) -- | Generate a public key address genAddress :: MonadGen m => m Address -genAddress = Gen.element $ pubKeyAddress <$> ["000fff", "aabbcc", "123123"] +genAddress = Gen.element + $ pubKeyAddress <$> (PaymentPubKey <$> ["000fff", "aabbcc", "123123"]) + <*> pure Nothing -- | Generate random Value (possibly containing Ada) with a positive Ada value. genNonZeroAdaValue :: MonadGen m => m Value diff --git a/plutus-contract/src/Plutus/Contract.hs b/plutus-contract/src/Plutus/Contract.hs index d5d20c3d3e..ff577afc66 100644 --- a/plutus-contract/src/Plutus/Contract.hs +++ b/plutus-contract/src/Plutus/Contract.hs @@ -63,7 +63,7 @@ module Plutus.Contract( , Request.utxosTxOutTxFromTx , Request.getTip -- * Wallet's own public key - , Request.ownPubKeyHash + , Request.ownPaymentPubKeyHash -- * Contract instance Id , Wallet.Types.ContractInstanceId , Request.ownInstanceId @@ -121,7 +121,6 @@ import Plutus.Contract.Types (AsCheckpointError (..), AsContractError (..), Chec import Control.Monad.Freer.Extras.Log qualified as L import Control.Monad.Freer.Writer qualified as W import Data.Functor.Apply (liftF2) -import Prelude import Wallet.API (WalletAPIError) import Wallet.Types qualified diff --git a/plutus-contract/src/Plutus/Contract/Effects.hs b/plutus-contract/src/Plutus/Contract/Effects.hs index 869380a9a9..40045b3dac 100644 --- a/plutus-contract/src/Plutus/Contract/Effects.hs +++ b/plutus-contract/src/Plutus/Contract/Effects.hs @@ -17,7 +17,7 @@ module Plutus.Contract.Effects( -- TODO: Move to Requests.Internal _AwaitTxStatusChangeReq, _AwaitTxOutStatusChangeReq, _OwnContractInstanceIdReq, - _OwnPublicKeyHashReq, + _OwnPaymentPublicKeyHashReq, _ChainIndexQueryReq, _BalanceTxReq, _WriteBalancedTxReq, @@ -47,7 +47,7 @@ module Plutus.Contract.Effects( -- TODO: Move to Requests.Internal _AwaitTxStatusChangeResp', _AwaitTxOutStatusChangeResp, _OwnContractInstanceIdResp, - _OwnPublicKeyHashResp, + _OwnPaymentPublicKeyHashResp, _ChainIndexQueryResp, _BalanceTxResp, _WriteBalancedTxResp, @@ -82,7 +82,7 @@ import Data.Aeson qualified as JSON import Data.List.NonEmpty (NonEmpty) import Data.OpenApi.Schema qualified as OpenApi import GHC.Generics (Generic) -import Ledger (Address, AssetClass, Datum, DatumHash, MintingPolicy, MintingPolicyHash, PubKeyHash, Redeemer, +import Ledger (Address, AssetClass, Datum, DatumHash, MintingPolicy, MintingPolicyHash, PaymentPubKeyHash, Redeemer, RedeemerHash, StakeValidator, StakeValidatorHash, TxId, TxOutRef, ValidatorHash) import Ledger.Constraints.OffChain (UnbalancedTx) import Ledger.Credential (Credential) @@ -110,7 +110,7 @@ data PABReq = | CurrentSlotReq | CurrentTimeReq | OwnContractInstanceIdReq - | OwnPublicKeyHashReq + | OwnPaymentPublicKeyHashReq | ChainIndexQueryReq ChainIndexQuery | BalanceTxReq UnbalancedTx | WriteBalancedTxReq CardanoTx @@ -131,7 +131,7 @@ instance Pretty PABReq where AwaitTxStatusChangeReq txid -> "Await tx status change:" <+> pretty txid AwaitTxOutStatusChangeReq ref -> "Await txout status change:" <+> pretty ref OwnContractInstanceIdReq -> "Own contract instance ID" - OwnPublicKeyHashReq -> "Own public key" + OwnPaymentPublicKeyHashReq -> "Own public key" ChainIndexQueryReq q -> "Chain index query:" <+> pretty q BalanceTxReq utx -> "Balance tx:" <+> pretty utx WriteBalancedTxReq tx -> "Write balanced tx:" <+> pretty tx @@ -150,7 +150,7 @@ data PABResp = | CurrentSlotResp Slot | CurrentTimeResp POSIXTime | OwnContractInstanceIdResp ContractInstanceId - | OwnPublicKeyHashResp PubKeyHash + | OwnPaymentPublicKeyHashResp PaymentPubKeyHash | ChainIndexQueryResp ChainIndexResponse | BalanceTxResp BalanceTxResponse | WriteBalancedTxResp WriteBalancedTxResponse @@ -171,7 +171,7 @@ instance Pretty PABResp where AwaitTxStatusChangeResp txid status -> "Status of" <+> pretty txid <+> "changed to" <+> pretty status AwaitTxOutStatusChangeResp ref status -> "Status of" <+> pretty ref <+> "changed to" <+> pretty status OwnContractInstanceIdResp i -> "Own contract instance ID:" <+> pretty i - OwnPublicKeyHashResp k -> "Own public key:" <+> pretty k + OwnPaymentPublicKeyHashResp k -> "Own public key:" <+> pretty k ChainIndexQueryResp rsp -> pretty rsp BalanceTxResp r -> "Balance tx:" <+> pretty r WriteBalancedTxResp r -> "Write balanced tx:" <+> pretty r @@ -190,7 +190,7 @@ matches a b = case (a, b) of (AwaitTxStatusChangeReq i, AwaitTxStatusChangeResp i' _) -> i == i' (AwaitTxOutStatusChangeReq i, AwaitTxOutStatusChangeResp i' _) -> i == i' (OwnContractInstanceIdReq, OwnContractInstanceIdResp{}) -> True - (OwnPublicKeyHashReq, OwnPublicKeyHashResp{}) -> True + (OwnPaymentPublicKeyHashReq, OwnPaymentPublicKeyHashResp{}) -> True (ChainIndexQueryReq r, ChainIndexQueryResp r') -> chainIndexMatches r r' (BalanceTxReq{}, BalanceTxResp{}) -> True (WriteBalancedTxReq{}, WriteBalancedTxResp{}) -> True diff --git a/plutus-contract/src/Plutus/Contract/Oracle.hs b/plutus-contract/src/Plutus/Contract/Oracle.hs index 9011754396..99166edba5 100644 --- a/plutus-contract/src/Plutus/Contract/Oracle.hs +++ b/plutus-contract/src/Plutus/Contract/Oracle.hs @@ -32,16 +32,18 @@ module Plutus.Contract.Oracle( import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) -import PlutusTx -import PlutusTx.Prelude +import PlutusTx (FromData (fromBuiltinData), ToData (toBuiltinData), makeIsDataIndexed, makeLift) +import PlutusTx.Prelude (Applicative (pure), Either (Left, Right), Eq ((==)), maybe, trace, unless, verifySignature, + ($), (&&), (>>)) +import Ledger.Address (PaymentPrivateKey (unPaymentPrivateKey), PaymentPubKey (PaymentPubKey)) import Ledger.Constraints (TxConstraints) import Ledger.Constraints qualified as Constraints -import Ledger.Crypto (PrivateKey, PubKey (..), Signature (..)) +import Ledger.Crypto (PubKey (PubKey), Signature (Signature)) import Ledger.Crypto qualified as Crypto -import Ledger.Scripts (Datum (..), DatumHash (..)) +import Ledger.Scripts (Datum (Datum), DatumHash (DatumHash)) import Ledger.Scripts qualified as Scripts -import Plutus.V1.Ledger.Bytes +import Plutus.V1.Ledger.Bytes (LedgerBytes (LedgerBytes)) import Plutus.V1.Ledger.Contexts (ScriptContext) import Plutus.V1.Ledger.Time (POSIXTime) @@ -98,7 +100,7 @@ instance Eq a => Eq (SignedMessage a) where && osmDatum l == osmDatum r data SignedMessageCheckError = - SignatureMismatch Signature PubKey DatumHash + SignatureMismatch Signature PaymentPubKey DatumHash -- ^ The signature did not match the public key | DatumMissing DatumHash -- ^ The datum was missing from the pending transaction @@ -113,13 +115,13 @@ data SignedMessageCheckError = checkSignature :: DatumHash -- ^ The hash of the message - -> PubKey + -> PaymentPubKey -- ^ The public key of the signatory -> Signature -- ^ The signed message -> Either SignedMessageCheckError () checkSignature datumHash pubKey signature_ = - let PubKey (LedgerBytes pk) = pubKey + let PaymentPubKey (PubKey (LedgerBytes pk)) = pubKey Signature sig = signature_ DatumHash h = datumHash in if verifySignature pk h sig @@ -147,7 +149,7 @@ checkHashConstraints SignedMessage{osmMessageHash, osmDatum=Datum dt} = -- up. verifySignedMessageConstraints :: ( FromData a) - => PubKey + => PaymentPubKey -> SignedMessage a -> Either SignedMessageCheckError (a, TxConstraints i o) verifySignedMessageConstraints pk s@SignedMessage{osmSignature, osmMessageHash} = @@ -162,7 +164,7 @@ verifySignedMessageConstraints pk s@SignedMessage{osmSignature, osmMessageHash} verifySignedMessageOnChain :: ( FromData a) => ScriptContext - -> PubKey + -> PaymentPubKey -> SignedMessage a -> Either SignedMessageCheckError a verifySignedMessageOnChain ptx pk s@SignedMessage{osmSignature, osmMessageHash} = do @@ -187,7 +189,7 @@ checkHashOffChain SignedMessage{osmMessageHash, osmDatum=dt} = do -- message. verifySignedMessageOffChain :: ( FromData a) - => PubKey + => PaymentPubKey -> SignedMessage a -> Either SignedMessageCheckError a verifySignedMessageOffChain pk s@SignedMessage{osmSignature, osmMessageHash} = @@ -196,11 +198,11 @@ verifySignedMessageOffChain pk s@SignedMessage{osmSignature, osmMessageHash} = -- | Encode a message of type @a@ as a @Data@ value and sign the -- hash of the datum. -signMessage :: ToData a => a -> PrivateKey -> SignedMessage a +signMessage :: ToData a => a -> PaymentPrivateKey -> SignedMessage a signMessage msg pk = let dt = Datum (toBuiltinData msg) DatumHash msgHash = Scripts.datumHash dt - sig = Crypto.sign msgHash pk + sig = Crypto.sign msgHash (unPaymentPrivateKey pk) in SignedMessage { osmSignature = sig , osmMessageHash = DatumHash msgHash @@ -208,7 +210,7 @@ signMessage msg pk = } -- | Encode an observation of a value of type @a@ that was made at the given time -signObservation :: ToData a => POSIXTime -> a -> PrivateKey -> SignedMessage (Observation a) +signObservation :: ToData a => POSIXTime -> a -> PaymentPrivateKey -> SignedMessage (Observation a) signObservation time vl = signMessage Observation{obsValue=vl, obsTime=time} makeLift ''SignedMessage diff --git a/plutus-contract/src/Plutus/Contract/Request.hs b/plutus-contract/src/Plutus/Contract/Request.hs index 05eae02ec2..0de254808c 100644 --- a/plutus-contract/src/Plutus/Contract/Request.hs +++ b/plutus-contract/src/Plutus/Contract/Request.hs @@ -71,7 +71,7 @@ module Plutus.Contract.Request( , endpointReq , endpointResp -- ** Public key hashes - , ownPubKeyHash + , ownPaymentPubKeyHash -- ** Submitting transactions , submitUnbalancedTx , submitBalancedTx @@ -106,7 +106,7 @@ import Data.Void (Void) import GHC.Natural (Natural) import GHC.TypeLits (Symbol, symbolVal) import Ledger (Address, AssetClass, Datum, DatumHash, DiffMilliSeconds, MintingPolicy, MintingPolicyHash, POSIXTime, - PubKeyHash, Redeemer, RedeemerHash, Slot, StakeValidator, StakeValidatorHash, TxId, + PaymentPubKeyHash, Redeemer, RedeemerHash, Slot, StakeValidator, StakeValidatorHash, TxId, TxOutRef (txOutRefId), Validator, ValidatorHash, Value, addressCredential, fromMilliSeconds) import Ledger.Constraints (TxConstraints) import Ledger.Constraints.OffChain (ScriptLookups, UnbalancedTx) @@ -117,12 +117,13 @@ import Ledger.Value qualified as V import Plutus.Contract.Util (loopM) import PlutusTx qualified -import Plutus.Contract.Effects (ActiveEndpoint (..), - PABReq (AwaitSlotReq, AwaitTimeReq, AwaitTxOutStatusChangeReq, AwaitTxStatusChangeReq, AwaitUtxoProducedReq, AwaitUtxoSpentReq, BalanceTxReq, ChainIndexQueryReq, CurrentSlotReq, CurrentTimeReq, ExposeEndpointReq, OwnContractInstanceIdReq, OwnPublicKeyHashReq, WriteBalancedTxReq, YieldUnbalancedTxReq), +import Plutus.Contract.Effects (ActiveEndpoint (ActiveEndpoint, aeDescription, aeMetadata), + PABReq (AwaitSlotReq, AwaitTimeReq, AwaitTxOutStatusChangeReq, AwaitTxStatusChangeReq, AwaitUtxoProducedReq, AwaitUtxoSpentReq, BalanceTxReq, ChainIndexQueryReq, CurrentSlotReq, CurrentTimeReq, ExposeEndpointReq, OwnContractInstanceIdReq, OwnPaymentPublicKeyHashReq, WriteBalancedTxReq, YieldUnbalancedTxReq), PABResp (ExposeEndpointResp)) import Plutus.Contract.Effects qualified as E import Plutus.Contract.Schema (Input, Output) -import Wallet.Types (ContractInstanceId, EndpointDescription (..), EndpointValue (..)) +import Wallet.Types (ContractInstanceId, EndpointDescription (EndpointDescription), + EndpointValue (EndpointValue, unEndpointValue)) import Plutus.ChainIndex (ChainIndexTx, Page (nextPageQuery, pageItems), PageQuery, txOutRefs) import Plutus.ChainIndex.Api (IsUtxoResponse, UtxosResponse (page)) @@ -694,8 +695,8 @@ endpointDescription = EndpointDescription . symbolVal -- 'requiredSignatures' field of 'Tx'. -- * There is a 1-n relationship between wallets and public keys (although in -- the mockchain n=1) -ownPubKeyHash :: forall w s e. (AsContractError e) => Contract w s e PubKeyHash -ownPubKeyHash = pabReq OwnPublicKeyHashReq E._OwnPublicKeyHashResp +ownPaymentPubKeyHash :: forall w s e. (AsContractError e) => Contract w s e PaymentPubKeyHash +ownPaymentPubKeyHash = pabReq OwnPaymentPublicKeyHashReq E._OwnPaymentPublicKeyHashResp -- | Send an unbalanced transaction to be balanced and signed. Returns the ID -- of the final transaction when the transaction was submitted. Throws an diff --git a/plutus-contract/src/Plutus/Contract/StateMachine.hs b/plutus-contract/src/Plutus/Contract/StateMachine.hs index ca26ed721b..f7e13c8c46 100644 --- a/plutus-contract/src/Plutus/Contract/StateMachine.hs +++ b/plutus-contract/src/Plutus/Contract/StateMachine.hs @@ -52,7 +52,7 @@ module Plutus.Contract.StateMachine( , Void ) where -import Control.Lens +import Control.Lens (makeClassyPrisms, review) import Control.Monad (unless) import Control.Monad.Error.Lens import Data.Aeson (FromJSON, ToJSON) @@ -67,22 +67,29 @@ import Data.Void (Void, absurd) import GHC.Generics (Generic) import Ledger (POSIXTime, Slot, TxOutRef, Value, scriptCurrencySymbol) import Ledger qualified -import Ledger.Constraints (ScriptLookups, TxConstraints (..), mintingPolicy, mustMintValueWithRedeemer, - mustPayToTheScript, mustSpendPubKeyOutput) +import Ledger.Constraints (ScriptLookups, TxConstraints, mintingPolicy, mustMintValueWithRedeemer, mustPayToTheScript, + mustSpendPubKeyOutput) import Ledger.Constraints.OffChain (UnbalancedTx) import Ledger.Constraints.OffChain qualified as Constraints -import Ledger.Constraints.TxConstraints (InputConstraint (..), OutputConstraint (..)) +import Ledger.Constraints.TxConstraints (InputConstraint (InputConstraint, icRedeemer, icTxOutRef), + OutputConstraint (OutputConstraint, ocDatum, ocValue), txOwnInputs, + txOwnOutputs) import Ledger.Tx qualified as Tx import Ledger.Typed.Scripts qualified as Scripts -import Ledger.Typed.Tx (TypedScriptTxOut (..)) +import Ledger.Typed.Tx (TypedScriptTxOut (TypedScriptTxOut, tyTxOutData, tyTxOutTxOut)) import Ledger.Typed.Tx qualified as Typed import Ledger.Value qualified as Value -import Plutus.ChainIndex (ChainIndexTx (..)) -import Plutus.Contract -import Plutus.Contract.StateMachine.MintingPolarity (MintingPolarity (..)) -import Plutus.Contract.StateMachine.OnChain (State (..), StateMachine (..), StateMachineInstance (..)) +import Plutus.ChainIndex (ChainIndexTx (_citxInputs)) +import Plutus.Contract (AsContractError (_ConstraintResolutionError, _ContractError), Contract, ContractError, Promise, + awaitPromise, isSlot, isTime, logWarn, mapError, never, ownPaymentPubKeyHash, promiseBind, + select, submitTxConfirmed, utxoIsProduced, utxoIsSpent, utxosAt, utxosTxOutTxAt, + utxosTxOutTxFromTx) +import Plutus.Contract.StateMachine.MintingPolarity (MintingPolarity (Burn, Mint)) +import Plutus.Contract.StateMachine.OnChain (State (State, stateData, stateValue), + StateMachine (StateMachine, smFinal, smThreadToken, smTransition), + StateMachineInstance (StateMachineInstance, stateMachine, typedValidator)) import Plutus.Contract.StateMachine.OnChain qualified as SM -import Plutus.Contract.StateMachine.ThreadToken (ThreadToken (..), curPolicy, ttOutRef) +import Plutus.Contract.StateMachine.ThreadToken (ThreadToken (ThreadToken), curPolicy, ttOutRef) import Plutus.Contract.Wallet (getUnspentOutput) import PlutusTx qualified import PlutusTx.Monoid (inv) @@ -413,8 +420,8 @@ runInitialiseWith :: -- ^ The value locked by the contract at the beginning -> Contract w schema e state runInitialiseWith customLookups customConstraints StateMachineClient{scInstance} initialState initialValue = mapError (review _SMContractError) $ do - ownPK <- ownPubKeyHash - utxo <- utxosAt (Ledger.pubKeyHashAddress ownPK) + ownPK <- ownPaymentPubKeyHash + utxo <- utxosAt (Ledger.pubKeyHashAddress ownPK Nothing) let StateMachineInstance{stateMachine, typedValidator} = scInstance constraints = mustPayToTheScript initialState (initialValue <> SM.threadTokenValueOrZero scInstance) <> foldMap ttConstraints (smThreadToken stateMachine) @@ -473,8 +480,8 @@ runGuardedStepWith :: -> Contract w schema e (Either a (TransitionResult state input)) runGuardedStepWith userLookups userConstraints smc input guard = mapError (review _SMContractError) $ mkStep smc input >>= \case Right StateMachineTransition{smtConstraints,smtOldState=State{stateData=os}, smtNewState=State{stateData=ns}, smtLookups} -> do - pk <- ownPubKeyHash - let lookups = smtLookups { Constraints.slOwnPubkeyHash = Just pk } + pk <- ownPaymentPubKeyHash + let lookups = smtLookups { Constraints.slOwnPaymentPubKeyHash = Just pk } utx <- either (throwing _ConstraintResolutionError) pure (Constraints.mkTx (lookups <> userLookups) (smtConstraints <> userConstraints)) diff --git a/plutus-contract/src/Plutus/Contract/Trace.hs b/plutus-contract/src/Plutus/Contract/Trace.hs index 416e37de9f..b1c7fc5ca8 100644 --- a/plutus-contract/src/Plutus/Contract/Trace.hs +++ b/plutus-contract/src/Plutus/Contract/Trace.hs @@ -26,7 +26,7 @@ module Plutus.Contract.Trace -- * Handle contract requests , handleSlotNotifications , handleTimeNotifications - , handleOwnPubKeyHashQueries + , handleOwnPaymentPubKeyHashQueries , handleCurrentSlotQueries , handleCurrentTimeQueries , handleTimeToSlotConversions @@ -41,8 +41,8 @@ module Plutus.Contract.Trace , defaultDistFor -- * Wallets , EM.Wallet(..) - , EM.walletPubKey - , EM.walletPubKeyHash + , EM.mockWalletPaymentPubKey + , EM.mockWalletPaymentPubKeyHash , EM.knownWallets , EM.knownWallet ) where @@ -174,13 +174,13 @@ handleChainIndexQueries = E.ChainIndexQueryResp RequestHandler.handleChainIndexQueries -handleOwnPubKeyHashQueries :: +handleOwnPaymentPubKeyHashQueries :: ( Member (LogObserve (LogMessage Text)) effs , Member WalletEffect effs ) => RequestHandler effs PABReq PABResp -handleOwnPubKeyHashQueries = - generalise (preview E._OwnPublicKeyHashReq) E.OwnPublicKeyHashResp RequestHandler.handleOwnPubKeyHash +handleOwnPaymentPubKeyHashQueries = + generalise (preview E._OwnPaymentPublicKeyHashReq) E.OwnPaymentPublicKeyHashResp RequestHandler.handleOwnPaymentPubKeyHash handleOwnInstanceIdQueries :: ( Member (LogObserve (LogMessage Text)) effs diff --git a/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs b/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs index 36e3858619..a48a0006dd 100644 --- a/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs +++ b/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs @@ -17,7 +17,7 @@ module Plutus.Contract.Trace.RequestHandler( , maybeToHandler , generalise -- * handlers for common requests - , handleOwnPubKeyHash + , handleOwnPaymentPubKeyHash , handleSlotNotifications , handleCurrentSlot , handleTimeNotifications @@ -31,11 +31,11 @@ module Plutus.Contract.Trace.RequestHandler( ) where import Control.Applicative (Alternative (empty, (<|>))) -import Control.Arrow (Arrow, Kleisli (..)) +import Control.Arrow (Arrow, Kleisli (Kleisli)) import Control.Category (Category) -import Control.Lens +import Control.Lens (Prism', Profunctor, preview) import Control.Monad (foldM, guard, join) -import Control.Monad.Freer +import Control.Monad.Freer (Eff, Member) import Control.Monad.Freer.Error qualified as Eff import Control.Monad.Freer.NonDet (NonDet) import Control.Monad.Freer.NonDet qualified as NonDet @@ -43,10 +43,11 @@ import Control.Monad.Freer.Reader (Reader, ask) import Data.Monoid (Alt (Alt), Ap (Ap)) import Data.Text (Text) -import Plutus.Contract.Resumable (Request (..), Response (..)) +import Plutus.Contract.Resumable (Request (Request, itID, rqID, rqRequest), + Response (Response, rspItID, rspResponse, rspRqID)) import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg, LogObserve, logDebug, logWarn, surroundDebug) -import Ledger (POSIXTime, POSIXTimeRange, PubKeyHash, Slot, SlotRange) +import Ledger (POSIXTime, POSIXTimeRange, PaymentPubKeyHash, Slot, SlotRange) import Ledger.Constraints.OffChain (UnbalancedTx) import Ledger.TimeSlot qualified as TimeSlot import Ledger.Tx (CardanoTx) @@ -111,15 +112,15 @@ maybeToHandler f = RequestHandler $ maybe empty pure . f -- handlers for common requests -handleOwnPubKeyHash :: +handleOwnPaymentPubKeyHash :: forall a effs. ( Member WalletEffect effs , Member (LogObserve (LogMessage Text)) effs ) - => RequestHandler effs a PubKeyHash -handleOwnPubKeyHash = + => RequestHandler effs a PaymentPubKeyHash +handleOwnPaymentPubKeyHash = RequestHandler $ \_ -> - surroundDebug @Text "handleOwnPubKeyHash" Wallet.Effects.ownPubKeyHash + surroundDebug @Text "handleOwnPaymentPubKeyHash" Wallet.Effects.ownPaymentPubKeyHash handleSlotNotifications :: forall effs. diff --git a/plutus-contract/src/Plutus/Contract/Wallet.hs b/plutus-contract/src/Plutus/Contract/Wallet.hs index cc12c9d555..d7a3dd4b4a 100644 --- a/plutus-contract/src/Plutus/Contract/Wallet.hs +++ b/plutus-contract/src/Plutus/Contract/Wallet.hs @@ -109,8 +109,8 @@ handleTx = balanceTx >=> either throwError WAPI.signTxAndSubmit -- | Get an unspent output belonging to the wallet. getUnspentOutput :: AsContractError e => Contract w s e TxOutRef getUnspentOutput = do - ownPK <- Contract.ownPubKeyHash - let constraints = mustPayToPubKey ownPK (Ada.lovelaceValueOf 1) + ownPkh <- Contract.ownPaymentPubKeyHash + let constraints = mustPayToPubKey ownPkh (Ada.lovelaceValueOf 1) utx <- either (throwing _ConstraintResolutionError) pure (mkTx @Void mempty constraints) tx <- Contract.balanceTx (adjustUnbalancedTx utx) case Set.lookupMin (getCardanoTxInputs tx) of @@ -241,8 +241,15 @@ export params networkId UnbalancedTx{unBalancedTxTx, unBalancedTxUtxoIndex, unBa <*> mkInputs networkId unBalancedTxUtxoIndex <*> mkRedeemers unBalancedTxTx -mkPartialTx :: [WAPI.PubKeyHash] -> C.ProtocolParameters -> C.NetworkId -> Plutus.Tx -> Either CardanoAPI.ToCardanoError (C.Tx C.AlonzoEra) -mkPartialTx requiredSigners params networkId = fmap (C.makeSignedTransaction []) . CardanoAPI.toCardanoTxBody requiredSigners (Just params) networkId +mkPartialTx + :: [Plutus.PaymentPubKeyHash] + -> C.ProtocolParameters + -> C.NetworkId + -> Plutus.Tx + -> Either CardanoAPI.ToCardanoError (C.Tx C.AlonzoEra) +mkPartialTx requiredSigners params networkId = + fmap (C.makeSignedTransaction []) + . CardanoAPI.toCardanoTxBody requiredSigners (Just params) networkId mkInputs :: C.NetworkId -> Map Plutus.TxOutRef ScriptOutput -> Either CardanoAPI.ToCardanoError [ExportTxInput] mkInputs networkId = traverse (uncurry (toExportTxInput networkId)) . Map.toList diff --git a/plutus-contract/src/Plutus/Trace/Effects/EmulatedWalletAPI.hs b/plutus-contract/src/Plutus/Trace/Effects/EmulatedWalletAPI.hs index b6d0948679..768d57bcf8 100644 --- a/plutus-contract/src/Plutus/Trace/Effects/EmulatedWalletAPI.hs +++ b/plutus-contract/src/Plutus/Trace/Effects/EmulatedWalletAPI.hs @@ -22,7 +22,7 @@ import Data.Text (Text) import Ledger.Tx (txId) import Ledger.TxId (TxId) import Ledger.Value (Value) -import Wallet.API (WalletAPIError, defaultSlotRange, payToPublicKeyHash) +import Wallet.API (WalletAPIError, defaultSlotRange, payToPaymentPublicKeyHash) import Wallet.Effects (WalletEffect) import Wallet.Emulator qualified as EM import Wallet.Emulator.MultiAgent (MultiAgentEffect, walletAction) @@ -44,7 +44,7 @@ payToWallet :: -> Eff effs TxId payToWallet source target amount = do ctx <- liftWallet source - $ payToPublicKeyHash defaultSlotRange amount (EM.walletPubKeyHash target) + $ payToPaymentPublicKeyHash defaultSlotRange amount (EM.mockWalletPaymentPubKeyHash target) case ctx of Left _ -> error "Plutus.Trace.EmulatedWalletAPI.payToWallet: Expecting a mock tx, not an Alonzo tx" Right tx -> pure $ txId tx diff --git a/plutus-contract/src/Plutus/Trace/Emulator.hs b/plutus-contract/src/Plutus/Trace/Emulator.hs index ac96da6d4a..6a42b29b08 100644 --- a/plutus-contract/src/Plutus/Trace/Emulator.hs +++ b/plutus-contract/src/Plutus/Trace/Emulator.hs @@ -17,8 +17,8 @@ An emulator trace is a contract trace that can be run in the Plutus emulator. module Plutus.Trace.Emulator( Emulator , EmulatorTrace - , EmulatorErr(..) - , ContractHandle(..) + , Wallet.Emulator.Stream.EmulatorErr(..) + , Plutus.Trace.Emulator.Types.ContractHandle(..) , ContractInstanceTag , ContractConstraints -- * Constructing Traces @@ -49,7 +49,7 @@ module Plutus.Trace.Emulator( , ChainState.currentSlot -- ** Inspecting the agent states , EmulatorControl.agentState - , Wallet.ownPrivateKey + , Wallet.ownPaymentPrivateKey , Wallet.nodeClient , Wallet.signingProcess -- * Throwing errors @@ -74,15 +74,15 @@ module Plutus.Trace.Emulator( import Control.Foldl (generalize, list) import Control.Lens hiding ((:>)) import Control.Monad (forM_, void) -import Control.Monad.Freer +import Control.Monad.Freer (Eff, Member, interpret, interpretM, raise, reinterpret, run, runM, subsume) import Control.Monad.Freer.Coroutine (Yield) import Control.Monad.Freer.Error (Error, handleError, throwError) -import Control.Monad.Freer.Extras.Log (LogMessage (..), LogMsg (..), mapLog) +import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg, mapLog) import Control.Monad.Freer.Extras.Modify (raiseEnd) import Control.Monad.Freer.Reader (Reader, runReader) import Control.Monad.Freer.State (State, evalState) import Control.Monad.Freer.TH (makeEffect) -import Data.Default (Default (..)) +import Data.Default (Default (def)) import Data.Map qualified as Map import Data.Maybe (fromMaybe) import Plutus.Trace.Scheduler (EmSystemCall, ThreadId, exit, runThreads) @@ -91,10 +91,13 @@ import Prettyprinter.Render.String (renderString) import System.IO (Handle, hPutStrLn, stdout) import Wallet.Emulator.Chain (ChainControlEffect) import Wallet.Emulator.Chain qualified as ChainState -import Wallet.Emulator.MultiAgent (EmulatorEvent, EmulatorEvent' (..), EmulatorState (..), MultiAgentControlEffect, +import Wallet.Emulator.MultiAgent (EmulatorEvent, + EmulatorEvent' (InstanceEvent, SchedulerEvent, UserThreadEvent, WalletEvent), + EmulatorState (_chainState, _walletStates), MultiAgentControlEffect, MultiAgentEffect, _eteEmulatorTime, _eteEvent, schedulerEvent) -import Wallet.Emulator.Stream (EmulatorConfig (..), EmulatorErr (..), feeConfig, foldEmulatorStreamM, initialChainState, - initialDist, runTraceStream, slotConfig) +import Wallet.Emulator.Stream (EmulatorConfig (_initialChainState), EmulatorErr, _slotConfig, feeConfig, + foldEmulatorStreamM, initialChainState, initialDist, runTraceStream, slotConfig) +import Wallet.Emulator.Stream qualified import Wallet.Emulator.Wallet (Entity, balances) import Wallet.Emulator.Wallet qualified as Wallet @@ -111,16 +114,19 @@ import Plutus.Trace.Effects.RunContract qualified as RunContract import Plutus.Trace.Effects.Waiting (Waiting, handleWaiting) import Plutus.Trace.Effects.Waiting qualified as Waiting import Plutus.Trace.Emulator.System (launchSystemThreads) -import Plutus.Trace.Emulator.Types (ContractConstraints, ContractHandle (..), ContractInstanceLog (..), - ContractInstanceMsg (..), ContractInstanceTag, Emulator, EmulatorMessage (..), - EmulatorRuntimeError (..), EmulatorThreads, UserThreadMsg (..)) +import Plutus.Trace.Emulator.Types (ContractConstraints, ContractInstanceLog (ContractInstanceLog), + ContractInstanceMsg (ContractLog, CurrentRequests, HandledRequest, NoRequestsHandled, StoppedWithError), + ContractInstanceTag, Emulator, EmulatorMessage, + EmulatorRuntimeError (EmulatedWalletError), EmulatorThreads, + UserThreadMsg (UserLog)) +import Plutus.Trace.Emulator.Types qualified import Streaming (Stream) -import Streaming.Prelude (Of (..)) +import Streaming.Prelude (Of ((:>))) import Data.Aeson qualified as A import Ledger.TimeSlot (SlotConfig) import Plutus.V1.Ledger.Slot (getSlot) -import Plutus.V1.Ledger.Value (Value (..), flattenValue) +import Plutus.V1.Ledger.Value (Value, flattenValue) -- | A very simple effect for interpreting the output printing done by the -- trace printing functions: @@ -193,7 +199,7 @@ interpretEmulatorTrace conf action = -- initial transaction gets validated before the wallets -- try to spend their funds let action' = Waiting.nextSlot >> action >> Waiting.nextSlot - wallets = fromMaybe (Wallet.toMockWallet <$> CW.knownWallets) (preview (initialChainState . _Left . to Map.keys) conf) + wallets = fromMaybe (Wallet.toMockWallet <$> CW.knownMockWallets) (preview (initialChainState . _Left . to Map.keys) conf) in evalState @EmulatorThreads mempty $ handleDeterministicIds diff --git a/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs b/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs index 6a5073fc24..25415d5391 100644 --- a/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs +++ b/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs @@ -250,7 +250,7 @@ handleBlockchainQueries = RequestHandler.handleUnbalancedTransactions <> RequestHandler.handlePendingTransactions <> RequestHandler.handleChainIndexQueries - <> RequestHandler.handleOwnPubKeyHashQueries + <> RequestHandler.handleOwnPaymentPubKeyHashQueries <> RequestHandler.handleOwnInstanceIdQueries <> RequestHandler.handleSlotNotifications <> RequestHandler.handleCurrentSlotQueries diff --git a/plutus-contract/src/Wallet/API.hs b/plutus-contract/src/Wallet/API.hs index 0e25e93839..15a8b6f238 100644 --- a/plutus-contract/src/Wallet/API.hs +++ b/plutus-contract/src/Wallet/API.hs @@ -23,7 +23,7 @@ Mock wallet implementation module Wallet.API( WalletEffect, submitTxn, - ownPubKeyHash, + ownPaymentPubKeyHash, balanceTx, yieldUnbalancedTx, NodeClientEffect, @@ -34,8 +34,8 @@ module Wallet.API( PubKeyHash(..), signTxAndSubmit, signTxAndSubmit_, - payToPublicKeyHash, - payToPublicKeyHash_, + payToPaymentPublicKeyHash, + payToPaymentPublicKeyHash_, -- * Slot ranges Interval(..), Slot, @@ -63,13 +63,13 @@ import Control.Monad.Freer.Extras.Log (LogMsg, logWarn) import Data.Default (Default (def)) import Data.Text (Text) import Data.Void (Void) -import Ledger (CardanoTx, Interval (Interval, ivFrom, ivTo), PubKey (PubKey, getPubKey), +import Ledger (CardanoTx, Interval (Interval, ivFrom, ivTo), PaymentPubKeyHash, PubKey (PubKey, getPubKey), PubKeyHash (PubKeyHash, getPubKeyHash), Slot, SlotRange, Value, after, always, before, contains, interval, isEmpty, member, singleton, width) import Ledger.Constraints qualified as Constraints import Ledger.TimeSlot qualified as TimeSlot -import Wallet.Effects (NodeClientEffect, WalletEffect, balanceTx, getClientSlot, getClientSlotConfig, ownPubKeyHash, - publishTx, submitTxn, walletAddSignature, yieldUnbalancedTx) +import Wallet.Effects (NodeClientEffect, WalletEffect, balanceTx, getClientSlot, getClientSlotConfig, + ownPaymentPubKeyHash, publishTx, submitTxn, walletAddSignature, yieldUnbalancedTx) import Wallet.Error (WalletAPIError (PaymentMkTxError)) import Wallet.Error qualified @@ -79,13 +79,13 @@ import Wallet.Error qualified -- Note: Due to a constraint in the Cardano ledger, each tx output must have a -- minimum amount of Ada. Therefore, the funds to transfer will be adjusted -- to satisfy that constraint. See 'Ledger.Constraints.OffChain.adjustUnbalancedTx. -payToPublicKeyHash :: +payToPaymentPublicKeyHash :: ( Member WalletEffect effs , Member (Error WalletAPIError) effs , Member (LogMsg Text) effs ) - => SlotRange -> Value -> PubKeyHash -> Eff effs CardanoTx -payToPublicKeyHash range v pk = do + => SlotRange -> Value -> PaymentPubKeyHash -> Eff effs CardanoTx +payToPaymentPublicKeyHash range v pk = do let constraints = Constraints.mustPayToPubKey pk v <> Constraints.mustValidateIn (TimeSlot.slotRangeToPOSIXTimeRange def range) utx <- either (throwError . PaymentMkTxError) @@ -99,13 +99,13 @@ payToPublicKeyHash range v pk = do either throwError signTxAndSubmit balancedTx -- | Transfer some funds to an address locked by a public key. -payToPublicKeyHash_ :: +payToPaymentPublicKeyHash_ :: ( Member WalletEffect effs , Member (Error WalletAPIError) effs , Member (LogMsg Text) effs ) - => SlotRange -> Value -> PubKeyHash -> Eff effs () -payToPublicKeyHash_ r v = void . payToPublicKeyHash r v + => SlotRange -> Value -> PaymentPubKeyHash -> Eff effs () +payToPaymentPublicKeyHash_ r v = void . payToPaymentPublicKeyHash r v -- | Add the wallet's signature to the transaction and submit it. Returns -- the transaction with the wallet's signature. diff --git a/plutus-contract/src/Wallet/Effects.hs b/plutus-contract/src/Wallet/Effects.hs index efbfb41b54..41889dc129 100644 --- a/plutus-contract/src/Wallet/Effects.hs +++ b/plutus-contract/src/Wallet/Effects.hs @@ -13,7 +13,7 @@ module Wallet.Effects( -- * Wallet effect WalletEffect(..) , submitTxn - , ownPubKeyHash + , ownPaymentPubKeyHash , balanceTx , totalFunds , walletAddSignature @@ -26,14 +26,14 @@ module Wallet.Effects( ) where import Control.Monad.Freer.TH (makeEffect) -import Ledger (CardanoTx, PubKeyHash, Slot, Tx, Value) +import Ledger (CardanoTx, PaymentPubKeyHash, Slot, Tx, Value) import Ledger.Constraints.OffChain (UnbalancedTx) import Ledger.TimeSlot (SlotConfig) import Wallet.Error (WalletAPIError) data WalletEffect r where SubmitTxn :: CardanoTx -> WalletEffect () - OwnPubKeyHash :: WalletEffect PubKeyHash + OwnPaymentPubKeyHash :: WalletEffect PaymentPubKeyHash BalanceTx :: UnbalancedTx -> WalletEffect (Either WalletAPIError CardanoTx) TotalFunds :: WalletEffect Value -- ^ Total of all funds that are in the wallet (incl. tokens) WalletAddSignature :: CardanoTx -> WalletEffect CardanoTx diff --git a/plutus-contract/src/Wallet/Emulator/Error.hs b/plutus-contract/src/Wallet/Emulator/Error.hs index bc49008a76..1adc28355d 100644 --- a/plutus-contract/src/Wallet/Emulator/Error.hs +++ b/plutus-contract/src/Wallet/Emulator/Error.hs @@ -11,9 +11,9 @@ import Control.Monad.Freer.Error (Error, throwError) import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text) import GHC.Generics (Generic) -import Prettyprinter +import Prettyprinter (Pretty (pretty), viaShow, (<+>)) -import Ledger (PubKeyHash, ValidationError, Value) +import Ledger (PaymentPubKeyHash, ValidationError, Value) import Ledger.Constraints qualified as Constraints import Ledger.Tx.CardanoAPI (ToCardanoError) import Plutus.V1.Ledger.Ada (Ada) @@ -25,8 +25,8 @@ data WalletAPIError = | ChangeHasLessThanNAda Value Ada -- ^ The change when selecting coins contains less than the minimum amount -- of Ada. - | PrivateKeyNotFound PubKeyHash - -- ^ The private key of this public key hahs is not known to the wallet. + | PaymentPrivateKeyNotFound PaymentPubKeyHash + -- ^ The private key of this public key hash is not known to the wallet. | ValidationError ValidationError -- ^ There was an error during off-chain validation. | ToCardanoError ToCardanoError @@ -45,8 +45,8 @@ instance Pretty WalletAPIError where "Insufficient funds:" <+> pretty t ChangeHasLessThanNAda v ada -> "Coin change has less than" <+> pretty ada <> ":" <+> pretty v - PrivateKeyNotFound pk -> - "Private key not found:" <+> viaShow pk + PaymentPrivateKeyNotFound pk -> + "Payment private key not found:" <+> viaShow pk ValidationError e -> "Validation error:" <+> pretty e ToCardanoError t -> diff --git a/plutus-contract/src/Wallet/Emulator/Folds.hs b/plutus-contract/src/Wallet/Emulator/Folds.hs index 11fccca2f8..53aacebf23 100644 --- a/plutus-contract/src/Wallet/Emulator/Folds.hs +++ b/plutus-contract/src/Wallet/Emulator/Folds.hs @@ -49,41 +49,41 @@ module Wallet.Emulator.Folds ( ) where import Control.Applicative ((<|>)) -import Control.Foldl (Fold (..), FoldM (..)) +import Control.Foldl (Fold (Fold), FoldM (FoldM)) import Control.Foldl qualified as L import Control.Lens hiding (Empty, Fold) import Control.Monad ((>=>)) -import Control.Monad.Freer -import Control.Monad.Freer.Error +import Control.Monad.Freer (Eff, Member) +import Control.Monad.Freer.Error (Error, throwError) import Data.Aeson qualified as JSON import Data.Foldable (fold, toList) import Data.Map qualified as Map import Data.Maybe (fromMaybe, mapMaybe) import Data.Text (Text) -import Ledger (Block, OnChainTx (..), TxId) +import Ledger (Block, OnChainTx (Invalid, Valid), TxId) import Ledger.AddressMap (UtxoMap) import Ledger.AddressMap qualified as AM import Ledger.Constraints.OffChain (UnbalancedTx) -import Ledger.Index (ScriptValidationEvent, ValidationError, ValidationPhase (..)) -import Ledger.Tx (Address, Tx, TxOut (..), TxOutTx (..)) +import Ledger.Index (ScriptValidationEvent, ValidationError, ValidationPhase (Phase1, Phase2)) +import Ledger.Tx (Address, Tx, TxOut (txOutValue), TxOutTx (txOutTxOut)) import Ledger.Value (Value) import Plutus.Contract (Contract) import Plutus.Contract.Effects (PABReq, PABResp, _BalanceTxReq) import Plutus.Contract.Resumable (Request, Response) import Plutus.Contract.Resumable qualified as State -import Plutus.Contract.Types (ResumableResult (..)) +import Plutus.Contract.Types (ResumableResult (_finalState, _observableState, _requests)) import Plutus.Trace.Emulator.ContractInstance (ContractInstanceState, addEventInstanceState, emptyInstanceState, instContractState, instEvents, instHandlersHistory) import Plutus.Trace.Emulator.Types (ContractInstanceLog, ContractInstanceTag, UserThreadMsg, _HandledRequest, cilMessage, cilTag, toInstanceState) -import Prettyprinter (Pretty (..), defaultLayoutOptions, layoutPretty, vsep) +import Prettyprinter (Pretty (pretty), defaultLayoutOptions, layoutPretty, vsep) import Prettyprinter.Render.Text (renderStrict) -import Wallet.Emulator.Chain (ChainEvent (..), _TxnValidate, _TxnValidationFail) +import Wallet.Emulator.Chain (ChainEvent (SlotAdd, TxnValidate, TxnValidationFail), _TxnValidate, _TxnValidationFail) import Wallet.Emulator.LogMessages (_BalancingUnbalancedTx, _ValidationFailed) import Wallet.Emulator.MultiAgent (EmulatorEvent, EmulatorTimeEvent, chainEvent, eteEvent, instanceEvent, userThreadEvent, walletClientEvent, walletEvent') import Wallet.Emulator.NodeClient (_TxSubmit) -import Wallet.Emulator.Wallet (Wallet, _TxBalanceLog, walletAddress) +import Wallet.Emulator.Wallet (Wallet, _TxBalanceLog, mockWalletAddress) import Wallet.Rollup qualified as Rollup import Wallet.Rollup.Types (AnnotatedTx) @@ -244,7 +244,7 @@ valueAtAddress = fmap (foldMap (txOutValue . txOutTxOut)) . utxoAtAddress -- | The funds belonging to a wallet walletFunds :: Wallet -> EmulatorEventFold Value -walletFunds = valueAtAddress . walletAddress +walletFunds = valueAtAddress . mockWalletAddress -- | The fees paid by a wallet walletFees :: Wallet -> EmulatorEventFold Value diff --git a/plutus-contract/src/Wallet/Emulator/MultiAgent.hs b/plutus-contract/src/Wallet/Emulator/MultiAgent.hs index 795499877b..24d8255959 100644 --- a/plutus-contract/src/Wallet/Emulator/MultiAgent.hs +++ b/plutus-contract/src/Wallet/Emulator/MultiAgent.hs @@ -17,13 +17,14 @@ {-# OPTIONS_GHC -Wno-overlapping-patterns #-} module Wallet.Emulator.MultiAgent where -import Control.Lens -import Control.Monad -import Control.Monad.Freer -import Control.Monad.Freer.Error +import Control.Lens (AReview, Getter, Lens', Prism', anon, at, folded, makeLenses, prism', reversed, review, to, unto, + view, (&), (.~), (^.), (^..)) +import Control.Monad (join) +import Control.Monad.Freer (Eff, Member, Members, interpret, send, subsume, type (~>)) +import Control.Monad.Freer.Error (Error, throwError) import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg, LogObserve, handleObserveLog, mapLog) import Control.Monad.Freer.Extras.Modify (handleZoomedState, raiseEnd, writeIntoState) -import Control.Monad.Freer.State +import Control.Monad.Freer.State (State, get) import Data.Aeson (FromJSON, ToJSON) import Data.Map (Map) import Data.Map qualified as Map @@ -32,7 +33,7 @@ import Data.Text qualified as T import Data.Text.Extras (tshow) import GHC.Generics (Generic) import Ledger.Fee (FeeConfig) -import Prettyprinter +import Prettyprinter (Pretty (pretty), colon, (<+>)) import Ledger hiding (to, value) import Ledger.AddressMap qualified as AM @@ -44,9 +45,9 @@ import Wallet.API qualified as WAPI import Wallet.Emulator.Chain qualified as Chain import Wallet.Emulator.LogMessages (RequestHandlerLogMsg, TxBalanceMsg) import Wallet.Emulator.NodeClient qualified as NC -import Wallet.Emulator.Wallet (Wallet (..)) +import Wallet.Emulator.Wallet (Wallet) import Wallet.Emulator.Wallet qualified as Wallet -import Wallet.Types (AssertionError (..)) +import Wallet.Types (AssertionError (GenericAssertion)) -- | Assertions which will be checked during execution of the emulator. data Assertion @@ -251,7 +252,7 @@ fundsDistribution st = let fullState = view chainUtxo st wallets = st ^.. walletStates . to Map.keys . folded walletFunds = flip fmap wallets $ \w -> - (w, foldMap (txOutValue . txOutTxOut) $ view (AM.fundsAt (Wallet.walletAddress w)) fullState) + (w, foldMap (txOutValue . txOutTxOut) $ view (AM.fundsAt (Wallet.mockWalletAddress w)) fullState) in Map.fromList walletFunds -- | Get the emulator log. @@ -278,12 +279,12 @@ emulatorStatePool tp = emptyEmulatorState -- | Initialise the emulator state with a single pending transaction that -- creates the initial distribution of funds to public key addresses. -emulatorStateInitialDist :: Map PubKeyHash Value -> EmulatorState +emulatorStateInitialDist :: Map PaymentPubKeyHash Value -> EmulatorState emulatorStateInitialDist mp = emulatorStatePool [tx] where tx = Tx { txInputs = mempty , txCollateral = mempty - , txOutputs = uncurry (flip pubKeyHashTxOut) <$> Map.toList mp + , txOutputs = uncurry (flip pubKeyHashTxOut . unPaymentPubKeyHash) <$> Map.toList mp , txMint = foldMap snd $ Map.toList mp , txFee = mempty , txValidRange = WAPI.defaultSlotRange @@ -382,7 +383,7 @@ assert (OwnFundsEqual wallet value) = ownFundsEqual wallet value ownFundsEqual :: (Members MultiAgentEffs effs) => Wallet -> Value -> Eff effs () ownFundsEqual wallet value = do es <- get - let total = foldMap (txOutValue . txOutTxOut) $ es ^. chainUtxo . AM.fundsAt (Wallet.walletAddress wallet) + let total = foldMap (txOutValue . txOutTxOut) $ es ^. chainUtxo . AM.fundsAt (Wallet.mockWalletAddress wallet) if value == total then pure () else throwError $ GenericAssertion $ T.unwords ["Funds in wallet", tshow wallet, "were", tshow total, ". Expected:", tshow value] diff --git a/plutus-contract/src/Wallet/Emulator/Stream.hs b/plutus-contract/src/Wallet/Emulator/Stream.hs index bc2df0de6c..80bd41b2cf 100644 --- a/plutus-contract/src/Wallet/Emulator/Stream.hs +++ b/plutus-contract/src/Wallet/Emulator/Stream.hs @@ -33,17 +33,18 @@ import Control.Monad.Freer (Eff, Member, interpret, reinterpret, run, subsume, t import Control.Monad.Freer.Coroutine (Yield, yield) import Control.Monad.Freer.Error (Error, runError) import Control.Monad.Freer.Extras (raiseEnd, wrapError) -import Control.Monad.Freer.Extras.Log (LogLevel, LogMessage (..), LogMsg (..), logMessageContent, mapMLog) +import Control.Monad.Freer.Extras.Log (LogLevel, LogMessage (LogMessage, _logLevel), LogMsg (LMessage), + logMessageContent, mapMLog) import Control.Monad.Freer.Extras.Stream (runStream) import Control.Monad.Freer.State (State, gets, runState) import Data.Bifunctor (first) -import Data.Default (Default (..)) +import Data.Default (Default (def)) import Data.Map (Map) import Data.Map qualified as Map import Data.Maybe (fromMaybe) import Data.Set qualified as Set import Ledger.AddressMap qualified as AM -import Ledger.Blockchain (Block, OnChainTx (..)) +import Ledger.Blockchain (Block, OnChainTx (Valid)) import Ledger.Fee (FeeConfig) import Ledger.Slot (Slot) import Ledger.Value (Value) @@ -56,9 +57,9 @@ import Wallet.API (WalletAPIError) import Wallet.Emulator (EmulatorEvent, EmulatorEvent') import Wallet.Emulator qualified as EM import Wallet.Emulator.Chain (ChainControlEffect, ChainEffect, _SlotAdd) -import Wallet.Emulator.MultiAgent (EmulatorState, EmulatorTimeEvent (..), MultiAgentControlEffect, MultiAgentEffect, - chainEvent, eteEvent) -import Wallet.Emulator.Wallet (Wallet (..), walletAddress) +import Wallet.Emulator.MultiAgent (EmulatorState, EmulatorTimeEvent (EmulatorTimeEvent), MultiAgentControlEffect, + MultiAgentEffect, chainEvent, eteEvent) +import Wallet.Emulator.Wallet (Wallet, mockWalletAddress) -- TODO: Move these two to 'Wallet.Emulator.XXX'? import Ledger.TimeSlot (SlotConfig) @@ -151,7 +152,7 @@ initialDist = either id (walletFunds . map Valid) where walletFunds :: Block -> Map Wallet Value walletFunds theBlock = let values = AM.values $ AM.fromChain [theBlock] - getFunds wllt = fromMaybe mempty $ Map.lookup (walletAddress wllt) values + getFunds wllt = fromMaybe mempty $ Map.lookup (mockWalletAddress wllt) values in Map.fromSet getFunds (Set.fromList knownWallets) instance Default EmulatorConfig where @@ -164,7 +165,7 @@ instance Default EmulatorConfig where initialState :: EmulatorConfig -> EM.EmulatorState initialState EmulatorConfig{_initialChainState} = either - (EM.emulatorStateInitialDist . Map.mapKeys EM.walletPubKeyHash) + (EM.emulatorStateInitialDist . Map.mapKeys EM.mockWalletPaymentPubKeyHash) EM.emulatorStatePool _initialChainState diff --git a/plutus-contract/src/Wallet/Emulator/Types.hs b/plutus-contract/src/Wallet/Emulator/Types.hs index 4bea56fd71..c28a69ec60 100644 --- a/plutus-contract/src/Wallet/Emulator/Types.hs +++ b/plutus-contract/src/Wallet/Emulator/Types.hs @@ -13,79 +13,82 @@ {-# OPTIONS_GHC -Wno-overlapping-patterns #-} module Wallet.Emulator.Types( -- * Wallets - Wallet(..), - WalletId(..), + Wallet.Emulator.Wallet.Wallet(..), + Wallet.Emulator.Wallet.WalletId(..), Crypto.XPrv, Crypto.XPub, - walletPubKey, - walletPubKeyHash, + Wallet.Emulator.Wallet.mockWalletPaymentPubKey, + Wallet.Emulator.Wallet.mockWalletPaymentPubKeyHash, addSignature, - knownWallets, - knownWallet, - WalletNumber(..), - toWalletNumber, - fromWalletNumber, - MockWallet(..), - -- fromWalletNumber, - TxPool, + Wallet.Emulator.Wallet.knownWallets, + Wallet.Emulator.Wallet.knownWallet, + Ledger.CardanoWallet.WalletNumber(..), + Ledger.CardanoWallet.toWalletNumber, + Wallet.Emulator.Wallet.fromWalletNumber, + Ledger.CardanoWallet.MockWallet(..), + Wallet.Emulator.Chain.TxPool, -- * Emulator EmulatorEffs, - Assertion(OwnFundsEqual, IsValidated), - assert, - assertIsValidated, - AssertionError(..), - AsAssertionError(..), - ChainClientNotification(..), - EmulatorEvent, - EmulatorEvent', - EmulatorTimeEvent(..), + Wallet.Emulator.MultiAgent.Assertion(OwnFundsEqual, IsValidated), + Wallet.Emulator.MultiAgent.assert, + Wallet.Emulator.MultiAgent.assertIsValidated, + Wallet.Types.AssertionError(..), + Wallet.Types.AsAssertionError(..), + Wallet.Emulator.NodeClient.ChainClientNotification(..), + Wallet.Emulator.MultiAgent.EmulatorEvent, + Wallet.Emulator.MultiAgent.EmulatorEvent', + Wallet.Emulator.MultiAgent.EmulatorTimeEvent(..), -- ** Wallet state - WalletState(..), - emptyWalletState, - ownPrivateKey, - ownAddress, + Wallet.Emulator.Wallet.WalletState(..), + Wallet.Emulator.Wallet.emptyWalletState, + Wallet.Emulator.Wallet.ownPaymentPrivateKey, + Wallet.Emulator.Wallet.ownAddress, -- ** Traces - walletAction, - assertion, - assertOwnFundsEq, - ownFundsEqual, + Wallet.Emulator.MultiAgent.walletAction, + Wallet.Emulator.MultiAgent.assertion, + Wallet.Emulator.MultiAgent.assertOwnFundsEq, + Wallet.Emulator.MultiAgent.ownFundsEqual, -- * Emulator internals - EmulatorState(..), - emptyEmulatorState, - emulatorState, - emulatorStatePool, - emulatorStateInitialDist, - txPool, - walletStates, - index, - chainState, - currentSlot, + Wallet.Emulator.MultiAgent.EmulatorState(..), + Wallet.Emulator.MultiAgent.emptyEmulatorState, + Wallet.Emulator.MultiAgent.emulatorState, + Wallet.Emulator.MultiAgent.emulatorStatePool, + Wallet.Emulator.MultiAgent.emulatorStateInitialDist, + Wallet.Emulator.Chain.txPool, + Wallet.Emulator.MultiAgent.walletStates, + Wallet.Emulator.Chain.index, + Wallet.Emulator.MultiAgent.chainState, + Wallet.Emulator.Chain.currentSlot, processEmulated, - fundsDistribution, - emLog, - selectCoin + Wallet.Emulator.MultiAgent.fundsDistribution, + Wallet.Emulator.MultiAgent.emLog, + Wallet.Emulator.Wallet.selectCoin ) where import Cardano.Crypto.Wallet qualified as Crypto import Control.Lens hiding (index) -import Control.Monad.Freer +import Control.Monad.Freer (Eff, Member, interpret, reinterpret2, type (~>)) import Control.Monad.Freer.Error (Error) import Control.Monad.Freer.Extras qualified as Eff import Control.Monad.Freer.Extras.Log (LogMsg, mapLog) import Control.Monad.Freer.State (State) -import Ledger +import Ledger (addSignature) import Plutus.ChainIndex (ChainIndexError) -import Wallet.API (WalletAPIError (..)) +import Wallet.API (WalletAPIError) -import Ledger.CardanoWallet (MockWallet (..), WalletNumber (..), toWalletNumber) +import Ledger.CardanoWallet qualified import Ledger.Fee (FeeConfig) import Ledger.TimeSlot (SlotConfig) -import Wallet.Emulator.Chain -import Wallet.Emulator.MultiAgent -import Wallet.Emulator.NodeClient -import Wallet.Emulator.Wallet -import Wallet.Types (AsAssertionError (..), AssertionError (..)) +import Wallet.Emulator.Chain (ChainControlEffect, ChainEffect, ChainEvent, ChainState, handleChain, handleControlChain) +import Wallet.Emulator.Chain qualified +import Wallet.Emulator.MultiAgent (EmulatorEvent', EmulatorState, MultiAgentControlEffect, MultiAgentEffect, chainEvent, + chainState, handleMultiAgent, handleMultiAgentControl) +import Wallet.Emulator.MultiAgent qualified +import Wallet.Emulator.NodeClient qualified +import Wallet.Emulator.Wallet qualified +import Wallet.Types (AssertionError) +import Wallet.Types qualified type EmulatorEffs = '[MultiAgentEffect, ChainEffect, ChainControlEffect] diff --git a/plutus-contract/src/Wallet/Emulator/Wallet.hs b/plutus-contract/src/Wallet/Emulator/Wallet.hs index 7bb58138e5..19f93ebf70 100644 --- a/plutus-contract/src/Wallet/Emulator/Wallet.hs +++ b/plutus-contract/src/Wallet/Emulator/Wallet.hs @@ -42,9 +42,12 @@ import Data.String (IsString (fromString)) import Data.Text qualified as T import Data.Text.Class (fromText, toText) import GHC.Generics (Generic) -import Ledger (Address (addressCredential), CardanoTx, ChainIndexTxOut, PrivateKey, PubKey, PubKeyHash, - ScriptValidationEvent (sveScript), Tx (txFee, txMint), TxIn (TxIn, txInRef), TxOut, TxOutRef, - UtxoIndex (UtxoIndex, getIndex), ValidationCtx (ValidationCtx), ValidatorHash, Value) +import Ledger (Address (addressCredential), CardanoTx, ChainIndexTxOut, + PaymentPrivateKey (PaymentPrivateKey, unPaymentPrivateKey), + PaymentPubKey (PaymentPubKey, unPaymentPubKey), + PaymentPubKeyHash (PaymentPubKeyHash, unPaymentPubKeyHash), PubKeyHash, + ScriptValidationEvent (sveScript), StakePubKey, Tx (txFee, txMint), TxIn (TxIn, txInRef), TxOut, + TxOutRef, UtxoIndex (UtxoIndex, getIndex), ValidationCtx (ValidationCtx), ValidatorHash, Value) import Ledger qualified import Ledger.Ada qualified as Ada import Ledger.CardanoWallet (MockWallet, WalletNumber) @@ -67,7 +70,7 @@ import Prettyprinter (Pretty (pretty)) import Servant.API (FromHttpApiData (parseUrlPiece), ToHttpApiData (toUrlPiece)) import Wallet.API qualified as WAPI import Wallet.Effects (NodeClientEffect, - WalletEffect (BalanceTx, OwnPubKeyHash, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx), + WalletEffect (BalanceTx, OwnPaymentPubKeyHash, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx), publishTx) import Wallet.Emulator.Chain (ChainState (_index)) import Wallet.Emulator.LogMessages (RequestHandlerLogMsg, @@ -75,7 +78,7 @@ import Wallet.Emulator.LogMessages (RequestHandlerLogMsg, import Wallet.Emulator.NodeClient (NodeClientState, emptyNodeClientState) newtype SigningProcess = SigningProcess { - unSigningProcess :: forall effs. (Member (Error WAPI.WalletAPIError) effs) => [PubKeyHash] -> Tx -> Eff effs Tx + unSigningProcess :: forall effs. (Member (Error WAPI.WalletAPIError) effs) => [PaymentPubKeyHash] -> Tx -> Eff effs Tx } instance Show SigningProcess where @@ -91,7 +94,7 @@ toMockWallet :: MockWallet -> Wallet toMockWallet = Wallet . WalletId . CW.mwWalletId knownWallets :: [Wallet] -knownWallets = toMockWallet <$> CW.knownWallets +knownWallets = toMockWallet <$> CW.knownMockWallets knownWallet :: Integer -> Wallet knownWallet = fromWalletNumber . CW.WalletNumber @@ -131,24 +134,29 @@ fromBase16 :: T.Text -> Either String WalletId fromBase16 s = bimap show WalletId (fromText s) -- | The 'MockWallet' whose ID is the given wallet ID (if it exists) -walletMockWallet :: Wallet -> Maybe MockWallet -walletMockWallet (Wallet wid) = find ((==) wid . WalletId . CW.mwWalletId) CW.knownWallets +walletToMockWallet :: Wallet -> Maybe MockWallet +walletToMockWallet (Wallet wid) = find ((==) wid . WalletId . CW.mwWalletId) CW.knownMockWallets -- | The public key of a mock wallet. (Fails if the wallet is not a mock wallet). -walletPubKey :: Wallet -> PubKey -walletPubKey w = CW.pubKey - $ fromMaybe (error $ "Wallet.Emulator.Wallet.walletPubKey: Wallet " - <> show w - <> " is not a mock wallet") - $ walletMockWallet w - --- | The public key hash of a mock wallet. (Fails if the wallet is not a mock wallet). -walletPubKeyHash :: Wallet -> PubKeyHash -walletPubKeyHash = Ledger.pubKeyHash . walletPubKey +mockWalletPaymentPubKey :: Wallet -> PaymentPubKey +mockWalletPaymentPubKey w = + CW.paymentPubKey + $ fromMaybe (error $ "Wallet.Emulator.Wallet.walletPubKey: Wallet " + <> show w + <> " is not a mock wallet") + $ walletToMockWallet w + +-- | The payment public key hash of a mock wallet. (Fails if the wallet is not a mock wallet). +mockWalletPaymentPubKeyHash :: Wallet -> PaymentPubKeyHash +mockWalletPaymentPubKeyHash = + PaymentPubKeyHash + . Ledger.pubKeyHash + . unPaymentPubKey + . mockWalletPaymentPubKey -- | Get the address of a mock wallet. (Fails if the wallet is not a mock wallet). -walletAddress :: Wallet -> Address -walletAddress = Ledger.pubKeyHashAddress . walletPubKeyHash +mockWalletAddress :: Wallet -> Address +mockWalletAddress w = Ledger.pubKeyHashAddress (mockWalletPaymentPubKeyHash w) Nothing data WalletEvent = GenericLog T.Text @@ -177,26 +185,30 @@ data WalletState = WalletState { makeLenses ''WalletState -ownPrivateKey :: WalletState -> PrivateKey -ownPrivateKey = CW.privateKey . _mockWallet +ownPaymentPrivateKey :: WalletState -> PaymentPrivateKey +ownPaymentPrivateKey = CW.paymentPrivateKey . _mockWallet -ownPublicKey :: WalletState -> PubKey -ownPublicKey = CW.pubKey . _mockWallet +ownPaymentPublicKey :: WalletState -> PaymentPubKey +ownPaymentPublicKey = CW.paymentPubKey . _mockWallet --- | Get the user's own public-key address. +-- | Get the user's own payment public-key address. ownAddress :: WalletState -> Address -ownAddress = Ledger.pubKeyAddress . Ledger.toPublicKey . ownPrivateKey +ownAddress = flip Ledger.pubKeyAddress Nothing + . PaymentPubKey + . Ledger.toPublicKey + . unPaymentPrivateKey + . ownPaymentPrivateKey -- | An empty wallet using the given private key. -- for that wallet as the sole watched address. fromMockWallet :: MockWallet -> WalletState fromMockWallet mw = WalletState mw emptyNodeClientState mempty sp where - sp = signWithPrivateKey (CW.privateKey mw) + sp = signWithPrivateKey (CW.paymentPrivateKey mw) -- | Empty wallet state for an emulator 'Wallet'. Returns 'Nothing' if the wallet -- is not known in the emulator. emptyWalletState :: Wallet -> Maybe WalletState -emptyWalletState = fmap fromMockWallet . walletMockWallet +emptyWalletState = fmap fromMockWallet . walletToMockWallet handleWallet :: ( Member (Error WalletAPIError) effs @@ -209,7 +221,7 @@ handleWallet :: -> WalletEffect ~> Eff effs handleWallet feeCfg = \case SubmitTxn tx -> submitTxnH tx - OwnPubKeyHash -> ownPubKeyHashH + OwnPaymentPubKeyHash -> ownPaymentPubKeyHashH BalanceTx utx -> balanceTxH utx WalletAddSignature tx -> walletAddSignatureH tx TotalFunds -> totalFundsH @@ -222,8 +234,8 @@ handleWallet feeCfg = \case logInfo $ SubmittingTx tx publishTx tx - ownPubKeyHashH :: (Member (State WalletState) effs) => Eff effs PubKeyHash - ownPubKeyHashH = gets (CW.pubKeyHash . _mockWallet) + ownPaymentPubKeyHashH :: (Member (State WalletState) effs) => Eff effs PaymentPubKeyHash + ownPaymentPubKeyHashH = gets (CW.paymentPubKeyHash . _mockWallet) balanceTxH :: ( Member NodeClientEffect effs @@ -273,7 +285,7 @@ handleAddSignature :: => Tx -> Eff effs Tx handleAddSignature tx = do - privKey <- gets ownPrivateKey + (PaymentPrivateKey privKey) <- gets ownPaymentPrivateKey pure (Ledger.addSignature privKey tx) ownOutputs :: forall effs. @@ -286,7 +298,7 @@ ownOutputs WalletState{_mockWallet} = do Map.fromList . catMaybes <$> traverse txOutRefTxOutFromRef refs where cred :: Credential - cred = PubKeyCredential (CW.pubKeyHash _mockWallet) + cred = PubKeyCredential (unPaymentPubKeyHash $ CW.paymentPubKeyHash _mockWallet) -- Accumulate all unspent 'TxOutRef's from the resulting pages. allUtxoSet :: Maybe (PageQuery TxOutRef) -> Eff effs [TxOutRef] @@ -350,7 +362,8 @@ handleBalanceTx :: handleBalanceTx utxo UnbalancedTx{unBalancedTxTx} = do let filteredUnbalancedTxTx = removeEmptyOutputs unBalancedTxTx let txInputs = Set.toList $ Tx.txInputs filteredUnbalancedTxTx - ownPubKey <- gets ownPublicKey + ownPaymentPubKey <- gets ownPaymentPublicKey + let ownStakePubKey = Nothing inputValues <- traverse lookupValue (Set.toList $ Tx.txInputs filteredUnbalancedTxTx) collateral <- traverse lookupValue (Set.toList $ Tx.txCollateral filteredUnbalancedTxTx) let fees = txFee filteredUnbalancedTxTx @@ -359,7 +372,7 @@ handleBalanceTx utxo UnbalancedTx{unBalancedTxTx} = do remainingFees = fees PlutusTx.- fold collateral -- TODO: add collateralPercent balance = left PlutusTx.- right - (neg, pos) <- adjustBalanceWithMissingLovelace utxo ownPubKey filteredUnbalancedTxTx $ Value.split balance + (neg, pos) <- adjustBalanceWithMissingLovelace utxo ownPaymentPubKey filteredUnbalancedTxTx $ Value.split balance tx' <- if Value.isZero pos then do @@ -367,7 +380,7 @@ handleBalanceTx utxo UnbalancedTx{unBalancedTxTx} = do pure filteredUnbalancedTxTx else do logDebug $ AddingPublicKeyOutputFor pos - pure $ addOutputs ownPubKey pos filteredUnbalancedTxTx + pure $ addOutputs ownPaymentPubKey ownStakePubKey pos filteredUnbalancedTxTx tx'' <- if Value.isZero neg then do @@ -379,7 +392,7 @@ handleBalanceTx utxo UnbalancedTx{unBalancedTxTx} = do let inputsOutRefs = map Tx.txInRef txInputs filteredUtxo = flip Map.filterWithKey utxo $ \txOutRef _ -> txOutRef `notElem` inputsOutRefs - addInputs filteredUtxo ownPubKey neg tx' + addInputs filteredUtxo ownPaymentPubKey ownStakePubKey neg tx' if remainingFees `Value.leq` PlutusTx.zero then do @@ -398,16 +411,17 @@ adjustBalanceWithMissingLovelace :: , Member (Error WAPI.WalletAPIError) effs ) => Map.Map TxOutRef ChainIndexTxOut -- ^ The current wallet's unspent transaction outputs. - -> PubKey -- ^ Wallet's public key + -> PaymentPubKey -- ^ Wallet's public key -> Tx -- ^ An unbalanced tx -> (Value, Value) -- ^ The unbalanced tx's left and right balance. -> Eff effs (Value, Value) -- ^ New left and right balance. -adjustBalanceWithMissingLovelace utxo ownPubKey unBalancedTx (neg, pos) = do +adjustBalanceWithMissingLovelace utxo ownPaymentPubKey unBalancedTx (neg, pos) = do -- Find the tx's input value which refer to the current wallet's address. - let ownTxInputs = - filter (\TxIn {txInRef} -> Just (Ledger.pubKeyHash ownPubKey) == ((Ledger.toPubKeyHash . view Ledger.ciTxOutAddress) - =<< Map.lookup txInRef utxo)) - (Set.toList $ Tx.txInputs unBalancedTx) + let ownPkh = Ledger.pubKeyHash $ unPaymentPubKey ownPaymentPubKey + let pkhOfUnspentTxIn TxIn { txInRef } = + (Ledger.toPubKeyHash . view Ledger.ciTxOutAddress) =<< Map.lookup txInRef utxo + let ownTxInputs = filter (\txIn -> Just ownPkh == pkhOfUnspentTxIn txIn) + (Set.toList $ Tx.txInputs unBalancedTx) ownInputValues <- traverse lookupValue ownTxInputs -- When minting a token, there will be eventually a transaction output @@ -438,9 +452,9 @@ adjustBalanceWithMissingLovelace utxo ownPubKey unBalancedTx (neg, pos) = do pure (newNeg, newPos) -addOutputs :: PubKey -> Value -> Tx -> Tx -addOutputs pk vl tx = tx & over Tx.outputs (pko :) where - pko = Tx.pubKeyTxOut vl pk +addOutputs :: PaymentPubKey -> Maybe StakePubKey -> Value -> Tx -> Tx +addOutputs pk sk vl tx = tx & over Tx.outputs (pko :) where + pko = Tx.pubKeyTxOut vl pk sk addCollateral :: ( Member (Error WAPI.WalletAPIError) effs @@ -463,11 +477,12 @@ addInputs :: ( Member (Error WAPI.WalletAPIError) effs ) => Map.Map TxOutRef ChainIndexTxOut -- ^ The current wallet's unspent transaction outputs. - -> PubKey + -> PaymentPubKey + -> Maybe StakePubKey -> Value -> Tx -> Eff effs Tx -addInputs mp pk vl tx = do +addInputs mp pk sk vl tx = do (spend, change) <- selectCoin (second (view Ledger.ciTxOutValue) <$> Map.toList mp) vl let @@ -477,14 +492,14 @@ addInputs mp pk vl tx = do addTxOuts = if Value.isZero change then id - else addOutputs pk change + else addOutputs pk sk change pure $ tx & addTxOuts & addTxIns -- Make a transaction output from a positive value. -mkChangeOutput :: PubKey -> Value -> Maybe TxOut -mkChangeOutput pubK v = - if Value.isZero v then Nothing else Just (Ledger.pubKeyTxOut v pubK) +mkChangeOutput :: PaymentPubKey -> Maybe StakePubKey -> Value -> Maybe TxOut +mkChangeOutput pubK sk v = + if Value.isZero v then Nothing else Just (Ledger.pubKeyTxOut v pubK sk) -- | Given a set of @a@s with coin values, and a target value, select a number -- of @a@ such that their total value is greater than or equal to the target. @@ -546,7 +561,7 @@ takeUntil p (x:xs) defaultSigningProcess :: MockWallet -> SigningProcess defaultSigningProcess = signWallet -signWithPrivateKey :: PrivateKey -> SigningProcess +signWithPrivateKey :: PaymentPrivateKey -> SigningProcess signWithPrivateKey pk = SigningProcess $ \pks tx -> foldM (signTxWithPrivateKey pk) tx pks @@ -558,23 +573,33 @@ signWallet wllt = SigningProcess $ \pks tx -> foldM (signTxnWithKey wllt) tx pks -- | Sign the transaction with the private key of the mock wallet. -signTxnWithKey :: (Member (Error WAPI.WalletAPIError) r) => MockWallet -> Tx -> PubKeyHash -> Eff r Tx -signTxnWithKey mw = signTxWithPrivateKey (CW.privateKey mw) +signTxnWithKey + :: (Member (Error WAPI.WalletAPIError) r) + => MockWallet + -> Tx + -> PaymentPubKeyHash + -> Eff r Tx +signTxnWithKey mw = signTxWithPrivateKey (CW.paymentPrivateKey mw) -- | Sign the transaction with the private key, if the hash is that of the -- private key. -signTxWithPrivateKey :: (Member (Error WAPI.WalletAPIError) r) => PrivateKey -> Tx -> PubKeyHash -> Eff r Tx -signTxWithPrivateKey pk tx pubK = do - let ownPubKey = Ledger.toPublicKey pk - if Ledger.pubKeyHash ownPubKey == pubK +signTxWithPrivateKey + :: (Member (Error WAPI.WalletAPIError) r) + => PaymentPrivateKey + -> Tx + -> PaymentPubKeyHash + -> Eff r Tx +signTxWithPrivateKey (PaymentPrivateKey pk) tx pkh@(PaymentPubKeyHash pubK) = do + let ownPaymentPubKey = Ledger.toPublicKey pk + if Ledger.pubKeyHash ownPaymentPubKey == pubK then pure (Ledger.addSignature pk tx) - else throwError (WAPI.PrivateKeyNotFound pubK) + else throwError (WAPI.PaymentPrivateKeyNotFound pkh) -- | Sign the transaction with the given private keys, -- ignoring the list of public keys that the 'SigningProcess' is passed. -signPrivateKeys :: [PrivateKey] -> SigningProcess +signPrivateKeys :: [PaymentPrivateKey] -> SigningProcess signPrivateKeys signingKeys = SigningProcess $ \_ tx -> - pure (foldr Ledger.addSignature tx signingKeys) + pure (foldr (Ledger.addSignature . unPaymentPrivateKey) tx signingKeys) data SigningProcessControlEffect r where SetSigningProcess :: SigningProcess -> SigningProcessControlEffect () @@ -603,10 +628,10 @@ type WalletSet = Map.Map Wallet WalletState -- | Pick out all the public keys from the set of wallets and map them back to -- their corresponding wallets. -walletPubKeyHashes :: WalletSet -> Map.Map PubKeyHash Wallet -walletPubKeyHashes = foldl' f Map.empty . Map.toList +walletPaymentPubKeyHashes :: WalletSet -> Map.Map PaymentPubKeyHash Wallet +walletPaymentPubKeyHashes = foldl' f Map.empty . Map.toList where - f m (w, ws) = Map.insert (CW.pubKeyHash $ _mockWallet ws) w m + f m (w, ws) = Map.insert (CW.paymentPubKeyHash $ _mockWallet ws) w m -- | For a set of wallets, convert them into a map of value: entity, -- where entity is one of 'Entity'. @@ -614,13 +639,15 @@ balances :: ChainState -> WalletSet -> Map.Map Entity Value balances state wallets = foldl' f Map.empty . getIndex . _index $ state where toEntity :: Address -> Entity - toEntity a = case addressCredential a of - PubKeyCredential h -> case Map.lookup h ws of - Nothing -> PubKeyHashEntity h - Just w -> WalletEntity w - ScriptCredential h -> ScriptEntity h - - ws :: Map.Map PubKeyHash Wallet - ws = walletPubKeyHashes wallets + toEntity a = + case addressCredential a of + PubKeyCredential h -> + case Map.lookup (PaymentPubKeyHash h) ws of + Nothing -> PubKeyHashEntity h + Just w -> WalletEntity w + ScriptCredential h -> ScriptEntity h + + ws :: Map.Map PaymentPubKeyHash Wallet + ws = walletPaymentPubKeyHashes wallets f m o = Map.insertWith (<>) (toEntity $ Ledger.txOutAddress o) (Ledger.txOutValue o) m diff --git a/plutus-contract/src/Wallet/Rollup/Render.hs b/plutus-contract/src/Wallet/Rollup/Render.hs index f7b0de863c..50ddf68023 100644 --- a/plutus-contract/src/Wallet/Rollup/Render.hs +++ b/plutus-contract/src/Wallet/Rollup/Render.hs @@ -33,8 +33,9 @@ import Data.Set (Set) import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as Text -import Ledger (Address, Blockchain, Tx (Tx), TxId, TxIn (TxIn), TxInType (..), TxOut (TxOut), - TxOutRef (TxOutRef, txOutRefId, txOutRefIdx), Value, txFee, txMint, txOutValue, txOutputs, txSignatures) +import Ledger (Address, Blockchain, PaymentPubKey, PaymentPubKeyHash, Tx (Tx), TxId, TxIn (TxIn), TxInType (..), + TxOut (TxOut), TxOutRef (TxOutRef, txOutRefId, txOutRefIdx), Value, txFee, txMint, txOutValue, txOutputs, + txSignatures) import Ledger.Ada (Ada (Lovelace)) import Ledger.Ada qualified as Ada import Ledger.Scripts (Datum (getDatum), Script, Validator, ValidatorHash (ValidatorHash), unValidatorScript) @@ -51,26 +52,26 @@ import Wallet.Emulator.Folds (EmulatorEventFold) import Wallet.Emulator.Folds qualified as Folds import Wallet.Emulator.Types (Wallet (Wallet)) import Wallet.Rollup (doAnnotateBlockchain) -import Wallet.Rollup.Types (AnnotatedTx (AnnotatedTx), BeneficialOwner (OwnedByPubKey, OwnedByScript), +import Wallet.Rollup.Types (AnnotatedTx (AnnotatedTx), BeneficialOwner (OwnedByPaymentPubKey, OwnedByScript), DereferencedInput (DereferencedInput, InputNotFound, originalInput, refersTo), SequenceId (SequenceId, slotIndex, txIndex), balances, dereferencedInputs, toBeneficialOwner, tx, txId, valid) -showBlockchainFold :: [(PubKeyHash, Wallet)] -> EmulatorEventFold (Either Text Text) +showBlockchainFold :: [(PaymentPubKeyHash, Wallet)] -> EmulatorEventFold (Either Text Text) showBlockchainFold walletKeys = let r txns = renderStrict . layoutPretty defaultLayoutOptions <$> runReaderT (render txns) (Map.fromList walletKeys) in fmap r Folds.annotatedBlockchain -showBlockchain :: [(PubKeyHash, Wallet)] -> Blockchain -> Either Text Text +showBlockchain :: [(PaymentPubKeyHash, Wallet)] -> Blockchain -> Either Text Text showBlockchain walletKeys blockchain = flip runReaderT (Map.fromList walletKeys) $ do annotatedBlockchain <- doAnnotateBlockchain blockchain doc <- render $ reverse annotatedBlockchain pure . renderStrict . layoutPretty defaultLayoutOptions $ doc -type RenderM = ReaderT (Map PubKeyHash Wallet) (Either Text) +type RenderM = ReaderT (Map PaymentPubKeyHash Wallet) (Either Text) class Render a where render :: a -> RenderM (Doc ann) @@ -126,7 +127,7 @@ instance Render AnnotatedTx where , heading "Fee:" txFee ] -heading :: Render a => Doc ann -> a -> ReaderT (Map PubKeyHash Wallet) (Either Text) (Doc ann) +heading :: Render a => Doc ann -> a -> ReaderT (Map PaymentPubKeyHash Wallet) (Either Text) (Doc ann) heading t x = do r <- indented x pure $ fill 10 t <> r @@ -206,7 +207,7 @@ instance Render Wallet where instance Render BeneficialOwner where render (OwnedByScript address) = ("Script:" <+>) <$> render address - render (OwnedByPubKey pkh) = do + render (OwnedByPaymentPubKey pkh) = do walletKeys <- ask wallet <- lookupWallet pkh walletKeys w <- render wallet @@ -235,6 +236,18 @@ instance Render PubKeyHash where let v = Text.pack (show (pretty pkh)) in "PubKeyHash:" <+> pretty (abbreviate 40 v) +instance Render PaymentPubKey where + render pubKey = + pure $ + let v = Text.pack (show (pretty pubKey)) + in "PaymentPubKey:" <+> pretty (abbreviate 40 v) + +instance Render PaymentPubKeyHash where + render pkh = + pure $ + let v = Text.pack (show (pretty pkh)) + in "PaymentPubKeyHash:" <+> pretty (abbreviate 40 v) + instance Render Signature where render sig = pure $ @@ -308,7 +321,7 @@ numbered separator title xs = ------------------------------------------------------------ lookupWallet :: - MonadError Text m => PubKeyHash -> Map PubKeyHash Wallet -> m Wallet + MonadError Text m => PaymentPubKeyHash -> Map PaymentPubKeyHash Wallet -> m Wallet lookupWallet pkh (Map.lookup pkh -> Just wallet) = pure wallet lookupWallet pkh _ = throwError $ diff --git a/plutus-contract/src/Wallet/Rollup/Types.hs b/plutus-contract/src/Wallet/Rollup/Types.hs index 05a97a894f..a7caba4887 100644 --- a/plutus-contract/src/Wallet/Rollup/Types.hs +++ b/plutus-contract/src/Wallet/Rollup/Types.hs @@ -57,7 +57,7 @@ isFound DereferencedInput {} = True isFound (InputNotFound _) = False data BeneficialOwner - = OwnedByPubKey PubKeyHash + = OwnedByPaymentPubKey PaymentPubKeyHash | OwnedByScript ValidatorHash deriving (Eq, Show, Ord, Generic) deriving anyclass (FromJSON, ToJSON, OpenApi.ToSchema, FromJSONKey, ToJSONKey) @@ -65,7 +65,7 @@ data BeneficialOwner toBeneficialOwner :: TxOut -> BeneficialOwner toBeneficialOwner TxOut {txOutAddress=Address{addressCredential}} = case addressCredential of - PubKeyCredential pkh -> OwnedByPubKey pkh + PubKeyCredential pkh -> OwnedByPaymentPubKey (PaymentPubKeyHash pkh) ScriptCredential vh -> OwnedByScript vh data AnnotatedTx = diff --git a/plutus-contract/test/Spec/Contract.hs b/plutus-contract/test/Spec/Contract.hs index 9cab02743c..659c0eda0a 100644 --- a/plutus-contract/test/Spec/Contract.hs +++ b/plutus-contract/test/Spec/Contract.hs @@ -16,16 +16,16 @@ module Spec.Contract(tests, loopCheckpointContract, initial, upd) where import Control.Lens hiding ((.>)) import Control.Monad (forever, replicateM_, void) -import Control.Monad.Error.Lens +import Control.Monad.Error.Lens (throwing) import Control.Monad.Except (catchError) -import Control.Monad.Freer.Extras.Log (LogLevel (..)) +import Control.Monad.Freer.Extras.Log (LogLevel (Debug)) import Control.Monad.Freer.Extras.Log qualified as Log import Data.Functor.Apply ((.>)) import Data.Map qualified as Map -import Data.Void -import Test.Tasty +import Data.Void (Void) +import Test.Tasty (TestTree, testGroup) -import Ledger (Address, PubKeyHash) +import Ledger (Address, PaymentPubKeyHash) import Ledger qualified import Ledger.Ada qualified as Ada import Ledger.Constraints qualified as Constraints @@ -33,22 +33,29 @@ import Ledger.Scripts (datumHash) import Ledger.Tx (getCardanoTxId) import Plutus.Contract as Con import Plutus.Contract.State qualified as State -import Plutus.Contract.Test -import Plutus.Contract.Types (ResumableResult (..), responses) +import Plutus.Contract.Test (Shrinking (DoShrink, DontShrink), TracePredicate, assertAccumState, assertContractError, + assertDone, assertInstanceLog, assertNoFailedTransactions, assertResumableResult, + assertUserLog, checkEmulatorFails, checkPredicateOptions, defaultCheckOptions, + endpointAvailable, minLogLevel, mockWalletPaymentPubKeyHash, not, w1, w2, waitingForSlot, + walletFundsChange, (.&&.)) +import Plutus.Contract.Types (ResumableResult (ResumableResult, _finalState), responses) import Plutus.Contract.Util (loopM) import Plutus.Trace qualified as Trace import Plutus.Trace.Emulator (ContractInstanceTag, EmulatorTrace, activateContract, activeEndpoints, callEndpoint) -import Plutus.Trace.Emulator.Types (ContractInstanceLog (..), ContractInstanceMsg (..), ContractInstanceState (..), - UserThreadMsg (..)) -import Plutus.V1.Ledger.Scripts (Datum (..), DatumHash) -import Plutus.V1.Ledger.Tx (TxOut (..)) +import Plutus.Trace.Emulator.Types (ContractInstanceLog (_cilMessage), + ContractInstanceMsg (ContractLog, CurrentRequests, HandledRequest, ReceiveEndpointCall, Started, StoppedNoError), + ContractInstanceState (ContractInstanceState, instContractState), + UserThreadMsg (UserLog)) +import Plutus.V1.Ledger.Scripts (Datum (Datum), DatumHash) +import Plutus.V1.Ledger.Tx (TxOut (txOutDatumHash)) import PlutusTx qualified import Prelude hiding (not) import Wallet.Emulator qualified as EM -import Wallet.Emulator.Wallet (walletAddress) +import Wallet.Emulator.Wallet (mockWalletAddress) -import Plutus.ChainIndex.Types -import Plutus.Contract.Effects (ActiveEndpoint (..)) +import Plutus.ChainIndex.Types (RollbackState (Committed), TxOutState (Spent, Unspent), TxOutStatus, TxStatus, + TxValidity (TxValid)) +import Plutus.Contract.Effects (ActiveEndpoint (ActiveEndpoint, aeDescription, aeMetadata)) tests :: TestTree tests = @@ -128,7 +135,7 @@ tests = (waitingForSlot theContract tag 20) (void $ activateContract w1 theContract tag) - , let smallTx = Constraints.mustPayToPubKey (walletPubKeyHash w2) (Ada.adaValueOf 10) + , let smallTx = Constraints.mustPayToPubKey (mockWalletPaymentPubKeyHash w2) (Ada.adaValueOf 10) theContract :: Contract () Schema ContractError () = submitTx smallTx >>= awaitTxConfirmed . getCardanoTxId >> submitTx smallTx >>= awaitTxConfirmed . getCardanoTxId in run "handle several blockchain events" (walletFundsChange w1 (Ada.adaValueOf (-20)) @@ -159,7 +166,7 @@ tests = .&&. assertNoFailedTransactions) (void $ Trace.payToWallet w1 w2 (Ada.adaValueOf 20)) - , let theContract :: Contract () Schema ContractError () = void $ awaitUtxoProduced (walletAddress w2) + , let theContract :: Contract () Schema ContractError () = void $ awaitUtxoProduced (mockWalletAddress w2) in run "await utxo produced" (assertDone theContract tag (const True) "should receive a notification") (void $ do @@ -168,7 +175,7 @@ tests = Trace.waitNSlots 1 ) - , let theContract :: Contract () Schema ContractError () = void (utxosAt (walletAddress w1) >>= awaitUtxoSpent . fst . head . Map.toList) + , let theContract :: Contract () Schema ContractError () = void (utxosAt (mockWalletAddress w1) >>= awaitUtxoSpent . fst . head . Map.toList) in run "await txout spent" (assertDone theContract tag (const True) "should receive a notification") (void $ do @@ -177,18 +184,18 @@ tests = Trace.waitNSlots 1 ) - , let theContract :: Contract () Schema ContractError PubKeyHash = ownPubKeyHash + , let theContract :: Contract () Schema ContractError PaymentPubKeyHash = ownPaymentPubKeyHash in run "own public key" - (assertDone theContract tag (== walletPubKeyHash w2) "should return the wallet's public key") + (assertDone theContract tag (== mockWalletPaymentPubKeyHash w2) "should return the wallet's public key") (void $ activateContract w2 (void theContract) tag) - , let payment = Constraints.mustPayToPubKey (walletPubKeyHash w2) (Ada.adaValueOf 10) + , let payment = Constraints.mustPayToPubKey (mockWalletPaymentPubKeyHash w2) (Ada.adaValueOf 10) theContract :: Contract () Schema ContractError () = submitTx payment >>= awaitTxConfirmed . Ledger.getCardanoTxId in run "await tx confirmed" (assertDone theContract tag (const True) "should be done") (activateContract w1 theContract tag >> void (Trace.waitNSlots 1)) - , let payment = Constraints.mustPayToPubKey (walletPubKeyHash w2) (Ada.adaValueOf 10) + , let payment = Constraints.mustPayToPubKey (mockWalletPaymentPubKeyHash w2) (Ada.adaValueOf 10) theContract :: Contract () Schema ContractError TxStatus = submitTx payment >>= awaitTxStatusChange . Ledger.getCardanoTxId in run "await change in tx status" @@ -196,7 +203,7 @@ tests = (activateContract w1 theContract tag >> void (Trace.waitNSlots 1)) , let c :: Contract [Maybe DatumHash] Schema ContractError () = do - let w2PubKeyHash = walletPubKeyHash w2 + let w2PubKeyHash = mockWalletPaymentPubKeyHash w2 let payment = Constraints.mustPayWithDatumToPubKey w2PubKeyHash datum (Ada.adaValueOf 10) tx <- submitTx payment let txOuts = fmap fst $ Ledger.getCardanoTxOutRefs tx @@ -215,7 +222,7 @@ tests = , let c :: Contract [TxOutStatus] Schema ContractError () = do -- Submit a payment tx of 10 lovelace to W2. - let w2PubKeyHash = walletPubKeyHash w2 + let w2PubKeyHash = mockWalletPaymentPubKeyHash w2 let payment = Constraints.mustPayToPubKey w2PubKeyHash (Ada.adaValueOf 10) tx <- submitTx payment @@ -230,7 +237,7 @@ tests = -- We submit another tx which spends the utxo belonging to the -- contract's caller. It's status should be changed eventually -- to confirmed spent. - pubKeyHash <- ownPubKeyHash + pubKeyHash <- ownPaymentPubKeyHash ciTxOutM <- txOutFromRef utxo let lookups = Constraints.unspentOutputs (maybe mempty (Map.singleton utxo) ciTxOutM) submitTxConstraintsWith @Void lookups $ Constraints.mustSpendPubKeyOutput utxo @@ -306,7 +313,7 @@ tests = void $ submitTx payment in run "mustSatisfyAnyOf [mempty] works" ( assertDone c tag (const True) "should be done" - ) $ (void $ activateContract w1 c tag) + ) (void $ activateContract w1 c tag) ] checkpointContract :: Contract () Schema ContractError () diff --git a/plutus-contract/test/Spec/Emulator.hs b/plutus-contract/test/Spec/Emulator.hs index c8908afa4c..f5fd264814 100644 --- a/plutus-contract/test/Spec/Emulator.hs +++ b/plutus-contract/test/Spec/Emulator.hs @@ -12,21 +12,23 @@ module Spec.Emulator(tests) where -import Control.Lens +import Control.Lens (element, (%~), (&), (.~)) import Control.Monad (void) import Control.Monad.Freer qualified as Eff import Control.Monad.Freer.Error qualified as E import Control.Monad.Freer.Writer (Writer, runWriter, tell) import Data.ByteString.Lazy qualified as BSL import Data.ByteString.Lazy.Char8 (pack) -import Data.Default (Default (..)) +import Data.Default (Default (def)) import Data.Foldable (fold) import Data.Set qualified as Set import Hedgehog (Property, forAll, property) import Hedgehog qualified import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range -import Ledger +import Ledger (OnChainTx (Valid), PaymentPubKeyHash, ScriptContext, ScriptError (EvaluationError), + Tx (txFee, txMint, txOutputs), TxOut (txOutValue), ValidationError (ScriptFailure), Validator, Value, + mkValidatorScript, outputs, scriptTxIn, scriptTxOut, txOutRefs, unitDatum, unitRedeemer, unspentOutputs) import Ledger.Ada qualified as Ada import Ledger.Generators (Mockchain (Mockchain)) import Ledger.Generators qualified as Gen @@ -34,21 +36,20 @@ import Ledger.Index qualified as Index import Ledger.Typed.Scripts (wrapValidator) import Ledger.Value qualified as Value import Plutus.Contract.Test hiding (not) -import Plutus.Trace (EmulatorTrace, PrintEffect (..)) +import Plutus.Trace (EmulatorTrace, PrintEffect (PrintLn)) import Plutus.Trace qualified as Trace import PlutusTx qualified import PlutusTx.Numeric qualified as P import PlutusTx.Prelude qualified as PlutusTx -import Test.Tasty +import Test.Tasty (TestTree, testGroup) import Test.Tasty.Golden (goldenVsString) import Test.Tasty.Hedgehog (testProperty) -import Wallet +import Wallet (WalletAPIError, payToPaymentPublicKeyHash_, submitTxn) import Wallet.API qualified as W import Wallet.Emulator.Chain qualified as Chain -import Wallet.Emulator.Types +import Wallet.Emulator.Types (selectCoin) import Wallet.Graph qualified - tests :: TestTree tests = testGroup "all tests" [ testGroup "UTXO model" [ @@ -63,8 +64,8 @@ tests = testGroup "all tests" [ testProperty "reject invalid txn" invalidTrace, testProperty "notify wallet" notifyWallet, testProperty "log script validation failures" invalidScript, - testProperty "payToPubkey" payToPubKeyScript, - testProperty "payToPubkey-2" payToPubKeyScript2 + testProperty "payToPaymentPubkey" payToPaymentPubKeyScript, + testProperty "payToPaymentPubkey-2" payToPaymentPubKeyScript2 ], testGroup "trace output" [ goldenVsString @@ -109,10 +110,10 @@ wallet1 = knownWallet 1 wallet2 = knownWallet 2 wallet3 = knownWallet 3 -pubKey1, pubKey2, pubKey3 :: PubKeyHash -pubKey1 = walletPubKeyHash wallet1 -pubKey2 = walletPubKeyHash wallet2 -pubKey3 = walletPubKeyHash wallet3 +pubKey1, pubKey2, pubKey3 :: PaymentPubKeyHash +pubKey1 = mockWalletPaymentPubKeyHash wallet1 +pubKey2 = mockWalletPaymentPubKeyHash wallet2 +pubKey3 = mockWalletPaymentPubKeyHash wallet3 utxo :: Property utxo = property $ do @@ -128,7 +129,7 @@ txnValidFrom :: Property txnValidFrom = let five = Ada.adaValueOf 5 -- Set the validation interval to (5, 5] for the - -- transaction generated by payToPublicKeyHash_ + -- transaction generated by payToPaymentPublicKeyHash_ -- so that the transaction can be validated only during slot 5 range = W.singleton 5 @@ -137,7 +138,7 @@ txnValidFrom = .&&. walletFundsChange wallet2 five ) $ do - Trace.liftWallet wallet1 $ payToPublicKeyHash_ range five pubKey2 + Trace.liftWallet wallet1 $ payToPaymentPublicKeyHash_ range five pubKey2 void $ Trace.waitUntilSlot 6 selectCoinProp :: Property @@ -262,8 +263,8 @@ notifyWallet = (walletFundsChange wallet1 mempty) (pure ()) -payToPubKeyScript :: Property -payToPubKeyScript = +payToPaymentPubKeyScript :: Property +payToPaymentPubKeyScript = let hasInitialBalance w = walletFundsChange w mempty in checkPredicateGen Gen.generatorModel (hasInitialBalance wallet1 @@ -271,8 +272,8 @@ payToPubKeyScript = .&&. hasInitialBalance wallet3) pubKeyTransactions -payToPubKeyScript2 :: Property -payToPubKeyScript2 = +payToPaymentPubKeyScript2 :: Property +payToPaymentPubKeyScript2 = let hasInitialBalance w = walletFundsChange w mempty in checkPredicateGen Gen.generatorModel (hasInitialBalance wallet1 @@ -283,24 +284,24 @@ payToPubKeyScript2 = pubKeyTransactions :: EmulatorTrace () pubKeyTransactions = do let five = Ada.adaValueOf 5 - Trace.liftWallet wallet1 $ payToPublicKeyHash_ W.always five pubKey2 + Trace.liftWallet wallet1 $ payToPaymentPublicKeyHash_ W.always five pubKey2 _ <- Trace.nextSlot - Trace.liftWallet wallet2 $ payToPublicKeyHash_ W.always five pubKey3 + Trace.liftWallet wallet2 $ payToPaymentPublicKeyHash_ W.always five pubKey3 _ <- Trace.nextSlot - Trace.liftWallet wallet3 $ payToPublicKeyHash_ W.always five pubKey1 + Trace.liftWallet wallet3 $ payToPaymentPublicKeyHash_ W.always five pubKey1 void Trace.nextSlot pubKeyTransactions2 :: EmulatorTrace () pubKeyTransactions2 = do let payment1 = initialBalance P.- Ada.adaValueOf 10 payment2 = initialBalance P.+ Ada.adaValueOf 10 - Trace.liftWallet wallet1 $ payToPublicKeyHash_ W.always payment1 pubKey2 + Trace.liftWallet wallet1 $ payToPaymentPublicKeyHash_ W.always payment1 pubKey2 _ <- Trace.nextSlot - Trace.liftWallet wallet2 $ payToPublicKeyHash_ W.always payment2 pubKey3 + Trace.liftWallet wallet2 $ payToPaymentPublicKeyHash_ W.always payment2 pubKey3 _ <- Trace.nextSlot - Trace.liftWallet wallet3 $ payToPublicKeyHash_ W.always payment2 pubKey1 + Trace.liftWallet wallet3 $ payToPaymentPublicKeyHash_ W.always payment2 pubKey1 _ <- Trace.nextSlot - Trace.liftWallet wallet1 $ payToPublicKeyHash_ W.always (Ada.adaValueOf 20) pubKey2 + Trace.liftWallet wallet1 $ payToPaymentPublicKeyHash_ W.always (Ada.adaValueOf 20) pubKey2 void Trace.nextSlot genChainTxn :: Hedgehog.MonadGen m => m (Mockchain, Tx) diff --git a/plutus-ledger-constraints/src/Ledger/Constraints.hs b/plutus-ledger-constraints/src/Ledger/Constraints.hs index d2010a9497..3d36beacd0 100644 --- a/plutus-ledger-constraints/src/Ledger/Constraints.hs +++ b/plutus-ledger-constraints/src/Ledger/Constraints.hs @@ -6,7 +6,9 @@ module Ledger.Constraints( -- * Defining constraints , TC.mustPayToTheScript , TC.mustPayToPubKey + , TC.mustPayToPubKeyAddress , TC.mustPayWithDatumToPubKey + , TC.mustPayWithDatumToPubKeyAddress , TC.mustMintCurrency , TC.mustMintCurrencyWithRedeemer , TC.mustMintValue @@ -35,9 +37,10 @@ module Ledger.Constraints( , OC.mintingPolicy , OC.otherScript , OC.otherData - , OC.ownPubKeyHash + , OC.ownPaymentPubKeyHash + , OC.ownStakePubKeyHash , OC.mkTx - , OC.pubKey + , OC.paymentPubKey , OC.adjustUnbalancedTx -- ** Combining multiple typed scripts into one transaction , OC.SomeLookupsAndConstraints(..) diff --git a/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs b/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs index e0279f9318..75d0006165 100644 --- a/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs +++ b/plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs @@ -23,8 +23,9 @@ module Ledger.Constraints.OffChain( , mintingPolicy , otherScript , otherData - , ownPubKeyHash - , pubKey + , ownPaymentPubKeyHash + , ownStakePubKeyHash + , paymentPubKey -- * Constraints resolution , SomeLookupsAndConstraints(..) , UnbalancedTx(..) @@ -69,11 +70,12 @@ import PlutusTx.Numeric qualified as N import Data.Semigroup (First (First, getFirst)) import Ledger qualified -import Ledger.Address (pubKeyHashAddress) +import Ledger.Address (PaymentPubKey (PaymentPubKey), PaymentPubKeyHash (PaymentPubKeyHash), StakePubKeyHash, + pubKeyHashAddress) import Ledger.Address qualified as Address import Ledger.Constraints.TxConstraints (InputConstraint (InputConstraint, icRedeemer, icTxOutRef), OutputConstraint (OutputConstraint, ocDatum, ocValue), - TxConstraint (MustBeSignedBy, MustHashDatum, MustIncludeDatum, MustMintValue, MustPayToOtherScript, MustPayToPubKey, MustProduceAtLeast, MustSatisfyAnyOf, MustSpendAtLeast, MustSpendPubKeyOutput, MustSpendScriptOutput, MustValidateIn), + TxConstraint (MustBeSignedBy, MustHashDatum, MustIncludeDatum, MustMintValue, MustPayToOtherScript, MustPayToPubKeyAddress, MustProduceAtLeast, MustSatisfyAnyOf, MustSpendAtLeast, MustSpendPubKeyOutput, MustSpendScriptOutput, MustValidateIn), TxConstraints (TxConstraints, txConstraints, txOwnInputs, txOwnOutputs)) import Ledger.Crypto (pubKeyHash) import Ledger.Orphans () @@ -87,27 +89,28 @@ import Ledger.Typed.Scripts qualified as Scripts import Ledger.Typed.Tx (ConnectionError) import Ledger.Typed.Tx qualified as Typed import Plutus.V1.Ledger.Ada qualified as Ada -import Plutus.V1.Ledger.Crypto (PubKey, PubKeyHash) import Plutus.V1.Ledger.Time (POSIXTimeRange) import Plutus.V1.Ledger.Value (Value) import Plutus.V1.Ledger.Value qualified as Value data ScriptLookups a = ScriptLookups - { slMPS :: Map MintingPolicyHash MintingPolicy + { slMPS :: Map MintingPolicyHash MintingPolicy -- ^ Minting policies that the script interacts with - , slTxOutputs :: Map TxOutRef ChainIndexTxOut + , slTxOutputs :: Map TxOutRef ChainIndexTxOut -- ^ Unspent outputs that the script may want to spend - , slOtherScripts :: Map ValidatorHash Validator + , slOtherScripts :: Map ValidatorHash Validator -- ^ Validators of scripts other than "our script" - , slOtherData :: Map DatumHash Datum + , slOtherData :: Map DatumHash Datum -- ^ Datums that we might need - , slPubKeyHashes :: Map PubKeyHash PubKey + , slPaymentPubKeyHashes :: Map PaymentPubKeyHash PaymentPubKey -- ^ Public keys that we might need - , slTypedValidator :: Maybe (TypedValidator a) + , slTypedValidator :: Maybe (TypedValidator a) -- ^ The script instance with the typed validator hash & actual compiled program - , slOwnPubkeyHash :: Maybe PubKeyHash - -- ^ The contract's public key address, used for depositing tokens etc. + , slOwnPaymentPubKeyHash :: Maybe PaymentPubKeyHash + -- ^ The contract's payment public key hash, used for depositing tokens etc. + , slOwnStakePubKeyHash :: Maybe StakePubKeyHash + -- ^ The contract's stake public key hash (optional) } deriving stock (Show, Generic) deriving anyclass (ToJSON, FromJSON) @@ -118,15 +121,20 @@ instance Semigroup (ScriptLookups a) where , slTxOutputs = slTxOutputs l <> slTxOutputs r , slOtherScripts = slOtherScripts l <> slOtherScripts r , slOtherData = slOtherData l <> slOtherData r - , slPubKeyHashes = slPubKeyHashes l <> slPubKeyHashes r + , slPaymentPubKeyHashes = slPaymentPubKeyHashes l <> slPaymentPubKeyHashes r -- 'First' to match the semigroup instance of Map (left-biased) , slTypedValidator = fmap getFirst $ (First <$> slTypedValidator l) <> (First <$> slTypedValidator r) - , slOwnPubkeyHash = fmap getFirst $ (First <$> slOwnPubkeyHash l) <> (First <$> slOwnPubkeyHash r) + , slOwnPaymentPubKeyHash = + fmap getFirst $ (First <$> slOwnPaymentPubKeyHash l) + <> (First <$> slOwnPaymentPubKeyHash r) + , slOwnStakePubKeyHash = + fmap getFirst $ (First <$> slOwnStakePubKeyHash l) + <> (First <$> slOwnStakePubKeyHash r) } instance Monoid (ScriptLookups a) where mappend = (<>) - mempty = ScriptLookups mempty mempty mempty mempty mempty Nothing Nothing + mempty = ScriptLookups mempty mempty mempty mempty mempty Nothing Nothing Nothing -- | A script lookups value with a script instance. For convenience this also -- includes the minting policy script that forwards all checks to the @@ -161,12 +169,15 @@ otherData dt = let dh = datumHash dt in mempty { slOtherData = Map.singleton dh dt } --- | A script lookups value with a public key -pubKey :: PubKey -> ScriptLookups a -pubKey pk = mempty { slPubKeyHashes = Map.singleton (pubKeyHash pk) pk } +-- | A script lookups value with a payment public key +paymentPubKey :: PaymentPubKey -> ScriptLookups a +paymentPubKey ppk@(PaymentPubKey pk) = mempty { slPaymentPubKeyHashes = Map.singleton (PaymentPubKeyHash $ pubKeyHash pk) ppk } -ownPubKeyHash :: PubKeyHash -> ScriptLookups a -ownPubKeyHash ph = mempty { slOwnPubkeyHash = Just ph} +ownPaymentPubKeyHash :: PaymentPubKeyHash -> ScriptLookups a +ownPaymentPubKeyHash pkh = mempty { slOwnPaymentPubKeyHash = Just pkh } + +ownStakePubKeyHash :: StakePubKeyHash -> ScriptLookups a +ownStakePubKeyHash skh = mempty { slOwnStakePubKeyHash = Just skh } data ScriptOutput = ScriptOutput @@ -197,7 +208,7 @@ instance Pretty ScriptOutput where data UnbalancedTx = UnbalancedTx { unBalancedTxTx :: Tx - , unBalancedTxRequiredSignatories :: Map PubKeyHash (Maybe PubKey) + , unBalancedTxRequiredSignatories :: Map PaymentPubKeyHash (Maybe PaymentPubKey) , unBalancedTxUtxoIndex :: Map TxOutRef ScriptOutput , unBalancedTxValidityTimeRange :: POSIXTimeRange } @@ -389,8 +400,12 @@ addMissingValueSpent = do -- wallet will add a corresponding input when balancing the -- transaction. -- Step 4 of the process described in [Balance of value spent] - pk <- asks slOwnPubkeyHash >>= maybe (throwError OwnPubKeyMissing) pure - unbalancedTx . tx . Tx.outputs %= (Tx.TxOut{txOutAddress=pubKeyHashAddress pk,txOutValue=missing,txOutDatumHash=Nothing} :) + pkh <- asks slOwnPaymentPubKeyHash >>= maybe (throwError OwnPubKeyMissing) pure + skh <- asks slOwnStakePubKeyHash + unbalancedTx . tx . Tx.outputs %= (Tx.TxOut { txOutAddress=pubKeyHashAddress pkh skh + , txOutValue=missing + , txOutDatumHash=Nothing + } :) addMintingRedeemers :: ( MonadState ConstraintProcessingState m @@ -521,16 +536,15 @@ lookupValidator vh = let err = throwError (ValidatorHashNotFound vh) in asks slOtherScripts >>= maybe err pure . view (at vh) --- | Get the 'Map.Map PubKeyHash (Maybe PubKey)' for a pub key hash, --- associating the pub key hash with the public key (if known). --- This value that can be added to the --- 'unBalancedTxRequiredSignatories' field +-- | Get the 'Map.Map PaymentPubKeyHash (Maybe PaymentPubKey)' for a payment pub +-- key hash, associating the pub key hash with the public key (if known). +-- This value that can be added to the 'unBalancedTxRequiredSignatories' field. getSignatories :: ( MonadReader (ScriptLookups a) m) - => PubKeyHash - -> m (Map.Map PubKeyHash (Maybe PubKey)) + => PaymentPubKeyHash + -> m (Map.Map PaymentPubKeyHash (Maybe PaymentPubKey)) getSignatories pkh = - asks (Map.singleton pkh . Map.lookup pkh . slPubKeyHashes) + asks (Map.singleton pkh . Map.lookup pkh . slPaymentPubKeyHashes) -- | Modify the 'UnbalancedTx' so that it satisfies the constraints, if -- possible. Fails if a hash is missing from the lookups, or if an output @@ -595,12 +609,15 @@ processConstraint = \case unbalancedTx . tx . Tx.mintScripts %= Set.insert mintingPolicyScript unbalancedTx . tx . Tx.mint <>= value i mintRedeemers . at mpsHash .= Just red - MustPayToPubKey pk mdv vl -> do + MustPayToPubKeyAddress pk skhM mdv vl -> do -- if datum is presented, add it to 'datumWitnesses' forM_ mdv $ \dv -> do unbalancedTx . tx . Tx.datumWitnesses . at (datumHash dv) .= Just dv let hash = datumHash <$> mdv - unbalancedTx . tx . Tx.outputs %= (Tx.TxOut{txOutAddress=pubKeyHashAddress pk,txOutValue=vl,txOutDatumHash=hash} :) + unbalancedTx . tx . Tx.outputs %= (Tx.TxOut{ txOutAddress=pubKeyHashAddress pk skhM + , txOutValue=vl + , txOutDatumHash=hash + } :) valueSpentOutputs <>= provided vl MustPayToOtherScript vlh dv vl -> do let addr = Address.scriptHashAddress vlh @@ -617,5 +634,5 @@ processConstraint = \case let tryNext [] = throwError CannotSatisfyAny tryNext (hs:qs) = do - (traverse_ processConstraint hs) `catchError` \_ -> put s >> tryNext qs + traverse_ processConstraint hs `catchError` \_ -> put s >> tryNext qs tryNext xs diff --git a/plutus-ledger-constraints/src/Ledger/Constraints/OnChain.hs b/plutus-ledger-constraints/src/Ledger/Constraints/OnChain.hs index f3381e6574..c5c6634c72 100644 --- a/plutus-ledger-constraints/src/Ledger/Constraints/OnChain.hs +++ b/plutus-ledger-constraints/src/Ledger/Constraints/OnChain.hs @@ -15,9 +15,10 @@ import PlutusTx.Prelude (AdditiveSemigroup ((+)), Bool (False, True), Eq ((==)), Ord ((<=), (>=)), all, any, elem, isJust, isNothing, maybe, snd, traceIfFalse, ($), (&&), (.)) import Ledger qualified +import Ledger.Address (PaymentPubKeyHash (PaymentPubKeyHash, unPaymentPubKeyHash)) import Ledger.Constraints.TxConstraints (InputConstraint (InputConstraint, icTxOutRef), OutputConstraint (OutputConstraint, ocDatum, ocValue), - TxConstraint (MustBeSignedBy, MustHashDatum, MustIncludeDatum, MustMintValue, MustPayToOtherScript, MustPayToPubKey, MustProduceAtLeast, MustSatisfyAnyOf, MustSpendAtLeast, MustSpendPubKeyOutput, MustSpendScriptOutput, MustValidateIn), + TxConstraint (MustBeSignedBy, MustHashDatum, MustIncludeDatum, MustMintValue, MustPayToOtherScript, MustPayToPubKeyAddress, MustProduceAtLeast, MustSatisfyAnyOf, MustSpendAtLeast, MustSpendPubKeyOutput, MustSpendScriptOutput, MustValidateIn), TxConstraints (TxConstraints, txConstraints, txOwnInputs, txOwnOutputs)) import Ledger.Value qualified as Value import Plutus.V1.Ledger.Ada qualified as Ada @@ -64,9 +65,9 @@ checkTxConstraint ctx@ScriptContext{scriptContextTxInfo} = \case MustValidateIn interval -> traceIfFalse "L3" -- "Wrong validation interval" $ interval `contains` txInfoValidRange scriptContextTxInfo - MustBeSignedBy pubKey -> + MustBeSignedBy pkh -> traceIfFalse "L4" -- "Missing signature" - $ scriptContextTxInfo `V.txSignedBy` pubKey + $ scriptContextTxInfo `V.txSignedBy` unPaymentPubKeyHash pkh MustSpendAtLeast vl -> traceIfFalse "L5" -- "Spent value not OK" $ vl `leq` V.valueSpent scriptContextTxInfo @@ -85,7 +86,7 @@ checkTxConstraint ctx@ScriptContext{scriptContextTxInfo} = \case MustMintValue mps _ tn v -> traceIfFalse "L9" -- "Value minted not OK" $ Value.valueOf (txInfoMint scriptContextTxInfo) (Value.mpsSymbol mps) tn == v - MustPayToPubKey pk mdv vl -> + MustPayToPubKeyAddress (PaymentPubKeyHash pk) _ mdv vl -> let outs = V.txInfoOutputs scriptContextTxInfo hsh dv = V.findDatumHash dv scriptContextTxInfo checkOutput (Just dv) TxOut{txOutDatumHash=Just svh} = hsh dv == Just svh diff --git a/plutus-ledger-constraints/src/Ledger/Constraints/TxConstraints.hs b/plutus-ledger-constraints/src/Ledger/Constraints/TxConstraints.hs index c01f5e5195..d92616b129 100644 --- a/plutus-ledger-constraints/src/Ledger/Constraints/TxConstraints.hs +++ b/plutus-ledger-constraints/src/Ledger/Constraints/TxConstraints.hs @@ -28,7 +28,7 @@ import PlutusTx.Prelude (Bool (False, True), Foldable (foldMap), Functor (fmap), Maybe (Just, Nothing), Monoid (mempty), Semigroup ((<>)), any, concat, foldl, map, mapMaybe, not, null, ($), (.), (>>=), (||)) -import Plutus.V1.Ledger.Crypto (PubKeyHash) +import Ledger.Address (PaymentPubKeyHash, StakePubKeyHash) import Plutus.V1.Ledger.Interval qualified as I import Plutus.V1.Ledger.Scripts (Datum (Datum), DatumHash, MintingPolicyHash, Redeemer, ValidatorHash, unitRedeemer) import Plutus.V1.Ledger.Time (POSIXTimeRange) @@ -42,13 +42,13 @@ import Prelude qualified as Haskell data TxConstraint = MustIncludeDatum Datum | MustValidateIn POSIXTimeRange - | MustBeSignedBy PubKeyHash + | MustBeSignedBy PaymentPubKeyHash | MustSpendAtLeast Value | MustProduceAtLeast Value | MustSpendPubKeyOutput TxOutRef | MustSpendScriptOutput TxOutRef Redeemer | MustMintValue MintingPolicyHash Redeemer TokenName Integer - | MustPayToPubKey PubKeyHash (Maybe Datum) Value + | MustPayToPubKeyAddress PaymentPubKeyHash (Maybe StakePubKeyHash) (Maybe Datum) Value | MustPayToOtherScript ValidatorHash Datum Value | MustHashDatum DatumHash Datum | MustSatisfyAnyOf [[TxConstraint]] @@ -73,8 +73,8 @@ instance Pretty TxConstraint where hang 2 $ vsep ["must spend script output:", pretty ref, pretty red] MustMintValue mps red tn i -> hang 2 $ vsep ["must mint value:", pretty mps, pretty red, pretty tn <+> pretty i] - MustPayToPubKey pk datum v -> - hang 2 $ vsep ["must pay to pubkey:", pretty pk, pretty datum, pretty v] + MustPayToPubKeyAddress pkh skh datum v -> + hang 2 $ vsep ["must pay to pubkey address:", pretty pkh, pretty skh, pretty datum, pretty v] MustPayToOtherScript vlh dv vl -> hang 2 $ vsep ["must pay to script:", pretty vlh, pretty dv, pretty vl] MustHashDatum dvh dv -> @@ -173,7 +173,7 @@ mustValidateIn = singleton . MustValidateIn {-# INLINABLE mustBeSignedBy #-} -- | Require the transaction to be signed by the public key. -mustBeSignedBy :: forall i o. PubKeyHash -> TxConstraints i o +mustBeSignedBy :: forall i o. PaymentPubKeyHash -> TxConstraints i o mustBeSignedBy = singleton . MustBeSignedBy {-# INLINABLE mustIncludeDatum #-} @@ -193,13 +193,41 @@ mustPayToTheScript dt vl = {-# INLINABLE mustPayToPubKey #-} -- | Lock the value with a public key -mustPayToPubKey :: forall i o. PubKeyHash -> Value -> TxConstraints i o -mustPayToPubKey pk = singleton . MustPayToPubKey pk Nothing +mustPayToPubKey :: forall i o. PaymentPubKeyHash -> Value -> TxConstraints i o +mustPayToPubKey pk = singleton . MustPayToPubKeyAddress pk Nothing Nothing + +{-# INLINABLE mustPayToPubKeyAddress #-} +-- | Lock the value with a payment public key hash and (optionally) a stake +-- public key hash. +mustPayToPubKeyAddress + :: forall i o. PaymentPubKeyHash + -> StakePubKeyHash + -> Value + -> TxConstraints i o +mustPayToPubKeyAddress pkh skh = + singleton . MustPayToPubKeyAddress pkh (Just skh) Nothing {-# INLINABLE mustPayWithDatumToPubKey #-} --- | Lock the value and datum with a public key -mustPayWithDatumToPubKey :: forall i o. PubKeyHash -> Datum -> Value -> TxConstraints i o -mustPayWithDatumToPubKey pk datum = singleton . MustPayToPubKey pk (Just datum) +-- | Lock the value and datum with a payment public key hash +mustPayWithDatumToPubKey + :: forall i o. PaymentPubKeyHash + -> Datum + -> Value + -> TxConstraints i o +mustPayWithDatumToPubKey pk datum = + singleton . MustPayToPubKeyAddress pk Nothing (Just datum) + +{-# INLINABLE mustPayWithDatumToPubKeyAddress #-} +-- | Lock the value and datum with a payment public key hash and (optionally) a +-- stake public key hash. +mustPayWithDatumToPubKeyAddress + :: forall i o. PaymentPubKeyHash + -> StakePubKeyHash + -> Datum + -> Value + -> TxConstraints i o +mustPayWithDatumToPubKeyAddress pkh skh datum = + singleton . MustPayToPubKeyAddress pkh (Just skh) (Just datum) {-# INLINABLE mustPayToOtherScript #-} -- | Lock the value with a public key @@ -266,11 +294,11 @@ isSatisfiable TxConstraints{txConstraints} = in not (I.isEmpty itvl) {-# INLINABLE pubKeyPayments #-} -pubKeyPayments :: forall i o. TxConstraints i o -> [(PubKeyHash, Value)] +pubKeyPayments :: forall i o. TxConstraints i o -> [(PaymentPubKeyHash, Value)] pubKeyPayments TxConstraints{txConstraints} = Map.toList $ Map.fromListWith (<>) - (txConstraints >>= \case { MustPayToPubKey pk _ vl -> [(pk, vl)]; _ -> [] }) + (txConstraints >>= \case { MustPayToPubKeyAddress pk _ _ vl -> [(pk, vl)]; _ -> [] }) -- | The minimum 'Value' that satisfies all 'MustSpendAtLeast' constraints {-# INLINABLE mustSpendAtLeastTotal #-} @@ -287,7 +315,7 @@ mustProduceAtLeastTotal = foldl (\/) mempty . fmap f . txConstraints where f _ = mempty {-# INLINABLE requiredSignatories #-} -requiredSignatories :: forall i o. TxConstraints i o -> [PubKeyHash] +requiredSignatories :: forall i o. TxConstraints i o -> [PaymentPubKeyHash] requiredSignatories = foldMap f . txConstraints where f (MustBeSignedBy pk) = [pk] f _ = [] @@ -310,15 +338,15 @@ requiredDatums = foldMap f . txConstraints where modifiesUtxoSet :: forall i o. TxConstraints i o -> Bool modifiesUtxoSet TxConstraints{txConstraints, txOwnOutputs, txOwnInputs} = let requiresInputOutput = \case - MustSpendAtLeast{} -> True - MustProduceAtLeast{} -> True - MustSpendPubKeyOutput{} -> True - MustSpendScriptOutput{} -> True - MustMintValue{} -> True - MustPayToPubKey _ _ vl -> not (isZero vl) - MustPayToOtherScript _ _ vl -> not (isZero vl) - MustSatisfyAnyOf xs -> any requiresInputOutput $ concat xs - _ -> False + MustSpendAtLeast{} -> True + MustProduceAtLeast{} -> True + MustSpendPubKeyOutput{} -> True + MustSpendScriptOutput{} -> True + MustMintValue{} -> True + MustPayToPubKeyAddress _ _ _ vl -> not (isZero vl) + MustPayToOtherScript _ _ vl -> not (isZero vl) + MustSatisfyAnyOf xs -> any requiresInputOutput $ concat xs + _ -> False in any requiresInputOutput txConstraints || not (null txOwnOutputs) || not (null txOwnInputs) diff --git a/plutus-ledger-constraints/test/Spec.hs b/plutus-ledger-constraints/test/Spec.hs index aca8035015..6ede97ea95 100644 --- a/plutus-ledger-constraints/test/Spec.hs +++ b/plutus-ledger-constraints/test/Spec.hs @@ -1,12 +1,26 @@ +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + module Main(main) where import Control.Monad (forM_, guard, replicateM, void) -import Hedgehog (Property, forAll, property) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Data.Maybe (mapMaybe) +import Data.Void (Void) +import Hedgehog (Property, forAll, property, (===)) import Hedgehog qualified import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range +import Ledger qualified +import Ledger.Ada qualified as Ada +import Ledger.Address (StakePubKeyHash (StakePubKeyHash), addressStakingCredential) +import Ledger.Constraints as Constraints import Ledger.Constraints.OffChain qualified as OC +import Ledger.Credential (Credential (PubKeyCredential), StakingCredential (StakingHash)) +import Ledger.Crypto (PubKeyHash (PubKeyHash)) +import Ledger.Generators qualified as Gen +import Ledger.Tx (Tx (txOutputs), TxOut (TxOut, txOutAddress)) import Ledger.Value (CurrencySymbol, Value (Value)) import Ledger.Value qualified as Value import PlutusTx.AssocMap qualified as AMap @@ -17,8 +31,9 @@ main :: IO () main = defaultMain tests tests :: TestTree -tests = testGroup "all tests" [ - testProperty "missing value spent" missingValueSpentProp +tests = testGroup "all tests" + [ testProperty "missing value spent" missingValueSpentProp + , testProperty "mustPayToPubKeyAddress should create output addresses with stake pub key hash" mustPayToPubKeyAddressStakePubKeyNotNothingProp ] -- | Reduce one of the elements in a 'Value' by one. @@ -68,3 +83,25 @@ missingValueSpentProp = property $ do smaller <- forAll (reduceByOne missing) forM_ smaller $ \smaller' -> Hedgehog.assert (not (OC.vbsRequired balances `Value.leq` (actual <> smaller'))) + +-- | The 'mustPayToPubKeyAddress' should be able to set the stake public key hash to some value. +mustPayToPubKeyAddressStakePubKeyNotNothingProp :: Property +mustPayToPubKeyAddressStakePubKeyNotNothingProp = property $ do + pkh <- forAll $ Ledger.paymentPubKeyHash <$> Gen.element Gen.knownPaymentPublicKeys + let skh = StakePubKeyHash $ PubKeyHash "00000000000000000000000000000000000000000000000000000000" + txE = mkTx @Void mempty (Constraints.mustPayToPubKeyAddress pkh skh (Ada.toValue Ledger.minAdaTxOut)) + case txE of + Left _ -> + Hedgehog.assert False + Right utx -> do + let outputs = txOutputs (OC.unBalancedTxTx utx) + let stakingCreds = mapMaybe stakePaymentPubKeyHash outputs + Hedgehog.assert $ not $ null stakingCreds + forM_ stakingCreds ((===) skh) + where + stakePaymentPubKeyHash :: TxOut -> Maybe StakePubKeyHash + stakePaymentPubKeyHash TxOut { txOutAddress } = do + stakeCred <- addressStakingCredential txOutAddress + case stakeCred of + StakingHash (PubKeyCredential pkh) -> Just $ StakePubKeyHash pkh + _ -> Nothing diff --git a/plutus-ledger/plutus-ledger.cabal b/plutus-ledger/plutus-ledger.cabal index 7a865d9188..c877866f6c 100644 --- a/plutus-ledger/plutus-ledger.cabal +++ b/plutus-ledger/plutus-ledger.cabal @@ -135,24 +135,24 @@ library ghc-options: -fplugin-opt PlutusTx.Plugin:defer-errors test-suite plutus-ledger-test + import: lang type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test default-language: Haskell2010 default-extensions: ImportQualifiedPost + other-modules: + Ledger.Tx.CardanoAPISpec build-depends: + aeson -any, base >=4.9 && <5, + bytestring -any, + cardano-api -any, + cardano-api:gen -any, containers -any, - data-default -any, hedgehog -any, + plutus-ledger -any, + plutus-tx -any, tasty -any, tasty-hedgehog -any, tasty-hunit -any, - transformers -any, - plutus-ledger -any, - plutus-tx -any, - lens -any, - bytestring -any, - aeson -any, - plutus-core -any, - plutus-tx-plugin -any diff --git a/plutus-ledger/src/Ledger/Address.hs b/plutus-ledger/src/Ledger/Address.hs index b506b64487..08907f89f9 100644 --- a/plutus-ledger/src/Ledger/Address.hs +++ b/plutus-ledger/src/Ledger/Address.hs @@ -1,20 +1,87 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE TemplateHaskell #-} + module Ledger.Address ( module Export + , PaymentPrivateKey(..) + , PaymentPubKey(..) + , PaymentPubKeyHash(..) + , StakePubKey(..) + , StakePubKeyHash(..) + , paymentPubKeyHash + , pubKeyHashAddress , pubKeyAddress , scriptAddress ) where -import Ledger.Crypto (pubKeyHash) +import Codec.Serialise (Serialise) +import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey) +import Data.Hashable (Hashable) +import Data.OpenApi qualified as OpenApi +import GHC.Generics (Generic) +import Ledger.Crypto (PrivateKey, PubKey (PubKey), PubKeyHash (PubKeyHash), pubKeyHash) +import Ledger.Orphans () import Ledger.Scripts (Validator, validatorHash) -import Plutus.V1.Ledger.Address as Export -import Plutus.V1.Ledger.Credential (Credential (..)) -import Plutus.V1.Ledger.Crypto (PubKey) +import Plutus.V1.Ledger.Address as Export hiding (pubKeyHashAddress) +import Plutus.V1.Ledger.Credential (Credential (PubKeyCredential, ScriptCredential), StakingCredential (StakingHash)) +import PlutusTx qualified +import PlutusTx.Lift (makeLift) +import PlutusTx.Prelude qualified as PlutusTx +import Prettyprinter (Pretty) + +newtype PaymentPrivateKey = PaymentPrivateKey { unPaymentPrivateKey :: PrivateKey } + +newtype PaymentPubKey = PaymentPubKey { unPaymentPubKey :: PubKey } + deriving stock (Eq, Ord, Generic) + deriving anyclass (ToJSON, FromJSON, ToJSONKey, FromJSONKey, OpenApi.ToSchema) + deriving newtype (PlutusTx.Eq, PlutusTx.Ord, Serialise, PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) + deriving (Show, Pretty) via PubKey +makeLift ''PaymentPubKey + +newtype PaymentPubKeyHash = PaymentPubKeyHash { unPaymentPubKeyHash :: PubKeyHash } + deriving stock (Eq, Ord, Generic) + deriving anyclass (ToJSON, FromJSON, ToJSONKey, FromJSONKey, OpenApi.ToSchema) + deriving newtype (PlutusTx.Eq, PlutusTx.Ord, Serialise, Hashable, PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) + deriving (Show, Pretty) via PubKeyHash +makeLift ''PaymentPubKeyHash + +newtype StakePubKey = StakePubKey { unStakePubKey :: PubKey } + deriving stock (Eq, Ord, Generic) + deriving anyclass (ToJSON, FromJSON, ToJSONKey, FromJSONKey, OpenApi.ToSchema) + deriving newtype (PlutusTx.Eq, PlutusTx.Ord, Serialise, PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) + deriving (Show, Pretty) via PubKey +makeLift ''StakePubKey + +newtype StakePubKeyHash = StakePubKeyHash { unStakePubKeyHash :: PubKeyHash } + deriving stock (Eq, Ord, Generic) + deriving anyclass (ToJSON, FromJSON, ToJSONKey, FromJSONKey, OpenApi.ToSchema) + deriving newtype (PlutusTx.Eq, PlutusTx.Ord, Serialise, Hashable, PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) + deriving (Show, Pretty) via PubKeyHash +makeLift ''StakePubKeyHash + +{-# INLINABLE paymentPubKeyHash #-} +paymentPubKeyHash :: PaymentPubKey -> PaymentPubKeyHash +paymentPubKeyHash (PaymentPubKey pk) = PaymentPubKeyHash (pubKeyHash pk) + +{-# INLINABLE pubKeyHashAddress #-} +-- | The address that should be targeted by a transaction output locked by the +-- given public payment key (with it's public stake key). +-- +-- TODO: This should be moved to Plutus.V1(or V2).Ledger.Address with the newtypes. +pubKeyHashAddress :: PaymentPubKeyHash -> Maybe StakePubKeyHash -> Address +pubKeyHashAddress (PaymentPubKeyHash pkh) skh = + Address (PubKeyCredential pkh) + (fmap (StakingHash . PubKeyCredential . unStakePubKeyHash) skh) {-# INLINABLE pubKeyAddress #-} -- | The address that should be targeted by a transaction output locked by the given public key. -pubKeyAddress :: PubKey -> Address -pubKeyAddress pk = Address (PubKeyCredential (pubKeyHash pk)) Nothing +pubKeyAddress :: PaymentPubKey -> Maybe StakePubKey -> Address +pubKeyAddress (PaymentPubKey pk) skh = + Address (PubKeyCredential (pubKeyHash pk)) + (fmap (StakingHash . PubKeyCredential . pubKeyHash . unStakePubKey) skh) +{-# INLINABLE scriptAddress #-} -- | The address that should be used by a transaction output locked by the given validator script. scriptAddress :: Validator -> Address scriptAddress validator = Address (ScriptCredential (validatorHash validator)) Nothing diff --git a/plutus-ledger/src/Ledger/Blockchain.hs b/plutus-ledger/src/Ledger/Blockchain.hs index 2ec51672ee..9e0fc4bfbf 100644 --- a/plutus-ledger/src/Ledger/Blockchain.hs +++ b/plutus-ledger/src/Ledger/Blockchain.hs @@ -48,14 +48,15 @@ import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.Encoding (decodeUtf8') import GHC.Generics (Generic) -import Ledger.Tx (TxOutTx (..), spentOutputs, txId, unspentOutputsTx, updateUtxo, validValuesTx) +import Ledger.Tx (spentOutputs, txId, unspentOutputsTx, updateUtxo) import Prettyprinter (Pretty (..), (<+>)) +import Data.Either (fromRight) import Data.OpenApi qualified as OpenApi import Plutus.V1.Ledger.Crypto import Plutus.V1.Ledger.Scripts -import Plutus.V1.Ledger.Tx (Tx, TxIn, TxOut, TxOutRef (..), collateralInputs, inputs, txOutDatum, txOutPubKey, - txOutValue, txOutputs, updateUtxoCollateral) +import Plutus.V1.Ledger.Tx (Tx, TxIn, TxOut, TxOutRef (..), TxOutTx (TxOutTx, txOutTxOut, txOutTxTx), collateralInputs, + inputs, txOutDatum, txOutPubKey, txOutValue, txOutputs, updateUtxoCollateral, validValuesTx) import Plutus.V1.Ledger.TxId import Plutus.V1.Ledger.Value (Value) @@ -76,7 +77,7 @@ instance OpenApi.ToSchema BlockId where declareNamedSchema _ = OpenApi.declareNamedSchema (Proxy @String) instance Pretty BlockId where - pretty (BlockId blockId) = "BlockId(" <> pretty (either (const $ JSON.encodeByteString blockId) id $ decodeUtf8' blockId) <> ")" + pretty (BlockId blockId) = "BlockId(" <> pretty (fromRight (JSON.encodeByteString blockId) $ decodeUtf8' blockId) <> ")" -- | A transaction on the blockchain. -- Invalid transactions are still put on the chain to be able to collect fees. diff --git a/plutus-ledger/src/Ledger/CardanoWallet.hs b/plutus-ledger/src/Ledger/CardanoWallet.hs index 1d5a64ff2f..d37d19edca 100644 --- a/plutus-ledger/src/Ledger/CardanoWallet.hs +++ b/plutus-ledger/src/Ledger/CardanoWallet.hs @@ -14,13 +14,13 @@ module Ledger.CardanoWallet( WalletNumber(..), fromWalletNumber, toWalletNumber, - knownWallets, - knownWallet, + knownMockWallets, + knownMockWallet, fromSeed, -- ** Keys - privateKey, - pubKeyHash, - pubKey + paymentPrivateKey, + paymentPubKeyHash, + paymentPubKey ) where import Cardano.Address.Derivation (XPrv) @@ -37,10 +37,12 @@ import Data.List (findIndex) import Data.Maybe (fromMaybe) import Data.Text qualified as T import GHC.Generics (Generic) -import Ledger.Crypto (PrivateKey, PubKey (..), PubKeyHash (..)) +import Ledger (PaymentPrivateKey (PaymentPrivateKey), PaymentPubKey (PaymentPubKey, unPaymentPubKey), + PaymentPubKeyHash (PaymentPubKeyHash)) +import Ledger.Crypto (PubKey (..)) import Ledger.Crypto qualified as Crypto -import Plutus.V1.Ledger.Bytes (LedgerBytes (..)) -import Servant.API (FromHttpApiData (..), ToHttpApiData (..)) +import Plutus.V1.Ledger.Bytes (LedgerBytes (getLedgerBytes)) +import Servant.API (FromHttpApiData, ToHttpApiData) newtype MockPrivateKey = MockPrivateKey { unMockPrivateKey :: XPrv } @@ -56,8 +58,9 @@ instance Hashable MockPrivateKey where -- | Emulated wallet with a key and a passphrase data MockWallet = MockWallet - { mwWalletId :: CW.WalletId - , mwKey :: MockPrivateKey + { mwWalletId :: CW.WalletId + , mwPaymentKey :: MockPrivateKey + , mwStakeKey :: Maybe MockPrivateKey } deriving Show @@ -71,9 +74,10 @@ fromWalletNumber :: WalletNumber -> MockWallet fromWalletNumber (WalletNumber i) = fromSeed (BSL.toStrict $ serialise i) fromSeed :: BS.ByteString -> MockWallet -fromSeed bs = MockWallet{mwWalletId, mwKey} where +fromSeed bs = MockWallet{mwWalletId, mwPaymentKey, mwStakeKey} where missing = max 0 (32 - BS.length bs) bs' = bs <> BS.replicate missing 0 + k = Crypto.generateFromSeed bs' mwWalletId = CW.WalletId $ fromMaybe (error "Ledger.CardanoWallet.fromSeed: digestFromByteString") $ Crypto.digestFromByteString @@ -81,32 +85,32 @@ fromSeed bs = MockWallet{mwWalletId, mwKey} where $ getLedgerBytes $ getPubKey $ Crypto.toPublicKey k - k = Crypto.generateFromSeed bs' - mwKey = MockPrivateKey k + mwPaymentKey = MockPrivateKey k + mwStakeKey = Nothing toWalletNumber :: MockWallet -> WalletNumber toWalletNumber MockWallet{mwWalletId=w} = maybe (error "Ledger.CardanoWallet.toWalletNumber: not a known wallet") (WalletNumber . toInteger . succ) - $ findIndex ((==) w . mwWalletId) knownWallets + $ findIndex ((==) w . mwWalletId) knownMockWallets -- | The wallets used in mockchain simulations by default. There are -- ten wallets by default. -knownWallets :: [MockWallet] -knownWallets = fromWalletNumber . WalletNumber <$> [1..10] +knownMockWallets :: [MockWallet] +knownMockWallets = fromWalletNumber . WalletNumber <$> [1..10] -- | Get a known wallet from an @Integer@ indexed from 1 to 10. -knownWallet :: Integer -> MockWallet -knownWallet = (knownWallets !!) . pred . fromInteger +knownMockWallet :: Integer -> MockWallet +knownMockWallet = (knownMockWallets !!) . pred . fromInteger -- | Mock wallet's private key -privateKey :: MockWallet -> PrivateKey -privateKey = unMockPrivateKey . mwKey +paymentPrivateKey :: MockWallet -> PaymentPrivateKey +paymentPrivateKey = PaymentPrivateKey . unMockPrivateKey . mwPaymentKey -- | The mock wallet's public key hash -pubKeyHash :: MockWallet -> PubKeyHash -pubKeyHash = Crypto.pubKeyHash . pubKey +paymentPubKeyHash :: MockWallet -> PaymentPubKeyHash +paymentPubKeyHash = PaymentPubKeyHash . Crypto.pubKeyHash . unPaymentPubKey . paymentPubKey --- | The mock wallet's public key -pubKey :: MockWallet -> PubKey -pubKey = Crypto.toPublicKey . unMockPrivateKey . mwKey +-- | The mock wallet's payment public key +paymentPubKey :: MockWallet -> PaymentPubKey +paymentPubKey = PaymentPubKey . Crypto.toPublicKey . unMockPrivateKey . mwPaymentKey diff --git a/plutus-ledger/src/Ledger/Crypto.hs b/plutus-ledger/src/Ledger/Crypto.hs index 8e46cdce9c..e8450a8821 100644 --- a/plutus-ledger/src/Ledger/Crypto.hs +++ b/plutus-ledger/src/Ledger/Crypto.hs @@ -15,10 +15,10 @@ module Ledger.Crypto ) where import Cardano.Crypto.Wallet qualified as Crypto -import Crypto.Hash as Crypto +import Crypto.Hash qualified as Crypto import Data.ByteArray qualified as BA import Data.ByteString qualified as BS -import Plutus.V1.Ledger.Api +import Plutus.V1.Ledger.Api (LedgerBytes (LedgerBytes), TxId (TxId), fromBuiltin, toBuiltin) import Plutus.V1.Ledger.Bytes qualified as KB import Plutus.V1.Ledger.Crypto as Export hiding (PrivateKey) import PlutusTx.Prelude qualified as P diff --git a/plutus-ledger/src/Ledger/Generators.hs b/plutus-ledger/src/Ledger/Generators.hs index 95ca8c255a..fde6c7b451 100644 --- a/plutus-ledger/src/Ledger/Generators.hs +++ b/plutus-ledger/src/Ledger/Generators.hs @@ -43,7 +43,8 @@ module Ledger.Generators( genTokenName, splitVal, validateMockchain, - signAll + signAll, + knownPaymentPublicKeys ) where import Cardano.Api qualified as C @@ -51,7 +52,7 @@ import Control.Monad (replicateM) import Control.Monad.Except (runExceptT) import Control.Monad.Reader (runReaderT) import Control.Monad.Trans.Writer (runWriter) -import Data.Bifunctor (Bifunctor (..)) +import Data.Bifunctor (Bifunctor (first)) import Data.ByteString qualified as BS import Data.Default (Default (def)) import Data.Foldable (fold, foldl') @@ -68,11 +69,19 @@ import Gen.Cardano.Api.Typed qualified as Gen import Hedgehog import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range -import Ledger +import Ledger (Ada, CurrencySymbol, Interval, MintingPolicy, OnChainTx (Valid), POSIXTime (POSIXTime, getPOSIXTime), + POSIXTimeRange, PaymentPrivateKey (unPaymentPrivateKey), PaymentPubKey (PaymentPubKey), + RedeemerPtr (RedeemerPtr), ScriptContext (ScriptContext), ScriptTag (Mint), Slot (Slot), SlotRange, + SomeCardanoApiTx (SomeTx), TokenName, + Tx (txFee, txInputs, txMint, txMintScripts, txOutputs, txRedeemers, txValidRange), TxIn, + TxInInfo (txInInfoOutRef), TxInfo (TxInfo), TxOut (txOutValue), TxOutRef (TxOutRef), + UtxoIndex (UtxoIndex), ValidationCtx (ValidationCtx), Value, _runValidation, addSignature, + mkMintingPolicyScript, pubKeyTxIn, pubKeyTxOut, scriptCurrencySymbol, toPublicKey, txId) +import Ledger qualified import Ledger.CardanoWallet qualified as CW import Ledger.Fee (FeeConfig (fcScriptsFeeFactor), calcFees) import Ledger.Index qualified as Index -import Ledger.TimeSlot (SlotConfig (..)) +import Ledger.TimeSlot (SlotConfig) import Ledger.TimeSlot qualified as TimeSlot import Ledger.Value qualified as Value import Plutus.V1.Ledger.Ada qualified as Ada @@ -83,13 +92,14 @@ import PlutusTx qualified -- | Attach signatures of all known private keys to a transaction. signAll :: Tx -> Tx -signAll tx = foldl' (flip addSignature) tx knownPrivateKeys +signAll tx = foldl' (flip addSignature) tx + $ fmap unPaymentPrivateKey knownPaymentPrivateKeys -- | The parameters for the generators in this module. data GeneratorModel = GeneratorModel { - gmInitialBalance :: Map PubKey Value, + gmInitialBalance :: Map PaymentPubKey Value, -- ^ Value created at the beginning of the blockchain. - gmPubKeys :: Set PubKey + gmPubKeys :: Set PaymentPubKey -- ^ Public keys that are to be used for generating transactions. } deriving Show @@ -97,7 +107,7 @@ data GeneratorModel = GeneratorModel { generatorModel :: GeneratorModel generatorModel = let vl = Ada.lovelaceValueOf 100_000_000 - pubKeys = toPublicKey <$> knownPrivateKeys + pubKeys = knownPaymentPublicKeys in GeneratorModel @@ -152,7 +162,7 @@ genInitialTransaction :: -> (Tx, [TxOut]) genInitialTransaction GeneratorModel{..} = let - o = (uncurry $ flip pubKeyTxOut) <$> Map.toList gmInitialBalance + o = fmap (\f -> f Nothing) $ (uncurry $ flip pubKeyTxOut) <$> Map.toList gmInitialBalance t = fold gmInitialBalance in (mempty { txOutputs = o, @@ -224,7 +234,7 @@ genValidTransactionSpending' g feeCfg ins totalVal = do Ada.toValue outValForMint <> mv : fmap Ada.toValue (List.delete outValForMint splitOutVals) let tx = mempty { txInputs = ins - , txOutputs = uncurry pubKeyTxOut <$> zip outVals (Set.toList $ gmPubKeys g) + , txOutputs = fmap (\f -> f Nothing) $ uncurry pubKeyTxOut <$> zip outVals (Set.toList $ gmPubKeys g) , txMint = maybe mempty id mintValue , txMintScripts = Set.singleton alwaysSucceedPolicy , txRedeemers = Map.singleton (RedeemerPtr Mint 0) Script.unitRedeemer @@ -286,7 +296,7 @@ genSomeCardanoApiTx = Gen.choice [ genByronEraInCardanoModeTx , genAlonzoEraInCardanoModeTx ] -genByronEraInCardanoModeTx :: (GenBase m ~ Identity, MonadGen m) => m SomeCardanoApiTx +genByronEraInCardanoModeTx :: (GenBase m ~ Identity, MonadGen m) => m SomeCardanoApiTx genByronEraInCardanoModeTx = do tx <- fromGenT $ Gen.genTx C.ByronEra pure $ SomeTx tx C.ByronEraInCardanoMode @@ -425,5 +435,9 @@ genMintingPolicyContext chain = do purpose <- genScriptPurposeMinting txInfo pure $ ScriptContext txInfo purpose -knownPrivateKeys :: [PrivateKey] -knownPrivateKeys = CW.privateKey <$> CW.knownWallets +knownPaymentPublicKeys :: [PaymentPubKey] +knownPaymentPublicKeys = + PaymentPubKey . toPublicKey . unPaymentPrivateKey <$> knownPaymentPrivateKeys + +knownPaymentPrivateKeys :: [PaymentPrivateKey] +knownPaymentPrivateKeys = CW.paymentPrivateKey <$> CW.knownMockWallets diff --git a/plutus-ledger/src/Ledger/Tx.hs b/plutus-ledger/src/Ledger/Tx.hs index 60564fa10f..2937c85d4a 100644 --- a/plutus-ledger/src/Ledger/Tx.hs +++ b/plutus-ledger/src/Ledger/Tx.hs @@ -43,23 +43,23 @@ module Ledger.Tx import Cardano.Api qualified as C import Cardano.Crypto.Hash (SHA256, digest) import Codec.CBOR.Write qualified as Write -import Codec.Serialise (Serialise (..)) -import Control.Lens hiding ((.=)) +import Codec.Serialise (Serialise (encode)) +import Control.Lens (At (at), makeLenses, makePrisms, (&), (?~)) import Data.Aeson (FromJSON, ToJSON) import Data.Map (Map) import Data.Map qualified as Map import Data.OpenApi qualified as OpenApi -import Data.Proxy +import Data.Proxy (Proxy (Proxy)) import Data.Set (Set) import Data.Set qualified as Set import GHC.Generics (Generic) -import Ledger.Address (pubKeyAddress, scriptAddress) -import Ledger.Crypto (PrivateKey, PubKey, signTx, toPublicKey) +import Ledger.Address (PaymentPubKey, StakePubKey, pubKeyAddress, scriptAddress) +import Ledger.Crypto (PrivateKey, signTx, toPublicKey) import Ledger.Orphans () import Ledger.Scripts (datumHash) import Ledger.Tx.CardanoAPI (SomeCardanoApiTx (SomeTx)) import Ledger.Tx.CardanoAPI qualified as CardanoAPI -import Plutus.V1.Ledger.Api (Credential (PubKeyCredential, ScriptCredential), Datum, DatumHash, TxId (..), Validator, +import Plutus.V1.Ledger.Api (Credential (PubKeyCredential, ScriptCredential), Datum, DatumHash, TxId (TxId), Validator, ValidatorHash, Value, addressCredential, toBuiltin) import Plutus.V1.Ledger.Tx as Export import Prettyprinter (Pretty (pretty), braces, colon, hang, nest, viaShow, vsep, (<+>)) @@ -180,9 +180,9 @@ scriptTxOut' v a ds = TxOut a v (Just (datumHash ds)) scriptTxOut :: Value -> Validator -> Datum -> TxOut scriptTxOut v vs = scriptTxOut' v (scriptAddress vs) --- | Create a transaction output locked by a public key. -pubKeyTxOut :: Value -> PubKey -> TxOut -pubKeyTxOut v pk = TxOut (pubKeyAddress pk) v Nothing +-- | Create a transaction output locked by a public payment key and optionnaly a public stake key. +pubKeyTxOut :: Value -> PaymentPubKey -> Maybe StakePubKey -> TxOut +pubKeyTxOut v pk sk = TxOut (pubKeyAddress pk sk) v Nothing -- | Sign the transaction with a 'PrivateKey' and add the signature to the -- transaction's list of signatures. @@ -190,4 +190,3 @@ addSignature :: PrivateKey -> Tx -> Tx addSignature privK tx = tx & signatures . at pubK ?~ sig where sig = signTx (txId tx) privK pubK = toPublicKey privK - diff --git a/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs b/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs index 017221c812..1226c83178 100644 --- a/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs +++ b/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs @@ -88,6 +88,7 @@ import Data.Set qualified as Set import Data.Tuple (swap) import Data.Typeable (Typeable) import GHC.Generics (Generic) +import Ledger.Address qualified as P import Ledger.Scripts qualified as P import Ledger.Tx.CardanoAPITemp (makeTransactionBody') import Plutus.V1.Ledger.Ada qualified as Ada @@ -305,7 +306,7 @@ fromAlonzoLedgerScript (Alonzo.PlutusScript _ bs) = toCardanoTxBody :: - [Api.PubKeyHash] -- ^ Required signers of the transaction + [P.PaymentPubKeyHash] -- ^ Required signers of the transaction -> Maybe C.ProtocolParameters -- ^ Protocol parameters to use. Building Plutus transactions will fail if this is 'Nothing' -> C.NetworkId -- ^ Network ID -> P.Tx @@ -458,14 +459,14 @@ fromCardanoPaymentCredential (C.PaymentCredentialByKey paymentKeyHash) = Credent fromCardanoPaymentCredential (C.PaymentCredentialByScript scriptHash) = Credential.ScriptCredential (fromCardanoScriptHash scriptHash) toCardanoPaymentCredential :: Credential.Credential -> Either ToCardanoError C.PaymentCredential -toCardanoPaymentCredential (Credential.PubKeyCredential pubKeyHash) = C.PaymentCredentialByKey <$> toCardanoPaymentKeyHash pubKeyHash +toCardanoPaymentCredential (Credential.PubKeyCredential pubKeyHash) = C.PaymentCredentialByKey <$> toCardanoPaymentKeyHash (P.PaymentPubKeyHash pubKeyHash) toCardanoPaymentCredential (Credential.ScriptCredential validatorHash) = C.PaymentCredentialByScript <$> toCardanoScriptHash validatorHash fromCardanoPaymentKeyHash :: C.Hash C.PaymentKey -> P.PubKeyHash fromCardanoPaymentKeyHash paymentKeyHash = P.PubKeyHash $ PlutusTx.toBuiltin $ C.serialiseToRawBytes paymentKeyHash -toCardanoPaymentKeyHash :: P.PubKeyHash -> Either ToCardanoError (C.Hash C.PaymentKey) -toCardanoPaymentKeyHash (P.PubKeyHash bs) = +toCardanoPaymentKeyHash :: P.PaymentPubKeyHash -> Either ToCardanoError (C.Hash C.PaymentKey) +toCardanoPaymentKeyHash (P.PaymentPubKeyHash (P.PubKeyHash bs)) = let bsx = PlutusTx.fromBuiltin bs tg = "toCardanoPaymentKeyHash (" <> show (BS.length bsx) <> " bytes)" in tag tg $ deserialiseFromRawBytes (C.AsHash C.AsPaymentKey) bsx diff --git a/plutus-ledger/src/Ledger/Typed/Tx.hs b/plutus-ledger/src/Ledger/Typed/Tx.hs index 202c694e12..198724fc5d 100644 --- a/plutus-ledger/src/Ledger/Typed/Tx.hs +++ b/plutus-ledger/src/Ledger/Typed/Tx.hs @@ -27,23 +27,26 @@ module Ledger.Typed.Tx where import Control.Lens (preview) -import Ledger.Scripts -import Ledger.Tx -import Ledger.Typed.Scripts -import Plutus.V1.Ledger.Crypto +import Ledger.Address (PaymentPubKey, StakePubKey) +import Ledger.Scripts (Datum (Datum), DatumHash, Redeemer (Redeemer), datumHash) +import Ledger.Tx (Address, ChainIndexTxOut, TxIn (TxIn, txInRef, txInType), + TxInType (ConsumePublicKeyAddress, ConsumeScriptAddress), + TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue), TxOutRef, _ScriptChainIndexTxOut, + pubKeyTxOut) +import Ledger.Typed.Scripts (DatumType, RedeemerType, TypedValidator, validatorAddress, validatorScript) import Plutus.V1.Ledger.Value qualified as Value -import PlutusTx +import PlutusTx (BuiltinData, FromData, ToData, builtinDataToData, dataToBuiltinData, fromBuiltinData, toBuiltinData) import Codec.Serialise (deserialise, serialise) import Data.ByteString.Lazy qualified as BSL -import Data.Aeson (FromJSON (..), ToJSON (..), Value (Object), object, (.:), (.=)) +import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value (Object), object, (.:), (.=)) import Data.Aeson.Types (typeMismatch) import GHC.Generics (Generic) import Prettyprinter (Pretty (pretty), viaShow, (<+>)) -import Control.Monad.Except +import Control.Monad.Except (MonadError, throwError, unless) -- | A 'TxIn' tagged by two phantom types: a list of the types of the data scripts in the transaction; and the connection type of the input. data TypedScriptTxIn a = TypedScriptTxIn { tyTxInTxIn :: TxIn, tyTxInOutRef :: TypedScriptTxOutRef a } @@ -141,8 +144,8 @@ newtype PubKeyTxOut = PubKeyTxOut { unPubKeyTxOut :: TxOut } deriving newtype (FromJSON, ToJSON) -- | Create a 'PubKeyTxOut'. -makePubKeyTxOut :: Value.Value -> PubKey -> PubKeyTxOut -makePubKeyTxOut value pubKey = PubKeyTxOut $ pubKeyTxOut value pubKey +makePubKeyTxOut :: Value.Value -> PaymentPubKey -> Maybe StakePubKey -> PubKeyTxOut +makePubKeyTxOut value pk sk = PubKeyTxOut $ pubKeyTxOut value pk sk data WrongOutTypeError = ExpectedScriptGotPubkey diff --git a/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs b/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs new file mode 100644 index 0000000000..d373b2e278 --- /dev/null +++ b/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -Wmissing-import-lists #-} +module Ledger.Tx.CardanoAPISpec(tests) where + +import Cardano.Api (AsType (AsPaymentKey, AsStakeKey), Key (verificationKeyHash), NetworkId (Mainnet, Testnet), + NetworkMagic (NetworkMagic), PaymentCredential (PaymentCredentialByKey), + StakeAddressReference (NoStakeAddress, StakeAddressByValue), StakeCredential, makeShelleyAddress, + shelleyAddressInEra) +import Cardano.Api.Shelley (StakeCredential (StakeCredentialByKey)) +import Ledger () +import Ledger.Tx.CardanoAPI (fromCardanoAddress, toCardanoAddress) + +import Gen.Cardano.Api.Typed qualified as Gen +import Hedgehog (Gen, Property, forAll, property, (===)) +import Hedgehog qualified +import Hedgehog.Gen qualified as Gen +import Hedgehog.Range qualified as Range +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.Hedgehog (testProperty) + +tests :: TestTree +tests = testGroup "Ledger.CardanoAPI" + [ testProperty "Cardano Address -> Plutus Address roundtrip" addressRoundTripSpec + ] + +-- | From a cardano address, we should be able to convert it to a plutus address, +-- back to the same initial cardano address. +addressRoundTripSpec :: Property +addressRoundTripSpec = property $ do + networkId <- forAll genNetworkId + shelleyAddr <- shelleyAddressInEra + <$> forAll (makeShelleyAddress networkId <$> genPaymentCredential + <*> genStakeAddressReference) + case fromCardanoAddress shelleyAddr of + Left _ -> Hedgehog.assert False + Right plutusAddr -> + case toCardanoAddress networkId plutusAddr of + Left _ -> Hedgehog.assert False + Right cAddr -> cAddr === shelleyAddr + +-- Copied from Gen.Cardano.Api.Typed, because it's not exported. +genPaymentCredential :: Gen PaymentCredential +genPaymentCredential = do + vKey <- Gen.genVerificationKey AsPaymentKey + return . PaymentCredentialByKey $ verificationKeyHash vKey + +-- Copied from Gen.Cardano.Api.Typed, because it's not exported. +genStakeAddressReference :: Gen StakeAddressReference +genStakeAddressReference = + Gen.choice + [ StakeAddressByValue <$> genStakeCredential + , return NoStakeAddress + ] + +genStakeCredential :: Gen StakeCredential +genStakeCredential = do + vKey <- Gen.genVerificationKey AsStakeKey + return . StakeCredentialByKey $ verificationKeyHash vKey + +-- Copied from Gen.Cardano.Api.Typed, because it's not exported. +genNetworkId :: Gen NetworkId +genNetworkId = + Gen.choice + [ pure Mainnet + , Testnet <$> genNetworkMagic + ] + +-- Copied from Gen.Cardano.Api.Typed, because it's not exported. +genNetworkMagic :: Gen NetworkMagic +genNetworkMagic = NetworkMagic <$> Gen.word32 Range.constantBounded diff --git a/plutus-ledger/test/Spec.hs b/plutus-ledger/test/Spec.hs index a581d8e37d..aecb23efa6 100644 --- a/plutus-ledger/test/Spec.hs +++ b/plutus-ledger/test/Spec.hs @@ -5,50 +5,34 @@ {-# LANGUAGE NumericUnderscores #-} module Main(main) where -import Control.Lens -import Control.Monad (forM_, guard, replicateM, void) -import Control.Monad.Trans.Except (runExcept) +import Control.Monad (forM_) import Data.Aeson qualified as JSON import Data.Aeson.Extras qualified as JSON import Data.Aeson.Internal qualified as Aeson -import Data.ByteString qualified as BSS import Data.ByteString.Lazy qualified as BSL -import Data.Default (Default (def)) -import Data.Either (isLeft, isRight) -import Data.Foldable (fold, foldl', traverse_) import Data.List (sort) import Data.Map qualified as Map import Data.Maybe (fromJust) -import Data.Monoid (Sum (..)) -import Data.Set qualified as Set import Data.String (IsString (fromString)) import Hedgehog (Property, forAll, property) import Hedgehog qualified import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range -import Ledger +import Ledger (DiffMilliSeconds (DiffMilliSeconds), Interval (Interval), LowerBound (LowerBound), Slot (Slot), + UpperBound (UpperBound), fromMilliSeconds, interval) +import Ledger qualified import Ledger.Ada qualified as Ada import Ledger.Bytes as Bytes -import Ledger.Contexts qualified as Validation -import Ledger.Crypto qualified as Crypto import Ledger.Fee (FeeConfig (..), calcFees) import Ledger.Generators qualified as Gen -import Ledger.Index qualified as Index import Ledger.Interval qualified as Interval -import Ledger.Scripts qualified as Scripts import Ledger.TimeSlot (SlotConfig (..)) import Ledger.TimeSlot qualified as TimeSlot import Ledger.Tx qualified as Tx -import Ledger.Value (CurrencySymbol, Value (Value)) +import Ledger.Tx.CardanoAPISpec qualified import Ledger.Value qualified as Value -import PlutusCore.Default qualified as PLC -import PlutusTx (CompiledCode, applyCode, liftCode) -import PlutusTx qualified -import PlutusTx.AssocMap qualified as AMap -import PlutusTx.AssocMap qualified as AssocMap -import PlutusTx.Builtins qualified as Builtins import PlutusTx.Prelude qualified as PlutusTx -import Test.Tasty hiding (after) +import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (testCase) import Test.Tasty.HUnit qualified as HUnit import Test.Tasty.Hedgehog (testProperty) @@ -114,7 +98,8 @@ tests = testGroup "all tests" [ ], testGroup "SomeCardanoApiTx" [ testProperty "Value ToJSON/FromJSON" (jsonRoundTrip Gen.genSomeCardanoApiTx) - ] + ], + Ledger.Tx.CardanoAPISpec.tests ] initialTxnValid :: Property @@ -178,7 +163,7 @@ intvlContains :: Property intvlContains = property $ do -- generate two intervals from a sorted list of ints -- the outer interval contains the inner interval - ints <- forAll $ traverse (const $ Gen.integral (fromIntegral <$> Range.linearBounded @Int)) [1..4] + ints <- forAll $ traverse (const $ Gen.integral (fromIntegral <$> Range.linearBounded @Int)) [(1::Integer)..4] let [i1, i2, i3, i4] = Slot <$> sort ints outer = Interval.interval i1 i4 inner = Interval.interval i2 i3 @@ -230,7 +215,7 @@ currencySymbolIsStringShow = property $ do let cs' = fromString (show cs) Hedgehog.assert $ cs' == cs --- byteStringJson :: (Eq a, JSON.FromJSON a) => BSL.ByteString -> a -> [TestCase] +byteStringJson :: (Show a, Eq a, JSON.ToJSON a, JSON.FromJSON a) => BSL.ByteString -> a -> [TestTree] byteStringJson jsonString value = [ testCase "decoding" $ HUnit.assertEqual "Simple Decode" (Right value) (JSON.eitherDecode jsonString) @@ -254,7 +239,7 @@ calcFeesTest = property $ do initialSlotToTimeProp :: Property initialSlotToTimeProp = property $ do sc <- forAll Gen.genSlotConfig - n <- forAll $ Gen.int (fromInteger <$> Range.linear 0 (fromIntegral $ scSlotLength sc)) + n <- forAll $ Gen.int (fromInteger <$> Range.linear 0 (scSlotLength sc)) let diff = DiffMilliSeconds $ toInteger n let time = TimeSlot.scSlotZeroTime sc + fromMilliSeconds diff if diff >= fromIntegral (scSlotLength sc) diff --git a/plutus-pab/examples/ContractExample/AtomicSwap.hs b/plutus-pab/examples/ContractExample/AtomicSwap.hs index e9da3e9027..b540fbc464 100644 --- a/plutus-pab/examples/ContractExample/AtomicSwap.hs +++ b/plutus-pab/examples/ContractExample/AtomicSwap.hs @@ -25,10 +25,10 @@ import Plutus.Contracts.Escrow (EscrowParams (..)) import Plutus.Contracts.Escrow qualified as Escrow import Schema (ToSchema) -import Ledger (CurrencySymbol, POSIXTime, PubKeyHash, TokenName, Value) +import Ledger (CurrencySymbol, POSIXTime, PaymentPubKeyHash, TokenName, Value) import Ledger.Value qualified as Value import Plutus.Contract -import Wallet.Emulator.Wallet (Wallet, walletPubKeyHash) +import Wallet.Emulator.Wallet (Wallet, mockWalletPaymentPubKeyHash) -- | Describes an exchange of two -- 'Value' amounts between two parties @@ -55,15 +55,15 @@ mkValue2 AtomicSwapParams{currencyHash, tokenName, amount} = mkEscrowParams :: AtomicSwapParams -> EscrowParams t mkEscrowParams p@AtomicSwapParams{party1,party2,deadline} = - let pubKey1 = walletPubKeyHash party1 - pubKey2 = walletPubKeyHash party2 + let pubKey1 = mockWalletPaymentPubKeyHash party1 + pubKey2 = mockWalletPaymentPubKeyHash party2 value1 = mkValue1 p value2 = mkValue2 p in EscrowParams { escrowDeadline = deadline , escrowTargets = - [ Escrow.payToPubKeyTarget pubKey1 value1 - , Escrow.payToPubKeyTarget pubKey2 value2 + [ Escrow.payToPaymentPubKeyTarget pubKey1 value1 + , Escrow.payToPaymentPubKeyTarget pubKey2 value2 ] } @@ -72,7 +72,7 @@ type AtomicSwapSchema = Endpoint "Atomic swap" AtomicSwapParams data AtomicSwapError = EscrowError Escrow.EscrowError | OtherAtomicSwapError ContractError - | NotInvolvedError PubKeyHash AtomicSwapParams -- ^ When the wallet's public key doesn't match either of the two keys specified in the 'AtomicSwapParams' + | NotInvolvedError PaymentPubKeyHash AtomicSwapParams -- ^ When the wallet's public key doesn't match either of the two keys specified in the 'AtomicSwapParams' deriving (Show, Generic, ToJSON, FromJSON) makeClassyPrisms ''AtomicSwapError @@ -88,16 +88,16 @@ atomicSwap = endpoint @"Atomic swap" $ \p -> do params = mkEscrowParams p go pkh - | pkh == walletPubKeyHash (party1 p) = + | pkh == mockWalletPaymentPubKeyHash (party1 p) = -- there are two paying transactions and one redeeming transaction. -- The redeeming tx is submitted by party 1. -- TODO: Change 'payRedeemRefund' to check before paying into the -- address, so that the last paying transaction can also be the -- redeeming transaction. void $ mapError EscrowError (Escrow.payRedeemRefund params value2) - | pkh == walletPubKeyHash (party2 p) = + | pkh == mockWalletPaymentPubKeyHash (party2 p) = void $ mapError EscrowError (Escrow.pay (Escrow.typedValidator params) params value1) >>= awaitTxConfirmed | otherwise = throwError (NotInvolvedError pkh p) - ownPubKeyHash >>= go + ownPaymentPubKeyHash >>= go diff --git a/plutus-pab/examples/ContractExample/IntegrationTest.hs b/plutus-pab/examples/ContractExample/IntegrationTest.hs index 22740d16a1..a9cbaa03e7 100644 --- a/plutus-pab/examples/ContractExample/IntegrationTest.hs +++ b/plutus-pab/examples/ContractExample/IntegrationTest.hs @@ -34,7 +34,7 @@ run = runError run' >>= \case run' :: Contract () EmptySchema IError () run' = do logInfo @Haskell.String "Starting integration test" - pkh <- mapError CError ownPubKeyHash + pkh <- mapError CError ownPaymentPubKeyHash (txOutRef, ciTxOut, pkInst) <- mapError PKError (PubKey.pubKeyContract pkh (Ada.adaValueOf 10)) logInfo @Haskell.String "pubKey contract complete:" logInfo txOutRef diff --git a/plutus-pab/examples/ContractExample/PayToWallet.hs b/plutus-pab/examples/ContractExample/PayToWallet.hs index 7386937cee..726c1adb82 100644 --- a/plutus-pab/examples/ContractExample/PayToWallet.hs +++ b/plutus-pab/examples/ContractExample/PayToWallet.hs @@ -18,14 +18,14 @@ import Data.Void (Void) import GHC.Generics (Generic) import Schema (ToSchema) -import Ledger (PubKeyHash, Value) +import Ledger (PaymentPubKeyHash, Value) import Ledger.Constraints (adjustUnbalancedTx, mustPayToPubKey) import Plutus.Contract (ContractError, Endpoint, Promise, endpoint, mkTxConstraints, yieldUnbalancedTx) data PayToWalletParams = PayToWalletParams { amount :: Value - , pkh :: PubKeyHash + , pkh :: PaymentPubKeyHash } deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON, ToSchema) diff --git a/plutus-pab/src/Cardano/Node/Types.hs b/plutus-pab/src/Cardano/Node/Types.hs index 594e0bd951..814fc399fc 100644 --- a/plutus-pab/src/Cardano/Node/Types.hs +++ b/plutus-pab/src/Cardano/Node/Types.hs @@ -236,7 +236,7 @@ initialAppState wallets = do initialChainState :: MonadIO m => Trace.InitialDistribution -> m MockNodeServerChainState initialChainState = fromEmulatorChainState . view EM.chainState . - MultiAgent.emulatorStateInitialDist . Map.mapKeys EM.walletPubKeyHash + MultiAgent.emulatorStateInitialDist . Map.mapKeys EM.mockWalletPaymentPubKeyHash -- Effects ------------------------------------------------------------------------------------------------------------- diff --git a/plutus-pab/src/Cardano/Wallet/LocalClient.hs b/plutus-pab/src/Cardano/Wallet/LocalClient.hs index 7560f96d60..5a000f8e1a 100644 --- a/plutus-pab/src/Cardano/Wallet/LocalClient.hs +++ b/plutus-pab/src/Cardano/Wallet/LocalClient.hs @@ -40,18 +40,19 @@ import Data.Text (pack) import Data.Text.Class (fromText) import Ledger (CardanoTx) import Ledger.Ada qualified as Ada +import Ledger.Address (PaymentPubKeyHash (PaymentPubKeyHash)) import Ledger.Constraints.OffChain (UnbalancedTx) +import Ledger.Crypto (PubKeyHash (PubKeyHash)) import Ledger.Tx.CardanoAPI (SomeCardanoApiTx (SomeTx), ToCardanoError, toCardanoTxBody) import Ledger.Value (CurrencySymbol (CurrencySymbol), TokenName (TokenName), Value (Value)) import Plutus.Contract.Wallet (export) import Plutus.PAB.Monitoring.PABLogMsg (WalletClientMsg (BalanceTxError, WalletClientError)) -import Plutus.V1.Ledger.Crypto (PubKeyHash (PubKeyHash)) import PlutusTx.AssocMap qualified as Map import PlutusTx.Builtins.Internal (BuiltinByteString (BuiltinByteString)) import Prettyprinter (Pretty (pretty)) import Servant ((:<|>) ((:<|>)), (:>)) import Servant.Client (ClientEnv, ClientError, ClientM, client, runClientM) -import Wallet.Effects (WalletEffect (BalanceTx, OwnPubKeyHash, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx)) +import Wallet.Effects (WalletEffect (BalanceTx, OwnPaymentPubKeyHash, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx)) import Wallet.Emulator.Error (WalletAPIError (OtherError, ToCardanoError)) import Wallet.Emulator.Wallet (Wallet (Wallet), WalletId (WalletId)) @@ -100,9 +101,9 @@ handleWalletClient config (Wallet (WalletId walletId)) event = do sealedTx <- either (throwError . ToCardanoError) pure $ toSealedTx protocolParams networkId tx void . runClient $ C.postExternalTransaction C.transactionClient (C.ApiBytesT (C.SerialisedTx $ C.serialisedTx sealedTx)) - ownPubKeyHashH :: Eff effs PubKeyHash - ownPubKeyHashH = - fmap (PubKeyHash . BuiltinByteString . fst . getApiVerificationKey) . runClient $ + ownPaymentPubKeyHashH :: Eff effs PaymentPubKeyHash + ownPaymentPubKeyHashH = + fmap (PaymentPubKeyHash . PubKeyHash . BuiltinByteString . fst . getApiVerificationKey) . runClient $ getWalletKey (C.ApiT walletId) (C.ApiT C.UtxoExternal) (C.ApiT (C.DerivationIndex 0)) @@ -146,7 +147,7 @@ handleWalletClient config (Wallet (WalletId walletId)) event = do case event of SubmitTxn tx -> submitTxnH tx - OwnPubKeyHash -> ownPubKeyHashH + OwnPaymentPubKeyHash -> ownPaymentPubKeyHashH BalanceTx utx -> balanceTxH utx WalletAddSignature tx -> walletAddSignatureH tx TotalFunds -> totalFundsH diff --git a/plutus-pab/src/Cardano/Wallet/Mock/API.hs b/plutus-pab/src/Cardano/Wallet/Mock/API.hs index 7f05d8df78..a2ee38c20e 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/API.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/API.hs @@ -36,7 +36,7 @@ PSGenerator we specialise it to 'Text'. type API walletId -- see note [WalletID type in wallet API] = "create" :> Post '[JSON] WalletInfo :<|> Capture "walletId" walletId :> "submit-txn" :> ReqBody '[JSON] Tx :> Post '[JSON] NoContent - :<|> Capture "walletId" walletId :> "own-public-key" :> Get '[JSON] WalletInfo + :<|> Capture "walletId" walletId :> "own-payment-public-key" :> Get '[JSON] WalletInfo :<|> Capture "walletId" walletId :> "balance-tx" :> ReqBody '[JSON] UnbalancedTx :> Post '[JSON] (Either WalletAPIError Tx) :<|> Capture "walletId" walletId :> "total-funds" :> Get '[JSON] Value :<|> Capture "walletId" walletId :> "sign" :> ReqBody '[JSON] Tx :> Post '[JSON] Tx diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Client.hs b/plutus-pab/src/Cardano/Wallet/Mock/Client.hs index 333310a845..e0d6d9039f 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Client.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Client.hs @@ -8,39 +8,39 @@ module Cardano.Wallet.Mock.Client where import Cardano.Wallet.Mock.API (API) -import Cardano.Wallet.Mock.Types (WalletInfo (wiPubKeyHash)) +import Cardano.Wallet.Mock.Types (WalletInfo (wiPaymentPubKeyHash)) import Control.Monad (void) import Control.Monad.Freer (Eff, LastMember, Member, sendM, type (~>)) import Control.Monad.Freer.Error (Error, throwError) import Control.Monad.Freer.Reader (Reader, ask) import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Proxy (Proxy (Proxy)) -import Ledger (PubKeyHash, Value) +import Ledger (PaymentPubKeyHash, Value) import Ledger.Constraints.OffChain (UnbalancedTx) import Ledger.Tx (CardanoTx, Tx) import Servant ((:<|>) ((:<|>))) import Servant.Client (ClientEnv, ClientError, ClientM, client, runClientM) -import Wallet.Effects (WalletEffect (BalanceTx, OwnPubKeyHash, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx)) +import Wallet.Effects (WalletEffect (BalanceTx, OwnPaymentPubKeyHash, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx)) import Wallet.Emulator.Error (WalletAPIError) import Wallet.Emulator.Wallet (Wallet (Wallet, getWalletId), WalletId) createWallet :: ClientM WalletInfo submitTxn :: Wallet -> Tx -> ClientM () -ownPublicKey :: Wallet -> ClientM WalletInfo +ownPaymentPublicKey :: Wallet -> ClientM WalletInfo balanceTx :: Wallet -> UnbalancedTx -> ClientM (Either WalletAPIError Tx) totalFunds :: Wallet -> ClientM Value sign :: Wallet -> Tx -> ClientM Tx -(createWallet, submitTxn, ownPublicKey, balanceTx, totalFunds, sign) = +(createWallet, submitTxn, ownPaymentPublicKey, balanceTx, totalFunds, sign) = ( createWallet_ , \(Wallet wid) tx -> void (submitTxn_ wid tx) - , ownPublicKey_ . getWalletId + , ownPaymentPublicKey_ . getWalletId , balanceTx_ . getWalletId , totalFunds_ . getWalletId , sign_ . getWalletId) where ( createWallet_ :<|> (submitTxn_ - :<|> ownPublicKey_ + :<|> ownPaymentPublicKey_ :<|> balanceTx_ :<|> totalFunds_ :<|> sign_)) = client (Proxy @(API WalletId)) @@ -66,8 +66,8 @@ handleWalletClient wallet event = do submitTxnH (Left _) = error "Cardano.Wallet.Mock.Client: Expecting a mock tx, not an Alonzo tx when submitting it." submitTxnH (Right tx) = runClient (submitTxn wallet tx) - ownPubKeyHashH :: Eff effs PubKeyHash - ownPubKeyHashH = wiPubKeyHash <$> runClient (ownPublicKey wallet) + ownPaymentPubKeyHashH :: Eff effs PaymentPubKeyHash + ownPaymentPubKeyHashH = wiPaymentPubKeyHash <$> runClient (ownPaymentPublicKey wallet) balanceTxH :: UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx) balanceTxH utx = runClient (fmap (fmap Right) $ balanceTx wallet utx) @@ -88,7 +88,7 @@ handleWalletClient wallet event = do case event of SubmitTxn tx -> submitTxnH tx - OwnPubKeyHash -> ownPubKeyHashH + OwnPaymentPubKeyHash -> ownPaymentPubKeyHashH BalanceTx utx -> balanceTxH utx WalletAddSignature tx -> walletAddSignatureH tx TotalFunds -> totalFundsH diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Handlers.hs b/plutus-pab/src/Cardano/Wallet/Mock/Handlers.hs index 6207d4f1b6..51f4469e77 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Handlers.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Handlers.hs @@ -45,9 +45,9 @@ import Data.Map qualified as Map import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) import Ledger.Ada qualified as Ada +import Ledger.Address (PaymentPubKeyHash) import Ledger.CardanoWallet (MockWallet) import Ledger.CardanoWallet qualified as CW -import Ledger.Crypto (PubKeyHash) import Ledger.Fee (FeeConfig) import Ledger.TimeSlot (SlotConfig) import Ledger.Tx (CardanoTx) @@ -87,9 +87,9 @@ distributeNewWalletFunds :: forall effs. , Member (Error WalletAPIError) effs , Member (LogMsg Text) effs ) - => PubKeyHash + => PaymentPubKeyHash -> Eff effs CardanoTx -distributeNewWalletFunds = WAPI.payToPublicKeyHash WAPI.defaultSlotRange (Ada.adaValueOf 10_000) +distributeNewWalletFunds = WAPI.payToPaymentPublicKeyHash WAPI.defaultSlotRange (Ada.adaValueOf 10_000) newWallet :: forall m effs. (LastMember m effs, MonadIO m) => Eff effs MockWallet newWallet = do @@ -128,17 +128,17 @@ handleMultiWallet feeCfg = \case mockWallet <- newWallet let walletId = Wallet.Wallet $ Wallet.WalletId $ CW.mwWalletId mockWallet wallets' = Map.insert walletId (Wallet.fromMockWallet mockWallet) wallets - pkh = CW.pubKeyHash mockWallet + pkh = CW.paymentPubKeyHash mockWallet put wallets' -- For some reason this doesn't work with (Wallet 1)/privateKey1, -- works just fine with (Wallet 2)/privateKey2 -- ¯\_(ツ)_/¯ - let sourceWallet = Wallet.fromMockWallet (CW.knownWallet 2) + let sourceWallet = Wallet.fromMockWallet (CW.knownMockWallet 2) _ <- evalState sourceWallet $ interpret (mapLog @TxBalanceMsg @WalletMsg Balancing) $ interpret (Wallet.handleWallet feeCfg) $ distributeNewWalletFunds pkh - return $ WalletInfo{wiWallet = walletId, wiPubKeyHash = pkh} + return $ WalletInfo{wiWallet = walletId, wiPaymentPubKeyHash = pkh} GetWalletInfo wllt -> do wallets <- get @Wallets return $ fmap fromWalletState $ Map.lookup (Wallet.Wallet wllt) wallets @@ -208,7 +208,7 @@ runWalletEffects trace txSendHandle chainSyncHandle chainIndexEnv wallets feeCfg fromWalletAPIError :: WalletAPIError -> ServerError fromWalletAPIError (InsufficientFunds text) = err401 {errBody = BSL.fromStrict $ encodeUtf8 text} -fromWalletAPIError e@(PrivateKeyNotFound _) = +fromWalletAPIError e@(PaymentPrivateKeyNotFound _) = err404 {errBody = BSL8.pack $ show e} fromWalletAPIError e@(ValidationError _) = err500 {errBody = BSL8.pack $ show $ pretty e} diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Server.hs b/plutus-pab/src/Cardano/Wallet/Mock/Server.hs index 0a9997b547..2827f81c25 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Server.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Server.hs @@ -70,7 +70,7 @@ app trace txSendHandle chainSyncHandle chainIndexEnv mVarState feeCfg slotCfg = main :: Trace IO WalletMsg -> LocalWalletSettings -> FeeConfig -> FilePath -> SlotConfig -> ChainIndexUrl -> Availability -> IO () main trace LocalWalletSettings { baseUrl } feeCfg serverSocket slotCfg (ChainIndexUrl chainUrl) availability = LM.runLogEffects trace $ do chainIndexEnv <- buildEnv chainUrl defaultManagerSettings - let knownWallets = Map.fromList $ zip Wallet.knownWallets (Wallet.fromMockWallet <$> CW.knownWallets) + let knownWallets = Map.fromList $ zip Wallet.knownWallets (Wallet.fromMockWallet <$> CW.knownMockWallets) mVarState <- liftIO $ newMVar knownWallets txSendHandle <- liftIO $ MockClient.runTxSender serverSocket chainSyncHandle <- Left <$> (liftIO $ MockClient.runChainSync' serverSocket slotCfg) diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Types.hs b/plutus-pab/src/Cardano/Wallet/Mock/Types.hs index e4f7fb1058..d2e6fed779 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Types.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Types.hs @@ -46,7 +46,7 @@ import Data.Aeson (FromJSON, ToJSON) import Data.Map.Strict (Map) import Data.Text (Text) import GHC.Generics (Generic) -import Ledger (PubKeyHash) +import Ledger (PaymentPubKeyHash) import Plutus.ChainIndex (ChainIndexQueryEffect) import Plutus.PAB.Arbitrary () import Prettyprinter (Pretty (pretty), (<+>)) @@ -56,13 +56,14 @@ import Servant.Client.Internal.HttpClient (ClientEnv) import Wallet.Effects (NodeClientEffect, WalletEffect) import Wallet.Emulator.Error (WalletAPIError) import Wallet.Emulator.LogMessages (TxBalanceMsg) -import Wallet.Emulator.Wallet (Wallet, WalletId, WalletState (WalletState, _mockWallet), toMockWallet, walletPubKeyHash) +import Wallet.Emulator.Wallet (Wallet, WalletId, WalletState (WalletState, _mockWallet), mockWalletPaymentPubKeyHash, + toMockWallet) -- | Information about an emulated wallet. data WalletInfo = WalletInfo - { wiWallet :: Wallet - , wiPubKeyHash :: PubKeyHash -- ^ Hash of the wallet's public key, serving as wallet ID + { wiWallet :: Wallet + , wiPaymentPubKeyHash :: PaymentPubKeyHash -- ^ Hash of the wallet's public key, serving as wallet ID } deriving stock (Show, Generic) deriving anyclass (ToJSON, FromJSON) @@ -70,9 +71,9 @@ data WalletInfo = type Wallets = Map Wallet WalletState fromWalletState :: WalletState -> WalletInfo -fromWalletState WalletState{_mockWallet} = WalletInfo{wiWallet, wiPubKeyHash} where +fromWalletState WalletState{_mockWallet} = WalletInfo{wiWallet, wiPaymentPubKeyHash} where wiWallet = toMockWallet _mockWallet - wiPubKeyHash = walletPubKeyHash wiWallet + wiPaymentPubKeyHash = mockWalletPaymentPubKeyHash wiWallet data MultiWalletEffect r where CreateWallet :: MultiWalletEffect WalletInfo diff --git a/plutus-pab/src/Cardano/Wallet/RemoteClient.hs b/plutus-pab/src/Cardano/Wallet/RemoteClient.hs index 437eec44d4..607fffa0d7 100644 --- a/plutus-pab/src/Cardano/Wallet/RemoteClient.hs +++ b/plutus-pab/src/Cardano/Wallet/RemoteClient.hs @@ -22,7 +22,7 @@ import Data.Text qualified as Text import Plutus.Contract.Wallet (export) import Plutus.PAB.Core.ContractInstance.STM (InstancesState) import Plutus.PAB.Core.ContractInstance.STM qualified as Instances -import Wallet.Effects (WalletEffect (BalanceTx, OwnPubKeyHash, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx)) +import Wallet.Effects (WalletEffect (BalanceTx, OwnPaymentPubKeyHash, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx)) import Wallet.Error (WalletAPIError (RemoteClientFunctionNotYetSupported), throwOtherError) import Wallet.Types (ContractInstanceId) @@ -48,8 +48,8 @@ handleWalletClient config cidM event = do let NetworkIdWrapper networkId = mscNetworkId config protocolParams <- ask @Cardano.Api.ProtocolParameters case event of - OwnPubKeyHash -> do - throwError $ RemoteClientFunctionNotYetSupported "Cardano.Wallet.RemoteClient.OwnPubKeyHash" + OwnPaymentPubKeyHash -> do + throwError $ RemoteClientFunctionNotYetSupported "Cardano.Wallet.RemoteClient.OwnPaymentPubKeyHash" WalletAddSignature _ -> do throwError $ RemoteClientFunctionNotYetSupported "Cardano.Wallet.RemoteClient.WalletAddSignature" diff --git a/plutus-pab/src/Plutus/PAB/Arbitrary.hs b/plutus-pab/src/Plutus/PAB/Arbitrary.hs index 71aa268834..7c7ec1a4a4 100644 --- a/plutus-pab/src/Plutus/PAB/Arbitrary.hs +++ b/plutus-pab/src/Plutus/PAB/Arbitrary.hs @@ -13,7 +13,7 @@ import Data.Aeson qualified as Aeson import Data.ByteString (ByteString) import Ledger (ValidatorHash (ValidatorHash)) import Ledger qualified -import Ledger.Address (Address (..)) +import Ledger.Address (Address (..), PaymentPubKey, PaymentPubKeyHash, StakePubKey, StakePubKeyHash) import Ledger.Bytes (LedgerBytes) import Ledger.Bytes qualified as LedgerBytes import Ledger.Constraints (MkTxError) @@ -139,6 +139,22 @@ instance Arbitrary PubKeyHash where arbitrary = genericArbitrary shrink = genericShrink +instance Arbitrary PaymentPubKey where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary PaymentPubKeyHash where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary StakePubKey where + arbitrary = genericArbitrary + shrink = genericShrink + +instance Arbitrary StakePubKeyHash where + arbitrary = genericArbitrary + shrink = genericShrink + instance Arbitrary Slot where arbitrary = genericArbitrary shrink = genericShrink @@ -204,14 +220,14 @@ instance Arbitrary PABReq where , pure CurrentSlotReq , pure OwnContractInstanceIdReq , ExposeEndpointReq <$> arbitrary - , pure OwnPublicKeyHashReq + , pure OwnPaymentPublicKeyHashReq -- TODO This would need an Arbitrary Tx instance: -- , BalanceTxRequest <$> arbitrary -- , WriteBalancedTxRequest <$> arbitrary ] instance Arbitrary Address where - arbitrary = oneof [Ledger.pubKeyAddress <$> arbitrary, Ledger.scriptAddress <$> arbitrary] + arbitrary = oneof [Ledger.pubKeyAddress <$> arbitrary <*> arbitrary, Ledger.scriptAddress <$> arbitrary] instance Arbitrary ValidatorHash where arbitrary = ValidatorHash <$> arbitrary @@ -239,7 +255,7 @@ instance Arbitrary ActiveEndpoint where -- 'Maybe' because we can't (yet) create a generator for every request -- type. genResponse :: PABReq -> Maybe (Gen PABResp) -genResponse (AwaitSlotReq slot) = Just . pure . AwaitSlotResp $ slot -genResponse (ExposeEndpointReq _) = Just $ ExposeEndpointResp <$> arbitrary <*> (EndpointValue <$> arbitrary) -genResponse OwnPublicKeyHashReq = Just $ OwnPublicKeyHashResp <$> arbitrary -genResponse _ = Nothing +genResponse (AwaitSlotReq slot) = Just . pure . AwaitSlotResp $ slot +genResponse (ExposeEndpointReq _) = Just $ ExposeEndpointResp <$> arbitrary <*> (EndpointValue <$> arbitrary) +genResponse OwnPaymentPublicKeyHashReq = Just $ OwnPaymentPublicKeyHashResp <$> arbitrary +genResponse _ = Nothing diff --git a/plutus-pab/src/Plutus/PAB/Core.hs b/plutus-pab/src/Plutus/PAB/Core.hs index 0f92886cc4..3e73ff69cf 100644 --- a/plutus-pab/src/Plutus/PAB/Core.hs +++ b/plutus-pab/src/Plutus/PAB/Core.hs @@ -46,7 +46,7 @@ module Plutus.PAB.Core , activateContract' , callEndpointOnInstance , callEndpointOnInstance' - , payToPublicKey + , payToPaymentPublicKey -- * Agent threads , ContractInstanceEffects , handleAgentThread @@ -105,6 +105,7 @@ import Data.Proxy (Proxy (Proxy)) import Data.Set (Set) import Data.Text (Text) import Ledger (Address (addressCredential), TxOutRef) +import Ledger.Address (PaymentPubKeyHash) import Ledger.Tx (CardanoTx, ciTxOutValue) import Ledger.TxId (TxId) import Ledger.Value (Value) @@ -128,12 +129,12 @@ import Plutus.PAB.Timeout (Timeout) import Plutus.PAB.Timeout qualified as Timeout import Plutus.PAB.Types (PABError (ContractInstanceNotFound, InstanceAlreadyStopped, WalletError)) import Plutus.PAB.Webserver.Types (ContractActivationArgs (ContractActivationArgs, caID, caWallet)) -import Wallet.API (PubKeyHash, Slot) +import Wallet.API (Slot) import Wallet.API qualified as WAPI import Wallet.Effects (NodeClientEffect, WalletEffect) import Wallet.Emulator.LogMessages (RequestHandlerLogMsg, TxBalanceMsg) import Wallet.Emulator.MultiAgent (EmulatorEvent' (WalletEvent), EmulatorTimeEvent (EmulatorTimeEvent)) -import Wallet.Emulator.Wallet (Wallet, WalletEvent (GenericLog, RequestHandlerLog, TxBalanceLog), walletAddress) +import Wallet.Emulator.Wallet (Wallet, WalletEvent (GenericLog, RequestHandlerLog, TxBalanceLog), mockWalletAddress) import Wallet.Types (ContractActivityStatus, ContractInstanceId, EndpointDescription (EndpointDescription), NotificationError) @@ -334,12 +335,12 @@ callEndpointOnInstance' instanceID ep value = do $ STM.atomically $ Instances.callEndpointOnInstance state (EndpointDescription ep) (JSON.toJSON value) instanceID --- | Make a payment to a public key. -payToPublicKey :: ContractInstanceId -> Wallet -> PubKeyHash -> Value -> PABAction t env CardanoTx -payToPublicKey cid source target amount = +-- | Make a payment to a payment public key. +payToPaymentPublicKey :: ContractInstanceId -> Wallet -> PaymentPubKeyHash -> Value -> PABAction t env CardanoTx +payToPaymentPublicKey cid source target amount = handleAgentThread source (Just cid) $ Modify.wrapError WalletError - $ WAPI.payToPublicKeyHash WAPI.defaultSlotRange amount target + $ WAPI.payToPaymentPublicKeyHash WAPI.defaultSlotRange amount target -- | Effects available to contract instances with access to external services. type ContractInstanceEffects t env effs = @@ -586,7 +587,7 @@ valueAt wallet = do txOutsM <- traverse ChainIndex.txOutFromRef utxoRefs pure $ foldMap (view ciTxOutValue) $ catMaybes txOutsM where - cred = addressCredential $ walletAddress wallet + cred = addressCredential $ mockWalletAddress wallet getAllUtxoRefs pq = do utxoRefsPage <- page <$> ChainIndex.utxoSetAtAddress pq cred case ChainIndex.nextPageQuery utxoRefsPage of diff --git a/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs b/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs index 31e30e4c05..86f2f03d25 100644 --- a/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs +++ b/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs @@ -261,7 +261,7 @@ stmRequestHandler = fmap sequence (wrapHandler (fmap pure nonBlockingRequests) < -- requests that can be handled by 'WalletEffect', 'ChainIndexQueryEffect', etc. nonBlockingRequests = - RequestHandler.handleOwnPubKeyHashQueries @effs + RequestHandler.handleOwnPaymentPubKeyHashQueries @effs <> RequestHandler.handleChainIndexQueries @effs <> RequestHandler.handleUnbalancedTransactions @effs <> RequestHandler.handlePendingTransactions @effs diff --git a/plutus-pab/src/Plutus/PAB/Simulator.hs b/plutus-pab/src/Plutus/PAB/Simulator.hs index 268d148ebb..ba492f01d7 100644 --- a/plutus-pab/src/Plutus/PAB/Simulator.hs +++ b/plutus-pab/src/Plutus/PAB/Simulator.hs @@ -32,7 +32,7 @@ module Plutus.PAB.Simulator( , logString -- ** Agent actions , payToWallet - , payToPublicKeyHash + , payToPaymentPublicKeyHash , activateContract , callEndpointOnInstance , handleAgentThread @@ -97,8 +97,8 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Text.IO qualified as Text import Data.Time.Units (Millisecond) -import Ledger (Address, Blockchain, CardanoTx, PubKeyHash, TxId, TxOut (TxOut, txOutAddress, txOutValue), eitherTx, - txFee, txId) +import Ledger (Address, Blockchain, CardanoTx, PaymentPubKeyHash, TxId, TxOut (TxOut, txOutAddress, txOutValue), + eitherTx, txFee, txId) import Ledger.Ada qualified as Ada import Ledger.CardanoWallet (MockWallet) import Ledger.CardanoWallet qualified as CW @@ -178,7 +178,7 @@ initialState :: forall t. IO (SimulatorState t) initialState = do let initialDistribution = Map.fromList $ fmap (, Ada.adaValueOf 100_000) knownWallets Emulator.EmulatorState{Emulator._chainState} = Emulator.initialState (def & Emulator.initialChainState .~ Left initialDistribution) - initialWallets = Map.fromList $ fmap (\w -> (Wallet.Wallet $ Wallet.WalletId $ CW.mwWalletId w, initialAgentState w)) CW.knownWallets + initialWallets = Map.fromList $ fmap (\w -> (Wallet.Wallet $ Wallet.WalletId $ CW.mwWalletId w, initialAgentState w)) CW.knownMockWallets STM.atomically $ SimulatorState <$> STM.newTQueue @@ -736,7 +736,7 @@ instanceActivity = Core.instanceActivity -- | Create a new wallet with a random key, give it some funds -- and add it to the list of simulated wallets. -addWallet :: forall t. Simulation t (Wallet,PubKeyHash) +addWallet :: forall t. Simulation t (Wallet, PaymentPubKeyHash) addWallet = do SimulatorState{_agentStates} <- Core.askUserEnv @t @(SimulatorState t) mockWallet <- MockWallet.newWallet @@ -746,8 +746,8 @@ addWallet = do STM.writeTVar _agentStates newWallets _ <- handleAgentThread (knownWallet 2) Nothing $ Modify.wrapError WalletError - $ MockWallet.distributeNewWalletFunds (CW.pubKeyHash mockWallet) - pure (Wallet.toMockWallet mockWallet, CW.pubKeyHash mockWallet) + $ MockWallet.distributeNewWalletFunds (CW.paymentPubKeyHash mockWallet) + pure (Wallet.toMockWallet mockWallet, CW.paymentPubKeyHash mockWallet) -- | Retrieve the balances of all the entities in the simulator. @@ -775,11 +775,11 @@ logString = logInfo @(PABMultiAgentMsg t) . UserLog . Text.pack -- | Make a payment from one wallet to another payToWallet :: forall t. Wallet -> Wallet -> Value -> Simulation t CardanoTx -payToWallet source target = payToPublicKeyHash source (Emulator.walletPubKeyHash target) +payToWallet source target = payToPaymentPublicKeyHash source (Emulator.mockWalletPaymentPubKeyHash target) -- | Make a payment from one wallet to a public key address -payToPublicKeyHash :: forall t. Wallet -> PubKeyHash -> Value -> Simulation t CardanoTx -payToPublicKeyHash source target amount = +payToPaymentPublicKeyHash :: forall t. Wallet -> PaymentPubKeyHash -> Value -> Simulation t CardanoTx +payToPaymentPublicKeyHash source target amount = handleAgentThread source Nothing $ flip (handleError @WAPI.WalletAPIError) (throwError . WalletError) - $ WAPI.payToPublicKeyHash WAPI.defaultSlotRange amount target + $ WAPI.payToPaymentPublicKeyHash WAPI.defaultSlotRange amount target diff --git a/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs b/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs index 330b651c90..eb24c388b7 100644 --- a/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs +++ b/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs @@ -25,7 +25,7 @@ module Plutus.PAB.Webserver.Handler ) where import Cardano.Wallet.Mock.Client qualified as Wallet.Client -import Cardano.Wallet.Mock.Types (WalletInfo (WalletInfo, wiPubKeyHash, wiWallet)) +import Cardano.Wallet.Mock.Types (WalletInfo (WalletInfo, wiPaymentPubKeyHash, wiWallet)) import Control.Lens (preview) import Control.Monad (join) import Control.Monad.Freer (sendM) @@ -230,8 +230,8 @@ walletProxy :: walletProxy createNewWallet = createNewWallet :<|> (\w tx -> fmap (const NoContent) (Core.handleAgentThread (Wallet w) Nothing $ Wallet.Effects.submitTxn $ Right tx)) - :<|> (\w -> (\pkh -> WalletInfo{wiWallet=Wallet w, wiPubKeyHash = pkh }) - <$> Core.handleAgentThread (Wallet w) Nothing Wallet.Effects.ownPubKeyHash) + :<|> (\w -> (\pkh -> WalletInfo{wiWallet=Wallet w, wiPaymentPubKeyHash = pkh }) + <$> Core.handleAgentThread (Wallet w) Nothing Wallet.Effects.ownPaymentPubKeyHash) :<|> (\w -> fmap (fmap (fromRight (error "Plutus.PAB.Webserver.Handler: Expecting a mock tx, not an Alonzo tx when submitting it."))) . Core.handleAgentThread (Wallet w) Nothing . Wallet.Effects.balanceTx) :<|> (\w -> Core.handleAgentThread (Wallet w) Nothing Wallet.Effects.totalFunds) diff --git a/plutus-pab/src/Plutus/PAB/Webserver/Server.hs b/plutus-pab/src/Plutus/PAB/Webserver/Server.hs index 5834dfbce5..b4cddfd5ed 100644 --- a/plutus-pab/src/Plutus/PAB/Webserver/Server.hs +++ b/plutus-pab/src/Plutus/PAB/Webserver/Server.hs @@ -18,7 +18,7 @@ module Plutus.PAB.Webserver.Server , startServerDebug' ) where -import Cardano.Wallet.Mock.Types (WalletInfo (WalletInfo, wiPubKeyHash, wiWallet)) +import Cardano.Wallet.Mock.Types (WalletInfo (WalletInfo, wiPaymentPubKeyHash, wiWallet)) import Control.Concurrent (MVar, forkFinally, forkIO, newEmptyMVar, putMVar) import Control.Concurrent.Availability (Availability, available, newToken) import Control.Concurrent.STM qualified as STM @@ -221,5 +221,5 @@ startServerDebug' conf = do tk <- newToken let mkWalletInfo = do (wllt, pk) <- Simulator.addWallet - pure $ WalletInfo{wiWallet = wllt, wiPubKeyHash = pk} + pure $ WalletInfo{wiWallet = wllt, wiPaymentPubKeyHash = pk} snd <$> startServer conf (Right mkWalletInfo) tk diff --git a/plutus-pab/test/full/Plutus/PAB/CoreSpec.hs b/plutus-pab/test/full/Plutus/PAB/CoreSpec.hs index cb8c2470a8..bba75a5d78 100644 --- a/plutus-pab/test/full/Plutus/PAB/CoreSpec.hs +++ b/plutus-pab/test/full/Plutus/PAB/CoreSpec.hs @@ -43,8 +43,8 @@ import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Extras (tshow) -import Ledger (PubKeyHash, getCardanoTxId, getCardanoTxOutRefs, pubKeyAddress, pubKeyHash, pubKeyHashAddress, - toPubKeyHash, txId, txOutAddress, txOutRefId, txOutRefs, txOutputs) +import Ledger (PaymentPubKeyHash (unPaymentPubKeyHash), getCardanoTxId, getCardanoTxOutRefs, pubKeyAddress, pubKeyHash, + pubKeyHashAddress, toPubKeyHash, txId, txOutAddress, txOutRefId, txOutRefs, txOutputs) import Ledger qualified import Ledger.Ada (adaSymbol, adaToken, lovelaceValueOf) import Ledger.Ada qualified as Ada @@ -75,7 +75,7 @@ import PlutusTx.Monoid (Group (inv)) import Test.QuickCheck.Instances.UUID () import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (testCase) -import Wallet.API (WalletAPIError, ownPubKeyHash) +import Wallet.API (WalletAPIError, ownPaymentPubKeyHash) import Wallet.API qualified as WAPI import Wallet.Emulator.Chain qualified as Chain import Wallet.Emulator.Wallet (Wallet, knownWallet, knownWallets) @@ -102,8 +102,8 @@ runScenario sim = do defaultWallet :: Wallet defaultWallet = knownWallet 1 -defaultWalletPubKeyHash :: PubKeyHash -defaultWalletPubKeyHash = CW.pubKeyHash (CW.fromWalletNumber $ CW.WalletNumber 1) +defaultWalletPaymentPubKeyHash :: PaymentPubKeyHash +defaultWalletPaymentPubKeyHash = CW.paymentPubKeyHash (CW.fromWalletNumber $ CW.WalletNumber 1) activateContractTests :: TestTree activateContractTests = @@ -182,7 +182,7 @@ waitForTxStatusChangeTest = runScenario $ do -- for a status change. (w1, pk1) <- Simulator.addWallet Simulator.waitNSlots 1 - tx <- Simulator.payToPublicKeyHash w1 pk1 (lovelaceValueOf 100_000_000) + tx <- Simulator.payToPaymentPublicKeyHash w1 pk1 (lovelaceValueOf 100_000_000) txStatus <- Simulator.waitForTxStatusChange (getCardanoTxId tx) assertEqual "tx should be tentatively confirmed of depth 1" (TentativelyConfirmed 1 TxValid ()) @@ -190,7 +190,7 @@ waitForTxStatusChangeTest = runScenario $ do -- We create a new transaction to trigger a block creation in order to -- increment the block number. - void $ Simulator.payToPublicKeyHash w1 pk1 (Ada.toValue Ledger.minAdaTxOut) + void $ Simulator.payToPaymentPublicKeyHash w1 pk1 (Ada.toValue Ledger.minAdaTxOut) Simulator.waitNSlots 1 txStatus' <- Simulator.waitForTxStatusChange (getCardanoTxId tx) assertEqual "tx should be tentatively confirmed of depth 2" @@ -200,7 +200,7 @@ waitForTxStatusChangeTest = runScenario $ do -- We create `n` more blocks to test whether the tx status is committed. let (Depth n) = chainConstant replicateM_ (n - 1) $ do - void $ Simulator.payToPublicKeyHash w1 pk1 (Ada.toValue Ledger.minAdaTxOut) + void $ Simulator.payToPaymentPublicKeyHash w1 pk1 (Ada.toValue Ledger.minAdaTxOut) Simulator.waitNSlots 1 txStatus'' <- Simulator.waitForTxStatusChange (getCardanoTxId tx) @@ -218,12 +218,18 @@ waitForTxOutStatusChangeTest = runScenario $ do Simulator.waitNSlots 1 (w2, pk2) <- Simulator.addWallet Simulator.waitNSlots 1 - tx <- Simulator.payToPublicKeyHash w1 pk2 (lovelaceValueOf 100_000_000) + tx <- Simulator.payToPaymentPublicKeyHash w1 pk2 (lovelaceValueOf 100_000_000) -- We should have 2 UTxOs present. -- We find the 'TxOutRef' from wallet 1 - let txOutRef1 = head $ fmap snd $ filter (\(txOut, txOutref) -> toPubKeyHash (txOutAddress txOut) == Just pk1) $ getCardanoTxOutRefs tx + let txOutRef1 = head + $ fmap snd + $ filter (\(txOut, txOutref) -> toPubKeyHash (txOutAddress txOut) == Just (unPaymentPubKeyHash pk1)) + $ getCardanoTxOutRefs tx -- We find the 'TxOutRef' from wallet 2 - let txOutRef2 = head $ fmap snd $ filter (\(txOut, txOutref) -> toPubKeyHash (txOutAddress txOut) == Just pk2) $ getCardanoTxOutRefs tx + let txOutRef2 = head + $ fmap snd + $ filter (\(txOut, txOutref) -> toPubKeyHash (txOutAddress txOut) == Just (unPaymentPubKeyHash pk2)) + $ getCardanoTxOutRefs tx txOutStatus1 <- Simulator.waitForTxOutStatusChange txOutRef1 assertEqual "tx output 1 should be tentatively confirmed of depth 1" (TentativelyConfirmed 1 TxValid Unspent) @@ -235,7 +241,7 @@ waitForTxOutStatusChangeTest = runScenario $ do -- We create a new transaction to trigger a block creation in order to -- increment the block number. - tx2 <- Simulator.payToPublicKeyHash w1 pk1 (Ada.toValue Ledger.minAdaTxOut) + tx2 <- Simulator.payToPaymentPublicKeyHash w1 pk1 (Ada.toValue Ledger.minAdaTxOut) Simulator.waitNSlots 1 txOutStatus1' <- Simulator.waitForTxOutStatusChange txOutRef1 assertEqual "tx output 1 should be tentatively confirmed of depth 1" @@ -249,7 +255,7 @@ waitForTxOutStatusChangeTest = runScenario $ do -- We create `n` more blocks to test whether the tx status is committed. let (Depth n) = chainConstant replicateM_ n $ do - void $ Simulator.payToPublicKeyHash w1 pk1 (Ada.toValue Ledger.minAdaTxOut) + void $ Simulator.payToPaymentPublicKeyHash w1 pk1 (Ada.toValue Ledger.minAdaTxOut) Simulator.waitNSlots 1 txOutStatus1'' <- Simulator.waitForTxOutStatusChange txOutRef1 @@ -270,9 +276,9 @@ valueAtTest = runScenario $ do initialValue <- Core.valueAt defaultWallet let mockWallet = knownWallet 2 - mockWalletPubKeyHash = CW.pubKeyHash (CW.fromWalletNumber $ CW.WalletNumber 2) + mockWalletPubKeyHash = CW.paymentPubKeyHash (CW.fromWalletNumber $ CW.WalletNumber 2) - tx <- Simulator.payToPublicKeyHash defaultWallet mockWalletPubKeyHash payment + tx <- Simulator.payToPaymentPublicKeyHash defaultWallet mockWalletPubKeyHash payment -- Waiting for the tx to be confirmed void $ Core.waitForTxStatusChange $ getCardanoTxId tx finalValue <- Core.valueAt defaultWallet @@ -326,7 +332,8 @@ guessingGameTest = let openingBalance = 100_000_000_000 lockAmount = 15_000_000 pubKeyHashFundsChange cid msg delta = do - address <- pubKeyHashAddress <$> Simulator.handleAgentThread defaultWallet (Just cid) ownPubKeyHash + address <- pubKeyHashAddress <$> Simulator.handleAgentThread defaultWallet (Just cid) ownPaymentPubKeyHash + <*> pure Nothing balance <- Simulator.valueAt address fees <- Simulator.walletFees defaultWallet assertEqual msg diff --git a/plutus-pab/tx-inject/Main.hs b/plutus-pab/tx-inject/Main.hs index b25284f564..35f698b6e6 100644 --- a/plutus-pab/tx-inject/Main.hs +++ b/plutus-pab/tx-inject/Main.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} @@ -42,7 +41,7 @@ import Ledger.Slot (Slot (..)) import Ledger.Tx (Tx (..)) import Plutus.PAB.Types (Config (..)) import TxInject.RandomTx (generateTx) -import Wallet.Emulator (chainState, txPool, walletPubKeyHash) +import Wallet.Emulator (chainState, mockWalletPaymentPubKeyHash, txPool) import Wallet.Emulator.MultiAgent (emulatorStateInitialDist) import Wallet.Emulator.Wallet (fromWalletNumber) @@ -76,7 +75,7 @@ initialUtxoIndex config = initialTxs = view (chainState . txPool) $ emulatorStateInitialDist $ - Map.mapKeys walletPubKeyHash dist + Map.mapKeys mockWalletPaymentPubKeyHash dist in insertBlock (map Valid initialTxs) (UtxoIndex Map.empty) -- | Starts the producer thread diff --git a/plutus-pab/tx-inject/TxInject/RandomTx.hs b/plutus-pab/tx-inject/TxInject/RandomTx.hs index 58b7b9f4bb..f33617c54d 100644 --- a/plutus-pab/tx-inject/TxInject/RandomTx.hs +++ b/plutus-pab/tx-inject/TxInject/RandomTx.hs @@ -1,10 +1,8 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} module TxInject.RandomTx( -- $randomTx @@ -20,9 +18,9 @@ import Hedgehog.Gen qualified as Gen import System.Random.MWC as MWC import Ledger.Ada qualified as Ada +import Ledger.Address (PaymentPrivateKey, PaymentPubKey) import Ledger.Address qualified as Address import Ledger.CardanoWallet qualified as CW -import Ledger.Crypto (PrivateKey, PubKey) import Ledger.Generators qualified as Generators import Ledger.Index (UtxoIndex (..), ValidationCtx (..), runValidation, validateTransaction) import Ledger.Slot (Slot (..)) @@ -56,7 +54,7 @@ generateTx -> IO Tx generateTx gen slot (UtxoIndex utxo) = do (_, sourcePubKey) <- pickNEL gen keyPairs - let sourceAddress = Address.pubKeyAddress sourcePubKey + let sourceAddress = Address.pubKeyAddress sourcePubKey Nothing -- outputs at the source address sourceOutputs -- we restrict ourselves to outputs that contain no currencies other than Ada, @@ -95,11 +93,11 @@ generateTx gen slot (UtxoIndex utxo) = do Nothing -> pure tx Just _ -> generateTx gen slot (UtxoIndex utxo) -keyPairs :: NonEmpty (PrivateKey, PubKey) +keyPairs :: NonEmpty (PaymentPrivateKey, PaymentPubKey) keyPairs = fmap - (\mockWallet -> (CW.privateKey mockWallet, CW.pubKey mockWallet)) - (CW.knownWallet 1 :| drop 1 CW.knownWallets) + (\mockWallet -> (CW.paymentPrivateKey mockWallet, CW.paymentPubKey mockWallet)) + (CW.knownMockWallet 1 :| drop 1 CW.knownMockWallets) -- | Pick a random element from a non-empty list pickNEL :: PrimMonad m => Gen (PrimState m) -> NonEmpty a -> m a diff --git a/plutus-playground-client/src/MainFrame/Lenses.purs b/plutus-playground-client/src/MainFrame/Lenses.purs index 0dc5d0860b..5af4b30ff2 100644 --- a/plutus-playground-client/src/MainFrame/Lenses.purs +++ b/plutus-playground-client/src/MainFrame/Lenses.purs @@ -49,10 +49,10 @@ import Editor.Types (State) as Editor import Gist (Gist) import Language.Haskell.Interpreter (InterpreterError, InterpreterResult, SourceCode, _InterpreterResult) import Ledger.CardanoWallet (WalletNumber) +import Ledger.Address (PaymentPubKeyHash) import MainFrame.Types (FullSimulation, State, View, WebData, WebEvaluationResult) import Network.RemoteData (_Success, RemoteData(NotAsked)) import Playground.Types (CompilationResult, ContractCall, ContractDemo, EvaluationResult, FunctionSchema, KnownCurrency, Simulation, SimulatorWallet) -import Plutus.V1.Ledger.Crypto (PubKeyHash) import Schema (FormSchema) import Schema.Types (FormArgument) import Type.Proxy (Proxy(..)) @@ -158,7 +158,7 @@ _resultRollup = _Newtype <<< prop (Proxy :: _ "resultRollup") _functionSchema :: Lens' CompilationResult (Array (FunctionSchema FormSchema)) _functionSchema = _Newtype <<< prop (Proxy :: _ "functionSchema") -_walletKeys :: Lens' EvaluationResult (Array (Tuple PubKeyHash WalletNumber)) +_walletKeys :: Lens' EvaluationResult (Array (Tuple PaymentPubKeyHash WalletNumber)) _walletKeys = _Newtype <<< prop (Proxy :: _ "walletKeys") _knownCurrencies :: Lens' CompilationResult (Array KnownCurrency) diff --git a/plutus-playground-client/src/Transaction/View.purs b/plutus-playground-client/src/Transaction/View.purs index 972c4be40a..a2f8513b6d 100644 --- a/plutus-playground-client/src/Transaction/View.purs +++ b/plutus-playground-client/src/Transaction/View.purs @@ -35,6 +35,7 @@ import MainFrame.Types (ChildSlots, HAction(..), View(..)) import Playground.Lenses (_tokenName, _contractInstanceTag) import Playground.Types (EvaluationResult(EvaluationResult), SimulatorWallet) import Plutus.Trace.Emulator.Types (ContractInstanceLog(..)) +import Ledger.Address (PaymentPubKeyHash(..)) import Plutus.V1.Ledger.Slot (Slot(..)) import Plutus.V1.Ledger.TxId (TxId(TxId)) import Plutus.V1.Ledger.Value (CurrencySymbol, TokenName) @@ -85,7 +86,13 @@ evaluationPane state (EvaluationResult { emulatorLog, emulatorTrace, fundsDistri ] ] where - namingFn pubKeyHash = preview (ix pubKeyHash <<< _walletId <<< to (\n -> "Wallet " <> BigInt.toString n)) (AssocMap.Map walletKeys) + namingFn pkh = + preview + ( ix (PaymentPubKeyHash { unPaymentPubKeyHash: pkh }) + <<< _walletId + <<< to (\n -> "Wallet " <> BigInt.toString n) + ) + (AssocMap.Map walletKeys) eveEvent :: forall a. MultiAgent.EmulatorTimeEvent a -> a eveEvent (MultiAgent.EmulatorTimeEvent { _eteEvent }) = _eteEvent diff --git a/plutus-playground-server/usecases/Crowdfunding.hs b/plutus-playground-server/usecases/Crowdfunding.hs index 78a50a548b..807169d5bf 100644 --- a/plutus-playground-server/usecases/Crowdfunding.hs +++ b/plutus-playground-server/usecases/Crowdfunding.hs @@ -25,7 +25,8 @@ import Control.Applicative (Applicative (pure)) import Control.Monad (void) import Data.Default (Default (def)) import Data.Text (Text) -import Ledger (POSIXTime, POSIXTimeRange, PubKeyHash, ScriptContext (..), TxInfo (..), Validator, getCardanoTxId) +import Ledger (POSIXTime, POSIXTimeRange, PaymentPubKeyHash (unPaymentPubKeyHash), ScriptContext (..), TxInfo (..), + Validator, getCardanoTxId) import Ledger qualified import Ledger.Contexts qualified as V import Ledger.Interval qualified as Interval @@ -49,7 +50,7 @@ data Campaign = Campaign -- ^ The date by which the campaign funds can be contributed. , campaignCollectionDeadline :: POSIXTime -- ^ The date by which the campaign owner has to collect the funds - , campaignOwner :: PubKeyHash + , campaignOwner :: PaymentPubKeyHash -- ^ Public key of the campaign owner. This key is entitled to retrieve the -- funds if the campaign is successful. } deriving (Generic, ToJSON, FromJSON, ToSchema) @@ -82,7 +83,7 @@ mkCampaign ddl collectionDdl ownerWallet = Campaign { campaignDeadline = ddl , campaignCollectionDeadline = collectionDdl - , campaignOwner = Emulator.walletPubKeyHash ownerWallet + , campaignOwner = Emulator.mockWalletPaymentPubKeyHash ownerWallet } -- | The 'POSIXTimeRange' during which the funds can be collected @@ -98,7 +99,7 @@ refundRange cmp = data Crowdfunding instance Scripts.ValidatorTypes Crowdfunding where type instance RedeemerType Crowdfunding = CampaignAction - type instance DatumType Crowdfunding = PubKeyHash + type instance DatumType Crowdfunding = PaymentPubKeyHash typedValidator :: Campaign -> Scripts.TypedValidator Crowdfunding typedValidator = Scripts.mkTypedValidatorParam @Crowdfunding @@ -108,26 +109,26 @@ typedValidator = Scripts.mkTypedValidatorParam @Crowdfunding wrap = Scripts.wrapValidator {-# INLINABLE validRefund #-} -validRefund :: Campaign -> PubKeyHash -> TxInfo -> Bool +validRefund :: Campaign -> PaymentPubKeyHash -> TxInfo -> Bool validRefund campaign contributor txinfo = -- Check that the transaction falls in the refund range of the campaign (refundRange campaign `Interval.contains` txInfoValidRange txinfo) -- Check that the transaction is signed by the contributor - && (txinfo `V.txSignedBy` contributor) + && (txinfo `V.txSignedBy` unPaymentPubKeyHash contributor) validCollection :: Campaign -> TxInfo -> Bool validCollection campaign txinfo = -- Check that the transaction falls in the collection range of the campaign (collectionRange campaign `Interval.contains` txInfoValidRange txinfo) -- Check that the transaction is signed by the campaign owner - && (txinfo `V.txSignedBy` campaignOwner campaign) + && (txinfo `V.txSignedBy` unPaymentPubKeyHash (campaignOwner campaign)) -- | The validator script is of type 'CrowdfundingValidator', and is -- additionally parameterized by a 'Campaign' definition. This argument is -- provided by the Plutus client, using 'PlutusTx.applyCode'. -- As a result, the 'Campaign' definition is part of the script address, -- and different campaigns have different addresses. -mkValidator :: Campaign -> PubKeyHash -> CampaignAction -> ScriptContext -> Bool +mkValidator :: Campaign -> PaymentPubKeyHash -> CampaignAction -> ScriptContext -> Bool mkValidator c con act p = case act of -- the "refund" branch Refund -> validRefund c con (scriptContextTxInfo p) @@ -153,7 +154,7 @@ theCampaign :: POSIXTime -> Campaign theCampaign startTime = Campaign { campaignDeadline = startTime + 40000 , campaignCollectionDeadline = startTime + 60000 - , campaignOwner = Emulator.walletPubKeyHash (Emulator.knownWallet 1) + , campaignOwner = Emulator.mockWalletPaymentPubKeyHash (Emulator.knownWallet 1) } -- | The "contribute" branch of the contract for a specific 'Campaign'. Exposes @@ -162,7 +163,7 @@ theCampaign startTime = Campaign -- refund if the funding was not collected. contribute :: AsContractError e => Campaign -> Promise () CrowdfundingSchema e () contribute cmp = endpoint @"contribute" $ \Contribution{contribValue} -> do - contributor <- ownPubKeyHash + contributor <- ownPaymentPubKeyHash let inst = typedValidator cmp tx = Constraints.mustPayToTheScript contributor contribValue <> Constraints.mustValidateIn (Interval.to (campaignDeadline cmp)) diff --git a/plutus-playground-server/usecases/Vesting.hs b/plutus-playground-server/usecases/Vesting.hs index 904ec48fa5..fd94efc218 100644 --- a/plutus-playground-server/usecases/Vesting.hs +++ b/plutus-playground-server/usecases/Vesting.hs @@ -20,7 +20,7 @@ import Data.Default (Default (def)) import Data.Map qualified as Map import Data.Text qualified as T -import Ledger (Address, POSIXTime, POSIXTimeRange, PubKeyHash, Validator) +import Ledger (Address, POSIXTime, POSIXTimeRange, PaymentPubKeyHash (unPaymentPubKeyHash), Validator) import Ledger.Ada qualified as Ada import Ledger.Constraints (TxConstraints, mustBeSignedBy, mustPayToTheScript, mustValidateIn) import Ledger.Constraints qualified as Constraints @@ -75,7 +75,7 @@ PlutusTx.makeLift ''VestingTranche data VestingParams = VestingParams { vestingTranche1 :: VestingTranche, vestingTranche2 :: VestingTranche, - vestingOwner :: PubKeyHash + vestingOwner :: PaymentPubKeyHash } deriving Generic PlutusTx.makeLift ''VestingParams @@ -124,7 +124,7 @@ validate VestingParams{vestingTranche1, vestingTranche2, vestingOwner} () () ctx -- is "vestingOwner can do with the funds what they want" (as opposed -- to "the funds must be paid to vestingOwner"). This is enforcey by -- the following condition: - && Validation.txSignedBy txInfo vestingOwner + && Validation.txSignedBy txInfo (unPaymentPubKeyHash vestingOwner) -- That way the recipient of the funds can pay them to whatever address they -- please, potentially saving one transaction. @@ -215,7 +215,7 @@ retrieveFundsC vesting payment = do endpoints :: Contract () VestingSchema T.Text () endpoints = vestingContract vestingParams where - vestingOwner = walletPubKeyHash w1 + vestingOwner = mockWalletPaymentPubKeyHash w1 vestingParams = VestingParams {vestingTranche1, vestingTranche2, vestingOwner} vestingTranche1 = diff --git a/plutus-use-cases/src/Plutus/Contracts/Auction.hs b/plutus-use-cases/src/Plutus/Contracts/Auction.hs index 5a278e6984..fa7a9b6f19 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Auction.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Auction.hs @@ -31,7 +31,7 @@ import Data.Aeson (FromJSON, ToJSON) import Data.Monoid (Last (..)) import Data.Semigroup.Generic (GenericSemigroupMonoid (..)) import GHC.Generics (Generic) -import Ledger (Ada, POSIXTime, PubKeyHash, Value) +import Ledger (Ada, POSIXTime, PaymentPubKeyHash, Value) import Ledger.Ada qualified as Ada import Ledger.Constraints qualified as Constraints import Ledger.Constraints.TxConstraints (TxConstraints) @@ -51,7 +51,7 @@ import Prelude qualified as Haskell -- | Definition of an auction data AuctionParams = AuctionParams - { apOwner :: PubKeyHash -- ^ Current owner of the asset. This is where the proceeds of the auction will be sent. + { apOwner :: PaymentPubKeyHash -- ^ Current owner of the asset. This is where the proceeds of the auction will be sent. , apAsset :: Value -- ^ The asset itself. This value is going to be locked by the auction script output. , apEndTime :: POSIXTime -- ^ When the time window for bidding ends. } @@ -64,7 +64,7 @@ PlutusTx.makeLift ''AuctionParams data HighestBid = HighestBid { highestBid :: Ada - , highestBidder :: PubKeyHash + , highestBidder :: PaymentPubKeyHash } deriving stock (Haskell.Eq, Haskell.Show, Generic) deriving anyclass (ToJSON, FromJSON) @@ -99,14 +99,14 @@ threadTokenOut t = Haskell.mempty { auctionThreadToken = Last (Just t) } -- | Initial 'AuctionState'. In the beginning the highest bid is 0 and the -- highest bidder is seller of the asset. So if nobody submits -- any bids, the seller gets the asset back after the auction has ended. -initialState :: PubKeyHash -> AuctionState +initialState :: PaymentPubKeyHash -> AuctionState initialState self = Ongoing HighestBid{highestBid = 0, highestBidder = self} PlutusTx.unstableMakeIsData ''AuctionState -- | Transition between auction states data AuctionInput - = Bid { newBid :: Ada, newBidder :: PubKeyHash } -- Increase the price + = Bid { newBid :: Ada, newBidder :: PaymentPubKeyHash } -- Increase the price | Payout deriving stock (Generic, Haskell.Show) deriving anyclass (ToJSON, FromJSON) @@ -216,7 +216,7 @@ auctionSeller :: Value -> POSIXTime -> Contract AuctionOutput SellerSchema Aucti auctionSeller value time = do threadToken <- SM.getThreadToken tell $ threadTokenOut threadToken - self <- ownPubKeyHash + self <- ownPaymentPubKeyHash let params = AuctionParams{apOwner = self, apAsset = value, apEndTime = time } inst = typedValidator (threadToken, params) client = machineClient inst threadToken params @@ -327,7 +327,7 @@ handleEvent client lastHighestBid change = AuctionIsOver s -> tell (auctionStateOut $ Finished s) >> stop SubmitOwnBid ada -> do logInfo @Haskell.String "Submitting bid" - self <- ownPubKeyHash + self <- ownPaymentPubKeyHash logInfo @Haskell.String "Received pubkey" r <- SM.runStep client Bid{newBid = ada, newBidder = self} logInfo @Haskell.String "SM: runStep done" diff --git a/plutus-use-cases/src/Plutus/Contracts/Crowdfunding.hs b/plutus-use-cases/src/Plutus/Contracts/Crowdfunding.hs index 82a594f02a..9765caff98 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Crowdfunding.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Crowdfunding.hs @@ -55,7 +55,7 @@ import Data.Text (Text) import Data.Text qualified as Text import GHC.Generics (Generic) -import Ledger (POSIXTime, POSIXTimeRange, PubKeyHash, Validator, getCardanoTxId) +import Ledger (POSIXTime, POSIXTimeRange, PaymentPubKeyHash (unPaymentPubKeyHash), Validator, getCardanoTxId) import Ledger qualified import Ledger.Ada qualified as Ada import Ledger.Constraints qualified as Constraints @@ -84,7 +84,7 @@ data Campaign = Campaign -- ^ The date by which the campaign funds can be contributed. , campaignCollectionDeadline :: POSIXTime -- ^ The date by which the campaign owner has to collect the funds - , campaignOwner :: PubKeyHash + , campaignOwner :: PaymentPubKeyHash -- ^ Public key of the campaign owner. This key is entitled to retrieve the -- funds if the campaign is successful. } deriving (Generic, ToJSON, FromJSON, ToSchema, Haskell.Show) @@ -117,7 +117,7 @@ mkCampaign ddl collectionDdl ownerWallet = Campaign { campaignDeadline = ddl , campaignCollectionDeadline = collectionDdl - , campaignOwner = Emulator.walletPubKeyHash ownerWallet + , campaignOwner = Emulator.mockWalletPaymentPubKeyHash ownerWallet } -- | The 'POSIXTimeRange' during which the funds can be collected @@ -135,7 +135,7 @@ refundRange cmp = data Crowdfunding instance Scripts.ValidatorTypes Crowdfunding where type instance RedeemerType Crowdfunding = CampaignAction - type instance DatumType Crowdfunding = PubKeyHash + type instance DatumType Crowdfunding = PaymentPubKeyHash typedValidator :: Campaign -> Scripts.TypedValidator Crowdfunding typedValidator = Scripts.mkTypedValidatorParam @Crowdfunding @@ -145,12 +145,12 @@ typedValidator = Scripts.mkTypedValidatorParam @Crowdfunding wrap = Scripts.wrapValidator {-# INLINABLE validRefund #-} -validRefund :: Campaign -> PubKeyHash -> TxInfo -> Bool +validRefund :: Campaign -> PaymentPubKeyHash -> TxInfo -> Bool validRefund campaign contributor txinfo = -- Check that the transaction falls in the refund range of the campaign refundRange campaign `Interval.contains` txInfoValidRange txinfo -- Check that the transaction is signed by the contributor - && (txinfo `V.txSignedBy` contributor) + && (txinfo `V.txSignedBy` unPaymentPubKeyHash contributor) {-# INLINABLE validCollection #-} validCollection :: Campaign -> TxInfo -> Bool @@ -158,7 +158,7 @@ validCollection campaign txinfo = -- Check that the transaction falls in the collection range of the campaign (collectionRange campaign `Interval.contains` txInfoValidRange txinfo) -- Check that the transaction is signed by the campaign owner - && (txinfo `V.txSignedBy` campaignOwner campaign) + && (txinfo `V.txSignedBy` unPaymentPubKeyHash (campaignOwner campaign)) {-# INLINABLE mkValidator #-} -- | The validator script is of type 'CrowdfundingValidator', and is @@ -168,7 +168,7 @@ validCollection campaign txinfo = -- and different campaigns have different addresses. The Campaign{..} syntax -- means that all fields of the 'Campaign' value are in scope -- (for example 'campaignDeadline' in l. 70). -mkValidator :: Campaign -> PubKeyHash -> CampaignAction -> ScriptContext -> Bool +mkValidator :: Campaign -> PaymentPubKeyHash -> CampaignAction -> ScriptContext -> Bool mkValidator c con act ScriptContext{scriptContextTxInfo} = case act of -- the "refund" branch Refund -> validRefund c con scriptContextTxInfo @@ -194,7 +194,7 @@ theCampaign :: POSIXTime -> Campaign theCampaign startTime = Campaign { campaignDeadline = startTime + 20000 , campaignCollectionDeadline = startTime + 30000 - , campaignOwner = Emulator.walletPubKeyHash (knownWallet 1) + , campaignOwner = Emulator.mockWalletPaymentPubKeyHash (knownWallet 1) } -- | The "contribute" branch of the contract for a specific 'Campaign'. Exposes @@ -204,7 +204,7 @@ theCampaign startTime = Campaign contribute :: Campaign -> Promise () CrowdfundingSchema ContractError () contribute cmp = endpoint @"contribute" $ \Contribution{contribValue} -> do logInfo @Text $ "Contributing " <> Text.pack (Haskell.show contribValue) - contributor <- ownPubKeyHash + contributor <- ownPaymentPubKeyHash let inst = typedValidator cmp tx = Constraints.mustPayToTheScript contributor contribValue <> Constraints.mustValidateIn (Interval.to (campaignDeadline cmp)) diff --git a/plutus-use-cases/src/Plutus/Contracts/Currency.hs b/plutus-use-cases/src/Plutus/Contracts/Currency.hs index e509e2968f..2129f2a1f5 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Currency.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Currency.hs @@ -34,7 +34,8 @@ import PlutusTx.Prelude hiding (Monoid (..), Semigroup (..)) import Plutus.Contract as Contract import Plutus.Contract.Wallet (getUnspentOutput) -import Ledger (CurrencySymbol, PubKeyHash, TxId, TxOutRef (..), getCardanoTxId, pubKeyHashAddress, scriptCurrencySymbol) +import Ledger (CurrencySymbol, PaymentPubKeyHash, TxId, TxOutRef (..), getCardanoTxId, pubKeyHashAddress, + scriptCurrencySymbol) import Ledger.Constraints qualified as Constraints import Ledger.Contexts qualified as V import Ledger.Scripts @@ -149,12 +150,12 @@ mintContract :: forall w s e. ( AsCurrencyError e ) - => PubKeyHash + => PaymentPubKeyHash -> [(TokenName, Integer)] -> Contract w s e OneShotCurrency mintContract pk amounts = mapError (review _CurrencyError) $ do txOutRef <- getUnspentOutput - utxos <- utxosAt (pubKeyHashAddress pk) + utxos <- utxosAt (pubKeyHashAddress pk Nothing) let theCurrency = mkCurrency txOutRef amounts curVali = curPolicy theCurrency lookups = Constraints.mintingPolicy curVali @@ -182,7 +183,7 @@ type CurrencySchema = mintCurrency :: Promise (Maybe (Last OneShotCurrency)) CurrencySchema CurrencyError OneShotCurrency mintCurrency = endpoint @"Create native token" $ \SimpleMPS{tokenName, amount} -> do - ownPK <- ownPubKeyHash + ownPK <- ownPaymentPubKeyHash cur <- mintContract ownPK [(tokenName, amount)] tell (Just (Last cur)) pure cur diff --git a/plutus-use-cases/src/Plutus/Contracts/Escrow.hs b/plutus-use-cases/src/Plutus/Contracts/Escrow.hs index 481a9020b0..59bd50c975 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Escrow.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Escrow.hs @@ -22,7 +22,7 @@ module Plutus.Contracts.Escrow( , EscrowParams(..) , EscrowTarget(..) , payToScriptTarget - , payToPubKeyTarget + , payToPaymentPubKeyTarget , targetTotal , escrowContract , payRedeemRefund @@ -46,8 +46,8 @@ import Control.Monad.Error.Lens (throwing) import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) -import Ledger (Datum (..), DatumHash, POSIXTime, PubKeyHash, TxId, ValidatorHash, getCardanoTxId, interval, - scriptOutputsAt, txSignedBy, valuePaidTo) +import Ledger (Datum (..), DatumHash, POSIXTime, PaymentPubKeyHash (unPaymentPubKeyHash), TxId, ValidatorHash, + getCardanoTxId, interval, scriptOutputsAt, txSignedBy, valuePaidTo) import Ledger qualified import Ledger.Constraints (TxConstraints) import Ledger.Constraints qualified as Constraints @@ -113,15 +113,15 @@ instance AsContractError EscrowError where -- defining `EscrowTarget` values in off-chain code). Sometimes we have -- `d = DatumHash` (when checking the hashes in on-chain code) data EscrowTarget d = - PubKeyTarget PubKeyHash Value + PaymentPubKeyTarget PaymentPubKeyHash Value | ScriptTarget ValidatorHash d Value deriving (Haskell.Functor) PlutusTx.makeLift ''EscrowTarget -- | An 'EscrowTarget' that pays the value to a public key address. -payToPubKeyTarget :: PubKeyHash -> Value -> EscrowTarget d -payToPubKeyTarget = PubKeyTarget +payToPaymentPubKeyTarget :: PaymentPubKeyHash -> Value -> EscrowTarget d +payToPaymentPubKeyTarget = PaymentPubKeyTarget -- | An 'EscrowTarget' that pays the value to a script address, with the -- given data script. @@ -149,13 +149,13 @@ targetTotal = foldl (\vl tgt -> vl + targetValue tgt) mempty . escrowTargets -- | The 'Value' specified by an 'EscrowTarget' targetValue :: EscrowTarget d -> Value targetValue = \case - PubKeyTarget _ vl -> vl - ScriptTarget _ _ vl -> vl + PaymentPubKeyTarget _ vl -> vl + ScriptTarget _ _ vl -> vl -- | Create a 'Ledger.TxOut' value for the target -mkTx :: EscrowTarget Datum -> TxConstraints Action PubKeyHash +mkTx :: EscrowTarget Datum -> TxConstraints Action PaymentPubKeyHash mkTx = \case - PubKeyTarget pkh vl -> + PaymentPubKeyTarget pkh vl -> Constraints.mustPayToPubKey pkh vl ScriptTarget vs ds vl -> Constraints.mustPayToOtherScript vs ds vl @@ -165,7 +165,7 @@ data Action = Redeem | Refund data Escrow instance Scripts.ValidatorTypes Escrow where type instance RedeemerType Escrow = Action - type instance DatumType Escrow = PubKeyHash + type instance DatumType Escrow = PaymentPubKeyHash PlutusTx.unstableMakeIsData ''Action PlutusTx.makeLift ''Action @@ -182,8 +182,8 @@ PlutusTx.makeLift ''Action -- poisoning the contract by adding arbitrary outputs to the script address. meetsTarget :: TxInfo -> EscrowTarget DatumHash -> Bool meetsTarget ptx = \case - PubKeyTarget pkh vl -> - valuePaidTo ptx pkh `geq` vl + PaymentPubKeyTarget pkh vl -> + valuePaidTo ptx (unPaymentPubKeyHash pkh) `geq` vl ScriptTarget validatorHash dataValue vl -> case scriptOutputsAt validatorHash ptx of [(dataValue', vl')] -> @@ -192,7 +192,7 @@ meetsTarget ptx = \case _ -> False {-# INLINABLE validate #-} -validate :: EscrowParams DatumHash -> PubKeyHash -> Action -> ScriptContext -> Bool +validate :: EscrowParams DatumHash -> PaymentPubKeyHash -> Action -> ScriptContext -> Bool validate EscrowParams{escrowDeadline, escrowTargets} contributor action ScriptContext{scriptContextTxInfo} = case action of Redeem -> @@ -200,7 +200,7 @@ validate EscrowParams{escrowDeadline, escrowTargets} contributor action ScriptCo && traceIfFalse "meetsTarget" (all (meetsTarget scriptContextTxInfo) escrowTargets) Refund -> traceIfFalse "escrowDeadline-before" ((escrowDeadline - 1) `before` txInfoValidRange scriptContextTxInfo) - && traceIfFalse "txSignedBy" (scriptContextTxInfo `txSignedBy` contributor) + && traceIfFalse "txSignedBy" (scriptContextTxInfo `txSignedBy` unPaymentPubKeyHash contributor) typedValidator :: EscrowParams Datum -> Scripts.TypedValidator Escrow typedValidator escrow = go (Haskell.fmap Ledger.datumHash escrow) where @@ -249,7 +249,7 @@ pay :: -- ^ How much money to pay in -> Contract w s e TxId pay inst escrow vl = do - pk <- ownPubKeyHash + pk <- ownPaymentPubKeyHash let tx = Constraints.mustPayToTheScript pk vl <> Constraints.mustValidateIn (Ledger.interval 1 (escrowDeadline escrow)) utx <- mkTxConstraints (Constraints.typedValidatorLookups inst) tx @@ -318,7 +318,7 @@ refund :: -> EscrowParams Datum -> Contract w s EscrowError RefundSuccess refund inst escrow = do - pk <- ownPubKeyHash + pk <- ownPaymentPubKeyHash unspentOutputs <- utxosAt (Scripts.validatorAddress inst) let flt _ ciTxOut = either id Ledger.datumHash (Tx._ciTxOutDatum ciTxOut) == Ledger.datumHash (Datum (PlutusTx.toBuiltinData pk)) tx' = Typed.collectFromScriptFilter flt unspentOutputs Refund diff --git a/plutus-use-cases/src/Plutus/Contracts/Future.hs b/plutus-use-cases/src/Plutus/Contracts/Future.hs index fc2917d44c..f505fedc4a 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Future.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Future.hs @@ -47,7 +47,7 @@ import Control.Monad (void) import Control.Monad.Error.Lens (throwing) import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) -import Ledger (Address, Datum (..), POSIXTime, PubKey, PubKeyHash, Validator, ValidatorHash) +import Ledger (Address, Datum (..), POSIXTime, PaymentPubKey, PaymentPubKeyHash, Validator, ValidatorHash) import Ledger qualified import Ledger.Constraints qualified as Constraints import Ledger.Constraints.TxConstraints (TxConstraints) @@ -92,7 +92,7 @@ data Future = , ftUnits :: Integer , ftUnitPrice :: Value , ftInitialMargin :: Value - , ftPriceOracle :: PubKey + , ftPriceOracle :: PaymentPubKey , ftMarginPenalty :: Value -- ^ How much a participant loses if they fail to make the required -- margin payments. @@ -207,9 +207,9 @@ futureContract ft = do -- | The data needed to initialise the futures contract. data FutureSetup = FutureSetup - { shortPK :: PubKeyHash + { shortPK :: PaymentPubKeyHash -- ^ Initial owner of the short token - , longPK :: PubKeyHash + , longPK :: PaymentPubKeyHash -- ^ Initial owner of the long token , contractStart :: POSIXTime -- ^ Start of the futures contract itself. By this time the setup code @@ -331,7 +331,7 @@ validator :: Future -> FutureAccounts -> Validator validator ft fos = Scripts.validatorScript (typedValidator ft fos) {-# INLINABLE verifyOracle #-} -verifyOracle :: PlutusTx.FromData a => PubKey -> SignedMessage a -> Maybe (a, TxConstraints Void Void) +verifyOracle :: PlutusTx.FromData a => PaymentPubKey -> SignedMessage a -> Maybe (a, TxConstraints Void Void) verifyOracle pubKey sm = either (const Nothing) pure $ Oracle.verifySignedMessageConstraints pubKey sm @@ -565,7 +565,7 @@ setupTokens ) => Contract w s e FutureAccounts setupTokens = mapError (review _FutureError) $ do - pk <- ownPubKeyHash + pk <- ownPaymentPubKeyHash -- Create the tokens using the currency contract, wrapping any errors in -- 'TokenSetupFailed' @@ -589,8 +589,8 @@ escrowParams client future ftos FutureSetup{longPK, shortPK, contractStart} = [ Escrow.payToScriptTarget address dataScript (scale 2 (initialMargin future)) - , Escrow.payToPubKeyTarget longPK (tokenFor Long ftos) - , Escrow.payToPubKeyTarget shortPK (tokenFor Short ftos) + , Escrow.payToPaymentPubKeyTarget longPK (tokenFor Long ftos) + , Escrow.payToPaymentPubKeyTarget shortPK (tokenFor Short ftos) ] in EscrowParams { escrowDeadline = contractStart diff --git a/plutus-use-cases/src/Plutus/Contracts/Governance.hs b/plutus-use-cases/src/Plutus/Contracts/Governance.hs index 7fb45ef49b..79e59483ac 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Governance.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Governance.hs @@ -38,7 +38,7 @@ import Data.Semigroup (Sum (..)) import Data.String (fromString) import Data.Text (Text) import GHC.Generics (Generic) -import Ledger (MintingPolicyHash, POSIXTime, PubKeyHash, TokenName) +import Ledger (MintingPolicyHash, POSIXTime, PaymentPubKeyHash, TokenName) import Ledger.Ada qualified as Ada import Ledger.Constraints (TxConstraints) import Ledger.Constraints qualified as Constraints @@ -105,7 +105,7 @@ type Schema = data Params = Params { baseTokenName :: TokenName -- ^ The token names that allow voting are generated by adding an increasing number to the base token name. See `mkTokenName`. - , initialHolders :: [PubKeyHash] + , initialHolders :: [PaymentPubKeyHash] -- ^ The public key hashes of the initial holders of the voting tokens. , requiredVotes :: Integer -- ^ The number of votes in favor required for a proposal to be accepted. diff --git a/plutus-use-cases/src/Plutus/Contracts/MultiSig.hs b/plutus-use-cases/src/Plutus/Contracts/MultiSig.hs index 182c5d92bb..ff2717d87c 100644 --- a/plutus-use-cases/src/Plutus/Contracts/MultiSig.hs +++ b/plutus-use-cases/src/Plutus/Contracts/MultiSig.hs @@ -39,11 +39,11 @@ import Prelude as Haskell (Semigroup (..), Show, foldMap) type MultiSigSchema = Endpoint "lock" (MultiSig, Value) - .\/ Endpoint "unlock" (MultiSig, [PubKeyHash]) + .\/ Endpoint "unlock" (MultiSig, [PaymentPubKeyHash]) data MultiSig = MultiSig - { signatories :: [Ledger.PubKeyHash] + { signatories :: [Ledger.PaymentPubKeyHash] -- ^ List of public keys of people who may sign the transaction , minNumSignatures :: Integer -- ^ Minimum number of signatures required to unlock @@ -59,7 +59,7 @@ contract = selectList [lock, unlock] >> contract {-# INLINABLE validate #-} validate :: MultiSig -> () -> () -> ScriptContext -> Bool validate MultiSig{signatories, minNumSignatures} _ _ p = - let present = length (filter (V.txSignedBy (scriptContextTxInfo p)) signatories) + let present = length (filter (V.txSignedBy (scriptContextTxInfo p) . unPaymentPubKeyHash) signatories) in traceIfFalse "not enough signatures" (present >= minNumSignatures) instance Scripts.ValidatorTypes MultiSig where diff --git a/plutus-use-cases/src/Plutus/Contracts/MultiSigStateMachine.hs b/plutus-use-cases/src/Plutus/Contracts/MultiSigStateMachine.hs index 133210e5d2..12b8156876 100644 --- a/plutus-use-cases/src/Plutus/Contracts/MultiSigStateMachine.hs +++ b/plutus-use-cases/src/Plutus/Contracts/MultiSigStateMachine.hs @@ -33,7 +33,7 @@ import Control.Lens (makeClassyPrisms) import Control.Monad (forever, void) import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) -import Ledger (POSIXTime, PubKeyHash) +import Ledger (POSIXTime, PaymentPubKeyHash (unPaymentPubKeyHash)) import Ledger.Ada qualified as Ada import Ledger.Constraints (TxConstraints) import Ledger.Constraints qualified as Constraints @@ -70,7 +70,7 @@ import Prelude qualified as Haskell data Payment = Payment { paymentAmount :: Value -- ^ How much to pay out - , paymentRecipient :: PubKeyHash + , paymentRecipient :: PaymentPubKeyHash -- ^ Address to pay the value to , paymentDeadline :: POSIXTime -- ^ Time until the required amount of signatures has to be collected. @@ -84,7 +84,7 @@ instance Eq Payment where data Params = Params - { mspSignatories :: [PubKeyHash] + { mspSignatories :: [PaymentPubKeyHash] -- ^ Public keys that are allowed to authorise payments , mspRequiredSigs :: Integer -- ^ How many signatures are required for a payment @@ -96,7 +96,7 @@ data MSState = -- ^ Money is locked, anyone can make a proposal for a payment. If there is -- no value here then this is a final state and the machine will terminate. - | CollectingSignatures Payment [PubKeyHash] + | CollectingSignatures Payment [PaymentPubKeyHash] -- ^ A payment has been proposed and is awaiting signatures. | Finished -- ^ The payment was made @@ -115,7 +115,7 @@ data Input = -- ^ Propose a payment. The payment can be made as soon as enough -- signatures have been collected. - | AddSignature PubKeyHash + | AddSignature PaymentPubKeyHash -- ^ Add a signature to the sigs. that have been collected for the -- current proposal. @@ -149,12 +149,12 @@ type MultiSigSchema = {-# INLINABLE isSignatory #-} -- | Check if a public key is one of the signatories of the multisig contract. -isSignatory :: PubKeyHash -> Params -> Bool +isSignatory :: PaymentPubKeyHash -> Params -> Bool isSignatory pkh (Params sigs _) = any (\pkh' -> pkh == pkh') sigs {-# INLINABLE containsPk #-} -- | Check whether a list of public keys contains a given key. -containsPk :: PubKeyHash -> [PubKeyHash] -> Bool +containsPk :: PaymentPubKeyHash -> [PaymentPubKeyHash] -> Bool containsPk pk = any (\pk' -> pk' == pk) {-# INLINABLE isValidProposal #-} @@ -172,7 +172,7 @@ proposalExpired TxInfo{txInfoValidRange} Payment{paymentDeadline} = {-# INLINABLE proposalAccepted #-} -- | Check whether enough signatories (represented as a list of public keys) -- have signed a proposed payment. -proposalAccepted :: Params -> [PubKeyHash] -> Bool +proposalAccepted :: Params -> [PaymentPubKeyHash] -> Bool proposalAccepted (Params signatories numReq) pks = let numSigned = length (filter (\pk -> containsPk pk pks) signatories) in numSigned >= numReq @@ -188,7 +188,7 @@ valuePreserved vl ctx = vl == Validation.valueLockedBy (scriptContextTxInfo ctx) -- | @valuePaid pm ptx@ is true if the pending transaction @ptx@ pays -- the amount specified in @pm@ to the public key address specified in @pm@ valuePaid :: Payment -> TxInfo -> Bool -valuePaid (Payment vl pk _) txinfo = vl == Validation.valuePaidTo txinfo pk +valuePaid (Payment vl pk _) txinfo = vl == Validation.valuePaidTo txinfo (unPaymentPubKeyHash pk) {-# INLINABLE transition #-} transition :: Params -> State MSState -> Input -> Maybe (TxConstraints Void Void, State MSState) @@ -268,7 +268,7 @@ contract params = forever endpoints where endpoints = selectList [lock, propose, cancel, addSignature, pay] propose = endpoint @"propose-payment" $ void . SM.runStep theClient . ProposePayment cancel = endpoint @"cancel-payment" $ \() -> void $ SM.runStep theClient Cancel - addSignature = endpoint @"add-signature" $ \() -> ownPubKeyHash >>= void . SM.runStep theClient . AddSignature + addSignature = endpoint @"add-signature" $ \() -> ownPaymentPubKeyHash >>= void . SM.runStep theClient . AddSignature lock = endpoint @"lock" $ void . SM.runInitialise theClient Holding pay = endpoint @"pay" $ \() -> void $ SM.runStep theClient Pay diff --git a/plutus-use-cases/src/Plutus/Contracts/Prism/Credential.hs b/plutus-use-cases/src/Plutus/Contracts/Prism/Credential.hs index 727f4e85e2..e233dd00c4 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Prism/Credential.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Prism/Credential.hs @@ -19,8 +19,8 @@ module Plutus.Contracts.Prism.Credential( import Data.Aeson (FromJSON, ToJSON) import Data.Hashable (Hashable) import GHC.Generics (Generic) +import Ledger.Address (PaymentPubKeyHash (unPaymentPubKeyHash)) import Ledger.Contexts (ScriptContext (..), txSignedBy) -import Ledger.Crypto (PubKeyHash) import Ledger.Scripts (MintingPolicy, mintingPolicyHash, mkMintingPolicyScript) import Ledger.Typed.Scripts qualified as Scripts import Ledger.Value (TokenName, Value) @@ -34,7 +34,7 @@ import Schema (ToSchema) -- | Entity that is authorised to mint credential tokens newtype CredentialAuthority = CredentialAuthority - { unCredentialAuthority :: PubKeyHash + { unCredentialAuthority :: PaymentPubKeyHash } deriving stock (Generic, Haskell.Eq, Haskell.Show, Haskell.Ord) deriving anyclass (ToJSON, FromJSON, Hashable, ToSchema) @@ -54,7 +54,7 @@ validateMint :: CredentialAuthority -> () -> ScriptContext -> Bool validateMint CredentialAuthority{unCredentialAuthority} _ ScriptContext{scriptContextTxInfo=txinfo} = -- the credential authority is allowed to mint or destroy any number of -- tokens, so we just need to check the signature - txinfo `txSignedBy` unCredentialAuthority + txinfo `txSignedBy` unPaymentPubKeyHash unCredentialAuthority policy :: CredentialAuthority -> MintingPolicy policy credential = mkMintingPolicyScript $ diff --git a/plutus-use-cases/src/Plutus/Contracts/Prism/Mirror.hs b/plutus-use-cases/src/Plutus/Contracts/Prism/Mirror.hs index 0687dbd4c6..e9526902f7 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Prism/Mirror.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Prism/Mirror.hs @@ -22,8 +22,8 @@ import Control.Monad (forever, void) import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) import Ledger.Ada qualified as Ada +import Ledger.Address (PaymentPubKeyHash) import Ledger.Constraints qualified as Constraints -import Ledger.Crypto (PubKeyHash) import Ledger.Typed.Scripts qualified as Scripts import Ledger.Value (TokenName) import Plutus.Contract @@ -33,7 +33,7 @@ import Plutus.Contracts.Prism.Credential (Credential (..), CredentialAuthority ( import Plutus.Contracts.Prism.Credential qualified as Credential import Plutus.Contracts.Prism.StateMachine as StateMachine import Schema (ToSchema) -import Wallet.Emulator (walletPubKeyHash) +import Wallet.Emulator (mockWalletPaymentPubKeyHash) import Wallet.Emulator.Wallet (Wallet) -- | Reference to a credential tied to a specific owner (public key address). @@ -58,7 +58,7 @@ mirror :: => Contract w s MirrorError () mirror = do logInfo @String "mirror started" - authority <- mapError SetupError $ CredentialAuthority <$> ownPubKeyHash + authority <- mapError SetupError $ CredentialAuthority <$> ownPaymentPubKeyHash forever $ do logInfo @String "waiting for 'issue' call" selectList [createTokens authority, revokeToken authority] @@ -72,7 +72,7 @@ createTokens authority = endpoint @"issue" $ \CredentialOwnerReference{coTokenNa logInfo @String "Endpoint 'issue' called" let pk = Credential.unCredentialAuthority authority lookups = Constraints.mintingPolicy (Credential.policy authority) - <> Constraints.ownPubKeyHash pk + <> Constraints.ownPaymentPubKeyHash pk theToken = Credential.token Credential{credAuthority=authority,credName=coTokenName} constraints = Constraints.mustMintValue theToken @@ -81,7 +81,7 @@ createTokens authority = endpoint @"issue" $ \CredentialOwnerReference{coTokenNa _ <- mapError CreateTokenTxError $ do mkTxConstraints @Scripts.Any lookups constraints >>= submitTxConfirmed . Constraints.adjustUnbalancedTx - let stateMachine = StateMachine.mkMachineClient authority (walletPubKeyHash coOwner) coTokenName + let stateMachine = StateMachine.mkMachineClient authority (mockWalletPaymentPubKeyHash coOwner) coTokenName void $ mapError StateMachineError $ SM.runInitialise stateMachine Active theToken revokeToken :: @@ -90,9 +90,9 @@ revokeToken :: => CredentialAuthority -> Promise w s MirrorError () revokeToken authority = endpoint @"revoke" $ \CredentialOwnerReference{coTokenName, coOwner} -> do - let stateMachine = StateMachine.mkMachineClient authority (walletPubKeyHash coOwner) coTokenName + let stateMachine = StateMachine.mkMachineClient authority (mockWalletPaymentPubKeyHash coOwner) coTokenName lookups = Constraints.mintingPolicy (Credential.policy authority) <> - Constraints.ownPubKeyHash (Credential.unCredentialAuthority authority) + Constraints.ownPaymentPubKeyHash (Credential.unCredentialAuthority authority) t <- mapError StateMachineError $ SM.mkStep stateMachine RevokeCredential case t of Left{} -> return () -- Ignore invalid transitions @@ -105,7 +105,7 @@ revokeToken authority = endpoint @"revoke" $ \CredentialOwnerReference{coTokenNa --- data MirrorError = - StateNotFound TokenName PubKeyHash + StateNotFound TokenName PaymentPubKeyHash | SetupError ContractError | MirrorEndpointError ContractError | CreateTokenTxError ContractError diff --git a/plutus-use-cases/src/Plutus/Contracts/Prism/STO.hs b/plutus-use-cases/src/Plutus/Contracts/Prism/STO.hs index 36a7f352b4..a25368dc8e 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Prism/STO.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Prism/STO.hs @@ -30,10 +30,10 @@ module Plutus.Contracts.Prism.STO( import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) -import Ledger.Ada (Ada (..), fromValue) +import Ledger.Ada (Ada (Lovelace), fromValue) +import Ledger.Address (PaymentPubKeyHash (unPaymentPubKeyHash)) import Ledger.Contexts (ScriptContext (..), ScriptPurpose (..)) import Ledger.Contexts qualified as Validation -import Ledger.Crypto (PubKeyHash) import Ledger.Scripts (MintingPolicy, mintingPolicyHash, mkMintingPolicyScript) import Ledger.Typed.Scripts qualified as Scripts import Ledger.Value (TokenName, Value) @@ -44,7 +44,7 @@ import Prelude qualified as Haskell data STOData = STOData - { stoIssuer :: PubKeyHash + { stoIssuer :: PaymentPubKeyHash , stoTokenName :: TokenName , stoCredentialToken :: Value } @@ -55,7 +55,7 @@ data STOData = validateSTO :: STOData -> () -> ScriptContext -> Bool validateSTO STOData{stoIssuer,stoCredentialToken,stoTokenName} _ ScriptContext{scriptContextTxInfo=txInfo,scriptContextPurpose=Minting ownHash} = let tokenOK = stoCredentialToken `Value.leq` Validation.valueSpent txInfo - Lovelace paidToIssuer = fromValue (Validation.valuePaidTo txInfo stoIssuer) + Lovelace paidToIssuer = fromValue (Validation.valuePaidTo txInfo (unPaymentPubKeyHash stoIssuer)) mintOK = -- Note that this doesn't prevent any tokens with a name other than -- 'stoTokenName' from being minted diff --git a/plutus-use-cases/src/Plutus/Contracts/Prism/StateMachine.hs b/plutus-use-cases/src/Plutus/Contracts/Prism/StateMachine.hs index 6e7f6f7ef6..2bf967bb35 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Prism/StateMachine.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Prism/StateMachine.hs @@ -19,9 +19,9 @@ module Plutus.Contracts.Prism.StateMachine( import Data.Aeson (FromJSON, ToJSON) import Data.Hashable (Hashable) import GHC.Generics (Generic) +import Ledger.Address (PaymentPubKeyHash) import Ledger.Constraints qualified as Constraints import Ledger.Constraints.TxConstraints (TxConstraints) -import Ledger.Crypto (PubKeyHash) import Ledger.Typed.Scripts qualified as Scripts import Ledger.Value (TokenName, Value) import Plutus.Contract.StateMachine (State (..), StateMachine (..), StateMachineClient (..), Void) @@ -47,7 +47,7 @@ data IDAction = -- | A 'Credential' issued to a user (public key address) data UserCredential = UserCredential - { ucAddress :: PubKeyHash + { ucAddress :: PaymentPubKeyHash -- ^ Address of the credential holder , ucCredential :: Credential -- ^ The credential @@ -100,7 +100,7 @@ machineClient inst credentialData = let machine = credentialStateMachine credentialData in StateMachine.mkStateMachineClient (StateMachine.StateMachineInstance machine inst) -mkMachineClient :: CredentialAuthority -> PubKeyHash -> TokenName -> StateMachineClient IDState IDAction +mkMachineClient :: CredentialAuthority -> PaymentPubKeyHash -> TokenName -> StateMachineClient IDState IDAction mkMachineClient authority credentialOwner tokenName = let credential = Credential{credAuthority=authority,credName=tokenName} userCredential = diff --git a/plutus-use-cases/src/Plutus/Contracts/Prism/Unlock.hs b/plutus-use-cases/src/Plutus/Contracts/Prism/Unlock.hs index 6ed787744f..da8c99ef08 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Prism/Unlock.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Prism/Unlock.hs @@ -29,9 +29,9 @@ import Control.Monad (forever) import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) import Ledger.Ada qualified as Ada +import Ledger.Address (PaymentPubKeyHash) import Ledger.Constraints (ScriptLookups, SomeLookupsAndConstraints (..), TxConstraints (..)) import Ledger.Constraints qualified as Constraints -import Ledger.Crypto (PubKeyHash) import Ledger.Tx (getCardanoTxId) import Ledger.Value (TokenName) import Plutus.Contract @@ -51,7 +51,7 @@ import Schema (ToSchema) data STOSubscriber = STOSubscriber { wCredential :: Credential - , wSTOIssuer :: PubKeyHash + , wSTOIssuer :: PaymentPubKeyHash , wSTOTokenName :: TokenName , wSTOAmount :: Integer } @@ -95,7 +95,7 @@ unlockExchange :: forall w s. ) => Contract w s UnlockError () unlockExchange = awaitPromise $ endpoint @"unlock from exchange" $ \credential -> do - ownPK <- mapError WithdrawPkError ownPubKeyHash + ownPK <- mapError WithdrawPkError ownPaymentPubKeyHash (credConstraints, credLookups) <- obtainCredentialTokenData credential (accConstraints, accLookups) <- mapError UnlockExchangeTokenAccError @@ -115,7 +115,7 @@ obtainCredentialTokenData credential = do -- credentialManager <- mapError WithdrawEndpointError $ endpoint @"credential manager" userCredential <- mapError WithdrawPkError $ UserCredential - <$> ownPubKeyHash + <$> ownPaymentPubKeyHash <*> pure credential <*> pure (Credential.token credential) diff --git a/plutus-use-cases/src/Plutus/Contracts/PubKey.hs b/plutus-use-cases/src/Plutus/Contracts/PubKey.hs index 464782ff11..6ad0ac8acf 100644 --- a/plutus-use-cases/src/Plutus/Contracts/PubKey.hs +++ b/plutus-use-cases/src/Plutus/Contracts/PubKey.hs @@ -31,8 +31,8 @@ import PlutusTx qualified import Ledger.Constraints qualified as Constraints import Plutus.Contract as Contract -mkValidator :: PubKeyHash -> () -> () -> ScriptContext -> Bool -mkValidator pk' _ _ p = V.txSignedBy (scriptContextTxInfo p) pk' +mkValidator :: PaymentPubKeyHash -> () -> () -> ScriptContext -> Bool +mkValidator pk' _ _ p = V.txSignedBy (scriptContextTxInfo p) (unPaymentPubKeyHash pk') data PubKeyContract @@ -40,7 +40,7 @@ instance Scripts.ValidatorTypes PubKeyContract where type instance RedeemerType PubKeyContract = () type instance DatumType PubKeyContract = () -typedValidator :: PubKeyHash -> Scripts.TypedValidator PubKeyContract +typedValidator :: PaymentPubKeyHash -> Scripts.TypedValidator PubKeyContract typedValidator = Scripts.mkTypedValidatorParam @PubKeyContract $$(PlutusTx.compile [|| mkValidator ||]) $$(PlutusTx.compile [|| wrap ||]) @@ -48,8 +48,8 @@ typedValidator = Scripts.mkTypedValidatorParam @PubKeyContract wrap = Scripts.wrapValidator data PubKeyError = - ScriptOutputMissing PubKeyHash - | MultipleScriptOutputs PubKeyHash + ScriptOutputMissing PaymentPubKeyHash + | MultipleScriptOutputs PaymentPubKeyHash | PKContractError ContractError deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON) @@ -65,7 +65,7 @@ pubKeyContract :: forall w s e. ( AsPubKeyError e ) - => PubKeyHash + => PaymentPubKeyHash -> Value -> Contract w s e (TxOutRef, Maybe ChainIndexTxOut, TypedValidator PubKeyContract) pubKeyContract pk vl = mapError (review _PubKeyError ) $ do diff --git a/plutus-use-cases/src/Plutus/Contracts/SealedBidAuction.hs b/plutus-use-cases/src/Plutus/Contracts/SealedBidAuction.hs index cc8ee4d7c6..9197866f7e 100644 --- a/plutus-use-cases/src/Plutus/Contracts/SealedBidAuction.hs +++ b/plutus-use-cases/src/Plutus/Contracts/SealedBidAuction.hs @@ -33,7 +33,7 @@ import Control.Lens (makeClassyPrisms) import Control.Monad (void) import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) -import Ledger (POSIXTime, PubKeyHash, Value) +import Ledger (POSIXTime, PaymentPubKeyHash, Value) import Ledger.Ada qualified as Ada import Ledger.Constraints qualified as Constraints import Ledger.Constraints.TxConstraints (TxConstraints) @@ -77,7 +77,7 @@ type SellerSchema = Endpoint "payout" () -- | Definition of an auction data AuctionParams = AuctionParams - { apOwner :: PubKeyHash -- ^ Current owner of the asset. This is where the proceeds of the auction will be sent. + { apOwner :: PaymentPubKeyHash -- ^ Current owner of the asset. This is where the proceeds of the auction will be sent. , apAsset :: Value -- ^ The asset itself. This value is going to be locked by the auction script output. , apEndTime :: POSIXTime -- ^ When the time window for bidding ends. , apPayoutTime :: POSIXTime -- ^ When the time window for revealing your bid ends. @@ -91,7 +91,7 @@ PlutusTx.makeLift ''AuctionParams data SealedBid = SealedBid { sealedBid :: BuiltinByteString - , sealedBidBidder :: PubKeyHash + , sealedBidBidder :: PaymentPubKeyHash } deriving stock (Haskell.Eq, Haskell.Show, Generic) deriving anyclass (ToJSON, FromJSON) @@ -104,7 +104,7 @@ instance Eq SealedBid where data RevealedBid = RevealedBid { revealedBid :: Integer - , revealedBidBidder :: PubKeyHash + , revealedBidBidder :: PaymentPubKeyHash } deriving stock (Haskell.Eq, Haskell.Show, Generic) deriving anyclass (ToJSON, FromJSON) @@ -277,19 +277,19 @@ client auctionParams = startAuction :: Value -> POSIXTime -> POSIXTime -> Contract () SellerSchema AuctionError () startAuction asset endTime payoutTime = do - self <- ownPubKeyHash + self <- ownPaymentPubKeyHash let params = AuctionParams self asset endTime payoutTime void $ SM.runInitialise (client params) (Ongoing []) (apAsset params) bid :: AuctionParams -> Promise () BidderSchema AuctionError () bid params = endpoint @"bid" $ \ BidArgs{secretBid} -> do - self <- ownPubKeyHash + self <- ownPaymentPubKeyHash let sBid = extractSecret secretBid void $ SM.runStep (client params) (PlaceBid $ SealedBid (hashSecretInteger sBid) self) reveal :: AuctionParams -> Promise () BidderSchema AuctionError () reveal params = endpoint @"reveal" $ \ RevealArgs{publicBid} -> do - self <- ownPubKeyHash + self <- ownPaymentPubKeyHash void $ SM.runStep (client params) (RevealBid $ RevealedBid publicBid self) payout :: (HasEndpoint "payout" () s) => AuctionParams -> Promise () s AuctionError () diff --git a/plutus-use-cases/src/Plutus/Contracts/SimpleEscrow.hs b/plutus-use-cases/src/Plutus/Contracts/SimpleEscrow.hs index 18d2b704db..dd17810a20 100644 --- a/plutus-use-cases/src/Plutus/Contracts/SimpleEscrow.hs +++ b/plutus-use-cases/src/Plutus/Contracts/SimpleEscrow.hs @@ -24,7 +24,7 @@ import Control.Monad.Error.Lens (throwing) import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) -import Ledger (POSIXTime, PubKeyHash, TxId, getCardanoTxId, txSignedBy, valuePaidTo) +import Ledger (POSIXTime, PaymentPubKeyHash (unPaymentPubKeyHash), TxId, getCardanoTxId, txSignedBy, valuePaidTo) import Ledger qualified import Ledger.Constraints qualified as Constraints import Ledger.Contexts (ScriptContext (..), TxInfo (..)) @@ -44,7 +44,7 @@ import Prelude qualified as Haskell data EscrowParams = EscrowParams - { payee :: PubKeyHash + { payee :: PaymentPubKeyHash -- ^ The entity that needs to be paid the 'expecting' 'Value'. , paying :: Value -- ^ Value to be paid out to the redeemer. @@ -110,12 +110,12 @@ validate params action ScriptContext{scriptContextTxInfo=txInfo} = -- Can't redeem after the deadline let notLapsed = deadline params `after` txInfoValidRange txInfo -- Payee has to have been paid - paid = valuePaidTo txInfo (payee params) `geq` expecting params + paid = valuePaidTo txInfo (unPaymentPubKeyHash $ payee params) `geq` expecting params in traceIfFalse "escrow-deadline-lapsed" notLapsed && traceIfFalse "escrow-not-paid" paid Refund -> -- Has to be the person that locked value requesting the refund - let signed = txInfo `txSignedBy` payee params + let signed = txInfo `txSignedBy` unPaymentPubKeyHash (payee params) -- And we only refund after the deadline has passed lapsed = (deadline params - 1) `before` txInfoValidRange txInfo in traceIfFalse "escrow-not-signed" signed @@ -139,7 +139,7 @@ redeemEp = endpoint @"redeem" redeem where redeem params = do time <- currentTime - pk <- ownPubKeyHash + pk <- ownPaymentPubKeyHash unspentOutputs <- utxosAt escrowAddress let value = foldMap (view Tx.ciTxOutValue) unspentOutputs diff --git a/plutus-use-cases/src/Plutus/Contracts/Stablecoin.hs b/plutus-use-cases/src/Plutus/Contracts/Stablecoin.hs index 5e3b1889f0..ec07588806 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Stablecoin.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Stablecoin.hs @@ -85,9 +85,9 @@ import Data.Aeson (FromJSON, ToJSON) import Data.Functor.Identity (Identity (..)) import GHC.Generics (Generic) import Ledger.Ada qualified as Ada +import Ledger.Address (PaymentPubKey) import Ledger.Constraints (TxConstraints) import Ledger.Constraints qualified as Constraints -import Ledger.Crypto (PubKey) import Ledger.Interval qualified as Interval import Ledger.Scripts (MintingPolicyHash) import Ledger.Typed.Scripts qualified as Scripts @@ -192,7 +192,7 @@ equity r@BankState{bsReserves=BC reserves} cr = -- | Stablecoin parameters. data Stablecoin = Stablecoin - { scOracle :: PubKey -- ^ Public key of the oracle that provides exchange rates + { scOracle :: PaymentPubKey -- ^ Public key of the oracle that provides exchange rates , scFee :: Ratio Integer -- ^ Fee charged by bank for transactions. Calculated as a fraction of the total transaction volume in base currency. , scMinReserveRatio :: Ratio Integer -- ^ The minimum ratio of reserves to liabilities , scMaxReserveRatio :: Ratio Integer -- ^ The maximum ratio of reserves to liabilities diff --git a/plutus-use-cases/src/Plutus/Contracts/Swap.hs b/plutus-use-cases/src/Plutus/Contracts/Swap.hs index b320672b0b..463a2ae3b1 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Swap.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Swap.hs @@ -15,7 +15,7 @@ module Plutus.Contracts.Swap( swapValidator ) where -import Ledger (POSIXTime, PubKey, PubKeyHash, Validator) +import Ledger (POSIXTime, PaymentPubKey, PaymentPubKeyHash (unPaymentPubKeyHash), Validator) import Ledger qualified import Ledger.Ada (Ada) import Ledger.Ada qualified as Ada @@ -44,7 +44,7 @@ data Swap = Swap , swapFixedRate :: !Rational -- ^ Interest rate fixed at the beginning of the contract , swapFloatingRate :: !Rational -- ^ Interest rate whose value will be observed (by an oracle) on the day of the payment , swapMargin :: !Ada -- ^ Margin deposited at the beginning of the contract to protect against default (one party failing to pay) - , swapOracle :: !PubKey -- ^ Public key of the oracle (see note [Oracles] in [[Plutus.Contracts]]) + , swapOracle :: !PaymentPubKey -- ^ Public key of the oracle (see note [Oracles] in [[Plutus.Contracts]]) } PlutusTx.makeLift ''Swap @@ -56,8 +56,8 @@ PlutusTx.makeLift ''Swap -- In the future we could also put the `swapMargin` value in here to implement -- a variable margin. data SwapOwners = SwapOwners { - swapOwnersFixedLeg :: PubKeyHash, - swapOwnersFloating :: PubKeyHash + swapOwnersFixedLeg :: PaymentPubKeyHash, + swapOwnersFloating :: PaymentPubKeyHash } PlutusTx.unstableMakeIsData ''SwapOwners @@ -68,7 +68,7 @@ type SwapOracleMessage = SignedMessage (Observation Rational) mkValidator :: Swap -> SwapOwners -> SwapOracleMessage -> ScriptContext -> Bool mkValidator Swap{..} SwapOwners{..} redeemer p@ScriptContext{scriptContextTxInfo=txInfo} = let - extractVerifyAt :: SignedMessage (Observation Rational) -> PubKey -> POSIXTime -> Rational + extractVerifyAt :: SignedMessage (Observation Rational) -> PaymentPubKey -> POSIXTime -> Rational extractVerifyAt sm pk time = case Oracle.verifySignedMessageOnChain p pk sm of Left _ -> traceError "checkSignatureAndDecode failed" @@ -84,8 +84,8 @@ mkValidator Swap{..} SwapOwners{..} redeemer p@ScriptContext{scriptContextTxInfo adaValueIn :: Value -> Integer adaValueIn v = Ada.getLovelace (Ada.fromValue v) - isPubKeyOutput :: TxOut -> PubKeyHash -> Bool - isPubKeyOutput o k = maybe False ((==) k) (Validation.pubKeyOutput o) + isPaymentPubKeyOutput :: TxOut -> PaymentPubKeyHash -> Bool + isPaymentPubKeyOutput o k = maybe False ((==) (unPaymentPubKeyHash k)) (Validation.pubKeyOutput o) -- Verify the authenticity of the oracle value and compute -- the payments. @@ -133,12 +133,14 @@ mkValidator Swap{..} SwapOwners{..} redeemer p@ScriptContext{scriptContextTxInfo -- True if the transaction input is the margin payment of the -- fixed leg iP1 :: TxInInfo -> Bool - iP1 TxInInfo{txInInfoResolved=TxOut{txOutValue}} = Validation.txSignedBy txInfo swapOwnersFixedLeg && adaValueIn txOutValue == margin + iP1 TxInInfo{txInInfoResolved=TxOut{txOutValue}} = + Validation.txSignedBy txInfo (unPaymentPubKeyHash swapOwnersFixedLeg) && adaValueIn txOutValue == margin -- True if the transaction input is the margin payment of the -- floating leg iP2 :: TxInInfo -> Bool - iP2 TxInInfo{txInInfoResolved=TxOut{txOutValue}} = Validation.txSignedBy txInfo swapOwnersFloating && adaValueIn txOutValue == margin + iP2 TxInInfo{txInInfoResolved=TxOut{txOutValue}} = + Validation.txSignedBy txInfo (unPaymentPubKeyHash swapOwnersFloating) && adaValueIn txOutValue == margin inConditions = (iP1 t1 && iP2 t2) || (iP1 t2 && iP2 t1) @@ -148,11 +150,13 @@ mkValidator Swap{..} SwapOwners{..} redeemer p@ScriptContext{scriptContextTxInfo -- True if the output is the payment of the fixed leg. ol1 :: TxOut -> Bool - ol1 o@TxOut{txOutValue} = isPubKeyOutput o swapOwnersFixedLeg && adaValueIn txOutValue <= fixedRemainder + ol1 o@TxOut{txOutValue} = + isPaymentPubKeyOutput o swapOwnersFixedLeg && adaValueIn txOutValue <= fixedRemainder -- True if the output is the payment of the floating leg. ol2 :: TxOut -> Bool - ol2 o@TxOut{txOutValue} = isPubKeyOutput o swapOwnersFloating && adaValueIn txOutValue <= floatRemainder + ol2 o@TxOut{txOutValue} = + isPaymentPubKeyOutput o swapOwnersFloating && adaValueIn txOutValue <= floatRemainder -- NOTE: I didn't include a check that the time is greater -- than the observation time. This is because the time is diff --git a/plutus-use-cases/src/Plutus/Contracts/TokenAccount.hs b/plutus-use-cases/src/Plutus/Contracts/TokenAccount.hs index bb75ea0b0d..726d8d699a 100644 --- a/plutus-use-cases/src/Plutus/Contracts/TokenAccount.hs +++ b/plutus-use-cases/src/Plutus/Contracts/TokenAccount.hs @@ -49,7 +49,7 @@ import Plutus.Contract import Plutus.Contract.Constraints import PlutusTx qualified -import Ledger (Address, PubKeyHash, ValidatorHash) +import Ledger (Address, PaymentPubKeyHash, ValidatorHash) import Ledger qualified import Ledger.Constraints qualified as Constraints import Ledger.Contexts qualified as V @@ -77,14 +77,14 @@ instance ValidatorTypes TokenAccount where type DatumType TokenAccount = () type TokenAccountSchema = - Endpoint "redeem" (Account, PubKeyHash) + Endpoint "redeem" (Account, PaymentPubKeyHash) .\/ Endpoint "pay" (Account, Value) - .\/ Endpoint "new-account" (TokenName, PubKeyHash) + .\/ Endpoint "new-account" (TokenName, PaymentPubKeyHash) type HasTokenAccountSchema s = - ( HasEndpoint "redeem" (Account, PubKeyHash) s + ( HasEndpoint "redeem" (Account, PaymentPubKeyHash) s , HasEndpoint "pay" (Account, Value) s - , HasEndpoint "new-account" (TokenName, PubKeyHash) s + , HasEndpoint "new-account" (TokenName, PaymentPubKeyHash) s ) data TokenAccountError = @@ -109,7 +109,7 @@ tokenAccountContract ) => Contract w s e () tokenAccountContract = mapError (review _TokenAccountError) (selectList [redeem_, pay_, newAccount_]) where - redeem_ = endpoint @"redeem" @(Account, PubKeyHash) @w @s $ \(accountOwner, destination) -> do + redeem_ = endpoint @"redeem" @(Account, PaymentPubKeyHash) @w @s $ \(accountOwner, destination) -> do void $ redeem destination accountOwner tokenAccountContract pay_ = endpoint @"pay" @_ @w @s $ \(accountOwner, value) -> do @@ -170,7 +170,7 @@ redeemTx :: forall w s e. ( AsTokenAccountError e ) => Account - -> PubKeyHash + -> PaymentPubKeyHash -> Contract w s e (TxConstraints () (), ScriptLookups TokenAccount) redeemTx account pk = mapError (review _TAContractError) $ do let inst = typedValidator account @@ -195,7 +195,7 @@ redeemTx account pk = mapError (review _TAContractError) $ do redeem :: ( AsTokenAccountError e ) - => PubKeyHash + => PaymentPubKeyHash -- ^ Where the token should go after the transaction -> Account -- ^ The token account @@ -225,7 +225,7 @@ newAccount (AsTokenAccountError e) => TokenName -- ^ Name of the token - -> PubKeyHash + -> PaymentPubKeyHash -- ^ Public key of the token's initial owner -> Contract w s e Account newAccount tokenName pk = mapError (review _TokenAccountError) $ do diff --git a/plutus-use-cases/src/Plutus/Contracts/Uniswap/OffChain.hs b/plutus-use-cases/src/Plutus/Contracts/Uniswap/OffChain.hs index 8809ba70da..d4b9c0c98c 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Uniswap/OffChain.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Uniswap/OffChain.hs @@ -172,7 +172,7 @@ data AddParams = AddParams -- for any pair of tokens at any given time. start :: forall w s. Contract w s Text Uniswap start = do - pkh <- Contract.ownPubKeyHash + pkh <- Contract.ownPaymentPubKeyHash cs <- fmap Currency.currencySymbol $ mapError (pack . show @Currency.CurrencyError) $ Currency.mintContract pkh [(uniswapTokenName, 1)] @@ -223,7 +223,7 @@ create us CreateParams{..} = do close :: forall w s. Uniswap -> CloseParams -> Contract w s Text () close us CloseParams{..} = do ((oref1, o1, lps), (oref2, o2, lp, liquidity)) <- findUniswapFactoryAndPool us clpCoinA clpCoinB - pkh <- Contract.ownPubKeyHash + pkh <- Contract.ownPaymentPubKeyHash let usInst = uniswapInstance us usScript = uniswapScript us usDat = Factory $ filter (/= lp) lps @@ -238,7 +238,7 @@ close us CloseParams{..} = do lookups = Constraints.typedValidatorLookups usInst <> Constraints.otherScript usScript <> Constraints.mintingPolicy (liquidityPolicy us) <> - Constraints.ownPubKeyHash pkh <> + Constraints.ownPaymentPubKeyHash pkh <> Constraints.unspentOutputs (Map.singleton oref1 o1 <> Map.singleton oref2 o2) tx = Constraints.mustPayToTheScript usDat usVal <> @@ -255,7 +255,7 @@ close us CloseParams{..} = do remove :: forall w s. Uniswap -> RemoveParams -> Contract w s Text () remove us RemoveParams{..} = do (_, (oref, o, lp, liquidity)) <- findUniswapFactoryAndPool us rpCoinA rpCoinB - pkh <- Contract.ownPubKeyHash + pkh <- Contract.ownPaymentPubKeyHash when (rpDiff < 1 || rpDiff >= liquidity) $ throwError "removed liquidity must be positive and less than total liquidity" let usInst = uniswapInstance us usScript = uniswapScript us @@ -275,7 +275,7 @@ remove us RemoveParams{..} = do Constraints.otherScript usScript <> Constraints.mintingPolicy (liquidityPolicy us) <> Constraints.unspentOutputs (Map.singleton oref o) <> - Constraints.ownPubKeyHash pkh + Constraints.ownPaymentPubKeyHash pkh tx = Constraints.mustPayToTheScript dat val <> Constraints.mustMintValue (negate lVal) <> @@ -288,7 +288,7 @@ remove us RemoveParams{..} = do -- | Adds some liquidity to an existing liquidity pool in exchange for newly minted liquidity tokens. add :: forall w s. Uniswap -> AddParams -> Contract w s Text () add us AddParams{..} = do - pkh <- Contract.ownPubKeyHash + pkh <- Contract.ownPaymentPubKeyHash (_, (oref, o, lp, liquidity)) <- findUniswapFactoryAndPool us apCoinA apCoinB when (apAmountA < 0 || apAmountB < 0) $ throwError "amounts must not be negative" let outVal = view ciTxOutValue o @@ -314,7 +314,7 @@ add us AddParams{..} = do lookups = Constraints.typedValidatorLookups usInst <> Constraints.otherScript usScript <> Constraints.mintingPolicy (liquidityPolicy us) <> - Constraints.ownPubKeyHash pkh <> + Constraints.ownPaymentPubKeyHash pkh <> Constraints.unspentOutputs (Map.singleton oref o) tx = Constraints.mustPayToTheScript dat val <> @@ -345,7 +345,7 @@ swap us SwapParams{..} = do let outA = Amount $ findSwapB oldA oldB spAmountB when (outA == 0) $ throwError "no payout" return (oldA - outA, oldB + spAmountB) - pkh <- Contract.ownPubKeyHash + pkh <- Contract.ownPaymentPubKeyHash logInfo @String $ printf "oldA = %d, oldB = %d, old product = %d, newA = %d, newB = %d, new product = %d" oldA oldB (unAmount oldA * unAmount oldB) newA newB (unAmount newA * unAmount newB) @@ -355,7 +355,7 @@ swap us SwapParams{..} = do lookups = Constraints.typedValidatorLookups inst <> Constraints.otherScript (Scripts.validatorScript inst) <> Constraints.unspentOutputs (Map.singleton oref o) <> - Constraints.ownPubKeyHash pkh + Constraints.ownPaymentPubKeyHash pkh tx = mustSpendScriptOutput oref (Redeemer $ PlutusTx.toBuiltinData Swap) <> Constraints.mustPayToTheScript (Pool lp liquidity) val @@ -397,8 +397,8 @@ pools us = do -- | Gets the caller's funds. funds :: forall w s. Contract w s Text Value funds = do - pkh <- Contract.ownPubKeyHash - os <- map snd . Map.toList <$> utxosAt (pubKeyHashAddress pkh) + pkh <- Contract.ownPaymentPubKeyHash + os <- map snd . Map.toList <$> utxosAt (pubKeyHashAddress pkh Nothing) return $ mconcat [view ciTxOutValue o | o <- os] getUniswapDatum :: ChainIndexTxOut -> Contract w s Text UniswapDatum diff --git a/plutus-use-cases/src/Plutus/Contracts/Uniswap/Trace.hs b/plutus-use-cases/src/Plutus/Contracts/Uniswap/Trace.hs index a430e6effa..b993a71b23 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Uniswap/Trace.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Uniswap/Trace.hs @@ -29,7 +29,7 @@ import Plutus.Contracts.Uniswap.OffChain as OffChain import Plutus.Contracts.Uniswap.Types as Types import Plutus.Trace.Emulator (EmulatorRuntimeError (GenericError), EmulatorTrace) import Plutus.Trace.Emulator qualified as Emulator -import Wallet.Emulator (Wallet (..), knownWallet, knownWallets, walletPubKeyHash) +import Wallet.Emulator (Wallet (..), knownWallet, knownWallets, mockWalletPaymentPubKeyHash) -- | Set up a liquidity pool and call the "add" endpoint uniswapTrace :: EmulatorTrace () @@ -65,13 +65,13 @@ uniswapTrace = do -- the emulated wallets setupTokens :: Contract (Maybe (Semigroup.Last Currency.OneShotCurrency)) Currency.CurrencySchema Currency.CurrencyError () setupTokens = do - ownPK <- Contract.ownPubKeyHash + ownPK <- Contract.ownPaymentPubKeyHash cur <- Currency.mintContract ownPK [(tn, fromIntegral (length wallets) * amount) | tn <- tokenNames] let cs = Currency.currencySymbol cur v = mconcat [Value.singleton cs tn amount | tn <- tokenNames] forM_ wallets $ \w -> do - let pkh = walletPubKeyHash w + let pkh = mockWalletPaymentPubKeyHash w when (pkh /= ownPK) $ do mkTxConstraints @Void mempty (mustPayToPubKey pkh v) >>= submitTxConfirmed . adjustUnbalancedTx diff --git a/plutus-use-cases/src/Plutus/Contracts/Vesting.hs b/plutus-use-cases/src/Plutus/Contracts/Vesting.hs index 5ec88b52fd..5b4bad7a7b 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Vesting.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Vesting.hs @@ -33,7 +33,7 @@ import Data.Map qualified as Map import Prelude (Semigroup (..)) import GHC.Generics (Generic) -import Ledger (Address, POSIXTime, POSIXTimeRange, PubKeyHash (..), Validator) +import Ledger (Address, POSIXTime, POSIXTimeRange, PaymentPubKeyHash (unPaymentPubKeyHash), Validator) import Ledger.Constraints (TxConstraints, mustBeSignedBy, mustPayToTheScript, mustValidateIn) import Ledger.Constraints qualified as Constraints import Ledger.Contexts (ScriptContext (..), TxInfo (..)) @@ -91,7 +91,7 @@ PlutusTx.makeLift ''VestingTranche data VestingParams = VestingParams { vestingTranche1 :: VestingTranche, vestingTranche2 :: VestingTranche, - vestingOwner :: PubKeyHash + vestingOwner :: PaymentPubKeyHash } deriving Generic PlutusTx.makeLift ''VestingParams @@ -140,7 +140,7 @@ validate VestingParams{vestingTranche1, vestingTranche2, vestingOwner} () () ctx -- is "vestingOwner can do with the funds what they want" (as opposed -- to "the funds must be paid to vestingOwner"). This is enforcey by -- the following condition: - && Validation.txSignedBy txInfo vestingOwner + && Validation.txSignedBy txInfo (unPaymentPubKeyHash vestingOwner) -- That way the recipient of the funds can pay them to whatever address they -- please, potentially saving one transaction. diff --git a/plutus-use-cases/test/Spec/Auction.hs b/plutus-use-cases/test/Spec/Auction.hs index 2fd512e15c..796093ddb9 100644 --- a/plutus-use-cases/test/Spec/Auction.hs +++ b/plutus-use-cases/test/Spec/Auction.hs @@ -54,7 +54,7 @@ slotCfg = def params :: AuctionParams params = AuctionParams - { apOwner = walletPubKeyHash w1 + { apOwner = mockWalletPaymentPubKeyHash w1 , apAsset = theToken , apEndTime = TimeSlot.scSlotZeroTime slotCfg + 100000 } @@ -129,7 +129,7 @@ trace1FinalState = AuctionOutput { auctionState = Last $ Just $ Finished $ HighestBid { highestBid = trace1WinningBid - , highestBidder = walletPubKeyHash w2 + , highestBidder = mockWalletPaymentPubKeyHash w2 } , auctionThreadToken = Last $ Just threadToken } @@ -139,7 +139,7 @@ trace2FinalState = AuctionOutput { auctionState = Last $ Just $ Finished $ HighestBid { highestBid = trace2WinningBid - , highestBidder = walletPubKeyHash w2 + , highestBidder = mockWalletPaymentPubKeyHash w2 } , auctionThreadToken = Last $ Just threadToken } diff --git a/plutus-use-cases/test/Spec/Currency.hs b/plutus-use-cases/test/Spec/Currency.hs index 2c8b3bac59..c322a8cc57 100644 --- a/plutus-use-cases/test/Spec/Currency.hs +++ b/plutus-use-cases/test/Spec/Currency.hs @@ -37,4 +37,4 @@ tests = testGroup "currency" theContract :: Contract () EmptySchema Cur.CurrencyError OneShotCurrency theContract = let amounts = [("my currency", 1000), ("my token", 1)] in - Cur.mintContract (walletPubKeyHash w1) amounts + Cur.mintContract (mockWalletPaymentPubKeyHash w1) amounts diff --git a/plutus-use-cases/test/Spec/Escrow.hs b/plutus-use-cases/test/Spec/Escrow.hs index ca04a71192..e561d0b26f 100644 --- a/plutus-use-cases/test/Spec/Escrow.hs +++ b/plutus-use-cases/test/Spec/Escrow.hs @@ -80,7 +80,7 @@ instance ContractModel EscrowModel where Redeem w -> do targets <- viewContractState targets contribs <- viewContractState contributions - sequence_ [ deposit w v | (w, v) <- Map.toList $ targets ] + sequence_ [ deposit w v | (w, v) <- Map.toList targets ] let leftoverValue = fold contribs <> inv (fold targets) deposit w leftoverValue contributions $= Map.empty @@ -215,8 +215,8 @@ escrowParams startTime = EscrowParams { escrowDeadline = startTime + 10000 , escrowTargets = - [ payToPubKeyTarget (walletPubKeyHash w1) (Ada.adaValueOf 10) - , payToPubKeyTarget (walletPubKeyHash w2) (Ada.adaValueOf 20) + [ payToPaymentPubKeyTarget (mockWalletPaymentPubKeyHash w1) (Ada.adaValueOf 10) + , payToPaymentPubKeyTarget (mockWalletPaymentPubKeyHash w2) (Ada.adaValueOf 20) ] } diff --git a/plutus-use-cases/test/Spec/Future.hs b/plutus-use-cases/test/Spec/Future.hs index 1bdcfd0801..a23edf37b9 100644 --- a/plutus-use-cases/test/Spec/Future.hs +++ b/plutus-use-cases/test/Spec/Future.hs @@ -23,7 +23,7 @@ import Spec.TokenAccount (assertAccountBalance) import Ledger qualified import Ledger.Ada qualified as Ada -import Ledger.Crypto (PrivateKey, PubKey (..)) +import Ledger.Address (PaymentPrivateKey, PaymentPubKey) import Ledger.Time (POSIXTime) import Ledger.TimeSlot qualified as TimeSlot import Ledger.Value (Value, scale) @@ -99,8 +99,8 @@ tests = setup :: POSIXTime -> FutureSetup setup startTime = FutureSetup - { shortPK = walletPubKeyHash w1 - , longPK = walletPubKeyHash w2 + { shortPK = mockWalletPaymentPubKeyHash w1 + , longPK = mockWalletPaymentPubKeyHash w2 , contractStart = startTime + 15000 } @@ -182,8 +182,8 @@ forwardPrice = Ada.lovelaceValueOf 2_123_000 units :: Integer units = 187 -oracleKeys :: (PrivateKey, PubKey) -oracleKeys = (CW.privateKey wllt, CW.pubKey wllt) where +oracleKeys :: (PaymentPrivateKey, PaymentPubKey) +oracleKeys = (CW.paymentPrivateKey wllt, CW.paymentPubKey wllt) where wllt = CW.fromWalletNumber $ CW.WalletNumber 10 -- | Increase the margin of the 'Long' role by 100 lovelace diff --git a/plutus-use-cases/test/Spec/Governance.hs b/plutus-use-cases/test/Spec/Governance.hs index 0c28d3fc81..947386c24d 100644 --- a/plutus-use-cases/test/Spec/Governance.hs +++ b/plutus-use-cases/test/Spec/Governance.hs @@ -63,7 +63,7 @@ baseName = "TestLawToken" -- | A governance contract that requires 6 votes out of 10 params :: Gov.Params params = Gov.Params - { Gov.initialHolders = EM.walletPubKeyHash . knownWallet <$> [1..numberOfHolders] + { Gov.initialHolders = EM.mockWalletPaymentPubKeyHash . knownWallet <$> [1..numberOfHolders] , Gov.requiredVotes = 6 , Gov.baseTokenName = baseName } diff --git a/plutus-use-cases/test/Spec/MultiSig.hs b/plutus-use-cases/test/Spec/MultiSig.hs index 4434da421a..aa9030f03b 100644 --- a/plutus-use-cases/test/Spec/MultiSig.hs +++ b/plutus-use-cases/test/Spec/MultiSig.hs @@ -15,7 +15,7 @@ import Plutus.Contract.Test import Plutus.Contracts.MultiSig as MS import Plutus.Trace.Emulator (EmulatorTrace) import Plutus.Trace.Emulator qualified as Trace -import PlutusTx qualified as PlutusTx +import PlutusTx qualified import Prelude hiding (not) import Test.Tasty import Wallet.Emulator.Wallet (signPrivateKeys) @@ -40,8 +40,8 @@ failingTrace = do hdl <- Trace.activateContractWallet w1 theContract Trace.callEndpoint @"lock" hdl (multiSig, Ada.lovelaceValueOf 10) _ <- Trace.waitNSlots 1 - Trace.setSigningProcess w1 (signPrivateKeys [CW.privateKey (CW.knownWallet 1), CW.privateKey (CW.knownWallet 2)]) - Trace.callEndpoint @"unlock" hdl (multiSig, fmap walletPubKeyHash [w1, w2]) + Trace.setSigningProcess w1 (signPrivateKeys [CW.paymentPrivateKey (CW.knownMockWallet 1), CW.paymentPrivateKey (CW.knownMockWallet 2)]) + Trace.callEndpoint @"unlock" hdl (multiSig, fmap mockWalletPaymentPubKeyHash [w1, w2]) void $ Trace.waitNSlots 1 -- | Lock some funds, then unlock them with a transaction that has the @@ -51,8 +51,8 @@ succeedingTrace = do hdl <- Trace.activateContractWallet w1 theContract Trace.callEndpoint @"lock" hdl (multiSig, Ada.lovelaceValueOf 10) _ <- Trace.waitNSlots 1 - Trace.setSigningProcess w1 (signPrivateKeys [CW.privateKey (CW.knownWallet 1), CW.privateKey (CW.knownWallet 2), CW.privateKey (CW.knownWallet 3)]) - Trace.callEndpoint @"unlock" hdl (multiSig, fmap walletPubKeyHash [w1, w2, w3]) + Trace.setSigningProcess w1 (signPrivateKeys [CW.paymentPrivateKey (CW.knownMockWallet 1), CW.paymentPrivateKey (CW.knownMockWallet 2), CW.paymentPrivateKey (CW.knownMockWallet 3)]) + Trace.callEndpoint @"unlock" hdl (multiSig, fmap mockWalletPaymentPubKeyHash [w1, w2, w3]) void $ Trace.waitNSlots 1 theContract :: Contract () MultiSigSchema ContractError () @@ -61,6 +61,6 @@ theContract = MS.contract -- a 'MultiSig' contract that requires three out of five signatures multiSig :: MultiSig multiSig = MultiSig - { signatories = walletPubKeyHash . knownWallet <$> [1..5] + { signatories = mockWalletPaymentPubKeyHash . knownWallet <$> [1..5] , minNumSignatures = 3 } diff --git a/plutus-use-cases/test/Spec/MultiSigStateMachine.hs b/plutus-use-cases/test/Spec/MultiSigStateMachine.hs index 134716bd52..aded608062 100644 --- a/plutus-use-cases/test/Spec/MultiSigStateMachine.hs +++ b/plutus-use-cases/test/Spec/MultiSigStateMachine.hs @@ -62,14 +62,14 @@ tests = -- | A multisig contract that requires 3 out of 5 signatures params :: MS.Params params = MS.Params keys 3 where - keys = EM.walletPubKeyHash . knownWallet <$> [1..5] + keys = EM.mockWalletPaymentPubKeyHash . knownWallet <$> [1..5] -- | A payment of 5 Ada to the public key address of wallet 2 payment :: POSIXTime -> MS.Payment payment startTime = MS.Payment { MS.paymentAmount = Ada.adaValueOf 5 - , MS.paymentRecipient = EM.walletPubKeyHash w2 + , MS.paymentRecipient = EM.mockWalletPaymentPubKeyHash w2 , MS.paymentDeadline = startTime + 20000 } diff --git a/plutus-use-cases/test/Spec/Prism.hs b/plutus-use-cases/test/Spec/Prism.hs index 28017725cb..e234e43a88 100644 --- a/plutus-use-cases/test/Spec/Prism.hs +++ b/plutus-use-cases/test/Spec/Prism.hs @@ -55,14 +55,14 @@ credential :: Credential credential = Credential { credName = kyc - , credAuthority = CredentialAuthority (walletPubKeyHash mirror) + , credAuthority = CredentialAuthority (mockWalletPaymentPubKeyHash mirror) } stoSubscriber :: STOSubscriber stoSubscriber = STOSubscriber { wCredential = credential - , wSTOIssuer = walletPubKeyHash issuer + , wSTOIssuer = mockWalletPaymentPubKeyHash issuer , wSTOTokenName = sto , wSTOAmount = numTokens } @@ -70,7 +70,7 @@ stoSubscriber = stoData :: STOData stoData = STOData - { stoIssuer = walletPubKeyHash issuer + { stoIssuer = mockWalletPaymentPubKeyHash issuer , stoTokenName = sto , stoCredentialToken = Credential.token credential } diff --git a/plutus-use-cases/test/Spec/PubKey.hs b/plutus-use-cases/test/Spec/PubKey.hs index c2bcd7f537..54bcd4f12c 100644 --- a/plutus-use-cases/test/Spec/PubKey.hs +++ b/plutus-use-cases/test/Spec/PubKey.hs @@ -18,7 +18,7 @@ import Test.Tasty theContract :: Contract () EmptySchema PubKeyError () theContract = do - (txOutRef, ciTxOut, pkInst) <- pubKeyContract (walletPubKeyHash w1) (Ada.adaValueOf 10) + (txOutRef, ciTxOut, pkInst) <- pubKeyContract (mockWalletPaymentPubKeyHash w1) (Ada.adaValueOf 10) let lookups = maybe mempty (Constraints.unspentOutputs . Map.singleton txOutRef) ciTxOut <> Constraints.otherScript (Scripts.validatorScript pkInst) void $ submitTxConstraintsWith @Scripts.Any lookups (Constraints.mustSpendScriptOutput txOutRef unitRedeemer) diff --git a/plutus-use-cases/test/Spec/Rollup.hs b/plutus-use-cases/test/Spec/Rollup.hs index 4b257d9bb8..2f2cdd81f3 100644 --- a/plutus-use-cases/test/Spec/Rollup.hs +++ b/plutus-use-cases/test/Spec/Rollup.hs @@ -48,7 +48,7 @@ render trace = do $ foldEmulatorStreamM (L.generalize (showBlockchainFold knownWallets')) $ takeUntilSlot 21 $ runEmulatorStream def trace - knownWallets' = fmap (\w -> (walletPubKeyHash w, w)) knownWallets + knownWallets' = fmap (\w -> (mockWalletPaymentPubKeyHash w, w)) knownWallets case result of Left err -> assertFailure $ show err Right rendered -> pure $ LBS.fromStrict $ encodeUtf8 rendered diff --git a/plutus-use-cases/test/Spec/SealedBidAuction.hs b/plutus-use-cases/test/Spec/SealedBidAuction.hs index d13019e632..6701301006 100644 --- a/plutus-use-cases/test/Spec/SealedBidAuction.hs +++ b/plutus-use-cases/test/Spec/SealedBidAuction.hs @@ -37,7 +37,7 @@ instance Arbitrary AuctionParams where endTime <- choose (20, 50) payoutTime <- choose (endTime+1, 70) return $ AuctionParams - { apOwner = walletPubKeyHash w1 + { apOwner = mockWalletPaymentPubKeyHash w1 , apAsset = theToken , apEndTime = TimeSlot.scSlotZeroTime def + fromInteger (endTime*1000) , apPayoutTime = TimeSlot.scSlotZeroTime def + fromInteger (payoutTime*1000) diff --git a/plutus-use-cases/test/Spec/SimpleEscrow.hs b/plutus-use-cases/test/Spec/SimpleEscrow.hs index 963e73eac8..ca85047f37 100644 --- a/plutus-use-cases/test/Spec/SimpleEscrow.hs +++ b/plutus-use-cases/test/Spec/SimpleEscrow.hs @@ -107,7 +107,7 @@ options = mkEscrowParams :: POSIXTime -> Value -> Value -> EscrowParams mkEscrowParams startTime p e = EscrowParams - { payee = walletPubKeyHash w1 + { payee = mockWalletPaymentPubKeyHash w1 , paying = p , expecting = e , deadline = startTime + 100000 diff --git a/plutus-use-cases/test/Spec/Stablecoin.hs b/plutus-use-cases/test/Spec/Stablecoin.hs index d1cf90cf8d..f6613b2e9e 100644 --- a/plutus-use-cases/test/Spec/Stablecoin.hs +++ b/plutus-use-cases/test/Spec/Stablecoin.hs @@ -19,9 +19,9 @@ import Prelude hiding (negate) import Ledger.Ada (adaSymbol, adaToken) import Ledger.Ada qualified as Ada -import Ledger.Address (Address) +import Ledger.Address (Address, PaymentPrivateKey (unPaymentPrivateKey), PaymentPubKey (PaymentPubKey)) import Ledger.CardanoWallet qualified as CW -import Ledger.Crypto (PrivateKey, toPublicKey) +import Ledger.Crypto (toPublicKey) import Ledger.Time (POSIXTime) import Ledger.TimeSlot qualified as TimeSlot import Ledger.Typed.Scripts (validatorAddress) @@ -44,15 +44,15 @@ import Test.Tasty user :: Wallet user = w1 -oraclePrivateKey :: PrivateKey -oraclePrivateKey = CW.privateKey $ CW.fromWalletNumber $ CW.WalletNumber 2 +oraclePrivateKey :: PaymentPrivateKey +oraclePrivateKey = CW.paymentPrivateKey $ CW.fromWalletNumber $ CW.WalletNumber 2 onePercent :: Ratio Integer onePercent = 1 % 100 coin :: Stablecoin coin = Stablecoin - { scOracle = toPublicKey oraclePrivateKey + { scOracle = PaymentPubKey $ toPublicKey (unPaymentPrivateKey oraclePrivateKey) , scFee = onePercent , scMinReserveRatio = zero , scMaxReserveRatio = 4 % 1 diff --git a/plutus-use-cases/test/Spec/TokenAccount.hs b/plutus-use-cases/test/Spec/TokenAccount.hs index af1867dde1..dbee30a865 100644 --- a/plutus-use-cases/test/Spec/TokenAccount.hs +++ b/plutus-use-cases/test/Spec/TokenAccount.hs @@ -31,7 +31,7 @@ tests = testGroup "token account" .&&. walletFundsChange w1 theToken) $ do hdl <- Trace.activateContractWallet w1 contract - Trace.callEndpoint @"new-account" hdl (tokenName, walletPubKeyHash w1) + Trace.callEndpoint @"new-account" hdl (tokenName, mockWalletPaymentPubKeyHash w1) void $ Trace.waitNSlots 2 , checkPredicate "Pay into the account" @@ -40,7 +40,7 @@ tests = testGroup "token account" .&&. walletFundsChange w1 (Ada.adaValueOf (-10) <> theToken)) $ do hdl <- Trace.activateContractWallet w1 contract - Trace.callEndpoint @"new-account" hdl (tokenName, walletPubKeyHash w1) + Trace.callEndpoint @"new-account" hdl (tokenName, mockWalletPaymentPubKeyHash w1) _ <- Trace.waitNSlots 3 Trace.callEndpoint @"pay" hdl (account, Ada.adaValueOf 10) void $ Trace.waitNSlots 1 @@ -63,7 +63,7 @@ contract = tokenAccountContract account :: Account account = - let con = Accounts.newAccount @() @TokenAccountSchema @TokenAccountError tokenName (walletPubKeyHash w1) + let con = Accounts.newAccount @() @TokenAccountSchema @TokenAccountError tokenName (mockWalletPaymentPubKeyHash w1) fld = Folds.instanceOutcome @() con (Trace.walletInstanceTag w1) trace = Trace.activateContractWallet @_ @() w1 (void con) >> Trace.waitNSlots 2 getOutcome (Done a) = a @@ -90,11 +90,11 @@ tokenAccountTrace :: Trace.EmulatorTrace () tokenAccountTrace = do hdl <- Trace.activateContractWallet w1 contract hdl2 <- Trace.activateContractWallet w2 contract - Trace.callEndpoint @"new-account" hdl (tokenName, walletPubKeyHash w1) + Trace.callEndpoint @"new-account" hdl (tokenName, mockWalletPaymentPubKeyHash w1) _ <- Trace.waitNSlots 3 Trace.callEndpoint @"pay" hdl (account, Ada.adaValueOf 10) _ <- Trace.waitNSlots 2 _ <- Trace.payToWallet w1 w2 theToken _ <- Trace.waitNSlots 1 - Trace.callEndpoint @"redeem" hdl2 (account, walletPubKeyHash w2) + Trace.callEndpoint @"redeem" hdl2 (account, mockWalletPaymentPubKeyHash w2) void $ Trace.waitNSlots 1 diff --git a/plutus-use-cases/test/Spec/Vesting.hs b/plutus-use-cases/test/Spec/Vesting.hs index 6452897fc8..e22fbe203a 100644 --- a/plutus-use-cases/test/Spec/Vesting.hs +++ b/plutus-use-cases/test/Spec/Vesting.hs @@ -44,7 +44,7 @@ vesting startTime = VestingParams { vestingTranche1 = VestingTranche (startTime + 10000) (Ada.adaValueOf 20) , vestingTranche2 = VestingTranche (startTime + 20000) (Ada.adaValueOf 40) - , vestingOwner = walletPubKeyHash w1 } + , vestingOwner = mockWalletPaymentPubKeyHash w1 } params :: VestingParams params = vesting (TimeSlot.scSlotZeroTime def) @@ -114,7 +114,7 @@ instance ContractModel VestingModel where s <- getContractState when ( enoughValueLeft slot s v && v `leq` amount - && walletPubKeyHash w == vestingOwner params + && mockWalletPaymentPubKeyHash w == vestingOwner params && Ada.fromValue v >= Ledger.minAdaTxOut && (Ada.fromValue newAmount == 0 || Ada.fromValue newAmount >= Ledger.minAdaTxOut)) $ do deposit w v @@ -127,14 +127,14 @@ instance ContractModel VestingModel where waitUntil s precondition s (Vest w) = w `notElem` s ^. contractState . vested -- After a wallet has vested the contract shuts down - && walletPubKeyHash w /= vestingOwner params -- The vesting owner shouldn't vest + && mockWalletPaymentPubKeyHash w /= vestingOwner params -- The vesting owner shouldn't vest && slot < t1 -- If you vest after slot 1 it can cause the vesting owner to terminate prematurely where slot = s ^. currentSlot t1 = s ^. contractState . t1Slot precondition s (Retrieve w v) = enoughValueLeft slot (s ^. contractState) v - && walletPubKeyHash w == vestingOwner params + && mockWalletPaymentPubKeyHash w == vestingOwner params && Ada.fromValue v >= Ledger.minAdaTxOut && (Ada.fromValue newAmount == 0 || Ada.fromValue newAmount >= Ledger.minAdaTxOut) where diff --git a/plutus-use-cases/test/Spec/future.pir b/plutus-use-cases/test/Spec/future.pir index a98d327ed1..6aa4c1ba59 100644 --- a/plutus-use-cases/test/Spec/future.pir +++ b/plutus-use-cases/test/Spec/future.pir @@ -415,19 +415,14 @@ ) ) (vardecl - MustPayToPubKey + MustPayToPubKeyAddress (fun (con bytestring) (fun - [ Maybe (con data) ] + [ Maybe (con bytestring) ] (fun - [ - [ - (lam - k (type) (lam v (type) [ List [ [ Tuple2 k ] v ] ]) - ) - (con bytestring) - ] + [ Maybe (con data) ] + (fun [ [ (lam @@ -437,10 +432,20 @@ ) (con bytestring) ] - (con integer) + [ + [ + (lam + k + (type) + (lam v (type) [ List [ [ Tuple2 k ] v ] ]) + ) + (con bytestring) + ] + (con integer) + ] ] - ] - TxConstraint + TxConstraint + ) ) ) ) diff --git a/plutus-use-cases/test/Spec/gameStateMachine.pir b/plutus-use-cases/test/Spec/gameStateMachine.pir index b98fc52647..04ac4721ab 100644 --- a/plutus-use-cases/test/Spec/gameStateMachine.pir +++ b/plutus-use-cases/test/Spec/gameStateMachine.pir @@ -5573,21 +5573,14 @@ ) ) (vardecl - MustPayToPubKey + MustPayToPubKeyAddress (fun (con bytestring) (fun - [ Maybe (con data) ] + [ Maybe (con bytestring) ] (fun - [ - [ - (lam - k - (type) - (lam v (type) [ List [ [ Tuple2 k ] v ] ]) - ) - (con bytestring) - ] + [ Maybe (con data) ] + (fun [ [ (lam @@ -5599,10 +5592,22 @@ ) (con bytestring) ] - (con integer) + [ + [ + (lam + k + (type) + (lam + v (type) [ List [ [ Tuple2 k ] v ] ] + ) + ) + (con bytestring) + ] + (con integer) + ] ] - ] - TxConstraint + TxConstraint + ) ) ) ) @@ -6049,7 +6054,7 @@ Bool } (lam - pubKey + pkh (con bytestring) [ { @@ -6301,7 +6306,7 @@ (builtin equalsByteString ) - pubKey + pkh ] x ] @@ -8691,29 +8696,16 @@ ) ] (lam - pk + ds (con bytestring) (lam - mdv - [ Maybe (con data) ] + ds + [ Maybe (con bytestring) ] (lam - vl - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ [ Tuple2 k ] v ] - ] - ) - ) - (con bytestring) - ] + mdv + [ Maybe (con data) ] + (lam + vl [ [ (lam @@ -8730,29 +8722,101 @@ ) (con bytestring) ] - (con integer) - ] - ] - { - [ [ - { - [ - Bool_match - [ + [ + (lam + k + (type) + (lam + v + (type) [ + List [ - checkBinRel - lessThanEqualsInteger + [ Tuple2 k ] v ] - vl ] + ) + ) + (con bytestring) + ] + (con integer) + ] + ] + { + [ + [ + { + [ + Bool_match [ [ [ - { + checkBinRel + lessThanEqualsInteger + ] + vl + ] + [ + [ + [ { - foldr + { + foldr + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] + ] + } [ [ (lam @@ -8807,26 +8871,13 @@ ] ] } + fMonoidValue_c + ] + { + Nil [ [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) + Tuple2 (con bytestring ) @@ -8861,125 +8912,15 @@ ] ] } - fMonoidValue_c ] - { - Nil - [ - [ - Tuple2 - (con - bytestring - ) - ] + [ + { [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] - (con - integer - ) + TxInfo_match + ww ] - ] - } - ] - [ - { - [ - TxInfo_match - ww - ] - [ - List [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] - (con - integer - ) - ] - ] - ] - } - (lam - ww - [ - List - TxInInfo - ] - (lam - ww - [ - List - TxOut - ] - (lam - ww + List [ [ (lam @@ -9033,6 +8974,20 @@ ) ] ] + ] + } + (lam + ww + [ + List + TxInInfo + ] + (lam + ww + [ + List + TxOut + ] (lam ww [ @@ -9091,94 +9046,125 @@ (lam ww [ - List - DCert - ] - (lam - ww [ - List + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + [ [ - [ - Tuple2 - StakingCredential - ] + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) (con - integer + bytestring ) ] + (con + integer + ) + ] + ] + (lam + ww + [ + List + DCert ] (lam ww [ - Interval - (con - integer - ) + List + [ + [ + Tuple2 + StakingCredential + ] + (con + integer + ) + ] ] (lam ww [ - List + Interval (con - bytestring + integer ) ] (lam ww [ List + (con + bytestring + ) + ] + (lam + ww [ + List [ - Tuple2 + [ + Tuple2 + (con + bytestring + ) + ] (con - bytestring + data ) ] + ] + (lam + ww (con - data + bytestring ) - ] - ] - (lam - ww - (con - bytestring - ) - [ [ [ - { + [ { - foldr - TxOut - } - [ - List + { + foldr + TxOut + } [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] + List [ [ (lam @@ -9203,44 +9189,44 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - } - (lam - e - TxOut - (lam - xs - [ - List - [ [ - (lam - k - (type) + [ (lam - v + k (type) - [ - List + (lam + v + (type) [ + List [ - Tuple2 - k + [ + Tuple2 + k + ] + v ] - v ] - ] + ) ) - ) + (con + bytestring + ) + ] (con - bytestring + integer ) ] + ] + ] + } + (lam + e + TxOut + (lam + xs + [ + List [ [ (lam @@ -9265,20 +9251,6 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - [ - { - [ - TxOut_match - e - ] - [ - List [ [ (lam @@ -9303,6 +9275,20 @@ bytestring ) ] + (con + integer + ) + ] + ] + ] + [ + { + [ + TxOut_match + e + ] + [ + List [ [ (lam @@ -9327,42 +9313,42 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - } - (lam - ds - Address - (lam - ds - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ + [ + [ + (lam + k + (type) + (lam + v + (type) [ - Tuple2 - k + List + [ + [ + Tuple2 + k + ] + v + ] ] - v - ] - ] + ) + ) + (con + bytestring + ) + ] + (con + integer ) - ) - (con - bytestring - ) + ] ] + ] + } + (lam + ds + Address + (lam + ds [ [ (lam @@ -9387,51 +9373,51 @@ bytestring ) ] - (con - integer - ) - ] - ] - (lam - ds - [ - Maybe - (con - bytestring - ) - ] - [ - { - [ - Address_match - ds - ] + [ [ - List - [ - [ - (lam - k - (type) - (lam - v - (type) + (lam + k + (type) + (lam + v + (type) + [ + List + [ [ - List - [ - [ - Tuple2 - k - ] - v - ] + Tuple2 + k ] - ) - ) - (con - bytestring - ) - ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] + ] + (lam + ds + [ + Maybe + (con + bytestring + ) + ] + [ + { + [ + Address_match + ds + ] + [ + List [ [ (lam @@ -9456,55 +9442,55 @@ bytestring ) ] - (con - integer - ) + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] ] ] - ] - } - (lam - ds - Credential + } (lam ds - [ - Maybe - StakingCredential - ] - [ + Credential + (lam + ds [ - { - [ - Credential_match - ds - ] - [ - List + Maybe + StakingCredential + ] + [ + [ + { [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] + Credential_match + ds + ] + [ + List [ [ (lam @@ -9529,77 +9515,77 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - } - (lam - pk - (con - bytestring - ) - { - [ - [ - { + [ [ - Bool_match - [ - [ + (lam + k + (type) + (lam + v + (type) [ - { - (builtin - ifThenElse - ) - Bool - } + List [ [ - (builtin - equalsByteString - ) - pk + Tuple2 + k ] - pk + v ] ] - True - ] - False - ] + ) + ) + (con + bytestring + ) ] - (all - dead - (type) + (con + integer + ) + ] + ] + ] + } + (lam + pk + (con + bytestring + ) + { + [ + [ + { [ - List + Bool_match [ [ - (lam - k - (type) - (lam - v - (type) + [ + { + (builtin + ifThenElse + ) + Bool + } + [ [ - List - [ - [ - Tuple2 - k - ] - v - ] + (builtin + equalsByteString + ) + ds ] - ) - ) - (con - bytestring - ) + pk + ] + ] + True ] + False + ] + ] + (all + dead + (type) + [ + List [ [ (lam @@ -9624,45 +9610,45 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - ) - } - (abs - dead - (type) - [ - [ - { - Cons - [ [ - (lam - k - (type) + [ (lam - v + k (type) - [ - List + (lam + v + (type) [ + List [ - Tuple2 - k + [ + Tuple2 + k + ] + v ] - v ] - ] + ) ) - ) + (con + bytestring + ) + ] (con - bytestring + integer ) ] + ] + ] + ) + } + (abs + dead + (type) + [ + [ + { + Cons [ [ (lam @@ -9687,76 +9673,76 @@ bytestring ) ] - (con - integer - ) + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] ] - ] - } - ds + } + ds + ] + xs ] - xs - ] + ) + ] + (abs + dead + (type) + xs ) ] - (abs + (all dead (type) - xs + dead ) - ] - (all - dead - (type) - dead - ) - } + } + ) + ] + (lam + ipv + (con + bytestring + ) + xs ) ] - (lam - ipv - (con - bytestring - ) - xs - ) - ] + ) ) - ) - ] + ] + ) ) ) - ) - ] - ) - ) - ] - { - Nil - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring + ] ) - ] + ) + ] + { + Nil [ [ (lam @@ -9781,15 +9767,40 @@ bytestring ) ] - (con - integer - ) + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] ] - ] - } + } + ] + ww ] - ww - ] + ) ) ) ) @@ -9799,55 +9810,35 @@ ) ) ) - ) + ] ] ] ] - ] - (all dead (type) Bool) - } - (abs - dead - (type) - [ - { - [ - TxInfo_match ww - ] - Bool - } - (lam - ds - [ List TxInInfo ] + (all + dead (type) Bool + ) + } + (abs + dead + (type) + [ + { + [ + TxInfo_match + ww + ] + Bool + } (lam ds - [ List TxOut ] + [ + List TxInInfo + ] (lam ds - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] + [ List TxOut ] + (lam + ds [ [ (lam @@ -9872,37 +9863,37 @@ bytestring ) ] - (con - integer - ) - ] - ] - (lam - ds - [ [ - (lam - k - (type) + [ (lam - v + k (type) - [ - List + (lam + v + (type) [ + List [ - Tuple2 - k + [ + Tuple2 + k + ] + v ] - v ] - ] + ) ) - ) + (con + bytestring + ) + ] (con - bytestring + integer ) ] + ] + (lam + ds [ [ (lam @@ -9927,166 +9918,166 @@ bytestring ) ] - (con - integer - ) - ] - ] - (lam - ds - [ - List - DCert - ] - (lam - ds [ - List [ - [ - Tuple2 - StakingCredential - ] + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) (con - integer + bytestring ) ] + (con + integer + ) + ] + ] + (lam + ds + [ + List + DCert ] (lam ds [ - Interval - (con - integer - ) + List + [ + [ + Tuple2 + StakingCredential + ] + (con + integer + ) + ] ] (lam ds [ - List + Interval (con - bytestring + integer ) ] (lam ds [ List + (con + bytestring + ) + ] + (lam + ds [ + List [ - Tuple2 + [ + Tuple2 + (con + bytestring + ) + ] (con - bytestring + data ) ] + ] + (lam + ds (con - data + bytestring ) - ] - ] - (lam - ds - (con - bytestring - ) - { - [ + { [ - { - [ - Bool_match + [ + { [ + Bool_match [ [ - { - { - fFoldableNil_cfoldMap - [ - (lam - a - (type) - a - ) - Bool - ] - } - TxOut - } [ { - fMonoidSum - Bool + { + fFoldableNil_cfoldMap + [ + (lam + a + (type) + a + ) + Bool + ] + } + TxOut } - fAdditiveMonoidBool - ] - ] - (lam - ds - TxOut - { [ + { + fMonoidSum + Bool + } + fAdditiveMonoidBool + ] + ] + (lam + ds + TxOut + { [ - { - [ - { - Maybe_match - (con - data - ) - } - mdv - ] - (all - dead - (type) - Bool - ) - } - (lam - dv - (con - data - ) - (abs - dead - (type) + [ + { [ { - [ - TxOut_match - ds - ] - Bool - } - (lam - ds - Address + Maybe_match + (con + data + ) + } + mdv + ] + (all + dead + (type) + Bool + ) + } + (lam + dv + (con + data + ) + (abs + dead + (type) + [ + { + [ + TxOut_match + ds + ] + Bool + } (lam ds - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] + Address + (lam + ds [ [ (lam @@ -10111,164 +10102,189 @@ bytestring ) ] - (con - integer - ) - ] - ] - (lam - ds - [ - Maybe - (con - bytestring - ) - ] - { [ [ - { - [ - { - Maybe_match - (con - bytestring - ) - } - ds - ] - (all - dead - (type) - Bool - ) - } (lam - svh - (con - bytestring - ) - (abs - dead + k + (type) + (lam + v (type) - { + [ + List [ [ - { - [ - { - Maybe_match - (con - bytestring - ) - } + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] + ] + (lam + ds + [ + Maybe + (con + bytestring + ) + ] + { + [ + [ + { + [ + { + Maybe_match + (con + bytestring + ) + } + ds + ] + (all + dead + (type) + Bool + ) + } + (lam + svh + (con + bytestring + ) + (abs + dead + (type) + { + [ + [ + { [ + { + Maybe_match + (con + bytestring + ) + } [ - wfindDatumHash - dv + [ + wfindDatumHash + dv + ] + ds ] - ds ] - ] - (all - dead - (type) - Bool - ) - } - (lam - a - (con - bytestring - ) - (abs - dead - (type) - [ + (all + dead + (type) + Bool + ) + } + (lam + a + (con + bytestring + ) + (abs + dead + (type) [ - equalsByteString - a + [ + equalsByteString + a + ] + svh ] - svh - ] + ) ) + ] + (abs + dead + (type) + False ) ] - (abs + (all dead (type) - False + dead ) - ] - (all - dead - (type) - dead - ) - } + } + ) ) + ] + (abs + dead + (type) + True ) ] - (abs + (all dead (type) - True + dead ) - ] - (all - dead - (type) - dead - ) - } + } + ) ) ) - ) - ] + ] + ) ) + ] + (abs + dead + (type) + True ) ] - (abs + (all dead (type) - True + dead ) - ] - (all - dead - (type) - dead - ) - } - ) + } + ) + ] + ds ] - ds ] - ] - (all + (all + dead + (type) + Bool + ) + } + (abs dead (type) - Bool + True ) - } + ] (abs dead (type) - True + j ) ] - (abs + (all dead (type) - j + dead ) - ] - (all - dead - (type) - dead - ) - } + } + ) ) ) ) @@ -10278,14 +10294,14 @@ ) ) ) - ) - ] - ) + ] + ) + ] + (abs dead (type) j) ] - (abs dead (type) j) - ] - (all dead (type) dead) - } + (all dead (type) dead) + } + ) ) ) ) diff --git a/plutus-use-cases/test/Spec/governance.pir b/plutus-use-cases/test/Spec/governance.pir index 0215804673..5d47f73868 100644 --- a/plutus-use-cases/test/Spec/governance.pir +++ b/plutus-use-cases/test/Spec/governance.pir @@ -6433,25 +6433,14 @@ ) ) (vardecl - MustPayToPubKey + MustPayToPubKeyAddress (fun (con bytestring) (fun - [ Maybe (con data) ] + [ Maybe (con bytestring) ] (fun - [ - [ - (lam - k - (type) - (lam - v - (type) - [ List [ [ Tuple2 k ] v ] ] - ) - ) - (con bytestring) - ] + [ Maybe (con data) ] + (fun [ [ (lam @@ -6465,10 +6454,24 @@ ) (con bytestring) ] - (con integer) + [ + [ + (lam + k + (type) + (lam + v + (type) + [ List [ [ Tuple2 k ] v ] ] + ) + ) + (con bytestring) + ] + (con integer) + ] ] - ] - TxConstraint + TxConstraint + ) ) ) ) @@ -6985,7 +6988,7 @@ Bool } (lam - pubKey + pkh (con bytestring) [ { @@ -7246,7 +7249,7 @@ (builtin equalsByteString ) - pubKey + pkh ] x ] @@ -9685,32 +9688,16 @@ ) ] (lam - pk + ds (con bytestring) (lam - mdv - [ Maybe (con data) ] + ds + [ Maybe (con bytestring) ] (lam - vl - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ Tuple2 k ] - v - ] - ] - ) - ) - (con bytestring) - ] + mdv + [ Maybe (con data) ] + (lam + vl [ [ (lam @@ -9732,29 +9719,105 @@ ) (con bytestring) ] - (con integer) - ] - ] - { - [ [ - { - [ - Bool_match - [ + [ + (lam + k + (type) + (lam + v + (type) [ + List [ - checkBinRel - lessThanEqualsInteger + [ + Tuple2 + k + ] + v ] - vl ] + ) + ) + (con bytestring) + ] + (con integer) + ] + ] + { + [ + [ + { + [ + Bool_match [ [ [ - { + checkBinRel + lessThanEqualsInteger + ] + vl + ] + [ + [ + [ { - foldr + { + foldr + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] + ] + } [ [ (lam @@ -9809,26 +9872,13 @@ ] ] } + fMonoidValue_c + ] + { + Nil [ [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) + Tuple2 (con bytestring ) @@ -9863,125 +9913,15 @@ ] ] } - fMonoidValue_c ] - { - Nil - [ - [ - Tuple2 - (con - bytestring - ) - ] + [ + { [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] - (con - integer - ) + TxInfo_match + ww ] - ] - } - ] - [ - { - [ - TxInfo_match - ww - ] - [ - List [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] - (con - integer - ) - ] - ] - ] - } - (lam - ww - [ - List - TxInInfo - ] - (lam - ww - [ - List - TxOut - ] - (lam - ww + List [ [ (lam @@ -10035,6 +9975,20 @@ ) ] ] + ] + } + (lam + ww + [ + List + TxInInfo + ] + (lam + ww + [ + List + TxOut + ] (lam ww [ @@ -10093,94 +10047,125 @@ (lam ww [ - List - DCert - ] - (lam - ww [ - List + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + [ [ - [ - Tuple2 - StakingCredential - ] + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) (con - integer + bytestring ) ] + (con + integer + ) + ] + ] + (lam + ww + [ + List + DCert ] (lam ww [ - Interval - (con - integer - ) + List + [ + [ + Tuple2 + StakingCredential + ] + (con + integer + ) + ] ] (lam ww [ - List + Interval (con - bytestring + integer ) ] (lam ww [ List + (con + bytestring + ) + ] + (lam + ww [ + List [ - Tuple2 + [ + Tuple2 + (con + bytestring + ) + ] (con - bytestring + data ) ] + ] + (lam + ww (con - data + bytestring ) - ] - ] - (lam - ww - (con - bytestring - ) - [ [ [ - { + [ { - foldr - TxOut - } - [ - List + { + foldr + TxOut + } [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] + List [ [ (lam @@ -10205,44 +10190,44 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - } - (lam - e - TxOut - (lam - xs - [ - List - [ [ - (lam - k - (type) + [ (lam - v + k (type) - [ - List + (lam + v + (type) [ + List [ - Tuple2 - k + [ + Tuple2 + k + ] + v ] - v ] - ] + ) ) - ) + (con + bytestring + ) + ] (con - bytestring + integer ) ] + ] + ] + } + (lam + e + TxOut + (lam + xs + [ + List [ [ (lam @@ -10267,20 +10252,6 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - [ - { - [ - TxOut_match - e - ] - [ - List [ [ (lam @@ -10305,6 +10276,20 @@ bytestring ) ] + (con + integer + ) + ] + ] + ] + [ + { + [ + TxOut_match + e + ] + [ + List [ [ (lam @@ -10329,42 +10314,42 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - } - (lam - ds - Address - (lam - ds - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ + [ + [ + (lam + k + (type) + (lam + v + (type) [ - Tuple2 - k + List + [ + [ + Tuple2 + k + ] + v + ] ] - v - ] - ] + ) + ) + (con + bytestring + ) + ] + (con + integer ) - ) - (con - bytestring - ) + ] ] + ] + } + (lam + ds + Address + (lam + ds [ [ (lam @@ -10389,51 +10374,51 @@ bytestring ) ] - (con - integer - ) - ] - ] - (lam - ds - [ - Maybe - (con - bytestring - ) - ] - [ - { - [ - Address_match - ds - ] + [ [ - List - [ - [ - (lam - k - (type) - (lam - v - (type) + (lam + k + (type) + (lam + v + (type) + [ + List + [ [ - List - [ - [ - Tuple2 - k - ] - v - ] + Tuple2 + k ] - ) - ) - (con - bytestring - ) - ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] + ] + (lam + ds + [ + Maybe + (con + bytestring + ) + ] + [ + { + [ + Address_match + ds + ] + [ + List [ [ (lam @@ -10458,55 +10443,55 @@ bytestring ) ] - (con - integer - ) + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] ] ] - ] - } - (lam - ds - Credential + } (lam ds - [ - Maybe - StakingCredential - ] - [ + Credential + (lam + ds [ - { - [ - Credential_match - ds - ] - [ - List + Maybe + StakingCredential + ] + [ + [ + { [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] + Credential_match + ds + ] + [ + List [ [ (lam @@ -10531,77 +10516,77 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - } - (lam - pk - (con - bytestring - ) - { - [ - [ - { + [ [ - Bool_match - [ - [ + (lam + k + (type) + (lam + v + (type) [ - { - (builtin - ifThenElse - ) - Bool - } + List [ [ - (builtin - equalsByteString - ) - pk + Tuple2 + k ] - pk + v ] ] - True - ] - False - ] + ) + ) + (con + bytestring + ) ] - (all - dead - (type) + (con + integer + ) + ] + ] + ] + } + (lam + pk + (con + bytestring + ) + { + [ + [ + { [ - List + Bool_match [ [ - (lam - k - (type) - (lam - v - (type) + [ + { + (builtin + ifThenElse + ) + Bool + } + [ [ - List - [ - [ - Tuple2 - k - ] - v - ] + (builtin + equalsByteString + ) + ds ] - ) - ) - (con - bytestring - ) + pk + ] + ] + True ] + False + ] + ] + (all + dead + (type) + [ + List [ [ (lam @@ -10626,45 +10611,45 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - ) - } - (abs - dead - (type) - [ - [ - { - Cons - [ [ - (lam - k - (type) + [ (lam - v + k (type) - [ - List + (lam + v + (type) [ + List [ - Tuple2 - k + [ + Tuple2 + k + ] + v ] - v ] - ] + ) ) - ) + (con + bytestring + ) + ] (con - bytestring + integer ) ] + ] + ] + ) + } + (abs + dead + (type) + [ + [ + { + Cons [ [ (lam @@ -10689,76 +10674,76 @@ bytestring ) ] - (con - integer - ) + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] ] - ] - } - ds + } + ds + ] + xs ] - xs - ] + ) + ] + (abs + dead + (type) + xs ) ] - (abs + (all dead (type) - xs + dead ) - ] - (all - dead - (type) - dead - ) - } + } + ) + ] + (lam + ipv + (con + bytestring + ) + xs ) ] - (lam - ipv - (con - bytestring - ) - xs - ) - ] + ) ) - ) - ] + ] + ) ) ) - ) - ] - ) - ) - ] - { - Nil - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring + ] ) - ] + ) + ] + { + Nil [ [ (lam @@ -10783,15 +10768,40 @@ bytestring ) ] - (con - integer - ) + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] ] - ] - } + } + ] + ww ] - ww - ] + ) ) ) ) @@ -10801,94 +10811,38 @@ ) ) ) - ) + ] ] ] ] - ] - (all + (all + dead + (type) + Bool + ) + } + (abs dead (type) - Bool - ) - } - (abs - dead - (type) - [ - { - [ - TxInfo_match - ww - ] - Bool - } - (lam - ds - [ - List - TxInInfo - ] - (lam - ds + [ + { [ - List - TxOut + TxInfo_match + ww ] - (lam - ds - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] - (con - integer - ) - ] + Bool + } + (lam + ds + [ + List + TxInInfo + ] + (lam + ds + [ + List + TxOut ] (lam ds @@ -10948,340 +10902,396 @@ (lam ds [ - List - DCert - ] - (lam - ds [ - List + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + [ [ - [ - Tuple2 - StakingCredential - ] + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) (con - integer + bytestring ) ] + (con + integer + ) + ] + ] + (lam + ds + [ + List + DCert ] (lam ds [ - Interval - (con - integer - ) + List + [ + [ + Tuple2 + StakingCredential + ] + (con + integer + ) + ] ] (lam ds [ - List + Interval (con - bytestring + integer ) ] (lam ds [ List + (con + bytestring + ) + ] + (lam + ds [ + List [ - Tuple2 + [ + Tuple2 + (con + bytestring + ) + ] (con - bytestring + data ) ] + ] + (lam + ds (con - data + bytestring ) - ] - ] - (lam - ds - (con - bytestring - ) - { - [ + { [ - { - [ - Bool_match + [ + { [ + Bool_match [ [ - { - { - fFoldableNil_cfoldMap - [ - (lam - a - (type) - a - ) - Bool - ] - } - TxOut - } [ { - fMonoidSum - Bool + { + fFoldableNil_cfoldMap + [ + (lam + a + (type) + a + ) + Bool + ] + } + TxOut } - fAdditiveMonoidBool - ] - ] - (lam - ds - TxOut - { [ + { + fMonoidSum + Bool + } + fAdditiveMonoidBool + ] + ] + (lam + ds + TxOut + { [ - { - [ - { - Maybe_match - (con - data - ) - } - mdv - ] - (all - dead - (type) - Bool - ) - } - (lam - dv - (con - data - ) - (abs - dead - (type) + [ + { [ { - [ - TxOut_match - ds - ] - Bool + Maybe_match + (con + data + ) } - (lam - ds - Address + mdv + ] + (all + dead + (type) + Bool + ) + } + (lam + dv + (con + data + ) + (abs + dead + (type) + [ + { + [ + TxOut_match + ds + ] + Bool + } (lam ds - [ + Address + (lam + ds [ - (lam - k - (type) + [ (lam - v + k (type) - [ - List + (lam + v + (type) [ + List [ - Tuple2 - k + [ + Tuple2 + k + ] + v ] - v ] - ] + ) ) - ) - (con - bytestring - ) - ] - [ + (con + bytestring + ) + ] [ - (lam - k - (type) + [ (lam - v + k (type) - [ - List + (lam + v + (type) [ + List [ - Tuple2 - k + [ + Tuple2 + k + ] + v ] - v ] - ] + ) ) - ) + (con + bytestring + ) + ] (con - bytestring + integer ) ] - (con - integer - ) - ] - ] - (lam - ds - [ - Maybe - (con - bytestring - ) ] - { + (lam + ds [ + Maybe + (con + bytestring + ) + ] + { [ - { - [ - { - Maybe_match - (con - bytestring - ) - } - ds - ] - (all - dead - (type) - Bool - ) - } - (lam - svh - (con - bytestring - ) - (abs - dead - (type) - { - [ + [ + { + [ + { + Maybe_match + (con + bytestring + ) + } + ds + ] + (all + dead + (type) + Bool + ) + } + (lam + svh + (con + bytestring + ) + (abs + dead + (type) + { [ - { - [ - { - Maybe_match - (con - bytestring - ) - } + [ + { [ + { + Maybe_match + (con + bytestring + ) + } [ - wfindDatumHash - dv + [ + wfindDatumHash + dv + ] + ds ] - ds ] - ] - (all - dead - (type) - Bool - ) - } - (lam - a - (con - bytestring - ) - (abs - dead - (type) - [ + (all + dead + (type) + Bool + ) + } + (lam + a + (con + bytestring + ) + (abs + dead + (type) [ - equalsByteString - a + [ + equalsByteString + a + ] + svh ] - svh - ] + ) ) + ] + (abs + dead + (type) + False ) ] - (abs + (all dead (type) - False + dead ) - ] - (all - dead - (type) - dead - ) - } + } + ) ) + ] + (abs + dead + (type) + True ) ] - (abs + (all dead (type) - True + dead ) - ] - (all - dead - (type) - dead - ) - } + } + ) ) ) - ) - ] + ] + ) ) + ] + (abs + dead + (type) + True ) ] - (abs + (all dead (type) - True + dead ) - ] - (all - dead - (type) - dead - ) - } - ) + } + ) + ] + ds ] - ds ] - ] - (all + (all + dead + (type) + Bool + ) + } + (abs dead (type) - Bool + True ) - } + ] (abs dead (type) - True + j ) ] - (abs + (all dead (type) - j + dead ) - ] - (all - dead - (type) - dead - ) - } + } + ) ) ) ) @@ -11291,14 +11301,18 @@ ) ) ) - ) - ] + ] + ) + ] + (abs + dead (type) j ) ] - (abs dead (type) j) - ] - (all dead (type) dead) - } + (all + dead (type) dead + ) + } + ) ) ) ) @@ -22372,8 +22386,16 @@ [ [ [ - MustPayToPubKey - pk + [ + MustPayToPubKeyAddress + pk + ] + { + Nothing + (con + bytestring + ) + } ] { Nothing diff --git a/plutus-use-cases/test/Spec/multisigStateMachine.pir b/plutus-use-cases/test/Spec/multisigStateMachine.pir index 13365cf640..fb771f80aa 100644 --- a/plutus-use-cases/test/Spec/multisigStateMachine.pir +++ b/plutus-use-cases/test/Spec/multisigStateMachine.pir @@ -6004,23 +6004,14 @@ ) ) (vardecl - MustPayToPubKey + MustPayToPubKeyAddress (fun (con bytestring) (fun - [ Maybe (con data) ] + [ Maybe (con bytestring) ] (fun - [ - [ - (lam - k - (type) - (lam - v (type) [ List [ [ Tuple2 k ] v ] ] - ) - ) - (con bytestring) - ] + [ Maybe (con data) ] + (fun [ [ (lam @@ -6032,10 +6023,24 @@ ) (con bytestring) ] - (con integer) + [ + [ + (lam + k + (type) + (lam + v + (type) + [ List [ [ Tuple2 k ] v ] ] + ) + ) + (con bytestring) + ] + (con integer) + ] ] - ] - TxConstraint + TxConstraint + ) ) ) ) @@ -6502,7 +6507,7 @@ Bool } (lam - pubKey + pkh (con bytestring) [ { @@ -6757,7 +6762,7 @@ (builtin equalsByteString ) - pubKey + pkh ] x ] @@ -9168,29 +9173,16 @@ ) ] (lam - pk + ds (con bytestring) (lam - mdv - [ Maybe (con data) ] + ds + [ Maybe (con bytestring) ] (lam - vl - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ [ Tuple2 k ] v ] - ] - ) - ) - (con bytestring) - ] + mdv + [ Maybe (con data) ] + (lam + vl [ [ (lam @@ -9209,29 +9201,102 @@ ) (con bytestring) ] - (con integer) - ] - ] - { - [ [ - { - [ - Bool_match - [ + [ + (lam + k + (type) + (lam + v + (type) [ + List [ - checkBinRel - lessThanEqualsInteger + [ Tuple2 k ] + v ] - vl ] + ) + ) + (con bytestring) + ] + (con integer) + ] + ] + { + [ + [ + { + [ + Bool_match [ [ [ - { + checkBinRel + lessThanEqualsInteger + ] + vl + ] + [ + [ + [ { - foldr + { + foldr + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] + ] + } [ [ (lam @@ -9286,26 +9351,13 @@ ] ] } + fMonoidValue_c + ] + { + Nil [ [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) + Tuple2 (con bytestring ) @@ -9340,125 +9392,15 @@ ] ] } - fMonoidValue_c ] - { - Nil - [ - [ - Tuple2 - (con - bytestring - ) - ] + [ + { [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] - (con - integer - ) + TxInfo_match + ww ] - ] - } - ] - [ - { - [ - TxInfo_match - ww - ] - [ - List [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] - (con - integer - ) - ] - ] - ] - } - (lam - ww - [ - List - TxInInfo - ] - (lam - ww - [ - List - TxOut - ] - (lam - ww + List [ [ (lam @@ -9512,6 +9454,20 @@ ) ] ] + ] + } + (lam + ww + [ + List + TxInInfo + ] + (lam + ww + [ + List + TxOut + ] (lam ww [ @@ -9570,94 +9526,125 @@ (lam ww [ - List - DCert - ] - (lam - ww [ - List + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + [ [ - [ - Tuple2 - StakingCredential - ] + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) (con - integer + bytestring ) ] + (con + integer + ) + ] + ] + (lam + ww + [ + List + DCert ] (lam ww [ - Interval - (con - integer - ) + List + [ + [ + Tuple2 + StakingCredential + ] + (con + integer + ) + ] ] (lam ww [ - List + Interval (con - bytestring + integer ) ] (lam ww [ List + (con + bytestring + ) + ] + (lam + ww [ + List [ - Tuple2 + [ + Tuple2 + (con + bytestring + ) + ] (con - bytestring + data ) ] + ] + (lam + ww (con - data + bytestring ) - ] - ] - (lam - ww - (con - bytestring - ) - [ [ [ - { + [ { - foldr - TxOut - } - [ - List + { + foldr + TxOut + } [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] + List [ [ (lam @@ -9682,44 +9669,44 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - } - (lam - e - TxOut - (lam - xs - [ - List - [ [ - (lam - k - (type) + [ (lam - v + k (type) - [ - List + (lam + v + (type) [ + List [ - Tuple2 - k + [ + Tuple2 + k + ] + v ] - v ] - ] + ) ) - ) + (con + bytestring + ) + ] (con - bytestring + integer ) ] + ] + ] + } + (lam + e + TxOut + (lam + xs + [ + List [ [ (lam @@ -9744,20 +9731,6 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - [ - { - [ - TxOut_match - e - ] - [ - List [ [ (lam @@ -9782,6 +9755,20 @@ bytestring ) ] + (con + integer + ) + ] + ] + ] + [ + { + [ + TxOut_match + e + ] + [ + List [ [ (lam @@ -9806,42 +9793,42 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - } - (lam - ds - Address - (lam - ds - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ + [ + [ + (lam + k + (type) + (lam + v + (type) [ - Tuple2 - k + List + [ + [ + Tuple2 + k + ] + v + ] ] - v - ] - ] + ) + ) + (con + bytestring + ) + ] + (con + integer ) - ) - (con - bytestring - ) + ] ] + ] + } + (lam + ds + Address + (lam + ds [ [ (lam @@ -9866,51 +9853,51 @@ bytestring ) ] - (con - integer - ) - ] - ] - (lam - ds - [ - Maybe - (con - bytestring - ) - ] - [ - { - [ - Address_match - ds - ] + [ [ - List - [ - [ - (lam - k - (type) - (lam - v - (type) + (lam + k + (type) + (lam + v + (type) + [ + List + [ [ - List - [ - [ - Tuple2 - k - ] - v - ] + Tuple2 + k ] - ) - ) - (con - bytestring - ) - ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] + ] + (lam + ds + [ + Maybe + (con + bytestring + ) + ] + [ + { + [ + Address_match + ds + ] + [ + List [ [ (lam @@ -9935,55 +9922,55 @@ bytestring ) ] - (con - integer - ) + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] ] ] - ] - } - (lam - ds - Credential + } (lam ds - [ - Maybe - StakingCredential - ] - [ + Credential + (lam + ds [ - { - [ - Credential_match - ds - ] - [ - List + Maybe + StakingCredential + ] + [ + [ + { [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] + Credential_match + ds + ] + [ + List [ [ (lam @@ -10008,77 +9995,77 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - } - (lam - pk - (con - bytestring - ) - { - [ - [ - { + [ [ - Bool_match - [ - [ + (lam + k + (type) + (lam + v + (type) [ - { - (builtin - ifThenElse - ) - Bool - } + List [ [ - (builtin - equalsByteString - ) - pk + Tuple2 + k ] - pk + v ] ] - True - ] - False - ] - ] - (all - dead - (type) + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] + ] + ] + } + (lam + pk + (con + bytestring + ) + { + [ + [ + { [ - List + Bool_match [ [ - (lam - k - (type) - (lam - v - (type) + [ + { + (builtin + ifThenElse + ) + Bool + } + [ [ - List - [ - [ - Tuple2 - k - ] - v - ] + (builtin + equalsByteString + ) + ds ] - ) - ) - (con - bytestring - ) + pk + ] + ] + True ] + False + ] + ] + (all + dead + (type) + [ + List [ [ (lam @@ -10103,45 +10090,45 @@ bytestring ) ] - (con - integer - ) - ] - ] - ] - ) - } - (abs - dead - (type) - [ - [ - { - Cons - [ [ - (lam - k - (type) + [ (lam - v + k (type) - [ - List + (lam + v + (type) [ + List [ - Tuple2 - k + [ + Tuple2 + k + ] + v ] - v ] - ] + ) ) - ) + (con + bytestring + ) + ] (con - bytestring + integer ) ] + ] + ] + ) + } + (abs + dead + (type) + [ + [ + { + Cons [ [ (lam @@ -10166,76 +10153,76 @@ bytestring ) ] - (con - integer - ) + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] ] - ] - } - ds + } + ds + ] + xs ] - xs - ] + ) + ] + (abs + dead + (type) + xs ) ] - (abs + (all dead (type) - xs + dead ) - ] - (all - dead - (type) - dead - ) - } + } + ) + ] + (lam + ipv + (con + bytestring + ) + xs ) ] - (lam - ipv - (con - bytestring - ) - xs - ) - ] + ) ) - ) - ] + ] + ) ) ) - ) - ] - ) - ) - ] - { - Nil - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring + ] ) - ] + ) + ] + { + Nil [ [ (lam @@ -10260,15 +10247,40 @@ bytestring ) ] - (con - integer - ) + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] ] - ] - } + } + ] + ww ] - ww - ] + ) ) ) ) @@ -10278,88 +10290,35 @@ ) ) ) - ) + ] ] ] ] - ] - (all - dead (type) Bool - ) - } - (abs - dead - (type) - [ - { - [ - TxInfo_match - ww - ] - Bool - } - (lam - ds - [ - List TxInInfo - ] + (all + dead (type) Bool + ) + } + (abs + dead + (type) + [ + { + [ + TxInfo_match + ww + ] + Bool + } (lam ds - [ List TxOut ] + [ + List + TxInInfo + ] (lam ds [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] - (con - integer - ) - ] + List TxOut ] (lam ds @@ -10419,158 +10378,189 @@ (lam ds [ - List - DCert - ] - (lam - ds [ - List + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + [ [ - [ - Tuple2 - StakingCredential - ] + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) (con - integer + bytestring ) ] + (con + integer + ) + ] + ] + (lam + ds + [ + List + DCert ] (lam ds [ - Interval - (con - integer - ) + List + [ + [ + Tuple2 + StakingCredential + ] + (con + integer + ) + ] ] (lam ds [ - List + Interval (con - bytestring + integer ) ] (lam ds [ List + (con + bytestring + ) + ] + (lam + ds [ + List [ - Tuple2 + [ + Tuple2 + (con + bytestring + ) + ] (con - bytestring + data ) ] + ] + (lam + ds (con - data + bytestring ) - ] - ] - (lam - ds - (con - bytestring - ) - { - [ + { [ - { - [ - Bool_match + [ + { [ + Bool_match [ [ - { - { - fFoldableNil_cfoldMap - [ - (lam - a - (type) - a - ) - Bool - ] - } - TxOut - } [ { - fMonoidSum - Bool + { + fFoldableNil_cfoldMap + [ + (lam + a + (type) + a + ) + Bool + ] + } + TxOut } - fAdditiveMonoidBool - ] - ] - (lam - ds - TxOut - { [ + { + fMonoidSum + Bool + } + fAdditiveMonoidBool + ] + ] + (lam + ds + TxOut + { [ - { - [ - { - Maybe_match - (con - data - ) - } - mdv - ] - (all - dead - (type) - Bool - ) - } - (lam - dv - (con - data - ) - (abs - dead - (type) + [ + { [ { - [ - TxOut_match - ds - ] - Bool + Maybe_match + (con + data + ) } - (lam - ds - Address + mdv + ] + (all + dead + (type) + Bool + ) + } + (lam + dv + (con + data + ) + (abs + dead + (type) + [ + { + [ + TxOut_match + ds + ] + Bool + } (lam ds - [ - [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) - ] + Address + (lam + ds [ [ (lam @@ -10595,164 +10585,189 @@ bytestring ) ] - (con - integer - ) - ] - ] - (lam - ds - [ - Maybe - (con - bytestring - ) - ] - { [ [ - { - [ - { - Maybe_match - (con - bytestring - ) - } - ds - ] - (all - dead - (type) - Bool - ) - } (lam - svh - (con - bytestring - ) - (abs - dead + k + (type) + (lam + v (type) - { + [ + List [ [ - { - [ - { - Maybe_match - (con - bytestring - ) - } + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] + ] + (lam + ds + [ + Maybe + (con + bytestring + ) + ] + { + [ + [ + { + [ + { + Maybe_match + (con + bytestring + ) + } + ds + ] + (all + dead + (type) + Bool + ) + } + (lam + svh + (con + bytestring + ) + (abs + dead + (type) + { + [ + [ + { [ + { + Maybe_match + (con + bytestring + ) + } [ - wfindDatumHash - dv + [ + wfindDatumHash + dv + ] + ds ] - ds ] - ] - (all - dead - (type) - Bool - ) - } - (lam - a - (con - bytestring - ) - (abs - dead - (type) - [ + (all + dead + (type) + Bool + ) + } + (lam + a + (con + bytestring + ) + (abs + dead + (type) [ - equalsByteString - a + [ + equalsByteString + a + ] + svh ] - svh - ] + ) ) + ] + (abs + dead + (type) + False ) ] - (abs + (all dead (type) - False + dead ) - ] - (all - dead - (type) - dead - ) - } + } + ) ) + ] + (abs + dead + (type) + True ) ] - (abs + (all dead (type) - True + dead ) - ] - (all - dead - (type) - dead - ) - } + } + ) ) ) - ) - ] + ] + ) ) + ] + (abs + dead + (type) + True ) ] - (abs + (all dead (type) - True + dead ) - ] - (all - dead - (type) - dead - ) - } - ) + } + ) + ] + ds ] - ds ] - ] - (all + (all + dead + (type) + Bool + ) + } + (abs dead (type) - Bool + True ) - } + ] (abs dead (type) - True + j ) ] - (abs + (all dead (type) - j + dead ) - ] - (all - dead - (type) - dead - ) - } + } + ) ) ) ) @@ -10762,14 +10777,14 @@ ) ) ) - ) - ] - ) + ] + ) + ] + (abs dead (type) j) ] - (abs dead (type) j) - ] - (all dead (type) dead) - } + (all dead (type) dead) + } + ) ) ) ) @@ -18499,43 +18514,20 @@ [ [ [ - MustPayToPubKey [ - { - [ - Payment_match - pmt - ] - (con - bytestring - ) - } - (lam - ds - [ + MustPayToPubKeyAddress + [ + { [ - (lam - k - (type) - (lam - v - (type) - [ - List - [ - [ - Tuple2 - k - ] - v - ] - ] - ) - ) - (con - bytestring - ) + Payment_match + pmt ] + (con + bytestring + ) + } + (lam + ds [ [ (lam @@ -18560,26 +18552,57 @@ bytestring ) ] - (con - integer - ) + [ + [ + (lam + k + (type) + (lam + v + (type) + [ + List + [ + [ + Tuple2 + k + ] + v + ] + ] + ) + ) + (con + bytestring + ) + ] + (con + integer + ) + ] ] - ] - (lam - ds - (con - bytestring - ) (lam ds (con - integer + bytestring + ) + (lam + ds + (con + integer + ) + ds ) - ds ) ) - ) + ] ] + { + Nothing + (con + bytestring + ) + } ] { Nothing diff --git a/plutus-use-cases/test/Spec/renderCrowdfunding.txt b/plutus-use-cases/test/Spec/renderCrowdfunding.txt index 9458260067..9b516e0c28 100644 --- a/plutus-use-cases/test/Spec/renderCrowdfunding.txt +++ b/plutus-use-cases/test/Spec/renderCrowdfunding.txt @@ -9,94 +9,94 @@ Inputs: Outputs: ---- Output 0 ---- - Destination: PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + Destination: PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 100000000 ---- Output 1 ---- - Destination: PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + Destination: PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 100000000 ---- Output 2 ---- - Destination: PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + Destination: PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 100000000 ---- Output 3 ---- - Destination: PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + Destination: PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 ---- Output 4 ---- - Destination: PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + Destination: PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 ---- Output 5 ---- - Destination: PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 100000000 ---- Output 6 ---- - Destination: PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + Destination: PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 ---- Output 7 ---- - Destination: PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + Destination: PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 ---- Output 8 ---- - Destination: PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + Destination: PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 ---- Output 9 ---- - Destination: PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + Destination: PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 Balances Carried Forward: - PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 100000000 - PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 100000000 - PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 100000000 - PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 - PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 - PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 100000000 - PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 - PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 - PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 - PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 @@ -108,7 +108,7 @@ Signatures PubKey: c0a4b02f44c212ba6c1197df5a5cf8bd1a3dceef... Signature: 584035442e9f2f45e13e83bfa814d3a2b31e61b9... Inputs: ---- Input 0 ---- - Destination: PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + Destination: PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 100000000 Source: @@ -119,7 +119,7 @@ Inputs: Outputs: ---- Output 0 ---- - Destination: PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + Destination: PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 97499990 @@ -130,43 +130,43 @@ Outputs: Balances Carried Forward: - PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 100000000 - PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 97499990 - PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 100000000 - PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 - PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 - PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 100000000 - PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 - PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 - PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 - PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 @@ -182,7 +182,7 @@ Signatures PubKey: 4cdc632449cde98d811f78ad2e2d15a278731bc5... Signature: 58404581bd6283b86ac94dec77a04efc37005ca8... Inputs: ---- Input 0 ---- - Destination: PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + Destination: PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 100000000 Source: @@ -193,7 +193,7 @@ Inputs: Outputs: ---- Output 0 ---- - Destination: PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + Destination: PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 89999990 @@ -204,43 +204,43 @@ Outputs: Balances Carried Forward: - PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 89999990 - PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 97499990 - PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 100000000 - PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 - PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 - PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 100000000 - PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 - PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 - PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 - PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 @@ -256,7 +256,7 @@ Signatures PubKey: 98c77c40ccc536e0d433874dae97d4a0787b10b3... Signature: 5840a897183b0923b6a3f0cd4a7c1738ee08956b... Inputs: ---- Input 0 ---- - Destination: PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + Destination: PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 100000000 Source: @@ -267,7 +267,7 @@ Inputs: Outputs: ---- Output 0 ---- - Destination: PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + Destination: PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 89999990 @@ -278,43 +278,43 @@ Outputs: Balances Carried Forward: - PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 89999990 - PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 97499990 - PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 89999990 - PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 - PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 - PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 100000000 - PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 - PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 - PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 - PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 @@ -359,49 +359,49 @@ Inputs: Outputs: ---- Output 0 ---- - Destination: PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 22486334 Balances Carried Forward: - PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 89999990 - PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 97499990 - PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 89999990 - PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 - PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 - PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 122486334 - PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 - PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 - PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 - PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 diff --git a/plutus-use-cases/test/Spec/renderGuess.txt b/plutus-use-cases/test/Spec/renderGuess.txt index 0c3269e6f1..67547c50dc 100644 --- a/plutus-use-cases/test/Spec/renderGuess.txt +++ b/plutus-use-cases/test/Spec/renderGuess.txt @@ -9,106 +9,106 @@ Inputs: Outputs: ---- Output 0 ---- - Destination: PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + Destination: PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 100000000 ---- Output 1 ---- - Destination: PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + Destination: PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 100000000 ---- Output 2 ---- - Destination: PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + Destination: PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 100000000 ---- Output 3 ---- - Destination: PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + Destination: PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 ---- Output 4 ---- - Destination: PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + Destination: PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 ---- Output 5 ---- - Destination: PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 100000000 ---- Output 6 ---- - Destination: PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + Destination: PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 ---- Output 7 ---- - Destination: PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + Destination: PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 ---- Output 8 ---- - Destination: PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + Destination: PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 ---- Output 9 ---- - Destination: PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + Destination: PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 Balances Carried Forward: - PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 100000000 - PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 100000000 - PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 100000000 - PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 - PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 - PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 100000000 - PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 - PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 - PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 - PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 ==== Slot #1, Tx #0 ==== -TxId: ff223b39bba4f17e9b49399482822a0e73da124942c707885ceadd330dd3bb7f +TxId: 6b753350696782a1b24dfe7ec0549bf1e8d86cd08e5ad4d343ceca646f49f457 Fee: Ada: Lovelace: 10 Mint: - Signatures PubKey: 8d9de88fbf445b7f6c3875a14daba94caee2ffcb... - Signature: 5840b04bde1a2bfdc73ee9d3179e17c21b84ee5f... + Signature: 5840b6ec0478f7e38365d4c5f842760b7b440b05... Inputs: ---- Input 0 ---- - Destination: PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 100000000 Source: @@ -119,259 +119,250 @@ Inputs: Outputs: ---- Output 0 ---- - Destination: PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 91999990 ---- Output 1 ---- - Destination: Script: fac60964faf57aaef417ca85578a70192fcdc43304957446788a3e27 + Destination: Script: 21927cbad33338d4eae6141407bf783b198aa7e55dd9089dc73c8d1d Value: Ada: Lovelace: 8000000 Balances Carried Forward: - PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 100000000 - PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 100000000 - PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 100000000 - PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 - PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 - PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 91999990 - PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 - PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 - PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 - PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 - Script: fac60964faf57aaef417ca85578a70192fcdc43304957446788a3e27 + Script: 21927cbad33338d4eae6141407bf783b198aa7e55dd9089dc73c8d1d Value: Ada: Lovelace: 8000000 ==== Slot #2, Tx #0 ==== -TxId: 3c188ce3c008af955a01b5edb7f388c47919476d6f6b52b5662057f4abd59941 -Fee: Ada: Lovelace: 14166 -Mint: d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: guess: 1 +TxId: f02f6bdb4e032c86578adc0c8441b15ccb1033c9cc43cc71d17d689e5d107fd3 +Fee: Ada: Lovelace: 14170 +Mint: 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: guess: 1 Signatures PubKey: 8d9de88fbf445b7f6c3875a14daba94caee2ffcb... - Signature: 5840724ac42c0c9d8c4b1c81047852587e794a9a... + Signature: 584010f5e66630e0125bf97d894eb6b84fd0ad11... Inputs: ---- Input 0 ---- - Destination: PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 91999990 Source: - Tx: ff223b39bba4f17e9b49399482822a0e73da124942c707885ceadd330dd3bb7f + Tx: 6b753350696782a1b24dfe7ec0549bf1e8d86cd08e5ad4d343ceca646f49f457 Output #0 ---- Input 1 ---- - Destination: Script: fac60964faf57aaef417ca85578a70192fcdc43304957446788a3e27 + Destination: Script: 21927cbad33338d4eae6141407bf783b198aa7e55dd9089dc73c8d1d Value: Ada: Lovelace: 8000000 Source: - Tx: ff223b39bba4f17e9b49399482822a0e73da124942c707885ceadd330dd3bb7f + Tx: 6b753350696782a1b24dfe7ec0549bf1e8d86cd08e5ad4d343ceca646f49f457 Output #1 - Script: 59dba30100003323232332233322233322233332... + Script: 59dba60100003323232332233322233322233332... Outputs: ---- Output 0 ---- - Destination: PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: - Ada: Lovelace: 89985824 - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: - + Ada: Lovelace: 89985820 + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: - ---- Output 1 ---- - Destination: PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: guess: 1 + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: guess: 1 Ada: Lovelace: 2000000 ---- Output 2 ---- - Destination: Script: fac60964faf57aaef417ca85578a70192fcdc43304957446788a3e27 + Destination: Script: 21927cbad33338d4eae6141407bf783b198aa7e55dd9089dc73c8d1d Value: Ada: Lovelace: 8000000 Balances Carried Forward: - PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 100000000 - PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 100000000 - PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 100000000 - PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 - PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 - PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: - Ada: Lovelace: 91985824 - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: guess: 1 + Ada: Lovelace: 91985820 + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: guess: 1 - PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 - PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 - PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 - PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 - Script: fac60964faf57aaef417ca85578a70192fcdc43304957446788a3e27 + Script: 21927cbad33338d4eae6141407bf783b198aa7e55dd9089dc73c8d1d Value: Ada: Lovelace: 8000000 ==== Slot #3, Tx #0 ==== -TxId: a29631995cb54fff4b701245a66f9decf557a9ed4b28bf4ca567c9086b32cbad +TxId: ee4d350e115107d177d6f66c3ee6f1008474b306f90cc4c5519f654b7f9ce07d Fee: Ada: Lovelace: 10 Mint: - Signatures PubKey: 8d9de88fbf445b7f6c3875a14daba94caee2ffcb... - Signature: 5840699b789ae829fc1021784629f3e998203d17... + Signature: 58408db3d868a57af927ff3d5339f3e475ddcffb... Inputs: ---- Input 0 ---- - Destination: PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: - Ada: Lovelace: 89985824 - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: - + Ada: Lovelace: 89985820 + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: - Source: - Tx: 3c188ce3c008af955a01b5edb7f388c47919476d6f6b52b5662057f4abd59941 + Tx: f02f6bdb4e032c86578adc0c8441b15ccb1033c9cc43cc71d17d689e5d107fd3 Output #0 ---- Input 1 ---- - Destination: PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: guess: 1 + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: guess: 1 Ada: Lovelace: 2000000 Source: - Tx: 3c188ce3c008af955a01b5edb7f388c47919476d6f6b52b5662057f4abd59941 + Tx: f02f6bdb4e032c86578adc0c8441b15ccb1033c9cc43cc71d17d689e5d107fd3 Output #1 Outputs: ---- Output 0 ---- - Destination: PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: - Ada: Lovelace: 89985814 - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: guess: 0 + Ada: Lovelace: 89985810 + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: guess: 0 ---- Output 1 ---- - Destination: PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + Destination: PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: guess: 1 + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: guess: 1 Ada: Lovelace: 2000000 Balances Carried Forward: - PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 100000000 - PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 100000000 - PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 102000000 - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: guess: 1 + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: guess: 1 - PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 - PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 - PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: - Ada: Lovelace: 89985814 - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: guess: 0 + Ada: Lovelace: 89985810 + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: guess: 0 - PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 - PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 - PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 - PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 - Script: fac60964faf57aaef417ca85578a70192fcdc43304957446788a3e27 + Script: 21927cbad33338d4eae6141407bf783b198aa7e55dd9089dc73c8d1d Value: Ada: Lovelace: 8000000 ==== Slot #4, Tx #0 ==== -TxId: 5b44f2ae8250459f28d7bdec7f047cd0c49f7624234adb7160baa949b7b24d25 -Fee: Ada: Lovelace: 14166 -Mint: d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: guess: 0 +TxId: 7a084925ff291d944232e98b25a0980c7349ce46f01fed961494a58ff35be4fc +Fee: Ada: Lovelace: 14170 +Mint: 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: guess: 0 Signatures PubKey: 98c77c40ccc536e0d433874dae97d4a0787b10b3... - Signature: 58404904b342e0288a864e1226040d3e09c83e93... + Signature: 58406192d4c5813c83877ac9ec0b688e574c41a7... Inputs: ---- Input 0 ---- - Destination: Script: fac60964faf57aaef417ca85578a70192fcdc43304957446788a3e27 - Value: - Ada: Lovelace: 8000000 - Source: - Tx: 3c188ce3c008af955a01b5edb7f388c47919476d6f6b52b5662057f4abd59941 - Output #2 - Script: 59dba30100003323232332233322233322233332... - - ---- Input 1 ---- - Destination: PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + Destination: PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 100000000 Source: @@ -379,85 +370,94 @@ Inputs: Output #2 - ---- Input 2 ---- - Destination: PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + ---- Input 1 ---- + Destination: PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: guess: 1 + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: guess: 1 Ada: Lovelace: 2000000 Source: - Tx: a29631995cb54fff4b701245a66f9decf557a9ed4b28bf4ca567c9086b32cbad + Tx: ee4d350e115107d177d6f66c3ee6f1008474b306f90cc4c5519f654b7f9ce07d Output #1 + ---- Input 2 ---- + Destination: Script: 21927cbad33338d4eae6141407bf783b198aa7e55dd9089dc73c8d1d + Value: + Ada: Lovelace: 8000000 + Source: + Tx: f02f6bdb4e032c86578adc0c8441b15ccb1033c9cc43cc71d17d689e5d107fd3 + Output #2 + Script: 59dba60100003323232332233322233322233332... + Outputs: ---- Output 0 ---- - Destination: PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + Destination: PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: - Ada: Lovelace: 100985834 - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: guess: 0 + Ada: Lovelace: 100985830 + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: guess: 0 ---- Output 1 ---- - Destination: PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + Destination: PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: - + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: - Ada: Lovelace: 2000000 ---- Output 2 ---- - Destination: PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + Destination: PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: guess: 1 + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: guess: 1 Ada: Lovelace: 2000000 ---- Output 3 ---- - Destination: Script: fac60964faf57aaef417ca85578a70192fcdc43304957446788a3e27 + Destination: Script: 21927cbad33338d4eae6141407bf783b198aa7e55dd9089dc73c8d1d Value: Ada: Lovelace: 5000000 Balances Carried Forward: - PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 100000000 - PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 100000000 - PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: - Ada: Lovelace: 104985834 - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: guess: 1 + Ada: Lovelace: 104985830 + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: guess: 1 - PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 - PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 - PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: - Ada: Lovelace: 89985814 - d0ac01732a10a50ccee2aba114d614dcffe774f9d7f5be5399be2e3a: guess: 0 + Ada: Lovelace: 89985810 + 9b2c45472487bc82ae575fc57a338b1fa4f6a47e536bdd57f864c46c: guess: 0 - PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 - PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 - PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 - PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 - Script: fac60964faf57aaef417ca85578a70192fcdc43304957446788a3e27 + Script: 21927cbad33338d4eae6141407bf783b198aa7e55dd9089dc73c8d1d Value: Ada: Lovelace: 5000000 \ No newline at end of file diff --git a/plutus-use-cases/test/Spec/renderVesting.txt b/plutus-use-cases/test/Spec/renderVesting.txt index e627558d56..5e38e8e1ee 100644 --- a/plutus-use-cases/test/Spec/renderVesting.txt +++ b/plutus-use-cases/test/Spec/renderVesting.txt @@ -9,94 +9,94 @@ Inputs: Outputs: ---- Output 0 ---- - Destination: PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + Destination: PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 100000000 ---- Output 1 ---- - Destination: PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + Destination: PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 100000000 ---- Output 2 ---- - Destination: PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + Destination: PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 100000000 ---- Output 3 ---- - Destination: PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + Destination: PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 ---- Output 4 ---- - Destination: PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + Destination: PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 ---- Output 5 ---- - Destination: PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 100000000 ---- Output 6 ---- - Destination: PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + Destination: PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 ---- Output 7 ---- - Destination: PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + Destination: PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 ---- Output 8 ---- - Destination: PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + Destination: PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 ---- Output 9 ---- - Destination: PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + Destination: PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 Balances Carried Forward: - PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 100000000 - PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 100000000 - PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 100000000 - PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 - PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 - PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 100000000 - PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 - PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 - PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 - PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 @@ -108,7 +108,7 @@ Signatures PubKey: 98c77c40ccc536e0d433874dae97d4a0787b10b3... Signature: 58403205f4a6d3871e102ca23a6c46ede21cce10... Inputs: ---- Input 0 ---- - Destination: PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + Destination: PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 100000000 Source: @@ -119,7 +119,7 @@ Inputs: Outputs: ---- Output 0 ---- - Destination: PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + Destination: PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 39999990 @@ -130,43 +130,43 @@ Outputs: Balances Carried Forward: - PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 100000000 - PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 100000000 - PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 39999990 - PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 - PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 - PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 100000000 - PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 - PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 - PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 - PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 @@ -193,7 +193,7 @@ Inputs: Outputs: ---- Output 0 ---- - Destination: PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + Destination: PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 9994095 @@ -204,43 +204,43 @@ Outputs: Balances Carried Forward: - PubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) + PaymentPubKeyHash: 2e0ad60c3207248cecd47dbde3d752e0aad141d6... (Wallet c30efb78b4e272685c1f9f0c93787fd4b6743154) Value: Ada: Lovelace: 100000000 - PubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) + PaymentPubKeyHash: 557d23c0a533b4d295ac2dc14b783a7efc293bc2... (Wallet 5f5a4f5f465580a5500b9a9cede7f4e014a37ea8) Value: Ada: Lovelace: 100000000 - PubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) + PaymentPubKeyHash: 80a4f45b56b88d1139da23bc4c3c75ec6d32943c... (Wallet 7ce812d7a4770bbf58004067665c3a48f28ddd58) Value: Ada: Lovelace: 39999990 - PubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) + PaymentPubKeyHash: 8952ed1aff55f5b7674b122804a3c0a96f4e2863... (Wallet 3a4778247ad35117d7c3150d194da389f3148f4a) Value: Ada: Lovelace: 100000000 - PubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) + PaymentPubKeyHash: 97add5c3ca491534a1d81165f637d338e072d47e... (Wallet 4e76ce6b3f12c6cc5a6a2545f6770d2bcb360648) Value: Ada: Lovelace: 100000000 - PubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) + PaymentPubKeyHash: a2c20c77887ace1cd986193e4e75babd8993cfd5... (Wallet 872cb83b5ee40eb23bfdab1772660c822a48d491) Value: Ada: Lovelace: 109994095 - PubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) + PaymentPubKeyHash: a96a668ed7be83e332c872f51da7925b4472ca98... (Wallet bdf8dbca0cadeb365480c6ec29ec746a2b85274f) Value: Ada: Lovelace: 100000000 - PubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) + PaymentPubKeyHash: bf342ddd3b1a6191d4ce936c92d29834d6879edf... (Wallet d3eddd0d37989746b029a0e050386bc425363901) Value: Ada: Lovelace: 100000000 - PubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) + PaymentPubKeyHash: c605888d3c40386d7c323a4679c767e5a0a7b683... (Wallet 1bc5f27d7b4e20083977418e839e429d00cc87f3) Value: Ada: Lovelace: 100000000 - PubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) + PaymentPubKeyHash: dfe12ac160d354b690385751a144e3010610fe5e... (Wallet c19599f22890ced15c6a87222302109e83b78bdf) Value: Ada: Lovelace: 100000000 diff --git a/web-common-plutus/src/Chain/Types.purs b/web-common-plutus/src/Chain/Types.purs index 7c46fdb741..e2c62b2ed0 100644 --- a/web-common-plutus/src/Chain/Types.purs +++ b/web-common-plutus/src/Chain/Types.purs @@ -12,6 +12,7 @@ import Data.Map (Map) import Data.Newtype (class Newtype) import Type.Proxy (Proxy(..)) import Data.Set (Set) +import Ledger.Address (PaymentPubKeyHash(..)) import Plutus.V1.Ledger.Address (Address(..)) import Plutus.V1.Ledger.Credential (Credential(..)) import Plutus.V1.Ledger.Crypto (PubKey, Signature) @@ -127,7 +128,7 @@ toBeneficialOwner (TxOut { txOutAddress }) = Address { addressCredential } = txOutAddress in case addressCredential of - PubKeyCredential pkh -> OwnedByPubKey pkh + PubKeyCredential pkh -> OwnedByPaymentPubKey $ PaymentPubKeyHash { unPaymentPubKeyHash: pkh } ScriptCredential vh -> OwnedByScript vh _findTx :: forall m. Monoid m => TxId -> Fold' m AnnotatedBlockchain AnnotatedTx diff --git a/web-common-plutus/src/Chain/View.purs b/web-common-plutus/src/Chain/View.purs index 6c1a25cb8b..c480c56ae7 100644 --- a/web-common-plutus/src/Chain/View.purs +++ b/web-common-plutus/src/Chain/View.purs @@ -33,6 +33,7 @@ import Halogen.HTML.Properties (class_, classes, colSpan, rowSpan) import PlutusTx.AssocMap as AssocMap import Plutus.V1.Ledger.Crypto (PubKey(..), PubKeyHash(..)) import Ledger.Extra (humaniseSlotInterval) +import Ledger.Address (PaymentPubKeyHash(..)) import Plutus.V1.Ledger.Tx (TxOut(..)) import Plutus.V1.Ledger.TxId (TxId(..)) import Plutus.V1.Ledger.Value (CurrencySymbol(..), TokenName(..), Value(..)) @@ -377,12 +378,12 @@ txOutOfView namingFn showArrow txOut@(TxOut { txOutValue }) mFooter = beneficialOwner = toBeneficialOwner txOut beneficialOwnerClass :: BeneficialOwner -> ClassName -beneficialOwnerClass (OwnedByPubKey _) = ClassName "wallet" +beneficialOwnerClass (OwnedByPaymentPubKey _) = ClassName "wallet" beneficialOwnerClass (OwnedByScript _) = ClassName "script" beneficialOwnerView :: forall p. NamingFn -> BeneficialOwner -> HTML p Action -beneficialOwnerView namingFn (OwnedByPubKey pubKeyHash) = case namingFn pubKeyHash of +beneficialOwnerView namingFn (OwnedByPaymentPubKey (PaymentPubKeyHash { unPaymentPubKeyHash: pubKeyHash })) = case namingFn pubKeyHash of Nothing -> showPubKeyHash pubKeyHash Just name -> span_