diff --git a/doc/plutus/tutorials/EscrowImpl.hs b/doc/plutus/tutorials/EscrowImpl.hs index 2a2bd691b9..7855b9342e 100644 --- a/doc/plutus/tutorials/EscrowImpl.hs +++ b/doc/plutus/tutorials/EscrowImpl.hs @@ -70,7 +70,7 @@ import Plutus.V1.Ledger.Contexts (ScriptContext (ScriptContext, scriptContextTxI import Plutus.Contract (AsContractError (_ContractError), Contract, ContractError, Endpoint, HasEndpoint, Promise, adjustUnbalancedTx, awaitTime, currentTime, endpoint, mapError, mkTxConstraints, - ownPaymentPubKeyHash, promiseMap, selectList, submitUnbalancedTx, type (.\/), utxosAt, + ownFirstPaymentPubKeyHash, promiseMap, selectList, submitUnbalancedTx, type (.\/), utxosAt, waitNSlots) import Plutus.Contract.Typed.Tx qualified as Typed import PlutusTx qualified @@ -267,7 +267,7 @@ pay :: -- ^ How much money to pay in -> Contract w s e TxId pay inst escrow vl = do - pk <- ownPaymentPubKeyHash + pk <- ownFirstPaymentPubKeyHash let tx = Constraints.mustPayToTheScript pk vl <> Constraints.mustValidateIn (Ledger.interval 1 (escrowDeadline escrow)) utx <- mkTxConstraints (Constraints.typedValidatorLookups inst) tx >>= adjustUnbalancedTx @@ -336,7 +336,7 @@ refund :: -> EscrowParams Datum -> Contract w s EscrowError RefundSuccess refund inst escrow = do - pk <- ownPaymentPubKeyHash + pk <- ownFirstPaymentPubKeyHash unspentOutputs <- utxosAt (Scripts.validatorAddress inst) let flt _ ciTxOut = either id Scripts.datumHash (Tx._ciTxOutDatum ciTxOut) == Scripts.datumHash (Datum (PlutusTx.toBuiltinData pk)) tx' = Typed.collectFromScriptFilter flt unspentOutputs Refund diff --git a/playground-common/src/Playground/Contract.hs b/playground-common/src/Playground/Contract.hs index 1f10bed6e2..8b0be58ecf 100644 --- a/playground-common/src/Playground/Contract.hs +++ b/playground-common/src/Playground/Contract.hs @@ -42,6 +42,9 @@ module Playground.Contract , type (.\/) , interval , ownPaymentPubKeyHash + , ownFirstPaymentPubKeyHash + , ownPaymentPubKeyHashes + , ownAddresses , awaitSlot , modifiesUtxoSet , utxosAt @@ -66,8 +69,9 @@ 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, ownPaymentPubKeyHash, submitTx, - type (.\/), utxosAt, watchAddressUntilSlot) +import Plutus.Contract (AsContractError, Contract, Endpoint, awaitSlot, endpoint, ownAddresses, + ownFirstPaymentPubKeyHash, ownPaymentPubKeyHash, ownPaymentPubKeyHashes, submitTx, type (.\/), + utxosAt, watchAddressUntilSlot) import Plutus.Contract.Trace (TraceError (..)) import Schema (FormSchema, ToArgument, ToSchema) import Wallet.Emulator.Types (Wallet (..)) diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs index bc96bfe7de..cf38c60af0 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs @@ -162,6 +162,8 @@ data Tip = deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON, OpenApi.ToSchema) +makePrisms ''Tip + -- | When performing a rollback the chain sync protocol does not provide a block -- number where to resume from. data Point = diff --git a/plutus-contract/src/Plutus/Contract.hs b/plutus-contract/src/Plutus/Contract.hs index 2c859dec61..8c85807b7a 100644 --- a/plutus-contract/src/Plutus/Contract.hs +++ b/plutus-contract/src/Plutus/Contract.hs @@ -62,8 +62,12 @@ module Plutus.Contract( , Request.utxosAt , Request.utxosTxOutTxFromTx , Request.getTip - -- * Wallet's own public key + -- * Wallet's information , Request.ownPaymentPubKeyHash + , Request.ownPaymentPubKeyHashes + , Request.ownFirstPaymentPubKeyHash + , Request.ownAddresses + , Request.ownUtxos -- * Contract instance Id , Wallet.Types.ContractInstanceId , Request.ownInstanceId diff --git a/plutus-contract/src/Plutus/Contract/Effects.hs b/plutus-contract/src/Plutus/Contract/Effects.hs index 017873b80b..c75c8b4548 100644 --- a/plutus-contract/src/Plutus/Contract/Effects.hs +++ b/plutus-contract/src/Plutus/Contract/Effects.hs @@ -18,7 +18,7 @@ module Plutus.Contract.Effects( -- TODO: Move to Requests.Internal _AwaitTxStatusChangeReq, _AwaitTxOutStatusChangeReq, _OwnContractInstanceIdReq, - _OwnPaymentPublicKeyHashReq, + _OwnAddressesReq, _ChainIndexQueryReq, _BalanceTxReq, _WriteBalancedTxReq, @@ -52,7 +52,7 @@ module Plutus.Contract.Effects( -- TODO: Move to Requests.Internal _AwaitTxStatusChangeResp', _AwaitTxOutStatusChangeResp, _OwnContractInstanceIdResp, - _OwnPaymentPublicKeyHashResp, + _OwnAddressesResp, _ChainIndexQueryResp, _BalanceTxResp, _WriteBalancedTxResp, @@ -91,7 +91,6 @@ import Data.List.NonEmpty (NonEmpty) import Data.OpenApi.Schema qualified as OpenApi import Data.String (fromString) import GHC.Generics (Generic) -import Ledger (PaymentPubKeyHash) import Ledger.Constraints.OffChain (UnbalancedTx) import Ledger.Credential (Credential) import Ledger.Scripts (Validator) @@ -124,7 +123,7 @@ data PABReq = | CurrentSlotReq | CurrentTimeReq | OwnContractInstanceIdReq - | OwnPaymentPublicKeyHashReq + | OwnAddressesReq | ChainIndexQueryReq ChainIndexQuery | BalanceTxReq UnbalancedTx | WriteBalancedTxReq CardanoTx @@ -146,7 +145,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" - OwnPaymentPublicKeyHashReq -> "Own public key" + OwnAddressesReq -> "Own addresses" ChainIndexQueryReq q -> "Chain index query:" <+> pretty q BalanceTxReq utx -> "Balance tx:" <+> pretty utx WriteBalancedTxReq tx -> "Write balanced tx:" <+> onCardanoTx pretty (fromString . show) tx @@ -166,7 +165,7 @@ data PABResp = | CurrentSlotResp Slot | CurrentTimeResp POSIXTime | OwnContractInstanceIdResp ContractInstanceId - | OwnPaymentPublicKeyHashResp PaymentPubKeyHash + | OwnAddressesResp (NonEmpty Address) | ChainIndexQueryResp ChainIndexResponse | BalanceTxResp BalanceTxResponse | WriteBalancedTxResp WriteBalancedTxResponse @@ -188,7 +187,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 - OwnPaymentPublicKeyHashResp k -> "Own public key:" <+> pretty k + OwnAddressesResp addrs -> "Own addresses:" <+> pretty addrs ChainIndexQueryResp rsp -> pretty rsp BalanceTxResp r -> "Balance tx:" <+> pretty r WriteBalancedTxResp r -> "Write balanced tx:" <+> pretty r @@ -208,7 +207,7 @@ matches a b = case (a, b) of (AwaitTxStatusChangeReq i, AwaitTxStatusChangeResp i' _) -> i == i' (AwaitTxOutStatusChangeReq i, AwaitTxOutStatusChangeResp i' _) -> i == i' (OwnContractInstanceIdReq, OwnContractInstanceIdResp{}) -> True - (OwnPaymentPublicKeyHashReq, OwnPaymentPublicKeyHashResp{}) -> True + (OwnAddressesReq, OwnAddressesResp {}) -> True (ChainIndexQueryReq r, ChainIndexQueryResp r') -> chainIndexMatches r r' (BalanceTxReq{}, BalanceTxResp{}) -> True (WriteBalancedTxReq{}, WriteBalancedTxResp{}) -> True diff --git a/plutus-contract/src/Plutus/Contract/Request.hs b/plutus-contract/src/Plutus/Contract/Request.hs index c89efc9e32..924a91dbba 100644 --- a/plutus-contract/src/Plutus/Contract/Request.hs +++ b/plutus-contract/src/Plutus/Contract/Request.hs @@ -76,8 +76,12 @@ module Plutus.Contract.Request( , endpointDescription , endpointReq , endpointResp - -- ** Public key hashes + -- ** Wallet information , ownPaymentPubKeyHash + , ownPaymentPubKeyHashes + , ownFirstPaymentPubKeyHash + , ownAddresses + , ownUtxos -- ** Submitting transactions , adjustUnbalancedTx , submitUnbalancedTx @@ -116,8 +120,8 @@ import Data.Void (Void) import GHC.Generics (Generic) import GHC.Natural (Natural) import GHC.TypeLits (Symbol, symbolVal) -import Ledger (AssetClass, DiffMilliSeconds, POSIXTime, PaymentPubKeyHash, Slot, TxId, TxOutRef, Value, - addressCredential, fromMilliSeconds, txOutRefId) +import Ledger (AssetClass, DiffMilliSeconds, POSIXTime, PaymentPubKeyHash (PaymentPubKeyHash), Slot, TxId, TxOutRef, + Value, addressCredential, fromMilliSeconds, txOutRefId) import Ledger.Constraints (TxConstraints) import Ledger.Constraints.OffChain (ScriptLookups, UnbalancedTx) import Ledger.Constraints.OffChain qualified as Constraints @@ -130,7 +134,7 @@ import Plutus.V1.Ledger.Api (Address, Datum, DatumHash, MintingPolicy, MintingPo import PlutusTx qualified import Plutus.Contract.Effects (ActiveEndpoint (ActiveEndpoint, aeDescription, aeMetadata), - PABReq (AdjustUnbalancedTxReq, AwaitSlotReq, AwaitTimeReq, AwaitTxOutStatusChangeReq, AwaitTxStatusChangeReq, AwaitUtxoProducedReq, AwaitUtxoSpentReq, BalanceTxReq, ChainIndexQueryReq, CurrentSlotReq, CurrentTimeReq, ExposeEndpointReq, OwnContractInstanceIdReq, OwnPaymentPublicKeyHashReq, WriteBalancedTxReq, YieldUnbalancedTxReq), + PABReq (AdjustUnbalancedTxReq, AwaitSlotReq, AwaitTimeReq, AwaitTxOutStatusChangeReq, AwaitTxStatusChangeReq, AwaitUtxoProducedReq, AwaitUtxoSpentReq, BalanceTxReq, ChainIndexQueryReq, CurrentSlotReq, CurrentTimeReq, ExposeEndpointReq, OwnAddressesReq, OwnContractInstanceIdReq, WriteBalancedTxReq, YieldUnbalancedTxReq), PABResp (ExposeEndpointResp)) import Plutus.Contract.Effects qualified as E import Plutus.Contract.Logging (logDebug) @@ -138,6 +142,8 @@ import Plutus.Contract.Schema (Input, Output) import Wallet.Types (ContractInstanceId, EndpointDescription (EndpointDescription), EndpointValue (EndpointValue, unEndpointValue)) +import Data.Foldable (fold) +import Data.List.NonEmpty qualified as NonEmpty import Plutus.ChainIndex (ChainIndexTx, Page (nextPageQuery, pageItems), PageQuery, txOutRefs) import Plutus.ChainIndex.Api (IsUtxoResponse, TxosResponse, UtxosResponse (page), paget) import Plutus.ChainIndex.Types (RollbackState (Unknown), Tip, TxOutStatus, TxStatus) @@ -145,6 +151,8 @@ import Plutus.Contract.Error (AsContractError (_ChainIndexContractError, _Constr import Plutus.Contract.Resumable (prompt) import Plutus.Contract.Types (Contract (Contract), MatchingError (WrongVariantError), Promise (Promise), mapError, runError, throwError) +import Plutus.V1.Ledger.Address (toPubKeyHash) +import Wallet.Emulator.Error (WalletAPIError (NoPaymentPubKeyHashError)) -- | Constraints on the contract schema, ensuring that the labels of the schema -- are unique. @@ -424,6 +432,12 @@ foldUtxoRefsAt f ini addr = go ini (Just def) newAcc <- f acc page go newAcc (nextPageQuery page) +-- | Get all utxos belonging to the wallet that runs this contract. +ownUtxos :: forall w s e. (AsContractError e) => Contract w s e (Map TxOutRef ChainIndexTxOut) +ownUtxos = do + addrs <- ownAddresses + fold <$> mapM utxosAt (NonEmpty.toList addrs) + -- | Get the unspent transaction outputs at an address. utxosAt :: forall w s e. @@ -785,6 +799,7 @@ endpointWithMeta meta f = Promise $ do endpointDescription :: forall l. KnownSymbol l => Proxy l -> EndpointDescription endpointDescription = EndpointDescription . symbolVal +{-# DEPRECATED ownPaymentPubKeyHash "Use ownFirstPaymentPubKeyHash, ownPaymentPubKeyHashes or ownAddresses instead" #-} -- | Get the hash of a public key belonging to the wallet that runs this contract. -- * Any funds paid to this public key hash will be treated as the wallet's own -- funds @@ -794,7 +809,30 @@ endpointDescription = EndpointDescription . symbolVal -- * There is a 1-n relationship between wallets and public keys (although in -- the mockchain n=1) ownPaymentPubKeyHash :: forall w s e. (AsContractError e) => Contract w s e PaymentPubKeyHash -ownPaymentPubKeyHash = pabReq OwnPaymentPublicKeyHashReq E._OwnPaymentPublicKeyHashResp +ownPaymentPubKeyHash = ownFirstPaymentPubKeyHash + +-- | Get the addresses belonging to the wallet that runs this contract. +-- * Any funds paid to one of these addresses will be treated as the wallet's own +-- funds +-- * The wallet is able to sign transactions with the private key of one of its +-- public key, for example, if the public key is added to the +-- 'requiredSignatures' field of 'Tx'. +-- * There is a 1-n relationship between wallets and addresses (although in +-- the mockchain n=1) +ownAddresses :: forall w s e. (AsContractError e) => Contract w s e (NonEmpty Address) +ownAddresses = pabReq OwnAddressesReq E._OwnAddressesResp + +ownPaymentPubKeyHashes :: forall w s e. (AsContractError e) => Contract w s e [PaymentPubKeyHash] +ownPaymentPubKeyHashes = do + addrs <- ownAddresses + pure $ fmap PaymentPubKeyHash $ mapMaybe toPubKeyHash $ NonEmpty.toList addrs + +ownFirstPaymentPubKeyHash :: forall w s e. (AsContractError e) => Contract w s e PaymentPubKeyHash +ownFirstPaymentPubKeyHash = do + pkhs <- ownPaymentPubKeyHashes + case pkhs of + [] -> throwError $ review _WalletContractError NoPaymentPubKeyHashError + (pkh:_) -> pure pkh -- | 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 cb2ce8dd50..8dc1957ea7 100644 --- a/plutus-contract/src/Plutus/Contract/StateMachine.hs +++ b/plutus-contract/src/Plutus/Contract/StateMachine.hs @@ -80,8 +80,8 @@ import Ledger.Value qualified as Value import Plutus.ChainIndex (ChainIndexTx (_citxInputs)) import Plutus.Contract (AsContractError (_ConstraintResolutionContractError, _ContractError), Contract, ContractError, Promise, adjustUnbalancedTx, awaitPromise, isSlot, isTime, logWarn, mapError, never, - ownPaymentPubKeyHash, promiseBind, select, submitTxConfirmed, utxoIsProduced, utxoIsSpent, - utxosAt, utxosTxOutTxFromTx) + ownFirstPaymentPubKeyHash, ownUtxos, promiseBind, select, submitTxConfirmed, utxoIsProduced, + utxoIsSpent, utxosAt, utxosTxOutTxFromTx) import Plutus.Contract.Request (mkTxContract) import Plutus.Contract.StateMachine.MintingPolarity (MintingPolarity (Burn, Mint)) import Plutus.Contract.StateMachine.OnChain (State (State, stateData, stateValue), @@ -432,8 +432,7 @@ runInitialiseWith :: -> Contract w schema e state runInitialiseWith customLookups customConstraints StateMachineClient{scInstance} initialState initialValue = mapError (review _SMContractError) $ do - ownPK <- ownPaymentPubKeyHash - utxo <- utxosAt (Ledger.pubKeyHashAddress ownPK Nothing) + utxo <- ownUtxos let StateMachineInstance{stateMachine, typedValidator} = scInstance constraints = mustPayToTheScript initialState (initialValue <> SM.threadTokenValueOrZero scInstance) <> foldMap ttConstraints (smThreadToken stateMachine) @@ -493,7 +492,7 @@ runGuardedStepWith :: 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 <- ownPaymentPubKeyHash + pk <- ownFirstPaymentPubKeyHash let lookups = smtLookups { Constraints.slOwnPaymentPubKeyHash = Just pk } utx <- either (throwing _ConstraintResolutionContractError) pure diff --git a/plutus-contract/src/Plutus/Contract/Trace.hs b/plutus-contract/src/Plutus/Contract/Trace.hs index ffead19aba..a6ac57f141 100644 --- a/plutus-contract/src/Plutus/Contract/Trace.hs +++ b/plutus-contract/src/Plutus/Contract/Trace.hs @@ -27,7 +27,7 @@ module Plutus.Contract.Trace , handleAdjustUnbalancedTx , handleSlotNotifications , handleTimeNotifications - , handleOwnPaymentPubKeyHashQueries + , handleOwnAddressesQueries , handleCurrentSlotQueries , handleCurrentTimeQueries , handleTimeToSlotConversions @@ -175,13 +175,13 @@ handleChainIndexQueries = E.ChainIndexQueryResp RequestHandler.handleChainIndexQueries -handleOwnPaymentPubKeyHashQueries :: +handleOwnAddressesQueries :: ( Member (LogObserve (LogMessage Text)) effs , Member WalletEffect effs ) => RequestHandler effs PABReq PABResp -handleOwnPaymentPubKeyHashQueries = - generalise (preview E._OwnPaymentPublicKeyHashReq) E.OwnPaymentPublicKeyHashResp RequestHandler.handleOwnPaymentPubKeyHash +handleOwnAddressesQueries = + generalise (preview E._OwnAddressesReq) E.OwnAddressesResp RequestHandler.handleOwnAddresses 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 9c4359b1e0..b3aa328b57 100644 --- a/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs +++ b/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs @@ -18,7 +18,7 @@ module Plutus.Contract.Trace.RequestHandler( , generalise -- * handlers for common requests , handleAdjustUnbalancedTx - , handleOwnPaymentPubKeyHash + , handleOwnAddresses , handleSlotNotifications , handleCurrentSlot , handleTimeNotifications @@ -48,7 +48,8 @@ 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, Params (..), PaymentPubKeyHash, Slot, SlotRange) +import Data.List.NonEmpty (NonEmpty) +import Ledger (POSIXTime, POSIXTimeRange, Params (..), Slot, SlotRange) import Ledger.Constraints.OffChain (UnbalancedTx, adjustUnbalancedTx) import Ledger.TimeSlot qualified as TimeSlot import Ledger.Tx (CardanoTx, ToCardanoError) @@ -56,6 +57,7 @@ import Plutus.ChainIndex (ChainIndexQueryEffect) import Plutus.ChainIndex.Effects qualified as ChainIndexEff import Plutus.Contract.Effects (ChainIndexQuery (..), ChainIndexResponse (..)) import Plutus.Contract.Wallet qualified as Wallet +import Plutus.V1.Ledger.Api (Address) import Wallet.API (WalletAPIError) import Wallet.Effects (NodeClientEffect, WalletEffect) import Wallet.Effects qualified @@ -112,15 +114,15 @@ maybeToHandler f = RequestHandler $ maybe empty pure . f -- handlers for common requests -handleOwnPaymentPubKeyHash :: +handleOwnAddresses :: forall a effs. ( Member WalletEffect effs , Member (LogObserve (LogMessage Text)) effs ) - => RequestHandler effs a PaymentPubKeyHash -handleOwnPaymentPubKeyHash = + => RequestHandler effs a (NonEmpty Address) +handleOwnAddresses = RequestHandler $ \_ -> - surroundDebug @Text "handleOwnPaymentPubKeyHash" Wallet.Effects.ownPaymentPubKeyHash + surroundDebug @Text "handleOwnAddresses" Wallet.Effects.ownAddresses handleSlotNotifications :: forall effs. diff --git a/plutus-contract/src/Plutus/Contract/Wallet.hs b/plutus-contract/src/Plutus/Contract/Wallet.hs index 464b4c55b4..d1988fd73f 100644 --- a/plutus-contract/src/Plutus/Contract/Wallet.hs +++ b/plutus-contract/src/Plutus/Contract/Wallet.hs @@ -114,7 +114,7 @@ handleTx = balanceTx >=> either throwError WAPI.signTxAndSubmit -- | Get an unspent output belonging to the wallet. getUnspentOutput :: AsContractError e => Contract w s e TxOutRef getUnspentOutput = do - ownPkh <- Contract.ownPaymentPubKeyHash + ownPkh <- Contract.ownFirstPaymentPubKeyHash let constraints = mustPayToPubKey ownPkh (Ada.lovelaceValueOf 1) utx <- either (throwing _ConstraintResolutionContractError) pure (mkTx @Void mempty constraints) tx <- Contract.adjustUnbalancedTx utx >>= Contract.balanceTx @@ -281,7 +281,7 @@ toExportTxInput networkId Plutus.TxOutRef{Plutus.txOutRefId, Plutus.txOutRefIdx} ExportTxInput <$> CardanoAPI.toCardanoTxId txOutRefId <*> pure (C.TxIx $ fromInteger txOutRefIdx) - <*> CardanoAPI.toCardanoAddress networkId txOutAddress + <*> CardanoAPI.toCardanoAddressInEra networkId txOutAddress <*> pure (C.selectLovelace cardanoValue) <*> sequence (CardanoAPI.toCardanoScriptDataHash <$> txOutDatumHash) <*> pure otherQuantities diff --git a/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs b/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs index b9a240b977..673efdd677 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.handleOwnPaymentPubKeyHashQueries + <> RequestHandler.handleOwnAddressesQueries <> RequestHandler.handleOwnInstanceIdQueries <> RequestHandler.handleSlotNotifications <> RequestHandler.handleCurrentSlotQueries diff --git a/plutus-contract/src/Wallet/API.hs b/plutus-contract/src/Wallet/API.hs index ebe77e7582..048bc46e20 100644 --- a/plutus-contract/src/Wallet/API.hs +++ b/plutus-contract/src/Wallet/API.hs @@ -24,6 +24,9 @@ module Wallet.API( WalletEffect, submitTxn, ownPaymentPubKeyHash, + ownPaymentPubKeyHashes, + ownFirstPaymentPubKeyHash, + ownAddresses, balanceTx, yieldUnbalancedTx, NodeClientEffect, @@ -62,20 +65,51 @@ import Control.Monad.Freer (Eff, Member) import Control.Monad.Freer.Error (Error, throwError) import Control.Monad.Freer.Extras.Log (LogMsg, logDebug, logWarn) import Data.Default (Default (def)) +import Data.List.NonEmpty qualified as NonEmpty +import Data.Maybe (mapMaybe) import Data.Text (Text) import Data.Void (Void) -import Ledger (CardanoTx, Interval (Interval, ivFrom, ivTo), Params (..), PaymentPubKeyHash, PubKey (PubKey, getPubKey), - PubKeyHash (PubKeyHash, getPubKeyHash), Slot, SlotRange, Value, after, always, before, contains, - interval, isEmpty, member, singleton, width) +import Ledger (CardanoTx, Interval (Interval, ivFrom, ivTo), Params (..), PaymentPubKeyHash (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.Constraints.OffChain (adjustUnbalancedTx) import Ledger.TimeSlot qualified as TimeSlot -import Wallet.Effects (NodeClientEffect, WalletEffect, balanceTx, getClientParams, getClientSlot, ownPaymentPubKeyHash, +import Plutus.V1.Ledger.Address (toPubKeyHash) +import Wallet.Effects (NodeClientEffect, WalletEffect, balanceTx, getClientParams, getClientSlot, ownAddresses, publishTx, submitTxn, walletAddSignature, yieldUnbalancedTx) import Wallet.Emulator.LogMessages (RequestHandlerLogMsg (AdjustingUnbalancedTx)) -import Wallet.Error (WalletAPIError (PaymentMkTxError, ToCardanoError)) +import Wallet.Error (WalletAPIError (NoPaymentPubKeyHashError, PaymentMkTxError, ToCardanoError)) import Wallet.Error qualified +{-# DEPRECATED ownPaymentPubKeyHash "Use ownFirstPaymentPubKeyHash, ownPaymentPubKeyHashes or ownAddresses instead" #-} + +ownPaymentPubKeyHash :: + ( Member WalletEffect effs + , Member (Error WalletAPIError) effs + ) + => Eff effs PaymentPubKeyHash +ownPaymentPubKeyHash = ownFirstPaymentPubKeyHash + +ownPaymentPubKeyHashes :: + ( Member WalletEffect effs + ) + => Eff effs [PaymentPubKeyHash] +ownPaymentPubKeyHashes = do + addrs <- ownAddresses + pure $ fmap PaymentPubKeyHash $ mapMaybe toPubKeyHash $ NonEmpty.toList addrs + +ownFirstPaymentPubKeyHash :: + ( Member WalletEffect effs + , Member (Error WalletAPIError) effs + ) + => Eff effs PaymentPubKeyHash +ownFirstPaymentPubKeyHash = do + pkhs <- ownPaymentPubKeyHashes + case pkhs of + [] -> throwError NoPaymentPubKeyHashError + (pkh:_) -> pure pkh + -- | Transfer some funds to an address locked by a public key, returning the -- transaction that was submitted. -- diff --git a/plutus-contract/src/Wallet/Effects.hs b/plutus-contract/src/Wallet/Effects.hs index da8398f45d..335e1a95c5 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 - , ownPaymentPubKeyHash + , ownAddresses , balanceTx , totalFunds , walletAddSignature @@ -26,13 +26,14 @@ module Wallet.Effects( ) where import Control.Monad.Freer.TH (makeEffect) -import Ledger (CardanoTx, Params, PaymentPubKeyHash, Slot, Value) +import Data.List.NonEmpty (NonEmpty) +import Ledger (Address, CardanoTx, Params, Slot, Value) import Ledger.Constraints.OffChain (UnbalancedTx) import Wallet.Error (WalletAPIError) data WalletEffect r where SubmitTxn :: CardanoTx -> WalletEffect () - OwnPaymentPubKeyHash :: WalletEffect PaymentPubKeyHash + OwnAddresses :: WalletEffect (NonEmpty Address) 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 1adc28355d..5b06d9da2f 100644 --- a/plutus-contract/src/Wallet/Emulator/Error.hs +++ b/plutus-contract/src/Wallet/Emulator/Error.hs @@ -25,6 +25,9 @@ data WalletAPIError = | ChangeHasLessThanNAda Value Ada -- ^ The change when selecting coins contains less than the minimum amount -- of Ada. + | NoPaymentPubKeyHashError + -- ^ The wallet doesn't have any payment key hash, which should not be + -- possible. | PaymentPrivateKeyNotFound PaymentPubKeyHash -- ^ The private key of this public key hash is not known to the wallet. | ValidationError ValidationError @@ -45,6 +48,8 @@ instance Pretty WalletAPIError where "Insufficient funds:" <+> pretty t ChangeHasLessThanNAda v ada -> "Coin change has less than" <+> pretty ada <> ":" <+> pretty v + NoPaymentPubKeyHashError -> + "No payment public hash found" PaymentPrivateKeyNotFound pk -> "Payment private key not found:" <+> viaShow pk ValidationError e -> diff --git a/plutus-contract/src/Wallet/Emulator/Wallet.hs b/plutus-contract/src/Wallet/Emulator/Wallet.hs index ab45061e4b..dd7e2c8aff 100644 --- a/plutus-contract/src/Wallet/Emulator/Wallet.hs +++ b/plutus-contract/src/Wallet/Emulator/Wallet.hs @@ -72,8 +72,10 @@ import Prettyprinter (Pretty (pretty)) import Servant.API (FromHttpApiData (parseUrlPiece), ToHttpApiData (toUrlPiece)) import Wallet.API qualified as WAPI +import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty qualified as NonEmpty import Wallet.Effects (NodeClientEffect, - WalletEffect (BalanceTx, OwnPaymentPubKeyHash, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx), + WalletEffect (BalanceTx, OwnAddresses, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx), publishTx) import Wallet.Emulator.Chain (ChainState (_index)) import Wallet.Emulator.LogMessages (RequestHandlerLogMsg, @@ -243,7 +245,7 @@ handleWallet :: => WalletEffect ~> Eff effs handleWallet = \case SubmitTxn tx -> submitTxnH tx - OwnPaymentPubKeyHash -> ownPaymentPubKeyHashH + OwnAddresses -> ownAddressesH BalanceTx utx -> balanceTxH utx WalletAddSignature tx -> walletAddSignatureH tx TotalFunds -> totalFundsH @@ -255,8 +257,10 @@ handleWallet = \case logInfo $ SubmittingTx tx publishTx tx - ownPaymentPubKeyHashH :: (Member (State WalletState) effs) => Eff effs PaymentPubKeyHash - ownPaymentPubKeyHashH = gets (CW.paymentPubKeyHash . _mockWallet) + ownAddressesH :: (Member (State WalletState) effs) => Eff effs (NonEmpty Address) + ownAddressesH = do + mw <- gets _mockWallet + pure $ NonEmpty.fromList [CW.mockWalletAddress mw] balanceTxH :: ( Member NodeClientEffect effs diff --git a/plutus-contract/test/Spec/Balancing.hs b/plutus-contract/test/Spec/Balancing.hs index dfc31a5528..c4ec87ea2a 100644 --- a/plutus-contract/test/Spec/Balancing.hs +++ b/plutus-contract/test/Spec/Balancing.hs @@ -111,7 +111,7 @@ balanceTxnNoExtraOutput = mintingOperation :: Contract [Int] EmptySchema ContractError () mintingOperation = do - pkh <- Con.ownPaymentPubKeyHash + pkh <- Con.ownFirstPaymentPubKeyHash let val = vL 200 lookups = Constraints.mintingPolicy coinMintingPolicy diff --git a/plutus-contract/test/Spec/Contract.hs b/plutus-contract/test/Spec/Contract.hs index 8715dcaf8b..29d783cc37 100644 --- a/plutus-contract/test/Spec/Contract.hs +++ b/plutus-contract/test/Spec/Contract.hs @@ -194,7 +194,7 @@ tests = Trace.waitNSlots 1 ) - , let theContract :: Contract () Schema ContractError PaymentPubKeyHash = ownPaymentPubKeyHash + , let theContract :: Contract () Schema ContractError PaymentPubKeyHash = ownFirstPaymentPubKeyHash in run "own public key" (assertDone theContract tag (== mockWalletPaymentPubKeyHash w2) "should return the wallet's public key") (void $ activateContract w2 (void theContract) tag) @@ -268,7 +268,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 <- ownPaymentPubKeyHash + pubKeyHash <- ownFirstPaymentPubKeyHash ciTxOutM <- unspentTxOutFromRef utxo let lookups = Constraints.unspentOutputs (maybe mempty (Map.singleton utxo) ciTxOutM) submitTxConstraintsWith @Void lookups $ Constraints.mustSpendPubKeyOutput utxo @@ -306,7 +306,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 <- ownPaymentPubKeyHash + pubKeyHash <- ownFirstPaymentPubKeyHash ciTxOutM <- unspentTxOutFromRef utxo let lookups = Constraints.unspentOutputs (maybe mempty (Map.singleton utxo) ciTxOutM) submitCardanoTxConstraintsWith lookups $ Constraints.mustSpendPubKeyOutput utxo diff --git a/plutus-ledger/src/Ledger/CardanoWallet.hs b/plutus-ledger/src/Ledger/CardanoWallet.hs index 439b7b09bb..99499fbda5 100644 --- a/plutus-ledger/src/Ledger/CardanoWallet.hs +++ b/plutus-ledger/src/Ledger/CardanoWallet.hs @@ -19,9 +19,12 @@ module Ledger.CardanoWallet( fromSeed, fromSeed', -- ** Keys + mockWalletAddress, paymentPrivateKey, paymentPubKeyHash, - paymentPubKey + paymentPubKey, + stakePubKeyHash, + stakePubKey ) where import Cardano.Crypto.Wallet qualified as Crypto @@ -37,9 +40,12 @@ import Data.Maybe (fromMaybe) import Data.Text qualified as T import GHC.Generics (Generic) import Ledger (PaymentPrivateKey (PaymentPrivateKey), PaymentPubKey (PaymentPubKey, unPaymentPubKey), - PaymentPubKeyHash (PaymentPubKeyHash)) + PaymentPubKeyHash (PaymentPubKeyHash), StakePubKeyHash) +import Ledger.Address (PaymentPubKeyHash (unPaymentPubKeyHash), StakePubKey (StakePubKey, unStakePubKey), + StakePubKeyHash (StakePubKeyHash, unStakePubKeyHash)) import Ledger.Crypto (PubKey (..)) import Ledger.Crypto qualified as Crypto +import Plutus.V1.Ledger.Api (Address (Address), Credential (PubKeyCredential), StakingCredential (StakingHash)) import Plutus.V1.Ledger.Bytes (LedgerBytes (getLedgerBytes)) import Servant.API (FromHttpApiData, ToHttpApiData) @@ -108,6 +114,11 @@ knownMockWallets = fromWalletNumber . WalletNumber <$> [1..10] knownMockWallet :: Integer -> MockWallet knownMockWallet = (knownMockWallets !!) . pred . fromInteger +mockWalletAddress :: MockWallet -> Address +mockWalletAddress mw = + Address (PubKeyCredential $ unPaymentPubKeyHash $ paymentPubKeyHash mw) + (StakingHash . PubKeyCredential . unStakePubKeyHash <$> stakePubKeyHash mw) + -- | Mock wallet's private key paymentPrivateKey :: MockWallet -> PaymentPrivateKey paymentPrivateKey = PaymentPrivateKey . unMockPrivateKey . mwPaymentKey @@ -119,3 +130,11 @@ paymentPubKeyHash = PaymentPubKeyHash . Crypto.pubKeyHash . unPaymentPubKey . pa -- | The mock wallet's payment public key paymentPubKey :: MockWallet -> PaymentPubKey paymentPubKey = PaymentPubKey . Crypto.toPublicKey . unMockPrivateKey . mwPaymentKey + +-- | The mock wallet's stake public key hash +stakePubKeyHash :: MockWallet -> Maybe StakePubKeyHash +stakePubKeyHash w = StakePubKeyHash . Crypto.pubKeyHash . unStakePubKey <$> stakePubKey w + +-- | The mock wallet's stake public key +stakePubKey :: MockWallet -> Maybe StakePubKey +stakePubKey w = StakePubKey . Crypto.toPublicKey . unMockPrivateKey <$> mwStakeKey w diff --git a/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs b/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs index 92b50d23f2..d1a9064332 100644 --- a/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs +++ b/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs @@ -28,6 +28,7 @@ module Ledger.Tx.CardanoAPI( , fromCardanoTxInWitness , fromCardanoTxOut , fromCardanoTxOutDatum + , fromCardanoAddressInEra , fromCardanoAddress , fromCardanoMintValue , fromCardanoValue @@ -51,7 +52,7 @@ module Ledger.Tx.CardanoAPI( , toCardanoTxOutUnsafe , toCardanoTxOutDatumHash , toCardanoTxOutValue - , toCardanoAddress + , toCardanoAddressInEra , toCardanoMintValue , toCardanoValue , toCardanoFee @@ -475,7 +476,7 @@ toCardanoMintWitness redeemers idx (P.MintingPolicy script) = do fromCardanoTxOut :: C.TxOut C.CtxTx era -> Either FromCardanoError P.TxOut fromCardanoTxOut (C.TxOut addr value datum) = P.TxOut - <$> fromCardanoAddress addr + <$> fromCardanoAddressInEra addr <*> pure (fromCardanoTxOutValue value) <*> pure (fromCardanoTxOutDatum datum) @@ -485,7 +486,7 @@ toCardanoTxOut -> P.TxOut -> Either ToCardanoError (C.TxOut ctx C.AlonzoEra) toCardanoTxOut networkId fromHash (P.TxOut addr value datumHash) = - C.TxOut <$> toCardanoAddress networkId addr + C.TxOut <$> toCardanoAddressInEra networkId addr <*> toCardanoTxOutValue value <*> fromHash datumHash @@ -495,7 +496,7 @@ toCardanoTxOutUnsafe -> P.TxOut -> Either ToCardanoError (C.TxOut ctx C.AlonzoEra) toCardanoTxOutUnsafe networkId fromHash (P.TxOut addr value datumHash) = - C.TxOut <$> toCardanoAddress networkId addr + C.TxOut <$> toCardanoAddressInEra networkId addr <*> toCardanoTxOutValueUnsafe value <*> fromHash datumHash @@ -505,8 +506,12 @@ lookupDatum datums datumHash = Just datum -> pure $ C.TxOutDatum C.ScriptDataInAlonzoEra (toCardanoScriptData $ P.getDatum datum) Nothing -> toCardanoTxOutDatumHash datumHash -fromCardanoAddress :: C.AddressInEra era -> Either FromCardanoError P.Address -fromCardanoAddress (C.AddressInEra C.ByronAddressInAnyEra (C.ByronAddress address)) = +fromCardanoAddressInEra :: C.AddressInEra era -> Either FromCardanoError P.Address +fromCardanoAddressInEra (C.AddressInEra C.ByronAddressInAnyEra address) = fromCardanoAddress address +fromCardanoAddressInEra (C.AddressInEra _ address) = fromCardanoAddress address + +fromCardanoAddress :: C.Address addrtype -> Either FromCardanoError P.Address +fromCardanoAddress (C.ByronAddress address) = Right $ P.Address plutusCredential Nothing where plutusCredential :: Credential.Credential @@ -515,13 +520,12 @@ fromCardanoAddress (C.AddressInEra C.ByronAddressInAnyEra (C.ByronAddress addres $ P.PubKeyHash $ PlutusTx.toBuiltin $ addrToBase58 address - -fromCardanoAddress (C.AddressInEra _ (C.ShelleyAddress _ paymentCredential stakeAddressReference)) = +fromCardanoAddress (C.ShelleyAddress _ paymentCredential stakeAddressReference) = P.Address (fromCardanoPaymentCredential (C.fromShelleyPaymentCredential paymentCredential)) <$> fromCardanoStakeAddressReference (C.fromShelleyStakeReference stakeAddressReference) -toCardanoAddress :: C.NetworkId -> P.Address -> Either ToCardanoError (C.AddressInEra C.AlonzoEra) -toCardanoAddress networkId (P.Address addressCredential addressStakingCredential) = +toCardanoAddressInEra :: C.NetworkId -> P.Address -> Either ToCardanoError (C.AddressInEra C.AlonzoEra) +toCardanoAddressInEra networkId (P.Address addressCredential addressStakingCredential) = C.AddressInEra (C.ShelleyAddressInEra C.ShelleyBasedEraAlonzo) <$> (C.makeShelleyAddress networkId <$> toCardanoPaymentCredential addressCredential diff --git a/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs b/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs index 1a40deca50..6daf0e5d4e 100644 --- a/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs +++ b/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs @@ -9,19 +9,19 @@ import Cardano.Api (AsType (AsPaymentKey, AsStakeKey), Key (verificationKeyHash) StakeAddressReference (NoStakeAddress, StakeAddressByValue), StakeCredential, makeShelleyAddress, shelleyAddressInEra) import Cardano.Api.Shelley (StakeCredential (StakeCredentialByKey), TxBody (ShelleyTxBody)) -import Data.Default (def) -import Data.Map qualified as Map -import Data.Set qualified as Set +import Gen.Cardano.Api.Typed qualified as Gen import Ledger.Test (someValidator) import Ledger.Tx (RedeemerPtr (RedeemerPtr), ScriptTag (Mint), Tx (txMint, txMintScripts, txRedeemers)) -import Ledger.Tx.CardanoAPI (fromCardanoAddress, makeTransactionBody, toCardanoAddress) +import Ledger.Tx.CardanoAPI (fromCardanoAddressInEra, makeTransactionBody, toCardanoAddressInEra) import Ledger.Validation (fromPlutusTxToTxBodyContent) import Ledger.Value qualified as Value import Plutus.Script.Utils.V1.Scripts (mintingPolicyHash, validatorHash) import Plutus.Script.Utils.V1.Typed.Scripts.MonetaryPolicies qualified as MPS import Plutus.V1.Ledger.Scripts (unitRedeemer) -import Gen.Cardano.Api.Typed qualified as Gen +import Data.Default (def) +import Data.Map qualified as Map +import Data.Set qualified as Set import Hedgehog (Gen, Property, forAll, property, (===)) import Hedgehog qualified import Hedgehog.Gen qualified as Gen @@ -43,10 +43,10 @@ addressRoundTripSpec = property $ do shelleyAddr <- shelleyAddressInEra <$> forAll (makeShelleyAddress networkId <$> genPaymentCredential <*> genStakeAddressReference) - case fromCardanoAddress shelleyAddr of + case fromCardanoAddressInEra shelleyAddr of Left _ -> Hedgehog.assert False Right plutusAddr -> - case toCardanoAddress networkId plutusAddr of + case toCardanoAddressInEra networkId plutusAddr of Left _ -> Hedgehog.assert False Right cAddr -> cAddr === shelleyAddr diff --git a/plutus-pab-executables/demo/pab-nami/client/generated/Cardano/Wallet/Mock/Types.purs b/plutus-pab-executables/demo/pab-nami/client/generated/Cardano/Wallet/Mock/Types.purs index a8df5f5659..87b26c0a26 100644 --- a/plutus-pab-executables/demo/pab-nami/client/generated/Cardano/Wallet/Mock/Types.purs +++ b/plutus-pab-executables/demo/pab-nami/client/generated/Cardano/Wallet/Mock/Types.purs @@ -13,11 +13,13 @@ import Data.Generic.Rep (class Generic) import Data.Lens (Iso', Lens', Prism', iso, prism') import Data.Lens.Iso.Newtype (_Newtype) import Data.Lens.Record (prop) +import Data.List.Types (NonEmptyList) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype, unwrap) import Data.Show.Generic (genericShow) import Data.Tuple.Nested ((/\)) import Ledger.Address (PaymentPubKeyHash) +import Plutus.V1.Ledger.Address (Address) import Type.Proxy (Proxy(Proxy)) import Wallet.Emulator.Wallet (Wallet) import Data.Argonaut.Decode.Aeson as D @@ -27,6 +29,7 @@ import Data.Map as Map newtype WalletInfo = WalletInfo { wiWallet :: Wallet , wiPaymentPubKeyHash :: PaymentPubKeyHash + , wiAddresses :: NonEmptyList Address } instance Show WalletInfo where @@ -37,6 +40,7 @@ instance EncodeJson WalletInfo where ( E.record { wiWallet: E.value :: _ Wallet , wiPaymentPubKeyHash: E.value :: _ PaymentPubKeyHash + , wiAddresses: E.value :: _ (NonEmptyList Address) } ) @@ -45,6 +49,7 @@ instance DecodeJson WalletInfo where ( WalletInfo <$> D.record "WalletInfo" { wiWallet: D.value :: _ Wallet , wiPaymentPubKeyHash: D.value :: _ PaymentPubKeyHash + , wiAddresses: D.value :: _ (NonEmptyList Address) } ) @@ -54,5 +59,5 @@ derive instance Newtype WalletInfo _ -------------------------------------------------------------------------------- -_WalletInfo :: Iso' WalletInfo { wiWallet :: Wallet, wiPaymentPubKeyHash :: PaymentPubKeyHash } +_WalletInfo :: Iso' WalletInfo { wiWallet :: Wallet, wiPaymentPubKeyHash :: PaymentPubKeyHash, wiAddresses :: NonEmptyList Address } _WalletInfo = _Newtype diff --git a/plutus-pab-executables/demo/pab-nami/client/generated/Plutus/Contract/Effects.purs b/plutus-pab-executables/demo/pab-nami/client/generated/Plutus/Contract/Effects.purs index 74a53785a0..086de298fb 100644 --- a/plutus-pab-executables/demo/pab-nami/client/generated/Plutus/Contract/Effects.purs +++ b/plutus-pab-executables/demo/pab-nami/client/generated/Plutus/Contract/Effects.purs @@ -21,7 +21,6 @@ import Data.Newtype (class Newtype, unwrap) import Data.RawJson (RawJson) import Data.Show.Generic (genericShow) import Data.Tuple.Nested ((/\)) -import Ledger.Address (PaymentPubKeyHash) import Ledger.Constraints.OffChain (UnbalancedTx) import Ledger.TimeSlot (SlotConversionError) import Ledger.Tx (CardanoTx, ChainIndexTxOut) @@ -398,7 +397,7 @@ data PABReq | CurrentSlotReq | CurrentTimeReq | OwnContractInstanceIdReq - | OwnPaymentPublicKeyHashReq + | OwnAddressesReq | ChainIndexQueryReq ChainIndexQuery | BalanceTxReq UnbalancedTx | WriteBalancedTxReq CardanoTx @@ -423,7 +422,7 @@ instance EncodeJson PABReq where CurrentSlotReq -> encodeJson { tag: "CurrentSlotReq", contents: jsonNull } CurrentTimeReq -> encodeJson { tag: "CurrentTimeReq", contents: jsonNull } OwnContractInstanceIdReq -> encodeJson { tag: "OwnContractInstanceIdReq", contents: jsonNull } - OwnPaymentPublicKeyHashReq -> encodeJson { tag: "OwnPaymentPublicKeyHashReq", contents: jsonNull } + OwnAddressesReq -> encodeJson { tag: "OwnAddressesReq", contents: jsonNull } ChainIndexQueryReq a -> E.encodeTagged "ChainIndexQueryReq" a E.value BalanceTxReq a -> E.encodeTagged "BalanceTxReq" a E.value WriteBalancedTxReq a -> E.encodeTagged "WriteBalancedTxReq" a E.value @@ -445,7 +444,7 @@ instance DecodeJson PABReq where , "CurrentSlotReq" /\ pure CurrentSlotReq , "CurrentTimeReq" /\ pure CurrentTimeReq , "OwnContractInstanceIdReq" /\ pure OwnContractInstanceIdReq - , "OwnPaymentPublicKeyHashReq" /\ pure OwnPaymentPublicKeyHashReq + , "OwnAddressesReq" /\ pure OwnAddressesReq , "ChainIndexQueryReq" /\ D.content (ChainIndexQueryReq <$> D.value) , "BalanceTxReq" /\ D.content (BalanceTxReq <$> D.value) , "WriteBalancedTxReq" /\ D.content (WriteBalancedTxReq <$> D.value) @@ -508,9 +507,9 @@ _OwnContractInstanceIdReq = prism' (const OwnContractInstanceIdReq) case _ of OwnContractInstanceIdReq -> Just unit _ -> Nothing -_OwnPaymentPublicKeyHashReq :: Prism' PABReq Unit -_OwnPaymentPublicKeyHashReq = prism' (const OwnPaymentPublicKeyHashReq) case _ of - OwnPaymentPublicKeyHashReq -> Just unit +_OwnAddressesReq :: Prism' PABReq Unit +_OwnAddressesReq = prism' (const OwnAddressesReq) case _ of + OwnAddressesReq -> Just unit _ -> Nothing _ChainIndexQueryReq :: Prism' PABReq ChainIndexQuery @@ -556,7 +555,7 @@ data PABResp | CurrentSlotResp Slot | CurrentTimeResp POSIXTime | OwnContractInstanceIdResp ContractInstanceId - | OwnPaymentPublicKeyHashResp PaymentPubKeyHash + | OwnAddressesResp (NonEmptyList Address) | ChainIndexQueryResp ChainIndexResponse | BalanceTxResp BalanceTxResponse | WriteBalancedTxResp WriteBalancedTxResponse @@ -581,7 +580,7 @@ instance EncodeJson PABResp where CurrentSlotResp a -> E.encodeTagged "CurrentSlotResp" a E.value CurrentTimeResp a -> E.encodeTagged "CurrentTimeResp" a E.value OwnContractInstanceIdResp a -> E.encodeTagged "OwnContractInstanceIdResp" a E.value - OwnPaymentPublicKeyHashResp a -> E.encodeTagged "OwnPaymentPublicKeyHashResp" a E.value + OwnAddressesResp a -> E.encodeTagged "OwnAddressesResp" a E.value ChainIndexQueryResp a -> E.encodeTagged "ChainIndexQueryResp" a E.value BalanceTxResp a -> E.encodeTagged "BalanceTxResp" a E.value WriteBalancedTxResp a -> E.encodeTagged "WriteBalancedTxResp" a E.value @@ -603,7 +602,7 @@ instance DecodeJson PABResp where , "CurrentSlotResp" /\ D.content (CurrentSlotResp <$> D.value) , "CurrentTimeResp" /\ D.content (CurrentTimeResp <$> D.value) , "OwnContractInstanceIdResp" /\ D.content (OwnContractInstanceIdResp <$> D.value) - , "OwnPaymentPublicKeyHashResp" /\ D.content (OwnPaymentPublicKeyHashResp <$> D.value) + , "OwnAddressesResp" /\ D.content (OwnAddressesResp <$> D.value) , "ChainIndexQueryResp" /\ D.content (ChainIndexQueryResp <$> D.value) , "BalanceTxResp" /\ D.content (BalanceTxResp <$> D.value) , "WriteBalancedTxResp" /\ D.content (WriteBalancedTxResp <$> D.value) @@ -666,9 +665,9 @@ _OwnContractInstanceIdResp = prism' OwnContractInstanceIdResp case _ of (OwnContractInstanceIdResp a) -> Just a _ -> Nothing -_OwnPaymentPublicKeyHashResp :: Prism' PABResp PaymentPubKeyHash -_OwnPaymentPublicKeyHashResp = prism' OwnPaymentPublicKeyHashResp case _ of - (OwnPaymentPublicKeyHashResp a) -> Just a +_OwnAddressesResp :: Prism' PABResp (NonEmptyList Address) +_OwnAddressesResp = prism' OwnAddressesResp case _ of + (OwnAddressesResp a) -> Just a _ -> Nothing _ChainIndexQueryResp :: Prism' PABResp ChainIndexResponse diff --git a/plutus-pab-executables/demo/pab-nami/client/generated/Wallet/Emulator/Error.purs b/plutus-pab-executables/demo/pab-nami/client/generated/Wallet/Emulator/Error.purs index fef5b4f78b..598dc6dff1 100644 --- a/plutus-pab-executables/demo/pab-nami/client/generated/Wallet/Emulator/Error.purs +++ b/plutus-pab-executables/demo/pab-nami/client/generated/Wallet/Emulator/Error.purs @@ -31,6 +31,7 @@ import Data.Map as Map data WalletAPIError = InsufficientFunds String | ChangeHasLessThanNAda Value Ada + | NoPaymentPubKeyHashError | PaymentPrivateKeyNotFound PaymentPubKeyHash | ValidationError ValidationError | ToCardanoError ToCardanoError @@ -47,6 +48,7 @@ instance EncodeJson WalletAPIError where encodeJson = defer \_ -> case _ of InsufficientFunds a -> E.encodeTagged "InsufficientFunds" a E.value ChangeHasLessThanNAda a b -> E.encodeTagged "ChangeHasLessThanNAda" (a /\ b) (E.tuple (E.value >/\< E.value)) + NoPaymentPubKeyHashError -> encodeJson { tag: "NoPaymentPubKeyHashError", contents: jsonNull } PaymentPrivateKeyNotFound a -> E.encodeTagged "PaymentPrivateKeyNotFound" a E.value ValidationError a -> E.encodeTagged "ValidationError" a E.value ToCardanoError a -> E.encodeTagged "ToCardanoError" a E.value @@ -60,6 +62,7 @@ instance DecodeJson WalletAPIError where $ Map.fromFoldable [ "InsufficientFunds" /\ D.content (InsufficientFunds <$> D.value) , "ChangeHasLessThanNAda" /\ D.content (D.tuple $ ChangeHasLessThanNAda D.value D.value) + , "NoPaymentPubKeyHashError" /\ pure NoPaymentPubKeyHashError , "PaymentPrivateKeyNotFound" /\ D.content (PaymentPrivateKeyNotFound <$> D.value) , "ValidationError" /\ D.content (ValidationError <$> D.value) , "ToCardanoError" /\ D.content (ToCardanoError <$> D.value) @@ -82,6 +85,11 @@ _ChangeHasLessThanNAda = prism' (\{ a, b } -> (ChangeHasLessThanNAda a b)) case (ChangeHasLessThanNAda a b) -> Just { a, b } _ -> Nothing +_NoPaymentPubKeyHashError :: Prism' WalletAPIError Unit +_NoPaymentPubKeyHashError = prism' (const NoPaymentPubKeyHashError) case _ of + NoPaymentPubKeyHashError -> Just unit + _ -> Nothing + _PaymentPrivateKeyNotFound :: Prism' WalletAPIError PaymentPubKeyHash _PaymentPrivateKeyNotFound = prism' PaymentPrivateKeyNotFound case _ of (PaymentPrivateKeyNotFound a) -> Just a diff --git a/plutus-pab-executables/examples/ContractExample/AtomicSwap.hs b/plutus-pab-executables/examples/ContractExample/AtomicSwap.hs index b540fbc464..75d94a9eeb 100644 --- a/plutus-pab-executables/examples/ContractExample/AtomicSwap.hs +++ b/plutus-pab-executables/examples/ContractExample/AtomicSwap.hs @@ -17,17 +17,18 @@ module ContractExample.AtomicSwap( atomicSwap ) where -import Control.Lens +import Control.Lens (makeClassyPrisms) import Control.Monad (void) import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) -import Plutus.Contracts.Escrow (EscrowParams (..)) -import Plutus.Contracts.Escrow qualified as Escrow -import Schema (ToSchema) import Ledger (CurrencySymbol, POSIXTime, PaymentPubKeyHash, TokenName, Value) import Ledger.Value qualified as Value -import Plutus.Contract +import Plutus.Contract (AsContractError (_ContractError), ContractError, Endpoint, Promise, awaitTxConfirmed, endpoint, + mapError, ownFirstPaymentPubKeyHash, throwError) +import Plutus.Contracts.Escrow (EscrowParams (..)) +import Plutus.Contracts.Escrow qualified as Escrow +import Schema (ToSchema) import Wallet.Emulator.Wallet (Wallet, mockWalletPaymentPubKeyHash) -- | Describes an exchange of two @@ -99,5 +100,4 @@ atomicSwap = endpoint @"Atomic swap" $ \p -> do void $ mapError EscrowError (Escrow.pay (Escrow.typedValidator params) params value1) >>= awaitTxConfirmed | otherwise = throwError (NotInvolvedError pkh p) - ownPaymentPubKeyHash >>= go - + ownFirstPaymentPubKeyHash >>= go diff --git a/plutus-pab-executables/examples/ContractExample/IntegrationTest.hs b/plutus-pab-executables/examples/ContractExample/IntegrationTest.hs index 799fe26df7..244e04ec00 100644 --- a/plutus-pab-executables/examples/ContractExample/IntegrationTest.hs +++ b/plutus-pab-executables/examples/ContractExample/IntegrationTest.hs @@ -40,7 +40,7 @@ run = runError run' >>= \case run' :: Contract () EmptySchema IError () run' = do logInfo @Haskell.String "Starting integration test" - pkh <- ownPaymentPubKeyHash + pkh <- ownFirstPaymentPubKeyHash (txOutRef, ciTxOut, pkInst) <- mapError PKError (PubKey.pubKeyContract pkh (Ada.adaValueOf 10)) logInfo @Haskell.String "pubKey contract complete:" let lookups = diff --git a/plutus-pab-executables/plutus-pab-executables.cabal b/plutus-pab-executables/plutus-pab-executables.cabal index cd7fbf6e79..93d672c2a0 100644 --- a/plutus-pab-executables/plutus-pab-executables.cabal +++ b/plutus-pab-executables/plutus-pab-executables.cabal @@ -40,7 +40,7 @@ common lang ScopedTypeVariables StandaloneDeriving - -- See Plutus Tx readme for why we need the following flags: + -- See Plutus Tx readme for why we need the following flags: -- -fobject-code -fno-ignore-interface-pragmas and -fno-omit-interface-pragmas ghc-options: -Wall -Wnoncanonical-monad-instances -Wincomplete-uni-patterns @@ -121,6 +121,7 @@ executable plutus-pab-examples , playground-common , plutus-contract , plutus-ledger + , plutus-ledger-api , plutus-ledger-constraints , plutus-pab , plutus-pab-executables @@ -230,6 +231,7 @@ executable plutus-pab-test-psgenerator , playground-common , plutus-contract , plutus-ledger + , plutus-ledger-api , plutus-ledger-constraints , plutus-pab , plutus-use-cases @@ -276,6 +278,7 @@ test-suite plutus-pab-test-full , plutus-chain-index-core , plutus-contract , plutus-ledger + , plutus-ledger-api , plutus-ledger-constraints , plutus-pab , plutus-pab-executables @@ -330,6 +333,7 @@ test-suite plutus-pab-test-full-long-running , plutus-chain-index-core , plutus-contract , plutus-ledger + , plutus-ledger-api , plutus-ledger-constraints , plutus-pab , plutus-pab-executables diff --git a/plutus-pab-executables/test/full/Plutus/PAB/CoreSpec.hs b/plutus-pab-executables/test/full/Plutus/PAB/CoreSpec.hs index a2cc897691..9a89cd250b 100644 --- a/plutus-pab-executables/test/full/Plutus/PAB/CoreSpec.hs +++ b/plutus-pab-executables/test/full/Plutus/PAB/CoreSpec.hs @@ -36,6 +36,7 @@ import Control.Concurrent.STM qualified as STM import Data.Aeson.Types qualified as JSON import Data.Default (def) import Data.Either (isRight) +import Data.List.NonEmpty qualified as NonEmpty import Data.Map qualified as Map import Data.Maybe (isJust) import Data.Monoid qualified as M @@ -79,7 +80,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, ownPaymentPubKeyHash) +import Wallet.API (WalletAPIError, ownAddresses) import Wallet.API qualified as WAPI import Wallet.Emulator.Chain qualified as Chain import Wallet.Emulator.Wallet (Wallet, knownWallet, knownWallets) @@ -335,8 +336,7 @@ guessingGameTest = let openingBalance = 100_000_000_000 lockAmount = 15_000_000 pubKeyHashFundsChange cid msg delta = do - address <- pubKeyHashAddress <$> Simulator.handleAgentThread defaultWallet (Just cid) ownPaymentPubKeyHash - <*> pure Nothing + address <- NonEmpty.head <$> Simulator.handleAgentThread defaultWallet (Just cid) ownAddresses balance <- Simulator.valueAt address fees <- Simulator.walletFees defaultWallet assertEqual msg diff --git a/plutus-pab/src/Cardano/Wallet/LocalClient.hs b/plutus-pab/src/Cardano/Wallet/LocalClient.hs index f7e6036639..fbbdc99521 100644 --- a/plutus-pab/src/Cardano/Wallet/LocalClient.hs +++ b/plutus-pab/src/Cardano/Wallet/LocalClient.hs @@ -14,7 +14,7 @@ import Cardano.Api.Shelley qualified as Cardano.Api import Cardano.Node.Types (PABServerConfig (pscPassphrase)) import Cardano.Wallet.Api qualified as C import Cardano.Wallet.Api.Client qualified as C -import Cardano.Wallet.Api.Types (ApiVerificationKeyShelley (getApiVerificationKey), ApiWallet (assets, balance)) +import Cardano.Wallet.Api.Types (ApiWallet (assets, balance)) import Cardano.Wallet.Api.Types qualified as C import Cardano.Wallet.Primitive.AddressDerivation qualified as C import Cardano.Wallet.Primitive.Types qualified as C @@ -23,35 +23,42 @@ import Cardano.Wallet.Primitive.Types.TokenMap qualified as C import Cardano.Wallet.Primitive.Types.TokenPolicy qualified as C import Cardano.Wallet.Primitive.Types.TokenQuantity qualified as C import Cardano.Wallet.Primitive.Types.Tx qualified as C +import Cardano.Wallet.Shelley.Compatibility () +import Control.Monad ((>=>)) import Control.Monad.Freer (Eff, LastMember, Member, sendM, type (~>)) import Control.Monad.Freer.Error (Error, throwError) import Control.Monad.Freer.Extras.Log (LogMsg, logWarn) import Control.Monad.Freer.Reader (Reader, ask) import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson (toJSON) +import Data.Aeson qualified as Aeson +import Data.Aeson.Types (parseMaybe, (.:)) import Data.Bifunctor (bimap) import Data.Coerce (coerce) import Data.Foldable (toList) import Data.Functor (void) +import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty qualified as NonEmpty +import Data.Maybe (mapMaybe) import Data.Proxy (Proxy (Proxy)) import Data.Quantity (Quantity (Quantity)) -import Data.Text (pack) +import Data.Text (Text, pack) import Data.Text.Class (fromText) import Ledger (CardanoTx (..), Params (..)) -import Ledger qualified import Ledger.Ada qualified as Ada import Ledger.Constraints.OffChain (UnbalancedTx) -import Ledger.Tx.CardanoAPI (SomeCardanoApiTx (SomeTx), ToCardanoError, toCardanoTxBody) +import Ledger.Tx.CardanoAPI (SomeCardanoApiTx (SomeTx), ToCardanoError, fromCardanoAddress, 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.Api (Address) 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.API qualified as WAPI -import Wallet.Effects (WalletEffect (BalanceTx, OwnPaymentPubKeyHash, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx)) +import Wallet.Effects (WalletEffect (BalanceTx, OwnAddresses, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx)) import Wallet.Emulator.Error (WalletAPIError (OtherError, ToCardanoError)) import Wallet.Emulator.Wallet (Wallet (Wallet), WalletId (WalletId)) @@ -99,13 +106,22 @@ 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)) - ownPaymentPubKeyHashH :: Eff effs Ledger.PaymentPubKeyHash - ownPaymentPubKeyHashH = - fmap (Ledger.PaymentPubKeyHash . Ledger.PubKeyHash . BuiltinByteString . fst . getApiVerificationKey) . runClient $ - getWalletKey (C.ApiT walletId) - (C.ApiT C.UtxoExternal) - (C.ApiT (C.DerivationIndex 0)) - (Just True) + ownAddressesH :: Eff effs (NonEmpty Address) + ownAddressesH = do + addressValues <- runClient $ C.listAddresses C.addressClient (C.ApiT walletId) Nothing + pure $ NonEmpty.fromList $ mapMaybe (decodeApiAddress >=> fromApiAddress) addressValues + where + decodeApiAddress :: Aeson.Value -> Maybe Text + decodeApiAddress v = parseMaybe (Aeson.withObject "ApiAddress" (\o -> o .: "id")) v + + fromApiAddress :: Text -> Maybe Address + fromApiAddress addrBech32 = do + case Cardano.Api.deserialiseFromBech32 (Cardano.Api.AsAddress Cardano.Api.AsShelleyAddr) addrBech32 of + Left _ -> Nothing + Right addrCApi -> do + case fromCardanoAddress addrCApi of + Left _ -> Nothing + Right addr -> Just addr balanceTxH :: UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx) balanceTxH utx = do @@ -145,7 +161,7 @@ handleWalletClient config (Wallet _ (WalletId walletId)) event = do case event of SubmitTxn tx -> submitTxnH tx - OwnPaymentPubKeyHash -> ownPaymentPubKeyHashH + OwnAddresses -> ownAddressesH 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 7bc70c8096..f6478ca3d8 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/API.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/API.hs @@ -6,9 +6,11 @@ module Cardano.Wallet.Mock.API ) where import Cardano.Wallet.Mock.Types (WalletInfo) -import Ledger (Value) +import Data.List.NonEmpty (NonEmpty) +import Ledger (PaymentPubKeyHash) import Ledger.Constraints.OffChain (UnbalancedTx) import Ledger.Tx (CardanoTx) +import Plutus.V1.Ledger.Api (Address, Value) import Servant.API (Capture, Get, JSON, NoContent, Post, QueryParam, ReqBody, (:<|>), (:>)) import Wallet.Emulator.Error (WalletAPIError) @@ -36,7 +38,9 @@ PSGenerator we specialise it to 'Text'. type API walletId -- see note [WalletID type in wallet API] = "create" :> QueryParam "funds" Integer :> Post '[JSON] WalletInfo :<|> Capture "walletId" walletId :> "submit-txn" :> ReqBody '[JSON] CardanoTx :> Post '[JSON] NoContent - :<|> Capture "walletId" walletId :> "own-payment-public-key" :> Get '[JSON] WalletInfo + -- TODO: Should we removed in favor of 'own-addresses'. However, how do we deprecate an HTTP request? + :<|> Capture "walletId" walletId :> "own-payment-public-key-hash" :> Get '[JSON] PaymentPubKeyHash + :<|> Capture "walletId" walletId :> "own-addresses" :> Get '[JSON] (NonEmpty Address) :<|> Capture "walletId" walletId :> "balance-tx" :> ReqBody '[JSON] UnbalancedTx :> Post '[JSON] (Either WalletAPIError CardanoTx) :<|> Capture "walletId" walletId :> "total-funds" :> Get '[JSON] Value :<|> Capture "walletId" walletId :> "sign" :> ReqBody '[JSON] CardanoTx :> Post '[JSON] CardanoTx diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Client.hs b/plutus-pab/src/Cardano/Wallet/Mock/Client.hs index 0757392073..545f7cf460 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Client.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Client.hs @@ -8,39 +8,46 @@ module Cardano.Wallet.Mock.Client where import Cardano.Wallet.Mock.API (API) -import Cardano.Wallet.Mock.Types (WalletInfo (wiPaymentPubKeyHash)) +import Cardano.Wallet.Mock.Types (WalletInfo) 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.List.NonEmpty (NonEmpty) import Data.Proxy (Proxy (Proxy)) -import Ledger (PaymentPubKeyHash, Value) +import Ledger (PaymentPubKeyHash) import Ledger.Constraints.OffChain (UnbalancedTx) import Ledger.Tx (CardanoTx) +import Plutus.V1.Ledger.Api (Address, Value) import Servant ((:<|>) ((:<|>))) import Servant.Client (ClientEnv, ClientError, ClientM, client, runClientM) -import Wallet.Effects (WalletEffect (BalanceTx, OwnPaymentPubKeyHash, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx)) +import Wallet.Effects (WalletEffect (BalanceTx, OwnAddresses, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx)) import Wallet.Emulator.Error (WalletAPIError) import Wallet.Emulator.Wallet (Wallet (Wallet, getWalletId), WalletId) +{-# DEPRECATED ownPaymentPubKeyHash "Use ownAddresses instead" #-} + createWallet :: Maybe Integer -> ClientM WalletInfo submitTxn :: Wallet -> CardanoTx -> ClientM () -ownPaymentPublicKey :: Wallet -> ClientM WalletInfo +ownPaymentPubKeyHash :: Wallet -> ClientM PaymentPubKeyHash +ownAddresses :: Wallet -> ClientM (NonEmpty Address) balanceTx :: Wallet -> UnbalancedTx -> ClientM (Either WalletAPIError CardanoTx) totalFunds :: Wallet -> ClientM Value sign :: Wallet -> CardanoTx -> ClientM CardanoTx -(createWallet, submitTxn, ownPaymentPublicKey, balanceTx, totalFunds, sign) = +(createWallet, submitTxn, ownPaymentPubKeyHash, ownAddresses, balanceTx, totalFunds, sign) = ( createWallet_ , \(Wallet _ wid) tx -> void (submitTxn_ wid tx) - , ownPaymentPublicKey_ . getWalletId + , ownPaymentPubKeyHash_ . getWalletId + , ownAddresses_ . getWalletId , balanceTx_ . getWalletId , totalFunds_ . getWalletId , sign_ . getWalletId) where ( createWallet_ :<|> (submitTxn_ - :<|> ownPaymentPublicKey_ + :<|> ownPaymentPubKeyHash_ + :<|> ownAddresses_ :<|> balanceTx_ :<|> totalFunds_ :<|> sign_)) = client (Proxy @(API WalletId)) @@ -65,8 +72,8 @@ handleWalletClient wallet event = do submitTxnH :: CardanoTx -> Eff effs () submitTxnH tx = runClient (submitTxn wallet tx) - ownPaymentPubKeyHashH :: Eff effs PaymentPubKeyHash - ownPaymentPubKeyHashH = wiPaymentPubKeyHash <$> runClient (ownPaymentPublicKey wallet) + ownAddressesH :: Eff effs (NonEmpty Address) + ownAddressesH = runClient (ownAddresses wallet) balanceTxH :: UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx) balanceTxH utx = runClient (balanceTx wallet utx) @@ -86,7 +93,7 @@ handleWalletClient wallet event = do case event of SubmitTxn tx -> submitTxnH tx - OwnPaymentPubKeyHash -> ownPaymentPubKeyHashH + OwnAddresses -> ownAddressesH 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 a552c44dea..8492d11b0e 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Handlers.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Handlers.hs @@ -43,6 +43,7 @@ import Data.ByteString.Lazy qualified as BSL import Data.ByteString.Lazy.Char8 qualified as BSL8 import Data.ByteString.Lazy.Char8 qualified as Char8 import Data.Function ((&)) +import Data.List.NonEmpty qualified as NonEmpty import Data.Map qualified as Map import Data.Text (Text, pack) import Data.Text.Encoding (encodeUtf8) @@ -134,6 +135,7 @@ handleMultiWallet params = \case let walletId = Wallet.WalletId . CWP.WalletId $ CW.mwWalletId mockWallet wallets' = Map.insert walletId (Wallet.fromMockWallet mockWallet) wallets pkh = CW.paymentPubKeyHash mockWallet + addr = CW.mockWalletAddress mockWallet put wallets' -- For some reason this doesn't work with (Wallet 1)/privateKey1, -- works just fine with (Wallet 2)/privateKey2 @@ -144,7 +146,11 @@ handleMultiWallet params = \case $ interpret (mapLog @RequestHandlerLogMsg @WalletMsg RequestHandling) $ interpret Wallet.handleWallet $ distributeNewWalletFunds params funds pkh - return $ WalletInfo{wiWallet = Wallet.toMockWallet mockWallet, wiPaymentPubKeyHash = pkh} + return $ WalletInfo + { wiWallet = Wallet.toMockWallet mockWallet + , wiPaymentPubKeyHash = pkh + , wiAddresses = NonEmpty.fromList [addr] + } GetWalletInfo wllt -> do wallets <- get @Wallets return $ fmap fromWalletState $ Map.lookup wllt wallets @@ -217,6 +223,8 @@ runWalletEffects trace txSendHandle chainSyncHandle chainIndexEnv wallets params fromWalletAPIError :: WalletAPIError -> ServerError fromWalletAPIError (InsufficientFunds text) = err401 {errBody = BSL.fromStrict $ encodeUtf8 text} +fromWalletAPIError e@NoPaymentPubKeyHashError = + err404 {errBody = BSL8.pack $ show e} fromWalletAPIError e@(PaymentPrivateKeyNotFound _) = err404 {errBody = BSL8.pack $ show e} fromWalletAPIError e@(ValidationError _) = diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Server.hs b/plutus-pab/src/Cardano/Wallet/Mock/Server.hs index ac374c13d4..52074a8019 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Server.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Server.hs @@ -18,8 +18,8 @@ import Cardano.Node.Types (ChainSyncHandle) import Cardano.Protocol.Socket.Mock.Client qualified as MockClient import Cardano.Wallet.Mock.API (API) import Cardano.Wallet.Mock.Handlers (processWalletEffects) -import Cardano.Wallet.Mock.Types (Port (Port), WalletMsg (StartingWallet), Wallets, createWallet, getWalletInfo, - multiWallet) +import Cardano.Wallet.Mock.Types (Port (Port), WalletInfo (wiAddresses, wiPaymentPubKeyHash), + WalletMsg (StartingWallet), Wallets, createWallet, getWalletInfo, multiWallet) import Cardano.Wallet.Types (LocalWalletSettings (LocalWalletSettings, baseUrl), WalletUrl (WalletUrl)) import Control.Concurrent.Availability (Availability, available) import Control.Concurrent.MVar (MVar, newMVar) @@ -58,7 +58,8 @@ app trace txSendHandle chainSyncHandle chainIndexEnv mVarState params = (processWalletEffects trace txSendHandle chainSyncHandle chainIndexEnv mVarState params) $ (\funds -> createWallet (Ada.lovelaceOf <$> funds)) :<|> (\w tx -> multiWallet (Wallet Nothing w) (submitTxn tx) >>= const (pure NoContent)) :<|> - (getWalletInfo >=> maybe (throwError err404) pure ) :<|> + (getWalletInfo >=> maybe (throwError err404) (pure . wiPaymentPubKeyHash) ) :<|> + (getWalletInfo >=> maybe (throwError err404) (pure . wiAddresses) ) :<|> (\w -> multiWallet (Wallet Nothing w) . balanceTx) :<|> (\w -> multiWallet (Wallet Nothing w) totalFunds) :<|> (\w tx -> multiWallet (Wallet Nothing w) (walletAddSignature tx)) diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Types.hs b/plutus-pab/src/Cardano/Wallet/Mock/Types.hs index e22eb87dda..4330fc2c62 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Types.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Types.hs @@ -43,6 +43,7 @@ import Control.Monad.Freer.Extras.Log (LogMsg) import Control.Monad.Freer.State (State) import Control.Monad.Freer.TH (makeEffect) import Data.Aeson (FromJSON, ToJSON) +import Data.List.NonEmpty as NonEmpty import Data.Map.Strict (Map) import Data.Text (Text) import GHC.Generics (Generic) @@ -51,6 +52,7 @@ import Ledger.Ada (Ada) import Plutus.ChainIndex (ChainIndexQueryEffect) import Plutus.PAB.Arbitrary () import Plutus.PAB.Types (PABError) +import Plutus.V1.Ledger.Api (Address) import Prettyprinter (Pretty (pretty), (<+>)) import Servant (ServerError) import Servant.Client (ClientError) @@ -58,14 +60,17 @@ import Servant.Client.Internal.HttpClient (ClientEnv) import Wallet.Effects (NodeClientEffect, WalletEffect) import Wallet.Emulator.Error (WalletAPIError) import Wallet.Emulator.LogMessages (RequestHandlerLogMsg, TxBalanceMsg) -import Wallet.Emulator.Wallet (Wallet, WalletId, WalletState (WalletState, _mockWallet), mockWalletPaymentPubKeyHash, - toMockWallet) +import Wallet.Emulator.Wallet (Wallet, WalletId, WalletState (WalletState, _mockWallet), mockWalletAddress, + mockWalletPaymentPubKeyHash, toMockWallet) -- | Information about an emulated wallet. data WalletInfo = WalletInfo { wiWallet :: Wallet - , wiPaymentPubKeyHash :: PaymentPubKeyHash -- ^ Hash of the wallet's public key, serving as wallet ID + , wiPaymentPubKeyHash :: PaymentPubKeyHash + -- ^ Hash of the wallet's public key, serving as wallet ID. + -- TODO Remove eventually as it is replaced by 'wiAddresses'. + , wiAddresses :: NonEmpty Address -- ^ Wallet's addresses } deriving stock (Show, Generic) deriving anyclass (ToJSON, FromJSON) @@ -73,9 +78,11 @@ data WalletInfo = type Wallets = Map WalletId WalletState fromWalletState :: WalletState -> WalletInfo -fromWalletState WalletState{_mockWallet} = WalletInfo{wiWallet, wiPaymentPubKeyHash} where +fromWalletState WalletState{_mockWallet} = WalletInfo{wiWallet, wiPaymentPubKeyHash, wiAddresses} + where wiWallet = toMockWallet _mockWallet wiPaymentPubKeyHash = mockWalletPaymentPubKeyHash wiWallet + wiAddresses = NonEmpty.fromList [mockWalletAddress wiWallet] data MultiWalletEffect r where CreateWallet :: Maybe Ada -> MultiWalletEffect WalletInfo diff --git a/plutus-pab/src/Cardano/Wallet/RemoteClient.hs b/plutus-pab/src/Cardano/Wallet/RemoteClient.hs index 0f22f9c6a0..5c6b363c34 100644 --- a/plutus-pab/src/Cardano/Wallet/RemoteClient.hs +++ b/plutus-pab/src/Cardano/Wallet/RemoteClient.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} @@ -21,7 +20,7 @@ import Plutus.Contract.Wallet (export) import Plutus.PAB.Core.ContractInstance.STM (InstancesState) import Plutus.PAB.Core.ContractInstance.STM qualified as Instances import Wallet.API qualified as WAPI -import Wallet.Effects (WalletEffect (BalanceTx, OwnPaymentPubKeyHash, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx)) +import Wallet.Effects (WalletEffect (BalanceTx, OwnAddresses, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx)) import Wallet.Error (WalletAPIError (RemoteClientFunctionNotYetSupported), throwOtherError) import Wallet.Types (ContractInstanceId) @@ -44,8 +43,8 @@ handleWalletClient ~> Eff effs handleWalletClient cidM event = case event of - OwnPaymentPubKeyHash -> do - throwError $ RemoteClientFunctionNotYetSupported "Cardano.Wallet.RemoteClient.OwnPaymentPubKeyHash" + OwnAddresses -> do + throwError $ RemoteClientFunctionNotYetSupported "Cardano.Wallet.RemoteClient.OwnAddresses" 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 823a1296af..0d7d963869 100644 --- a/plutus-pab/src/Plutus/PAB/Arbitrary.hs +++ b/plutus-pab/src/Plutus/PAB/Arbitrary.hs @@ -264,7 +264,7 @@ instance Arbitrary PABReq where , pure CurrentSlotReq , pure OwnContractInstanceIdReq , ExposeEndpointReq <$> arbitrary - , pure OwnPaymentPublicKeyHashReq + , pure OwnAddressesReq -- TODO This would need an Arbitrary Tx instance: -- , BalanceTxRequest <$> arbitrary -- , WriteBalancedTxRequest <$> arbitrary @@ -299,7 +299,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 OwnPaymentPublicKeyHashReq = Just $ OwnPaymentPublicKeyHashResp <$> arbitrary -genResponse _ = Nothing +genResponse (AwaitSlotReq slot) = Just . pure . AwaitSlotResp $ slot +genResponse (ExposeEndpointReq _) = Just $ ExposeEndpointResp <$> arbitrary <*> (EndpointValue <$> arbitrary) +genResponse OwnAddressesReq = Just $ OwnAddressesResp <$> arbitrary +genResponse _ = Nothing diff --git a/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs b/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs index 38dfd96b41..19ddd8efcc 100644 --- a/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs +++ b/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs @@ -263,7 +263,7 @@ stmRequestHandler = fmap sequence (wrapHandler (fmap pure nonBlockingRequests) < -- requests that can be handled by 'WalletEffect', 'ChainIndexQueryEffect', etc. nonBlockingRequests = - RequestHandler.handleOwnPaymentPubKeyHashQueries @effs + RequestHandler.handleOwnAddressesQueries @effs <> RequestHandler.handleChainIndexQueries @effs <> RequestHandler.handleUnbalancedTransactions @effs <> RequestHandler.handlePendingTransactions @effs diff --git a/plutus-playground-client/generated/Playground/Usecases.purs b/plutus-playground-client/generated/Playground/Usecases.purs index 92199ce361..acf0f07fd2 100644 --- a/plutus-playground-client/generated/Playground/Usecases.purs +++ b/plutus-playground-client/generated/Playground/Usecases.purs @@ -542,7 +542,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 <- ownPaymentPubKeyHash + contributor <- ownFirstPaymentPubKeyHash let inst = typedValidator cmp tx = Constraints.mustPayToTheScript contributor contribValue <> Constraints.mustValidateIn (Interval.to (campaignDeadline cmp)) @@ -1732,7 +1732,7 @@ contractDemos = ] } }, - "contractDemoEditorContents": "-- Crowdfunding contract implemented using the [[Plutus]] interface.\n-- This is the fully parallel version that collects all contributions\n-- in a single transaction.\n--\n-- Note [Transactions in the crowdfunding campaign] explains the structure of\n-- this contract on the blockchain.\n\nimport Control.Applicative (Applicative (pure))\nimport Control.Monad (void)\nimport Data.Default (Default (def))\nimport Data.Text (Text)\nimport Ledger (POSIXTime, POSIXTimeRange, PaymentPubKeyHash (unPaymentPubKeyHash), ScriptContext (..), TxInfo (..),\n getCardanoTxId)\nimport Ledger qualified\nimport Ledger.Interval qualified as Interval\nimport Ledger.TimeSlot qualified as TimeSlot\nimport Ledger.Typed.Scripts qualified as Scripts hiding (validatorHash)\nimport Ledger.Value (Value)\nimport Playground.Contract\nimport Plutus.Contract\nimport Plutus.Contract.Constraints qualified as Constraints\nimport Plutus.Contract.Typed.Tx qualified as Typed\nimport Plutus.Script.Utils.V1.Scripts qualified as Scripts\nimport Plutus.V1.Ledger.Api (Validator)\nimport Plutus.V1.Ledger.Contexts qualified as V\nimport PlutusTx qualified\nimport PlutusTx.Prelude hiding (Applicative (..), Semigroup (..))\nimport Prelude (Semigroup (..))\nimport Prelude qualified as Haskell\nimport Wallet.Emulator qualified as Emulator\n\n-- | A crowdfunding campaign.\ndata Campaign = Campaign\n { campaignDeadline :: POSIXTime\n -- ^ The date by which the campaign funds can be contributed.\n , campaignCollectionDeadline :: POSIXTime\n -- ^ The date by which the campaign owner has to collect the funds\n , campaignOwner :: PaymentPubKeyHash\n -- ^ Public key of the campaign owner. This key is entitled to retrieve the\n -- funds if the campaign is successful.\n } deriving (Generic, ToJSON, FromJSON, ToSchema)\n\nPlutusTx.makeLift ''Campaign\n\n-- | Action that can be taken by the participants in this contract. A value of\n-- `CampaignAction` is provided as the redeemer. The validator script then\n-- checks if the conditions for performing this action are met.\n--\ndata CampaignAction = Collect | Refund\n\nPlutusTx.unstableMakeIsData ''CampaignAction\nPlutusTx.makeLift ''CampaignAction\n\ntype CrowdfundingSchema =\n Endpoint \"schedule collection\" ()\n .\\/ Endpoint \"contribute\" Contribution\n\nnewtype Contribution = Contribution\n { contribValue :: Value\n -- ^ how much to contribute\n } deriving stock (Haskell.Eq, Show, Generic)\n deriving anyclass (ToJSON, FromJSON, ToSchema, ToArgument)\n\n-- | Construct a 'Campaign' value from the campaign parameters,\n-- using the wallet's public key.\nmkCampaign :: POSIXTime -> POSIXTime -> Wallet -> Campaign\nmkCampaign ddl collectionDdl ownerWallet =\n Campaign\n { campaignDeadline = ddl\n , campaignCollectionDeadline = collectionDdl\n , campaignOwner = Emulator.mockWalletPaymentPubKeyHash ownerWallet\n }\n\n-- | The 'POSIXTimeRange' during which the funds can be collected\ncollectionRange :: Campaign -> POSIXTimeRange\ncollectionRange cmp =\n Interval.interval (campaignDeadline cmp) (campaignCollectionDeadline cmp - 1)\n\n-- | The 'POSIXTimeRange' during which a refund may be claimed\nrefundRange :: Campaign -> POSIXTimeRange\nrefundRange cmp =\n Interval.from (campaignCollectionDeadline cmp)\n\ndata Crowdfunding\ninstance Scripts.ValidatorTypes Crowdfunding where\n type instance RedeemerType Crowdfunding = CampaignAction\n type instance DatumType Crowdfunding = PaymentPubKeyHash\n\ntypedValidator :: Campaign -> Scripts.TypedValidator Crowdfunding\ntypedValidator = Scripts.mkTypedValidatorParam @Crowdfunding\n $$(PlutusTx.compile [|| mkValidator ||])\n $$(PlutusTx.compile [|| wrap ||])\n where\n wrap = Scripts.mkUntypedValidator\n\n{-# INLINABLE validRefund #-}\nvalidRefund :: Campaign -> PaymentPubKeyHash -> TxInfo -> Bool\nvalidRefund campaign contributor txinfo =\n -- Check that the transaction falls in the refund range of the campaign\n (refundRange campaign `Interval.contains` txInfoValidRange txinfo)\n -- Check that the transaction is signed by the contributor\n && (txinfo `V.txSignedBy` unPaymentPubKeyHash contributor)\n\nvalidCollection :: Campaign -> TxInfo -> Bool\nvalidCollection campaign txinfo =\n -- Check that the transaction falls in the collection range of the campaign\n (collectionRange campaign `Interval.contains` txInfoValidRange txinfo)\n -- Check that the transaction is signed by the campaign owner\n && (txinfo `V.txSignedBy` unPaymentPubKeyHash (campaignOwner campaign))\n\n-- | The validator script is of type 'CrowdfundingValidator', and is\n-- additionally parameterized by a 'Campaign' definition. This argument is\n-- provided by the Plutus client, using 'PlutusTx.applyCode'.\n-- As a result, the 'Campaign' definition is part of the script address,\n-- and different campaigns have different addresses.\nmkValidator :: Campaign -> PaymentPubKeyHash -> CampaignAction -> ScriptContext -> Bool\nmkValidator c con act p = case act of\n -- the \"refund\" branch\n Refund -> validRefund c con (scriptContextTxInfo p)\n -- the \"collection\" branch\n Collect -> validCollection c (scriptContextTxInfo p)\n\n-- | The validator script that determines whether the campaign owner can\n-- retrieve the funds or the contributors can claim a refund.\n--\ncontributionScript :: Campaign -> Validator\ncontributionScript = Scripts.validatorScript . typedValidator\n\n-- | The address of a [[Campaign]]\ncampaignAddress :: Campaign -> ValidatorHash\ncampaignAddress = Scripts.validatorHash . contributionScript\n\n-- | The crowdfunding contract for the 'Campaign'.\ncrowdfunding :: AsContractError e => Campaign -> Contract () CrowdfundingSchema e ()\ncrowdfunding c = selectList [contribute c, scheduleCollection c]\n\n-- | A sample campaign\ntheCampaign :: POSIXTime -> Campaign\ntheCampaign startTime = Campaign\n { campaignDeadline = startTime + 40000\n , campaignCollectionDeadline = startTime + 60000\n , campaignOwner = Emulator.mockWalletPaymentPubKeyHash (Emulator.knownWallet 1)\n }\n\n-- | The \"contribute\" branch of the contract for a specific 'Campaign'. Exposes\n-- an endpoint that allows the user to enter their public key and the\n-- contribution. Then waits until the campaign is over, and collects the\n-- refund if the funding was not collected.\ncontribute :: AsContractError e => Campaign -> Promise () CrowdfundingSchema e ()\ncontribute cmp = endpoint @\"contribute\" $ \\Contribution{contribValue} -> do\n contributor <- ownPaymentPubKeyHash\n let inst = typedValidator cmp\n tx = Constraints.mustPayToTheScript contributor contribValue\n <> Constraints.mustValidateIn (Interval.to (campaignDeadline cmp))\n txid <- fmap getCardanoTxId $ mkTxConstraints (Constraints.typedValidatorLookups inst) tx\n >>= adjustUnbalancedTx >>= submitUnbalancedTx\n\n utxo <- watchAddressUntilTime (Scripts.validatorAddress inst) (campaignCollectionDeadline cmp)\n\n -- 'utxo' is the set of unspent outputs at the campaign address at the\n -- collection deadline. If 'utxo' still contains our own contribution\n -- then we can claim a refund.\n\n let flt Ledger.TxOutRef{txOutRefId} _ = txid Haskell.== txOutRefId\n tx' = Typed.collectFromScriptFilter flt utxo Refund\n <> Constraints.mustValidateIn (refundRange cmp)\n <> Constraints.mustBeSignedBy contributor\n if Constraints.modifiesUtxoSet tx'\n then do\n logInfo @Text \"Claiming refund\"\n void $ mkTxConstraints (Constraints.typedValidatorLookups inst\n <> Constraints.unspentOutputs utxo) tx'\n >>= adjustUnbalancedTx >>= submitUnbalancedTx\n else pure ()\n\n-- | The campaign owner's branch of the contract for a given 'Campaign'. It\n-- watches the campaign address for contributions and collects them if\n-- the funding goal was reached in time.\nscheduleCollection :: AsContractError e => Campaign -> Promise () CrowdfundingSchema e ()\nscheduleCollection cmp =\n -- Expose an endpoint that lets the user fire the starting gun on the\n -- campaign. (This endpoint isn't technically necessary, we could just\n -- run the 'trg' action right away)\n endpoint @\"schedule collection\" $ \\() -> do\n let inst = typedValidator cmp\n\n _ <- awaitTime $ campaignDeadline cmp\n unspentOutputs <- utxosAt (Scripts.validatorAddress inst)\n\n let tx = Typed.collectFromScript unspentOutputs Collect\n <> Constraints.mustValidateIn (collectionRange cmp)\n void $ submitTxConstraintsSpending inst unspentOutputs tx\n\n{- note [Transactions in the crowdfunding campaign]\n\nAssume there is a campaign `c :: Campaign` with two contributors\n(identified by public key `pc_1` and `pc_2`) and one campaign owner (pco).\nEach contributor creates a transaction, `t_1` and `t_2`, whose outputs are\nlocked by the scripts `contributionScript c pc_1` and `contributionScript\nc pc_1` respectively.\n\nThere are two outcomes for the campaign.\n\n1. Campaign owner collects the funds from both contributors. In this case\n the owner creates a single transaction with two inputs, referring to\n `t_1` and `t_2`. Each input contains the script `contributionScript c`\n specialised to a contributor. The redeemer script of this transaction\n contains the value `Collect`, prompting the validator script to check the\n branch for `Collect`.\n\n2. Refund. In this case each contributor creates a transaction with a\n single input claiming back their part of the funds. This case is\n covered by the `Refund` branch, and its redeemer script is the\n `Refund` action.\n\nIn both cases, the validator script is run twice. In the first case\nthere is a single transaction consuming both inputs. In the second case there\nare two different transactions that may happen at different times.\n\n-}\n\n{- note [PendingTx]\n\nThis part of the API (the PendingTx argument) is experimental and subject\nto change.\n\n-}\n\nendpoints :: AsContractError e => Contract () CrowdfundingSchema e ()\nendpoints = crowdfunding (theCampaign $ TimeSlot.scSlotZeroTime def)\n\nmkSchemaDefinitions ''CrowdfundingSchema\n\n$(mkKnownCurrencies [])\n", + "contractDemoEditorContents": "-- Crowdfunding contract implemented using the [[Plutus]] interface.\n-- This is the fully parallel version that collects all contributions\n-- in a single transaction.\n--\n-- Note [Transactions in the crowdfunding campaign] explains the structure of\n-- this contract on the blockchain.\n\nimport Control.Applicative (Applicative (pure))\nimport Control.Monad (void)\nimport Data.Default (Default (def))\nimport Data.Text (Text)\nimport Ledger (POSIXTime, POSIXTimeRange, PaymentPubKeyHash (unPaymentPubKeyHash), ScriptContext (..), TxInfo (..),\n getCardanoTxId)\nimport Ledger qualified\nimport Ledger.Interval qualified as Interval\nimport Ledger.TimeSlot qualified as TimeSlot\nimport Ledger.Typed.Scripts qualified as Scripts hiding (validatorHash)\nimport Ledger.Value (Value)\nimport Playground.Contract\nimport Plutus.Contract\nimport Plutus.Contract.Constraints qualified as Constraints\nimport Plutus.Contract.Typed.Tx qualified as Typed\nimport Plutus.Script.Utils.V1.Scripts qualified as Scripts\nimport Plutus.V1.Ledger.Api (Validator)\nimport Plutus.V1.Ledger.Contexts qualified as V\nimport PlutusTx qualified\nimport PlutusTx.Prelude hiding (Applicative (..), Semigroup (..))\nimport Prelude (Semigroup (..))\nimport Prelude qualified as Haskell\nimport Wallet.Emulator qualified as Emulator\n\n-- | A crowdfunding campaign.\ndata Campaign = Campaign\n { campaignDeadline :: POSIXTime\n -- ^ The date by which the campaign funds can be contributed.\n , campaignCollectionDeadline :: POSIXTime\n -- ^ The date by which the campaign owner has to collect the funds\n , campaignOwner :: PaymentPubKeyHash\n -- ^ Public key of the campaign owner. This key is entitled to retrieve the\n -- funds if the campaign is successful.\n } deriving (Generic, ToJSON, FromJSON, ToSchema)\n\nPlutusTx.makeLift ''Campaign\n\n-- | Action that can be taken by the participants in this contract. A value of\n-- `CampaignAction` is provided as the redeemer. The validator script then\n-- checks if the conditions for performing this action are met.\n--\ndata CampaignAction = Collect | Refund\n\nPlutusTx.unstableMakeIsData ''CampaignAction\nPlutusTx.makeLift ''CampaignAction\n\ntype CrowdfundingSchema =\n Endpoint \"schedule collection\" ()\n .\\/ Endpoint \"contribute\" Contribution\n\nnewtype Contribution = Contribution\n { contribValue :: Value\n -- ^ how much to contribute\n } deriving stock (Haskell.Eq, Show, Generic)\n deriving anyclass (ToJSON, FromJSON, ToSchema, ToArgument)\n\n-- | Construct a 'Campaign' value from the campaign parameters,\n-- using the wallet's public key.\nmkCampaign :: POSIXTime -> POSIXTime -> Wallet -> Campaign\nmkCampaign ddl collectionDdl ownerWallet =\n Campaign\n { campaignDeadline = ddl\n , campaignCollectionDeadline = collectionDdl\n , campaignOwner = Emulator.mockWalletPaymentPubKeyHash ownerWallet\n }\n\n-- | The 'POSIXTimeRange' during which the funds can be collected\ncollectionRange :: Campaign -> POSIXTimeRange\ncollectionRange cmp =\n Interval.interval (campaignDeadline cmp) (campaignCollectionDeadline cmp - 1)\n\n-- | The 'POSIXTimeRange' during which a refund may be claimed\nrefundRange :: Campaign -> POSIXTimeRange\nrefundRange cmp =\n Interval.from (campaignCollectionDeadline cmp)\n\ndata Crowdfunding\ninstance Scripts.ValidatorTypes Crowdfunding where\n type instance RedeemerType Crowdfunding = CampaignAction\n type instance DatumType Crowdfunding = PaymentPubKeyHash\n\ntypedValidator :: Campaign -> Scripts.TypedValidator Crowdfunding\ntypedValidator = Scripts.mkTypedValidatorParam @Crowdfunding\n $$(PlutusTx.compile [|| mkValidator ||])\n $$(PlutusTx.compile [|| wrap ||])\n where\n wrap = Scripts.mkUntypedValidator\n\n{-# INLINABLE validRefund #-}\nvalidRefund :: Campaign -> PaymentPubKeyHash -> TxInfo -> Bool\nvalidRefund campaign contributor txinfo =\n -- Check that the transaction falls in the refund range of the campaign\n (refundRange campaign `Interval.contains` txInfoValidRange txinfo)\n -- Check that the transaction is signed by the contributor\n && (txinfo `V.txSignedBy` unPaymentPubKeyHash contributor)\n\nvalidCollection :: Campaign -> TxInfo -> Bool\nvalidCollection campaign txinfo =\n -- Check that the transaction falls in the collection range of the campaign\n (collectionRange campaign `Interval.contains` txInfoValidRange txinfo)\n -- Check that the transaction is signed by the campaign owner\n && (txinfo `V.txSignedBy` unPaymentPubKeyHash (campaignOwner campaign))\n\n-- | The validator script is of type 'CrowdfundingValidator', and is\n-- additionally parameterized by a 'Campaign' definition. This argument is\n-- provided by the Plutus client, using 'PlutusTx.applyCode'.\n-- As a result, the 'Campaign' definition is part of the script address,\n-- and different campaigns have different addresses.\nmkValidator :: Campaign -> PaymentPubKeyHash -> CampaignAction -> ScriptContext -> Bool\nmkValidator c con act p = case act of\n -- the \"refund\" branch\n Refund -> validRefund c con (scriptContextTxInfo p)\n -- the \"collection\" branch\n Collect -> validCollection c (scriptContextTxInfo p)\n\n-- | The validator script that determines whether the campaign owner can\n-- retrieve the funds or the contributors can claim a refund.\n--\ncontributionScript :: Campaign -> Validator\ncontributionScript = Scripts.validatorScript . typedValidator\n\n-- | The address of a [[Campaign]]\ncampaignAddress :: Campaign -> ValidatorHash\ncampaignAddress = Scripts.validatorHash . contributionScript\n\n-- | The crowdfunding contract for the 'Campaign'.\ncrowdfunding :: AsContractError e => Campaign -> Contract () CrowdfundingSchema e ()\ncrowdfunding c = selectList [contribute c, scheduleCollection c]\n\n-- | A sample campaign\ntheCampaign :: POSIXTime -> Campaign\ntheCampaign startTime = Campaign\n { campaignDeadline = startTime + 40000\n , campaignCollectionDeadline = startTime + 60000\n , campaignOwner = Emulator.mockWalletPaymentPubKeyHash (Emulator.knownWallet 1)\n }\n\n-- | The \"contribute\" branch of the contract for a specific 'Campaign'. Exposes\n-- an endpoint that allows the user to enter their public key and the\n-- contribution. Then waits until the campaign is over, and collects the\n-- refund if the funding was not collected.\ncontribute :: AsContractError e => Campaign -> Promise () CrowdfundingSchema e ()\ncontribute cmp = endpoint @\"contribute\" $ \\Contribution{contribValue} -> do\n contributor <- ownFirstPaymentPubKeyHash\n let inst = typedValidator cmp\n tx = Constraints.mustPayToTheScript contributor contribValue\n <> Constraints.mustValidateIn (Interval.to (campaignDeadline cmp))\n txid <- fmap getCardanoTxId $ mkTxConstraints (Constraints.typedValidatorLookups inst) tx\n >>= adjustUnbalancedTx >>= submitUnbalancedTx\n\n utxo <- watchAddressUntilTime (Scripts.validatorAddress inst) (campaignCollectionDeadline cmp)\n\n -- 'utxo' is the set of unspent outputs at the campaign address at the\n -- collection deadline. If 'utxo' still contains our own contribution\n -- then we can claim a refund.\n\n let flt Ledger.TxOutRef{txOutRefId} _ = txid Haskell.== txOutRefId\n tx' = Typed.collectFromScriptFilter flt utxo Refund\n <> Constraints.mustValidateIn (refundRange cmp)\n <> Constraints.mustBeSignedBy contributor\n if Constraints.modifiesUtxoSet tx'\n then do\n logInfo @Text \"Claiming refund\"\n void $ mkTxConstraints (Constraints.typedValidatorLookups inst\n <> Constraints.unspentOutputs utxo) tx'\n >>= adjustUnbalancedTx >>= submitUnbalancedTx\n else pure ()\n\n-- | The campaign owner's branch of the contract for a given 'Campaign'. It\n-- watches the campaign address for contributions and collects them if\n-- the funding goal was reached in time.\nscheduleCollection :: AsContractError e => Campaign -> Promise () CrowdfundingSchema e ()\nscheduleCollection cmp =\n -- Expose an endpoint that lets the user fire the starting gun on the\n -- campaign. (This endpoint isn't technically necessary, we could just\n -- run the 'trg' action right away)\n endpoint @\"schedule collection\" $ \\() -> do\n let inst = typedValidator cmp\n\n _ <- awaitTime $ campaignDeadline cmp\n unspentOutputs <- utxosAt (Scripts.validatorAddress inst)\n\n let tx = Typed.collectFromScript unspentOutputs Collect\n <> Constraints.mustValidateIn (collectionRange cmp)\n void $ submitTxConstraintsSpending inst unspentOutputs tx\n\n{- note [Transactions in the crowdfunding campaign]\n\nAssume there is a campaign `c :: Campaign` with two contributors\n(identified by public key `pc_1` and `pc_2`) and one campaign owner (pco).\nEach contributor creates a transaction, `t_1` and `t_2`, whose outputs are\nlocked by the scripts `contributionScript c pc_1` and `contributionScript\nc pc_1` respectively.\n\nThere are two outcomes for the campaign.\n\n1. Campaign owner collects the funds from both contributors. In this case\n the owner creates a single transaction with two inputs, referring to\n `t_1` and `t_2`. Each input contains the script `contributionScript c`\n specialised to a contributor. The redeemer script of this transaction\n contains the value `Collect`, prompting the validator script to check the\n branch for `Collect`.\n\n2. Refund. In this case each contributor creates a transaction with a\n single input claiming back their part of the funds. This case is\n covered by the `Refund` branch, and its redeemer script is the\n `Refund` action.\n\nIn both cases, the validator script is run twice. In the first case\nthere is a single transaction consuming both inputs. In the second case there\nare two different transactions that may happen at different times.\n\n-}\n\n{- note [PendingTx]\n\nThis part of the API (the PendingTx argument) is experimental and subject\nto change.\n\n-}\n\nendpoints :: AsContractError e => Contract () CrowdfundingSchema e ()\nendpoints = crowdfunding (theCampaign $ TimeSlot.scSlotZeroTime def)\n\nmkSchemaDefinitions ''CrowdfundingSchema\n\n$(mkKnownCurrencies [])\n", "contractDemoSimulations": [ { "simulationId": 1, diff --git a/plutus-playground-client/generated/Plutus/Contract/Effects.purs b/plutus-playground-client/generated/Plutus/Contract/Effects.purs index 74a53785a0..086de298fb 100644 --- a/plutus-playground-client/generated/Plutus/Contract/Effects.purs +++ b/plutus-playground-client/generated/Plutus/Contract/Effects.purs @@ -21,7 +21,6 @@ import Data.Newtype (class Newtype, unwrap) import Data.RawJson (RawJson) import Data.Show.Generic (genericShow) import Data.Tuple.Nested ((/\)) -import Ledger.Address (PaymentPubKeyHash) import Ledger.Constraints.OffChain (UnbalancedTx) import Ledger.TimeSlot (SlotConversionError) import Ledger.Tx (CardanoTx, ChainIndexTxOut) @@ -398,7 +397,7 @@ data PABReq | CurrentSlotReq | CurrentTimeReq | OwnContractInstanceIdReq - | OwnPaymentPublicKeyHashReq + | OwnAddressesReq | ChainIndexQueryReq ChainIndexQuery | BalanceTxReq UnbalancedTx | WriteBalancedTxReq CardanoTx @@ -423,7 +422,7 @@ instance EncodeJson PABReq where CurrentSlotReq -> encodeJson { tag: "CurrentSlotReq", contents: jsonNull } CurrentTimeReq -> encodeJson { tag: "CurrentTimeReq", contents: jsonNull } OwnContractInstanceIdReq -> encodeJson { tag: "OwnContractInstanceIdReq", contents: jsonNull } - OwnPaymentPublicKeyHashReq -> encodeJson { tag: "OwnPaymentPublicKeyHashReq", contents: jsonNull } + OwnAddressesReq -> encodeJson { tag: "OwnAddressesReq", contents: jsonNull } ChainIndexQueryReq a -> E.encodeTagged "ChainIndexQueryReq" a E.value BalanceTxReq a -> E.encodeTagged "BalanceTxReq" a E.value WriteBalancedTxReq a -> E.encodeTagged "WriteBalancedTxReq" a E.value @@ -445,7 +444,7 @@ instance DecodeJson PABReq where , "CurrentSlotReq" /\ pure CurrentSlotReq , "CurrentTimeReq" /\ pure CurrentTimeReq , "OwnContractInstanceIdReq" /\ pure OwnContractInstanceIdReq - , "OwnPaymentPublicKeyHashReq" /\ pure OwnPaymentPublicKeyHashReq + , "OwnAddressesReq" /\ pure OwnAddressesReq , "ChainIndexQueryReq" /\ D.content (ChainIndexQueryReq <$> D.value) , "BalanceTxReq" /\ D.content (BalanceTxReq <$> D.value) , "WriteBalancedTxReq" /\ D.content (WriteBalancedTxReq <$> D.value) @@ -508,9 +507,9 @@ _OwnContractInstanceIdReq = prism' (const OwnContractInstanceIdReq) case _ of OwnContractInstanceIdReq -> Just unit _ -> Nothing -_OwnPaymentPublicKeyHashReq :: Prism' PABReq Unit -_OwnPaymentPublicKeyHashReq = prism' (const OwnPaymentPublicKeyHashReq) case _ of - OwnPaymentPublicKeyHashReq -> Just unit +_OwnAddressesReq :: Prism' PABReq Unit +_OwnAddressesReq = prism' (const OwnAddressesReq) case _ of + OwnAddressesReq -> Just unit _ -> Nothing _ChainIndexQueryReq :: Prism' PABReq ChainIndexQuery @@ -556,7 +555,7 @@ data PABResp | CurrentSlotResp Slot | CurrentTimeResp POSIXTime | OwnContractInstanceIdResp ContractInstanceId - | OwnPaymentPublicKeyHashResp PaymentPubKeyHash + | OwnAddressesResp (NonEmptyList Address) | ChainIndexQueryResp ChainIndexResponse | BalanceTxResp BalanceTxResponse | WriteBalancedTxResp WriteBalancedTxResponse @@ -581,7 +580,7 @@ instance EncodeJson PABResp where CurrentSlotResp a -> E.encodeTagged "CurrentSlotResp" a E.value CurrentTimeResp a -> E.encodeTagged "CurrentTimeResp" a E.value OwnContractInstanceIdResp a -> E.encodeTagged "OwnContractInstanceIdResp" a E.value - OwnPaymentPublicKeyHashResp a -> E.encodeTagged "OwnPaymentPublicKeyHashResp" a E.value + OwnAddressesResp a -> E.encodeTagged "OwnAddressesResp" a E.value ChainIndexQueryResp a -> E.encodeTagged "ChainIndexQueryResp" a E.value BalanceTxResp a -> E.encodeTagged "BalanceTxResp" a E.value WriteBalancedTxResp a -> E.encodeTagged "WriteBalancedTxResp" a E.value @@ -603,7 +602,7 @@ instance DecodeJson PABResp where , "CurrentSlotResp" /\ D.content (CurrentSlotResp <$> D.value) , "CurrentTimeResp" /\ D.content (CurrentTimeResp <$> D.value) , "OwnContractInstanceIdResp" /\ D.content (OwnContractInstanceIdResp <$> D.value) - , "OwnPaymentPublicKeyHashResp" /\ D.content (OwnPaymentPublicKeyHashResp <$> D.value) + , "OwnAddressesResp" /\ D.content (OwnAddressesResp <$> D.value) , "ChainIndexQueryResp" /\ D.content (ChainIndexQueryResp <$> D.value) , "BalanceTxResp" /\ D.content (BalanceTxResp <$> D.value) , "WriteBalancedTxResp" /\ D.content (WriteBalancedTxResp <$> D.value) @@ -666,9 +665,9 @@ _OwnContractInstanceIdResp = prism' OwnContractInstanceIdResp case _ of (OwnContractInstanceIdResp a) -> Just a _ -> Nothing -_OwnPaymentPublicKeyHashResp :: Prism' PABResp PaymentPubKeyHash -_OwnPaymentPublicKeyHashResp = prism' OwnPaymentPublicKeyHashResp case _ of - (OwnPaymentPublicKeyHashResp a) -> Just a +_OwnAddressesResp :: Prism' PABResp (NonEmptyList Address) +_OwnAddressesResp = prism' OwnAddressesResp case _ of + (OwnAddressesResp a) -> Just a _ -> Nothing _ChainIndexQueryResp :: Prism' PABResp ChainIndexResponse diff --git a/plutus-playground-client/generated/Wallet/Emulator/Error.purs b/plutus-playground-client/generated/Wallet/Emulator/Error.purs index fef5b4f78b..598dc6dff1 100644 --- a/plutus-playground-client/generated/Wallet/Emulator/Error.purs +++ b/plutus-playground-client/generated/Wallet/Emulator/Error.purs @@ -31,6 +31,7 @@ import Data.Map as Map data WalletAPIError = InsufficientFunds String | ChangeHasLessThanNAda Value Ada + | NoPaymentPubKeyHashError | PaymentPrivateKeyNotFound PaymentPubKeyHash | ValidationError ValidationError | ToCardanoError ToCardanoError @@ -47,6 +48,7 @@ instance EncodeJson WalletAPIError where encodeJson = defer \_ -> case _ of InsufficientFunds a -> E.encodeTagged "InsufficientFunds" a E.value ChangeHasLessThanNAda a b -> E.encodeTagged "ChangeHasLessThanNAda" (a /\ b) (E.tuple (E.value >/\< E.value)) + NoPaymentPubKeyHashError -> encodeJson { tag: "NoPaymentPubKeyHashError", contents: jsonNull } PaymentPrivateKeyNotFound a -> E.encodeTagged "PaymentPrivateKeyNotFound" a E.value ValidationError a -> E.encodeTagged "ValidationError" a E.value ToCardanoError a -> E.encodeTagged "ToCardanoError" a E.value @@ -60,6 +62,7 @@ instance DecodeJson WalletAPIError where $ Map.fromFoldable [ "InsufficientFunds" /\ D.content (InsufficientFunds <$> D.value) , "ChangeHasLessThanNAda" /\ D.content (D.tuple $ ChangeHasLessThanNAda D.value D.value) + , "NoPaymentPubKeyHashError" /\ pure NoPaymentPubKeyHashError , "PaymentPrivateKeyNotFound" /\ D.content (PaymentPrivateKeyNotFound <$> D.value) , "ValidationError" /\ D.content (ValidationError <$> D.value) , "ToCardanoError" /\ D.content (ToCardanoError <$> D.value) @@ -82,6 +85,11 @@ _ChangeHasLessThanNAda = prism' (\{ a, b } -> (ChangeHasLessThanNAda a b)) case (ChangeHasLessThanNAda a b) -> Just { a, b } _ -> Nothing +_NoPaymentPubKeyHashError :: Prism' WalletAPIError Unit +_NoPaymentPubKeyHashError = prism' (const NoPaymentPubKeyHashError) case _ of + NoPaymentPubKeyHashError -> Just unit + _ -> Nothing + _PaymentPrivateKeyNotFound :: Prism' WalletAPIError PaymentPubKeyHash _PaymentPrivateKeyNotFound = prism' PaymentPrivateKeyNotFound case _ of (PaymentPrivateKeyNotFound a) -> Just a diff --git a/plutus-playground-server/usecases/Crowdfunding.hs b/plutus-playground-server/usecases/Crowdfunding.hs index cce21d76ee..24eec77418 100644 --- a/plutus-playground-server/usecases/Crowdfunding.hs +++ b/plutus-playground-server/usecases/Crowdfunding.hs @@ -164,7 +164,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 <- ownPaymentPubKeyHash + contributor <- ownFirstPaymentPubKeyHash let inst = typedValidator cmp tx = Constraints.mustPayToTheScript contributor contribValue <> Constraints.mustValidateIn (Interval.to (campaignDeadline cmp)) diff --git a/plutus-tx-constraints/src/Ledger/Tx/Constraints/OffChain.hs b/plutus-tx-constraints/src/Ledger/Tx/Constraints/OffChain.hs index 7861f0e9f6..ab85572b07 100644 --- a/plutus-tx-constraints/src/Ledger/Tx/Constraints/OffChain.hs +++ b/plutus-tx-constraints/src/Ledger/Tx/Constraints/OffChain.hs @@ -196,7 +196,7 @@ processConstraint = \case networkId <- use (P.paramsL . networkIdL) out <- throwLeft ToCardanoError $ C.TxOut - <$> C.toCardanoAddress networkId (pubKeyHashAddress pk mskh) + <$> C.toCardanoAddressInEra networkId (pubKeyHashAddress pk mskh) <*> C.toCardanoTxOutValue vl <*> pure (maybe C.TxOutDatumNone (C.TxOutDatum C.ScriptDataInAlonzoEra . C.toCardanoScriptData . getDatum) md) diff --git a/plutus-tx-constraints/test/Spec.hs b/plutus-tx-constraints/test/Spec.hs index 4e5afbf380..8175efb082 100644 --- a/plutus-tx-constraints/test/Spec.hs +++ b/plutus-tx-constraints/test/Spec.hs @@ -97,7 +97,7 @@ mustPayToPubKeyAddressStakePubKeyNotNothingProp = property $ do where stakePaymentPubKeyHash :: C.TxOut C.CtxTx C.AlonzoEra -> Maybe StakePubKeyHash stakePaymentPubKeyHash (C.TxOut addr _ _) = do - txOutAddress <- either (const Nothing) Just $ C.fromCardanoAddress addr + txOutAddress <- either (const Nothing) Just $ C.fromCardanoAddressInEra addr stakeCred <- addressStakingCredential txOutAddress case stakeCred of StakingHash (PubKeyCredential pkh) -> Just $ StakePubKeyHash pkh diff --git a/plutus-use-cases/plutus-use-cases.cabal b/plutus-use-cases/plutus-use-cases.cabal index cb499a9045..1a96ae69f8 100644 --- a/plutus-use-cases/plutus-use-cases.cabal +++ b/plutus-use-cases/plutus-use-cases.cabal @@ -97,6 +97,7 @@ library , lens , openapi3 , playground-common + , plutus-chain-index-core , plutus-contract , plutus-core , plutus-ledger diff --git a/plutus-use-cases/src/Plutus/Contracts/Auction.hs b/plutus-use-cases/src/Plutus/Contracts/Auction.hs index 191001e46b..bdc977bac6 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Auction.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Auction.hs @@ -220,7 +220,7 @@ auctionSeller :: Value -> POSIXTime -> Contract AuctionOutput SellerSchema Aucti auctionSeller value time = do threadToken <- SM.getThreadToken tell $ threadTokenOut threadToken - self <- ownPaymentPubKeyHash + self <- ownFirstPaymentPubKeyHash let params = AuctionParams{apOwner = self, apAsset = value, apEndTime = time } inst = typedValidator (threadToken, params) client = machineClient inst threadToken params @@ -333,7 +333,7 @@ handleEvent client lastHighestBid change = AuctionIsOver s -> tell (auctionStateOut $ Finished s) >> stop SubmitOwnBid ada -> do logInfo @Haskell.String "Submitting bid" - self <- ownPaymentPubKeyHash + self <- ownFirstPaymentPubKeyHash 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 f7b26452c0..d7b8c3e576 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Crowdfunding.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Crowdfunding.hs @@ -202,7 +202,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 <- ownPaymentPubKeyHash + contributor <- ownFirstPaymentPubKeyHash 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 760efb9380..687fa4ba6d 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Currency.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Currency.hs @@ -181,7 +181,7 @@ type CurrencySchema = mintCurrency :: Promise (Maybe (Last OneShotCurrency)) CurrencySchema CurrencyError OneShotCurrency mintCurrency = endpoint @"Create native token" $ \SimpleMPS{tokenName, amount} -> do - ownPK <- ownPaymentPubKeyHash + ownPK <- ownFirstPaymentPubKeyHash 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 e860eb3bde..15e1ad6bc3 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Escrow.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Escrow.hs @@ -258,7 +258,7 @@ pay :: -- ^ How much money to pay in -> Contract w s e TxId pay inst escrow vl = do - pk <- ownPaymentPubKeyHash + pk <- ownFirstPaymentPubKeyHash let tx = Constraints.mustPayToTheScript pk vl <> Constraints.mustValidateIn (Ledger.interval 1 (escrowDeadline escrow)) mkTxConstraints (Constraints.typedValidatorLookups inst) tx @@ -330,7 +330,7 @@ refund :: -> EscrowParams Datum -> Contract w s EscrowError RefundSuccess refund inst escrow = do - pk <- ownPaymentPubKeyHash + pk <- ownFirstPaymentPubKeyHash unspentOutputs <- utxosAt (Scripts.validatorAddress inst) let flt _ ciTxOut = either id datumHash (Tx._ciTxOutDatum ciTxOut) == 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 8ad049bebe..8de729552f 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Future.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Future.hs @@ -570,7 +570,7 @@ setupTokens ) => Contract w s e FutureAccounts setupTokens = mapError (review _FutureError) $ do - pk <- ownPaymentPubKeyHash + pk <- ownFirstPaymentPubKeyHash -- Create the tokens using the currency contract, wrapping any errors in -- 'TokenSetupFailed' diff --git a/plutus-use-cases/src/Plutus/Contracts/MultiSigStateMachine.hs b/plutus-use-cases/src/Plutus/Contracts/MultiSigStateMachine.hs index c89ad57a97..deac32e03b 100644 --- a/plutus-use-cases/src/Plutus/Contracts/MultiSigStateMachine.hs +++ b/plutus-use-cases/src/Plutus/Contracts/MultiSigStateMachine.hs @@ -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" $ \() -> ownPaymentPubKeyHash >>= void . SM.runStep theClient . AddSignature + addSignature = endpoint @"add-signature" $ \() -> ownFirstPaymentPubKeyHash >>= 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/Mirror.hs b/plutus-use-cases/src/Plutus/Contracts/Prism/Mirror.hs index c6b9357122..836ebd5002 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Prism/Mirror.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Prism/Mirror.hs @@ -58,7 +58,7 @@ mirror :: => Contract w s MirrorError () mirror = do logInfo @String "mirror started" - authority <- mapError SetupError $ CredentialAuthority <$> ownPaymentPubKeyHash + authority <- mapError SetupError $ CredentialAuthority <$> ownFirstPaymentPubKeyHash forever $ do logInfo @String "waiting for 'issue' call" selectList [createTokens authority, revokeToken authority] diff --git a/plutus-use-cases/src/Plutus/Contracts/Prism/Unlock.hs b/plutus-use-cases/src/Plutus/Contracts/Prism/Unlock.hs index da8c99ef08..5997d09651 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Prism/Unlock.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Prism/Unlock.hs @@ -95,7 +95,7 @@ unlockExchange :: forall w s. ) => Contract w s UnlockError () unlockExchange = awaitPromise $ endpoint @"unlock from exchange" $ \credential -> do - ownPK <- mapError WithdrawPkError ownPaymentPubKeyHash + ownPK <- mapError WithdrawPkError ownFirstPaymentPubKeyHash (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 - <$> ownPaymentPubKeyHash + <$> ownFirstPaymentPubKeyHash <*> 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 30db1d0318..dc6b28c96d 100644 --- a/plutus-use-cases/src/Plutus/Contracts/PubKey.hs +++ b/plutus-use-cases/src/Plutus/Contracts/PubKey.hs @@ -30,6 +30,7 @@ import Plutus.V1.Ledger.Contexts as V import PlutusTx qualified import Ledger.Constraints qualified as Constraints +import Plutus.ChainIndex.Types (Tip (Tip, TipAtGenesis)) import Plutus.Contract as Contract mkValidator :: PaymentPubKeyHash -> () -> () -> ScriptContext -> Bool @@ -92,11 +93,37 @@ pubKeyContract pk vl = mapError (review _PubKeyError ) $ do -- to update it's database with the new confirmed transaction. -- Ultimately, the solution is to move indexed information by the -- PAB to the chain-index, so that we get a single source of truth. - -- The `waitNSlots 1` only works if you have a chain-index closely - -- synced to the local node. If the chain-index is not synced with - -- the local node, `unspentTxOutFromRef outRef` will always return - -- `Nothing`. - void $ waitNSlots 1 + -- + -- The temporary solution is to use the 'awaitChainIndexSlot' call + -- which waits until the chain-index is up to date. Meaning, the + -- chain-index's synced slot should be at least as high as the + -- current slot. + -- + -- See https://plutus-apps.readthedocs.io/en/latest/adr/0002-pab-indexing-solution-integration.html" + -- for the full explanation. + -- + -- The 'awaitChainIndexSlot' blocks the contract until the chain-index + -- is synced until the current slot. This is not a good solution, + -- as the chain-index is always some time behind the current slot. + slot <- currentSlot + awaitChainIndexSlot slot + ciTxOut <- unspentTxOutFromRef outRef pure (outRef, ciTxOut, inst) _ -> throwing _MultipleScriptOutputs pk + +-- | Temporary. Read TODO in 'pubKeyContract'. +awaitChainIndexSlot :: (AsContractError e) => Slot -> Contract w s e () +awaitChainIndexSlot targetSlot = do + chainIndexTip <- getTip + let chainIndexSlot = getChainIndexSlot chainIndexTip + if chainIndexSlot < targetSlot + then do + void $ waitNSlots 1 + awaitChainIndexSlot targetSlot + else + pure () + where + getChainIndexSlot :: Tip -> Slot + getChainIndexSlot TipAtGenesis = Slot 0 + getChainIndexSlot (Tip slot _ _) = slot diff --git a/plutus-use-cases/src/Plutus/Contracts/SealedBidAuction.hs b/plutus-use-cases/src/Plutus/Contracts/SealedBidAuction.hs index 8cd992b239..3cc60c8488 100644 --- a/plutus-use-cases/src/Plutus/Contracts/SealedBidAuction.hs +++ b/plutus-use-cases/src/Plutus/Contracts/SealedBidAuction.hs @@ -277,19 +277,19 @@ client auctionParams = startAuction :: Value -> POSIXTime -> POSIXTime -> Contract () SellerSchema AuctionError () startAuction asset endTime payoutTime = do - self <- ownPaymentPubKeyHash + self <- ownFirstPaymentPubKeyHash 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 <- ownPaymentPubKeyHash + self <- ownFirstPaymentPubKeyHash 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 <- ownPaymentPubKeyHash + self <- ownFirstPaymentPubKeyHash 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 fbf4e7a72f..8586f1388f 100644 --- a/plutus-use-cases/src/Plutus/Contracts/SimpleEscrow.hs +++ b/plutus-use-cases/src/Plutus/Contracts/SimpleEscrow.hs @@ -139,7 +139,7 @@ redeemEp = endpoint @"redeem" redeem where redeem params = do time <- currentTime - pk <- ownPaymentPubKeyHash + pk <- ownFirstPaymentPubKeyHash unspentOutputs <- utxosAt escrowAddress let value = foldMap (view Tx.ciTxOutValue) unspentOutputs diff --git a/plutus-use-cases/src/Plutus/Contracts/Tutorial/Escrow.hs b/plutus-use-cases/src/Plutus/Contracts/Tutorial/Escrow.hs index 6b3aee7747..fb3bdbf3b5 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Tutorial/Escrow.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Tutorial/Escrow.hs @@ -238,7 +238,7 @@ pay :: -- ^ How much money to pay in -> Contract w s e TxId pay inst _escrow vl = do - pk <- ownPaymentPubKeyHash + pk <- ownFirstPaymentPubKeyHash let tx = Constraints.mustPayToTheScript pk vl utx <- mkTxConstraints (Constraints.typedValidatorLookups inst) tx >>= adjustUnbalancedTx getCardanoTxId <$> submitUnbalancedTx utx @@ -301,7 +301,7 @@ refund :: -> EscrowParams Datum -> Contract w s EscrowError RefundSuccess refund inst _escrow = do - pk <- ownPaymentPubKeyHash + pk <- ownFirstPaymentPubKeyHash 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/Tutorial/EscrowStrict.hs b/plutus-use-cases/src/Plutus/Contracts/Tutorial/EscrowStrict.hs index 2a448f6635..e06f6c05cd 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Tutorial/EscrowStrict.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Tutorial/EscrowStrict.hs @@ -245,7 +245,7 @@ pay :: -- ^ How much money to pay in -> Contract w s e TxId pay inst _escrow vl = do - pk <- ownPaymentPubKeyHash + pk <- ownFirstPaymentPubKeyHash let tx = Constraints.mustPayToTheScript pk vl utx <- mkTxConstraints (Constraints.typedValidatorLookups inst) tx >>= adjustUnbalancedTx getCardanoTxId <$> submitUnbalancedTx utx @@ -308,7 +308,7 @@ refund :: -> EscrowParams Datum -> Contract w s EscrowError RefundSuccess refund inst _escrow = do - pk <- ownPaymentPubKeyHash + pk <- ownFirstPaymentPubKeyHash 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/Uniswap/OffChain.hs b/plutus-use-cases/src/Plutus/Contracts/Uniswap/OffChain.hs index 6225a5a366..fd498ed72e 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Uniswap/OffChain.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Uniswap/OffChain.hs @@ -196,7 +196,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.ownPaymentPubKeyHash + pkh <- Contract.ownFirstPaymentPubKeyHash cs <- fmap Currency.currencySymbol $ mapError (pack . show @Currency.CurrencyError) $ Currency.mintContract pkh [(uniswapTokenName, 1)] @@ -247,7 +247,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.ownPaymentPubKeyHash + pkh <- Contract.ownFirstPaymentPubKeyHash let usInst = uniswapInstance us usScript = uniswapScript us usDat = Factory $ filter (/= lp) lps @@ -279,7 +279,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.ownPaymentPubKeyHash + pkh <- Contract.ownFirstPaymentPubKeyHash when (rpDiff < 1 || rpDiff >= liquidity) $ throwError "removed liquidity must be positive and less than total liquidity" let usInst = uniswapInstance us usScript = uniswapScript us @@ -312,7 +312,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.ownPaymentPubKeyHash + pkh <- Contract.ownFirstPaymentPubKeyHash (_, (oref, o, lp, liquidity)) <- findUniswapFactoryAndPool us apCoinA apCoinB when (apAmountA < 0 || apAmountB < 0) $ throwError "amounts must not be negative" let outVal = view ciTxOutValue o @@ -369,7 +369,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.ownPaymentPubKeyHash + pkh <- Contract.ownFirstPaymentPubKeyHash 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) @@ -421,7 +421,7 @@ pools us = do -- | Gets the caller's funds. funds :: forall w s. Contract w s Text Value funds = do - pkh <- Contract.ownPaymentPubKeyHash + pkh <- Contract.ownFirstPaymentPubKeyHash os <- map snd . Map.toList <$> utxosAt (pubKeyHashAddress pkh Nothing) return $ mconcat [view ciTxOutValue o | o <- os] diff --git a/plutus-use-cases/src/Plutus/Contracts/Uniswap/Trace.hs b/plutus-use-cases/src/Plutus/Contracts/Uniswap/Trace.hs index 6266c30e7e..891dffac5a 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Uniswap/Trace.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Uniswap/Trace.hs @@ -65,7 +65,7 @@ uniswapTrace = do -- the emulated wallets setupTokens :: Contract (Maybe (Semigroup.Last Currency.OneShotCurrency)) Currency.CurrencySchema Currency.CurrencyError () setupTokens = do - ownPK <- Contract.ownPaymentPubKeyHash + ownPK <- Contract.ownFirstPaymentPubKeyHash 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] diff --git a/plutus-use-cases/test/Spec/Uniswap.hs b/plutus-use-cases/test/Spec/Uniswap.hs index 3cbfc89e86..81be57e989 100644 --- a/plutus-use-cases/test/Spec/Uniswap.hs +++ b/plutus-use-cases/test/Spec/Uniswap.hs @@ -141,7 +141,7 @@ getBToken = max -- the emulated wallets setupTokens :: Contract (Maybe (Semigroup.Last Currency.OneShotCurrency)) Currency.CurrencySchema Currency.CurrencyError () setupTokens = do - ownPK <- Contract.ownPaymentPubKeyHash + ownPK <- Contract.ownFirstPaymentPubKeyHash cur <- Currency.mintContract ownPK [(fromString tn, fromIntegral (length wallets) * amount) | tn <- tokenNames] let cs = Currency.currencySymbol cur v = mconcat [Value.singleton cs (fromString tn) amount | tn <- tokenNames] diff --git a/plutus-use-cases/test/Spec/Uniswap/Endpoints.hs b/plutus-use-cases/test/Spec/Uniswap/Endpoints.hs index 6783a8fb83..50959bf91c 100644 --- a/plutus-use-cases/test/Spec/Uniswap/Endpoints.hs +++ b/plutus-use-cases/test/Spec/Uniswap/Endpoints.hs @@ -49,7 +49,7 @@ data BadRemoveParams = BadRemoveParams badRemove :: forall w s. Uniswap -> BadRemoveParams -> Contract w s Text () badRemove us BadRemoveParams{..} = do (_, (oref, o, lp, liquidity)) <- findUniswapFactoryAndPool us brpCoinA brpCoinB - pkh <- Contract.ownPaymentPubKeyHash + pkh <- Contract.ownFirstPaymentPubKeyHash --when (brpDiff < 1 || brpDiff >= liquidity) $ throwError "removed liquidity must be positive and less than total liquidity" let usInst = uniswapInstance us usScript = uniswapScript us