From 762d5e10741f4ab356eb22007e99faae27c05b93 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Thu, 23 Sep 2021 16:38:29 +0200 Subject: [PATCH] plutus-pab: FixesQ --- plutus-contract/src/Wallet/API.hs | 1 + .../examples/ContractExample/AtomicSwap.hs | 25 ++++++++--------- .../examples/ContractExample/PayToWallet.hs | 5 ++-- plutus-pab/plutus-pab.cabal | 3 +- plutus-pab/src/Cardano/Node/Types.hs | 2 +- plutus-pab/src/Cardano/Wallet/Mock/Client.hs | 2 +- .../src/Cardano/Wallet/Mock/Handlers.hs | 24 +++++++++------- plutus-pab/src/Cardano/Wallet/Mock/Server.hs | 15 ++++++---- plutus-pab/src/Cardano/Wallet/Mock/Types.hs | 21 ++++++++++++-- plutus-pab/src/Plutus/PAB/Core.hs | 6 ++-- plutus-pab/src/Plutus/PAB/Simulator.hs | 28 +++++++++---------- .../src/Plutus/PAB/Webserver/Handler.hs | 6 ++-- plutus-pab/src/Plutus/PAB/Webserver/Server.hs | 2 +- plutus-pab/test/full/Plutus/PAB/CoreSpec.hs | 8 +++--- plutus-pab/tx-inject/Main.hs | 4 +-- .../usecases/Crowdfunding.hs | 6 ++-- plutus-playground-server/usecases/Vesting.hs | 3 +- 17 files changed, 90 insertions(+), 71 deletions(-) diff --git a/plutus-contract/src/Wallet/API.hs b/plutus-contract/src/Wallet/API.hs index b2309f8e26b..7fd610cc758 100644 --- a/plutus-contract/src/Wallet/API.hs +++ b/plutus-contract/src/Wallet/API.hs @@ -29,6 +29,7 @@ module Wallet.API( getClientSlot, getClientSlotConfig, PubKey(..), + PubKeyHash(..), signTxAndSubmit, signTxAndSubmit_, payToPublicKeyHash, diff --git a/plutus-pab/examples/ContractExample/AtomicSwap.hs b/plutus-pab/examples/ContractExample/AtomicSwap.hs index 97d4925dcdd..950b25260f4 100644 --- a/plutus-pab/examples/ContractExample/AtomicSwap.hs +++ b/plutus-pab/examples/ContractExample/AtomicSwap.hs @@ -25,11 +25,10 @@ import Plutus.Contracts.Escrow (EscrowParams (..)) import qualified Plutus.Contracts.Escrow as Escrow import Schema (ToSchema) -import Ledger (CurrencySymbol, POSIXTime, PubKey, TokenName, Value) -import qualified Ledger +import Ledger (CurrencySymbol, POSIXTime, PubKeyHash, TokenName, Value) import qualified Ledger.Value as Value import Plutus.Contract -import Wallet.Emulator.Wallet (Wallet, walletPubKey) +import Wallet.Emulator.Wallet (Wallet, walletPubKeyHash) -- | Describes an exchange of two -- 'Value' amounts between two parties @@ -56,15 +55,15 @@ mkValue2 AtomicSwapParams{currencyHash, tokenName, amount} = mkEscrowParams :: AtomicSwapParams -> EscrowParams t mkEscrowParams p@AtomicSwapParams{party1,party2,deadline} = - let pubKey1 = walletPubKey party1 - pubKey2 = walletPubKey party2 + let pubKey1 = walletPubKeyHash party1 + pubKey2 = walletPubKeyHash party2 value1 = mkValue1 p value2 = mkValue2 p in EscrowParams { escrowDeadline = deadline , escrowTargets = - [ Escrow.payToPubKeyTarget (Ledger.pubKeyHash pubKey1) value1 - , Escrow.payToPubKeyTarget (Ledger.pubKeyHash pubKey2) value2 + [ Escrow.payToPubKeyTarget pubKey1 value1 + , Escrow.payToPubKeyTarget pubKey2 value2 ] } @@ -73,7 +72,7 @@ type AtomicSwapSchema = Endpoint "Atomic swap" AtomicSwapParams data AtomicSwapError = EscrowError Escrow.EscrowError | OtherAtomicSwapError ContractError - | NotInvolvedError PubKey AtomicSwapParams -- ^ When the wallet's public key doesn't match either of the two keys specified in the 'AtomicSwapParams' + | NotInvolvedError PubKeyHash AtomicSwapParams -- ^ When the wallet's public key doesn't match either of the two keys specified in the 'AtomicSwapParams' deriving (Show, Generic, ToJSON, FromJSON) makeClassyPrisms ''AtomicSwapError @@ -88,17 +87,17 @@ atomicSwap = endpoint @"Atomic swap" $ \p -> do value2 = mkValue2 p params = mkEscrowParams p - go pk - | pk == walletPubKey (party1 p) = + go pkh + | pkh == walletPubKeyHash (party1 p) = -- there are two paying transactions and one redeeming transaction. -- The redeeming tx is submitted by party 1. -- TODO: Change 'payRedeemRefund' to check before paying into the -- address, so that the last paying transaction can also be the -- redeeming transaction. void $ mapError EscrowError (Escrow.payRedeemRefund params value2) - | pk == walletPubKey (party2 p) = + | pkh == walletPubKeyHash (party2 p) = void $ mapError EscrowError (Escrow.pay (Escrow.typedValidator params) params value1) >>= awaitTxConfirmed - | otherwise = throwError (NotInvolvedError pk p) + | otherwise = throwError (NotInvolvedError pkh p) - ownPubKey >>= go + ownPubKeyHash >>= go diff --git a/plutus-pab/examples/ContractExample/PayToWallet.hs b/plutus-pab/examples/ContractExample/PayToWallet.hs index 981a1ed70fb..4fc606452a2 100644 --- a/plutus-pab/examples/ContractExample/PayToWallet.hs +++ b/plutus-pab/examples/ContractExample/PayToWallet.hs @@ -19,9 +19,8 @@ import Schema (ToSchema) import Ledger (Value, txId) import Ledger.Constraints -import Ledger.Crypto (pubKeyHash) import Plutus.Contract -import Wallet.Emulator.Types (Wallet, walletPubKey) +import Wallet.Emulator.Types (Wallet, walletPubKeyHash) data PayToWalletParams = PayToWalletParams @@ -35,6 +34,6 @@ type PayToWalletSchema = Endpoint "Pay to wallet" PayToWalletParams payToWallet :: Promise () PayToWalletSchema ContractError () payToWallet = endpoint @"Pay to wallet" $ \PayToWalletParams{amount, wallet} -> do - let pkh = pubKeyHash $ walletPubKey wallet + let pkh = walletPubKeyHash wallet txid <- submitTx (mustPayToPubKey pkh amount) awaitTxConfirmed (txId txid) diff --git a/plutus-pab/plutus-pab.cabal b/plutus-pab/plutus-pab.cabal index 9e10af74ae5..df8aee3379c 100644 --- a/plutus-pab/plutus-pab.cabal +++ b/plutus-pab/plutus-pab.cabal @@ -212,7 +212,8 @@ library beam-core -any, beam-sqlite -any, beam-migrate -any, - sqlite-simple -any + sqlite-simple -any, + cardano-crypto-class -any executable plutus-pab-setup main-is: Main.hs diff --git a/plutus-pab/src/Cardano/Node/Types.hs b/plutus-pab/src/Cardano/Node/Types.hs index ffe4a9c7cd7..8520f1233e4 100644 --- a/plutus-pab/src/Cardano/Node/Types.hs +++ b/plutus-pab/src/Cardano/Node/Types.hs @@ -229,7 +229,7 @@ initialAppState wallets = do initialChainState :: MonadIO m => Trace.InitialDistribution -> m MockNodeServerChainState initialChainState = fromEmulatorChainState . view EM.chainState . - MultiAgent.emulatorStateInitialDist . Map.mapKeys EM.walletPubKey + MultiAgent.emulatorStateInitialDist . Map.mapKeys EM.walletPubKeyHash -- Effects ------------------------------------------------------------------------------------------------------------- diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Client.hs b/plutus-pab/src/Cardano/Wallet/Mock/Client.hs index 94c9e6fdcdb..dc3ae219a88 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Client.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Client.hs @@ -63,7 +63,7 @@ handleWalletClient wallet event = do runClient a = (sendM $ liftIO $ runClientM a clientEnv) >>= either throwError pure case event of SubmitTxn t -> runClient (submitTxn wallet t) - OwnPubKey -> wiPubKey <$> runClient (ownPublicKey wallet) + OwnPubKeyHash -> wiPubKeyHash <$> runClient (ownPublicKey wallet) BalanceTx utx -> runClient (balanceTx wallet utx) WalletAddSignature tx -> runClient $ sign wallet tx TotalFunds -> runClient (totalFunds wallet) diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Handlers.hs b/plutus-pab/src/Cardano/Wallet/Mock/Handlers.hs index 8ffd027d205..da368e899f6 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Handlers.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Handlers.hs @@ -20,7 +20,7 @@ import Cardano.BM.Data.Trace (Trace) import qualified Cardano.Node.Client as NodeClient import qualified Cardano.Protocol.Socket.Mock.Client as MockClient import Cardano.Wallet.Mock.Types (MultiWalletEffect (..), WalletEffects, WalletInfo (..), - WalletMsg (..), Wallets) + WalletMsg (..), Wallets, fromWalletState) import Control.Concurrent (MVar) import Control.Concurrent.MVar (putMVar, takeMVar) import Control.Lens (at, (?~)) @@ -44,7 +44,8 @@ import qualified Data.Map as Map import Data.Text.Encoding (encodeUtf8) import Data.Text.Prettyprint.Doc (pretty) import qualified Ledger.Ada as Ada -import Ledger.Crypto (generateFromSeed, privateKey2, pubKeyHash) +import Ledger.Crypto (PubKeyHash, generateFromSeed, privateKey2, pubKeyHash, + toPublicKey) import Ledger.Fee (FeeConfig) import Ledger.TimeSlot (SlotConfig) import Ledger.Tx (Tx) @@ -80,15 +81,15 @@ byteString2Integer = BS.foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0 integer2ByteString32 :: Integer -> BS.ByteString integer2ByteString32 i = BS.unfoldr (\l' -> if l' < 0 then Nothing else Just (fromIntegral (i `shiftR` l'), l' - 8)) (31*8) -distributeNewWalletFunds :: forall effs. (Member WAPI.WalletEffect effs, Member (Error WalletAPIError) effs) => PubKey -> Eff effs Tx -distributeNewWalletFunds = WAPI.payToPublicKey WAPI.defaultSlotRange (Ada.adaValueOf 10000) +distributeNewWalletFunds :: forall effs. (Member WAPI.WalletEffect effs, Member (Error WalletAPIError) effs) => PubKeyHash -> Eff effs Tx +distributeNewWalletFunds = WAPI.payToPublicKeyHash WAPI.defaultSlotRange (Ada.adaValueOf 10000) -newWallet :: forall m effs. (LastMember m effs, MonadIO m) => Eff effs (Wallet, WalletState) +newWallet :: forall m effs. (LastMember m effs, MonadIO m) => Eff effs (Wallet, WalletState, PubKey) newWallet = do Seed seed <- generateSeed let secretKeyBytes = BS.pack . unpack $ seed let privateKey = generateFromSeed secretKeyBytes - pure (Wallet.Wallet (Wallet.MockWallet privateKey), Wallet.emptyWalletState privateKey) + pure (Wallet.Wallet (Wallet.MockWallet privateKey), Wallet.emptyWalletState privateKey, toPublicKey privateKey) -- | Handle multiple wallets using existing @Wallet.handleWallet@ handler handleMultiWallet :: forall m effs. @@ -117,8 +118,7 @@ handleMultiWallet feeCfg = \case Nothing -> throwError $ WAPI.OtherError "Wallet not found" CreateWallet -> do wallets <- get @Wallets - (wallet, newState) <- newWallet - let pubKey = Wallet.walletPubKey wallet + (wallet, newState, pubKey) <- newWallet let wallets' = Map.insert wallet newState wallets put wallets' -- For some reason this doesn't work with (Wallet 1)/privateKey1, @@ -128,8 +128,12 @@ handleMultiWallet feeCfg = \case _ <- evalState walletState $ interpret (mapLog @TxBalanceMsg @WalletMsg Balancing) $ interpret (Wallet.handleWallet feeCfg) - $ distributeNewWalletFunds pubKey - return $ WalletInfo{wiWallet = wallet, wiPubKey = pubKey, wiPubKeyHash = pubKeyHash pubKey} + $ distributeNewWalletFunds + $ Wallet.walletPubKeyHash wallet + return $ WalletInfo{wiWallet = wallet, wiPubKey = Just pubKey, wiPubKeyHash = pubKeyHash pubKey} + GetWalletInfo wllt -> do + wallets <- get @Wallets + return $ fmap fromWalletState $ Map.lookup (Wallet.Wallet wllt) wallets -- | Process wallet effects. Retain state and yield HTTP400 on error -- or set new state on success. diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Server.hs b/plutus-pab/src/Cardano/Wallet/Mock/Server.hs index c2ebe53f694..e2a603d7d83 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Server.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Server.hs @@ -18,26 +18,29 @@ import Cardano.Node.Client as NodeClient import qualified Cardano.Protocol.Socket.Mock.Client as MockClient import Cardano.Wallet.Mock.API (API) import Cardano.Wallet.Mock.Handlers -import Cardano.Wallet.Mock.Types (Port (..), WalletConfig (..), WalletInfo (..), WalletMsg (..), - WalletUrl (..), Wallets, createWallet, multiWallet) +import Cardano.Wallet.Mock.Types (Port (..), WalletConfig (..), WalletMsg (..), WalletUrl (..), + Wallets, createWallet, getWalletInfo, multiWallet) import Control.Concurrent.Availability (Availability, available) import Control.Concurrent.MVar (MVar, newMVar) +import Control.Monad ((>=>)) +import Control.Monad.Freer.Error (throwError) import Control.Monad.Freer.Extras.Log (logInfo) import Control.Monad.IO.Class (liftIO) import Data.Coerce (coerce) import Data.Function ((&)) import qualified Data.Map.Strict as Map import Data.Proxy (Proxy (Proxy)) -import Ledger.Crypto (knownPrivateKeys, pubKeyHash) +import Ledger.Crypto (knownPrivateKeys) import Ledger.Fee (FeeConfig) import Ledger.TimeSlot (SlotConfig) import Network.HTTP.Client (defaultManagerSettings, newManager) import qualified Network.Wai.Handler.Warp as Warp import Plutus.PAB.Arbitrary () import qualified Plutus.PAB.Monitoring.Monitoring as LM -import Servant (Application, NoContent (..), hoistServer, serve, (:<|>) ((:<|>))) +import Servant (Application, NoContent (..), err404, hoistServer, serve, + (:<|>) ((:<|>))) import Servant.Client (BaseUrl (baseUrlPort), ClientEnv, mkClientEnv) -import Wallet.Effects (balanceTx, ownPubKey, submitTxn, totalFunds, walletAddSignature) +import Wallet.Effects (balanceTx, submitTxn, totalFunds, walletAddSignature) import Wallet.Emulator.Wallet (Wallet (..), WalletId, emptyWalletState) import qualified Wallet.Emulator.Wallet as Wallet @@ -56,7 +59,7 @@ app trace txSendHandle chainSyncHandle chainIndexEnv mVarState feeCfg slotCfg = (processWalletEffects trace txSendHandle chainSyncHandle chainIndexEnv mVarState feeCfg slotCfg) $ createWallet :<|> (\w tx -> multiWallet (Wallet w) (submitTxn tx) >>= const (pure NoContent)) :<|> - (\w -> (\pk -> WalletInfo{wiWallet = Wallet w, wiPubKey = pk, wiPubKeyHash = pubKeyHash pk}) <$> multiWallet (Wallet w) ownPubKey) :<|> + (getWalletInfo >=> maybe (throwError err404) pure ) :<|> (\w -> multiWallet (Wallet w) . balanceTx) :<|> (\w -> multiWallet (Wallet w) totalFunds) :<|> (\w tx -> multiWallet (Wallet w) (walletAddSignature tx)) diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Types.hs b/plutus-pab/src/Cardano/Wallet/Mock/Types.hs index f77416af1c0..389e93a69b2 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Types.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Types.hs @@ -19,7 +19,8 @@ module Cardano.Wallet.Mock.Types ( , MultiWalletEffect (..) , createWallet , multiWallet - -- * wallet configuration + , getWalletInfo + -- * wallet configuration , WalletConfig (..) , defaultWalletConfig @@ -34,11 +35,13 @@ module Cardano.Wallet.Mock.Types ( , ChainIndexUrl -- * Wallet info , WalletInfo(..) + , fromWalletState ) where import Cardano.BM.Data.Tracer (ToObject (..)) import Cardano.BM.Data.Tracer.Extras (Tagged (..), mkObjectStr) import Cardano.ChainIndex.Types (ChainIndexUrl) +import qualified Cardano.Crypto.Wallet as Crypto import Control.Monad.Freer (Eff) import Control.Monad.Freer.Error (Error) import Control.Monad.Freer.Extras.Log (LogMsg) @@ -51,6 +54,7 @@ import Data.Text (Text) import Data.Text.Prettyprint.Doc (Pretty (..), (<+>)) import GHC.Generics (Generic) import Ledger (PubKey, PubKeyHash) +import qualified Ledger.Crypto as Crypto import Plutus.ChainIndex (ChainIndexQueryEffect) import Plutus.PAB.Arbitrary () import Servant (ServerError (..)) @@ -59,13 +63,13 @@ import Servant.Client.Internal.HttpClient (ClientEnv) import Wallet.Effects (NodeClientEffect, WalletEffect) import Wallet.Emulator.Error (WalletAPIError) import Wallet.Emulator.LogMessages (TxBalanceMsg) -import Wallet.Emulator.Wallet (Wallet, WalletState) +import Wallet.Emulator.Wallet (Wallet (..), WalletId (..), WalletState (..)) -- | Information about an emulated wallet. data WalletInfo = WalletInfo { wiWallet :: Wallet - , wiPubKey :: PubKey + , wiPubKey :: Maybe PubKey -- ^ Public key of the wallet (if known) , wiPubKeyHash :: PubKeyHash } deriving stock (Show, Generic) @@ -73,9 +77,20 @@ data WalletInfo = type Wallets = Map Wallet WalletState +fromWalletState :: WalletState -> WalletInfo +fromWalletState WalletState{_ownPrivateKey} = + let xpub = Crypto.toXPub _ownPrivateKey + pk = Crypto.xPubToPublicKey xpub + in WalletInfo + { wiWallet = Wallet (XPubWallet xpub) + , wiPubKey = Just pk + , wiPubKeyHash = Crypto.pubKeyHash pk + } + data MultiWalletEffect r where CreateWallet :: MultiWalletEffect WalletInfo MultiWallet :: Wallet -> Eff '[WalletEffect] a -> MultiWalletEffect a + GetWalletInfo :: WalletId -> MultiWalletEffect (Maybe WalletInfo) makeEffect ''MultiWalletEffect type WalletEffects m = '[ MultiWalletEffect diff --git a/plutus-pab/src/Plutus/PAB/Core.hs b/plutus-pab/src/Plutus/PAB/Core.hs index 2f387a7e685..450638f0723 100644 --- a/plutus-pab/src/Plutus/PAB/Core.hs +++ b/plutus-pab/src/Plutus/PAB/Core.hs @@ -121,7 +121,7 @@ import Plutus.PAB.Timeout (Timeout) import qualified Plutus.PAB.Timeout as Timeout import Plutus.PAB.Types (PABError (ContractInstanceNotFound, InstanceAlreadyStopped, WalletError)) import Plutus.PAB.Webserver.Types (ContractActivationArgs (..)) -import Wallet.API (PubKey, Slot) +import Wallet.API (PubKeyHash, Slot) import qualified Wallet.API as WAPI import Wallet.Effects (NodeClientEffect, WalletEffect) import Wallet.Emulator.LogMessages (RequestHandlerLogMsg, TxBalanceMsg) @@ -328,11 +328,11 @@ callEndpointOnInstance' instanceID ep value = do $ Instances.callEndpointOnInstance state (EndpointDescription ep) (JSON.toJSON value) instanceID -- | Make a payment to a public key -payToPublicKey :: Wallet -> PubKey -> Value -> PABAction t env Tx +payToPublicKey :: Wallet -> PubKeyHash -> Value -> PABAction t env Tx payToPublicKey source target amount = handleAgentThread source $ Modify.wrapError WalletError - $ WAPI.payToPublicKey WAPI.defaultSlotRange amount target + $ WAPI.payToPublicKeyHash WAPI.defaultSlotRange amount target -- | Effects available to contract instances with access to external services. type ContractInstanceEffects t env effs = diff --git a/plutus-pab/src/Plutus/PAB/Simulator.hs b/plutus-pab/src/Plutus/PAB/Simulator.hs index 133e751dc35..dae11f83aa7 100644 --- a/plutus-pab/src/Plutus/PAB/Simulator.hs +++ b/plutus-pab/src/Plutus/PAB/Simulator.hs @@ -32,7 +32,7 @@ module Plutus.PAB.Simulator( , logString -- ** Agent actions , payToWallet - , payToPublicKey + , payToPublicKeyHash , activateContract , callEndpointOnInstance , handleAgentThread @@ -99,8 +99,8 @@ import qualified Data.Text.IO as Text import Data.Text.Prettyprint.Doc (Pretty (pretty), defaultLayoutOptions, layoutPretty) import qualified Data.Text.Prettyprint.Doc.Render.Text as Render import Data.Time.Units (Millisecond) -import Ledger (Address (..), Blockchain, Tx, TxId, TxOut (..), - eitherTx, txFee, txId) +import Ledger (Address (..), Blockchain, PubKeyHash, Tx, TxId, + TxOut (..), eitherTx, txFee, txId) import qualified Ledger.Ada as Ada import Ledger.Crypto (PubKey) import Ledger.Fee (FeeConfig) @@ -161,7 +161,7 @@ initialAgentState (Wallet (MockWallet privKey)) = { _walletState = Wallet.emptyWalletState privKey , _submittedFees = mempty } -initialAgentState (Wallet (XPubWallet _)) = error "Only mock wallets supported in the simulator" +initialAgentState (Wallet _) = error "Only mock wallets supported in the simulator" data SimulatorState t = SimulatorState @@ -725,20 +725,18 @@ instanceActivity = Core.instanceActivity -- | Create a new wallet with a random key, give it some funds -- and add it to the list of simulated wallets. -addWallet :: forall t. Simulation t (Wallet, PubKey) +addWallet :: forall t. Simulation t (Wallet,PubKey) addWallet = do SimulatorState{_agentStates} <- Core.askUserEnv @t @(SimulatorState t) - (newWallet, newState) <- MockWallet.newWallet - let publicKey = Wallet.walletPubKey newWallet - result <- liftIO $ STM.atomically $ do + (newWallet, newState, walletKey) <- MockWallet.newWallet + void $ liftIO $ STM.atomically $ do currentWallets <- STM.readTVar _agentStates let newWallets = currentWallets & at newWallet ?~ AgentState newState mempty STM.writeTVar _agentStates newWallets - pure (newWallet, publicKey) _ <- handleAgentThread (knownWallet 2) $ Modify.wrapError WalletError - $ MockWallet.distributeNewWalletFunds publicKey - pure result + $ MockWallet.distributeNewWalletFunds (Wallet.walletPubKeyHash newWallet) + pure (newWallet, walletKey) -- | Retrieve the balances of all the entities in the simulator. @@ -766,11 +764,11 @@ logString = logInfo @(PABMultiAgentMsg t) . UserLog . Text.pack -- | Make a payment from one wallet to another payToWallet :: forall t. Wallet -> Wallet -> Value -> Simulation t Tx -payToWallet source target = payToPublicKey source (Emulator.walletPubKey target) +payToWallet source target = payToPublicKeyHash source (Emulator.walletPubKeyHash target) -- | Make a payment from one wallet to a public key address -payToPublicKey :: forall t. Wallet -> PubKey -> Value -> Simulation t Tx -payToPublicKey source target amount = +payToPublicKeyHash :: forall t. Wallet -> PubKeyHash -> Value -> Simulation t Tx +payToPublicKeyHash source target amount = handleAgentThread source $ flip (handleError @WAPI.WalletAPIError) (throwError . WalletError) - $ WAPI.payToPublicKey WAPI.defaultSlotRange amount target + $ WAPI.payToPublicKeyHash WAPI.defaultSlotRange amount target diff --git a/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs b/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs index d00a9045e15..07efc7c19ce 100644 --- a/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs +++ b/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs @@ -39,7 +39,7 @@ import Data.Proxy (Proxy (..)) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.UUID as UUID -import Ledger (Value, pubKeyHash) +import Ledger (Value) import Ledger.Constraints.OffChain (UnbalancedTx) import Ledger.Tx (Tx) import Plutus.Contract.Effects (PABReq, _ExposeEndpointReq) @@ -57,7 +57,7 @@ import qualified Servant.Server as Servant import Servant.Swagger.UI (SwaggerSchemaUI', swaggerSchemaUIServer) import qualified Wallet.Effects import Wallet.Emulator.Error (WalletAPIError) -import Wallet.Emulator.Wallet (Wallet (..), WalletId, knownWallet) +import Wallet.Emulator.Wallet (Wallet (..), WalletId, knownWallet, walletPubKey) import Wallet.Types (ContractInstanceId (..)) healthcheck :: forall t env. PABAction t env () @@ -208,7 +208,7 @@ walletProxy :: walletProxy createNewWallet = createNewWallet :<|> (\w tx -> fmap (const NoContent) (Core.handleAgentThread (Wallet w) $ Wallet.Effects.submitTxn tx)) - :<|> (\w -> (\pk -> WalletInfo{wiWallet=Wallet w, wiPubKey = pk, wiPubKeyHash = pubKeyHash pk }) <$> Core.handleAgentThread (Wallet w) Wallet.Effects.ownPubKey) + :<|> (\w -> (\pkh -> WalletInfo{wiWallet=Wallet w, wiPubKey = walletPubKey (Wallet w), wiPubKeyHash = pkh }) <$> Core.handleAgentThread (Wallet w) Wallet.Effects.ownPubKeyHash) :<|> (\w -> Core.handleAgentThread (Wallet w) . Wallet.Effects.balanceTx) :<|> (\w -> Core.handleAgentThread (Wallet w) Wallet.Effects.totalFunds) :<|> (\w tx -> Core.handleAgentThread (Wallet w) $ Wallet.Effects.walletAddSignature tx) diff --git a/plutus-pab/src/Plutus/PAB/Webserver/Server.hs b/plutus-pab/src/Plutus/PAB/Webserver/Server.hs index 66ae6ebf70f..de072c00b2e 100644 --- a/plutus-pab/src/Plutus/PAB/Webserver/Server.hs +++ b/plutus-pab/src/Plutus/PAB/Webserver/Server.hs @@ -214,5 +214,5 @@ startServerDebug' conf = do tk <- newToken let mkWalletInfo = do (wllt, pk) <- Simulator.addWallet - pure $ WalletInfo{wiWallet = wllt, wiPubKey = pk, wiPubKeyHash = pubKeyHash pk} + pure $ WalletInfo{wiWallet = wllt, wiPubKey = Just pk, wiPubKeyHash = pubKeyHash pk} snd <$> startServer conf (Right mkWalletInfo) tk diff --git a/plutus-pab/test/full/Plutus/PAB/CoreSpec.hs b/plutus-pab/test/full/Plutus/PAB/CoreSpec.hs index ba35049f595..6c152744537 100644 --- a/plutus-pab/test/full/Plutus/PAB/CoreSpec.hs +++ b/plutus-pab/test/full/Plutus/PAB/CoreSpec.hs @@ -42,7 +42,7 @@ import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as Text import Data.Text.Extras (tshow) -import Ledger (pubKeyAddress) +import Ledger (pubKeyAddress, pubKeyHash, pubKeyHashAddress) import Ledger.Ada (adaSymbol, adaToken, lovelaceValueOf) import qualified Ledger.Ada as Ada import qualified Ledger.AddressMap as AM @@ -68,7 +68,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, ownPubKey) +import Wallet.API (WalletAPIError, ownPubKeyHash) import qualified Wallet.API as WAPI import qualified Wallet.Emulator.Chain as Chain import Wallet.Emulator.Wallet (Wallet, knownWallet) @@ -166,7 +166,7 @@ walletFundsChangeTest = runScenario $ do let stream = WS.walletFundsChange defaultWallet env (initialValue, next) <- liftIO (readOne stream) (wllt, pk) <- Simulator.addWallet - _ <- Simulator.payToPublicKey defaultWallet pk payment + _ <- Simulator.payToPublicKeyHash defaultWallet (pubKeyHash pk) payment nextStream <- case next of { Nothing -> throwError (OtherError "no next value"); Just a -> pure a; } (finalValue, _) <- liftIO (readOne nextStream) let difference = initialValue <> inv finalValue @@ -220,7 +220,7 @@ guessingGameTest = let openingBalance = 100_000_000_000 lockAmount = 15 walletFundsChange msg delta = do - address <- pubKeyAddress <$> Simulator.handleAgentThread defaultWallet ownPubKey + address <- pubKeyHashAddress <$> Simulator.handleAgentThread defaultWallet ownPubKeyHash balance <- Simulator.valueAt address fees <- Simulator.walletFees defaultWallet assertEqual msg diff --git a/plutus-pab/tx-inject/Main.hs b/plutus-pab/tx-inject/Main.hs index a3cd74f0e78..3628ef759b4 100644 --- a/plutus-pab/tx-inject/Main.hs +++ b/plutus-pab/tx-inject/Main.hs @@ -43,7 +43,7 @@ import Ledger.Slot (Slot (..)) import Ledger.Tx (Tx (..)) import Plutus.PAB.Types (Config (..)) import TxInject.RandomTx (generateTx) -import Wallet.Emulator (chainState, txPool, walletPubKey) +import Wallet.Emulator (chainState, txPool, walletPubKeyHash) import Wallet.Emulator.MultiAgent (emulatorStateInitialDist) import Wallet.Emulator.Wallet (fromWalletNumber) @@ -77,7 +77,7 @@ initialUtxoIndex config = initialTxs = view (chainState . txPool) $ emulatorStateInitialDist $ - Map.mapKeys walletPubKey dist + Map.mapKeys walletPubKeyHash dist in insertBlock (map Valid initialTxs) (UtxoIndex Map.empty) -- | Starts the producer thread diff --git a/plutus-playground-server/usecases/Crowdfunding.hs b/plutus-playground-server/usecases/Crowdfunding.hs index d2df1d5afbd..3ba1cb9e143 100644 --- a/plutus-playground-server/usecases/Crowdfunding.hs +++ b/plutus-playground-server/usecases/Crowdfunding.hs @@ -82,7 +82,7 @@ mkCampaign ddl collectionDdl ownerWallet = Campaign { campaignDeadline = ddl , campaignCollectionDeadline = collectionDdl - , campaignOwner = pubKeyHash $ Emulator.walletPubKey ownerWallet + , campaignOwner = Emulator.walletPubKeyHash ownerWallet } -- | The 'POSIXTimeRange' during which the funds can be collected @@ -153,7 +153,7 @@ theCampaign :: POSIXTime -> Campaign theCampaign startTime = Campaign { campaignDeadline = startTime + 40000 , campaignCollectionDeadline = startTime + 60000 - , campaignOwner = pubKeyHash $ Emulator.walletPubKey (Emulator.knownWallet 1) + , campaignOwner = Emulator.walletPubKeyHash (Emulator.knownWallet 1) } -- | The "contribute" branch of the contract for a specific 'Campaign'. Exposes @@ -162,7 +162,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 <- pubKeyHash <$> ownPubKey + contributor <- ownPubKeyHash let inst = typedValidator cmp tx = Constraints.mustPayToTheScript contributor contribValue <> Constraints.mustValidateIn (Interval.to (campaignDeadline cmp)) diff --git a/plutus-playground-server/usecases/Vesting.hs b/plutus-playground-server/usecases/Vesting.hs index 31fc9bd1f0a..d528e7bbb8b 100644 --- a/plutus-playground-server/usecases/Vesting.hs +++ b/plutus-playground-server/usecases/Vesting.hs @@ -21,7 +21,6 @@ import qualified Data.Map as Map import qualified Data.Text as T import Ledger (Address, POSIXTime, POSIXTimeRange, PubKeyHash, Validator) -import qualified Ledger import qualified Ledger.Ada as Ada import Ledger.Constraints (TxConstraints, mustBeSignedBy, mustPayToTheScript, mustValidateIn) import Ledger.Contexts (ScriptContext (..), TxInfo (..)) @@ -212,7 +211,7 @@ retrieveFundsC vesting payment = do endpoints :: Contract () VestingSchema T.Text () endpoints = vestingContract vestingParams where - vestingOwner = Ledger.pubKeyHash $ walletPubKey w1 + vestingOwner = walletPubKeyHash w1 vestingParams = VestingParams {vestingTranche1, vestingTranche2, vestingOwner} vestingTranche1 =