diff --git a/plutus-pab/src/Cardano/Node/Types.hs b/plutus-pab/src/Cardano/Node/Types.hs index 8520f1233e4..96f97933919 100644 --- a/plutus-pab/src/Cardano/Node/Types.hs +++ b/plutus-pab/src/Cardano/Node/Types.hs @@ -61,6 +61,7 @@ import Data.Time.Units (Millisecond) import Data.Time.Units.Extra () import GHC.Generics (Generic) import Ledger (Tx, txId) +import Ledger.CardanoWallet (WalletNumber (..)) import Ledger.TimeSlot (SlotConfig) import qualified Plutus.Contract.Trace as Trace import Servant.Client (BaseUrl (..), Scheme (..)) @@ -68,7 +69,6 @@ import Wallet.Emulator (Wallet) import qualified Wallet.Emulator as EM import Wallet.Emulator.Chain (ChainControlEffect, ChainEffect, ChainEvent) import qualified Wallet.Emulator.MultiAgent as MultiAgent -import Wallet.Emulator.Wallet (WalletNumber (..)) import Cardano.Api.NetworkId.Extra (NetworkIdWrapper (..), testnetNetworkId) import Ledger.Fee (FeeConfig) diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Handlers.hs b/plutus-pab/src/Cardano/Wallet/Mock/Handlers.hs index da368e899f6..e7555b9ffe2 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Handlers.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Handlers.hs @@ -44,8 +44,9 @@ 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 (PubKeyHash, generateFromSeed, privateKey2, pubKeyHash, - toPublicKey) +import Ledger.CardanoWallet (MockWallet) +import qualified Ledger.CardanoWallet as CW +import Ledger.Crypto (PubKeyHash) import Ledger.Fee (FeeConfig) import Ledger.TimeSlot (SlotConfig) import Ledger.Tx (Tx) @@ -56,12 +57,10 @@ import qualified Plutus.PAB.Monitoring.Monitoring as LM import Servant (ServerError (..), err400, err401, err404) import Servant.Client (ClientEnv) import Servant.Server (err500) -import Wallet.API (PubKey, WalletAPIError (..)) +import Wallet.API (WalletAPIError (..)) import qualified Wallet.API as WAPI import Wallet.Effects (NodeClientEffect) import Wallet.Emulator.LogMessages (TxBalanceMsg) -import Wallet.Emulator.NodeClient (emptyNodeClientState) -import Wallet.Emulator.Wallet (Wallet, WalletState (..), defaultSigningProcess, knownWallet) import qualified Wallet.Emulator.Wallet as Wallet newtype Seed = Seed ScrubbedBytes @@ -84,12 +83,11 @@ integer2ByteString32 i = BS.unfoldr (\l' -> if l' < 0 then Nothing else Just (fr 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, PubKey) +newWallet :: forall m effs. (LastMember m effs, MonadIO m) => Eff effs MockWallet newWallet = do Seed seed <- generateSeed let secretKeyBytes = BS.pack . unpack $ seed - let privateKey = generateFromSeed secretKeyBytes - pure (Wallet.Wallet (Wallet.MockWallet privateKey), Wallet.emptyWalletState privateKey, toPublicKey privateKey) + return $ CW.fromSeed secretKeyBytes -- | Handle multiple wallets using existing @Wallet.handleWallet@ handler handleMultiWallet :: forall m effs. @@ -118,19 +116,21 @@ handleMultiWallet feeCfg = \case Nothing -> throwError $ WAPI.OtherError "Wallet not found" CreateWallet -> do wallets <- get @Wallets - (wallet, newState, pubKey) <- newWallet - let wallets' = Map.insert wallet newState wallets + mockWallet <- newWallet + let walletId = Wallet.Wallet $ Wallet.WalletId $ CW.mwWalletId mockWallet + wallets' = Map.insert walletId (Wallet.fromMockWallet mockWallet) wallets + pkh = CW.pubKeyHash mockWallet put wallets' -- For some reason this doesn't work with (Wallet 1)/privateKey1, -- works just fine with (Wallet 2)/privateKey2 -- ¯\_(ツ)_/¯ - let walletState = WalletState privateKey2 emptyNodeClientState mempty (defaultSigningProcess (knownWallet 2)) - _ <- evalState walletState $ + let sourceWallet = Wallet.fromMockWallet (CW.knownWallet 2) + _ <- evalState sourceWallet $ interpret (mapLog @TxBalanceMsg @WalletMsg Balancing) $ interpret (Wallet.handleWallet feeCfg) $ distributeNewWalletFunds - $ Wallet.walletPubKeyHash wallet - return $ WalletInfo{wiWallet = wallet, wiPubKey = Just pubKey, wiPubKeyHash = pubKeyHash pubKey} + $ pkh + return $ WalletInfo{wiWallet = walletId, wiPubKeyHash = pkh} GetWalletInfo wllt -> do wallets <- get @Wallets return $ fmap fromWalletState $ Map.lookup (Wallet.Wallet wllt) wallets diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Server.hs b/plutus-pab/src/Cardano/Wallet/Mock/Server.hs index e2a603d7d83..c9ddd08ebf6 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Server.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Server.hs @@ -30,7 +30,7 @@ import Data.Coerce (coerce) import Data.Function ((&)) import qualified Data.Map.Strict as Map import Data.Proxy (Proxy (Proxy)) -import Ledger.Crypto (knownPrivateKeys) +import qualified Ledger.CardanoWallet as CW import Ledger.Fee (FeeConfig) import Ledger.TimeSlot (SlotConfig) import Network.HTTP.Client (defaultManagerSettings, newManager) @@ -41,7 +41,7 @@ import Servant (Application, NoContent (.. (:<|>) ((:<|>))) import Servant.Client (BaseUrl (baseUrlPort), ClientEnv, mkClientEnv) import Wallet.Effects (balanceTx, submitTxn, totalFunds, walletAddSignature) -import Wallet.Emulator.Wallet (Wallet (..), WalletId, emptyWalletState) +import Wallet.Emulator.Wallet (Wallet (..), WalletId) import qualified Wallet.Emulator.Wallet as Wallet app :: Trace IO WalletMsg @@ -67,7 +67,7 @@ app trace txSendHandle chainSyncHandle chainIndexEnv mVarState feeCfg slotCfg = main :: Trace IO WalletMsg -> WalletConfig -> FeeConfig -> FilePath -> SlotConfig -> ChainIndexUrl -> Availability -> IO () main trace WalletConfig { baseUrl } feeCfg serverSocket slotCfg (ChainIndexUrl chainUrl) availability = LM.runLogEffects trace $ do chainIndexEnv <- buildEnv chainUrl defaultManagerSettings - let knownWallets = Map.fromList $ zip Wallet.knownWallets (emptyWalletState <$> knownPrivateKeys) + let knownWallets = Map.fromList $ zip Wallet.knownWallets (Wallet.fromMockWallet <$> CW.knownWallets) mVarState <- liftIO $ newMVar knownWallets txSendHandle <- liftIO $ MockClient.runTxSender serverSocket chainSyncHandle <- Left <$> (liftIO $ MockClient.runChainSync' serverSocket slotCfg) diff --git a/plutus-pab/src/Cardano/Wallet/Mock/Types.hs b/plutus-pab/src/Cardano/Wallet/Mock/Types.hs index 02b7cb0a33f..85352c56e68 100644 --- a/plutus-pab/src/Cardano/Wallet/Mock/Types.hs +++ b/plutus-pab/src/Cardano/Wallet/Mock/Types.hs @@ -38,41 +38,37 @@ module Cardano.Wallet.Mock.Types ( , 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 Cardano.Wallet.Primitive.AddressDerivation (digest) -import qualified Cardano.Wallet.Primitive.Types as Cardano.Wallet -import Control.Monad.Freer (Eff) -import Control.Monad.Freer.Error (Error) -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.Default (Default, def) -import Data.Map.Strict (Map) -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 (..)) -import Servant.Client (BaseUrl (..), ClientError, Scheme (..)) -import Servant.Client.Internal.HttpClient (ClientEnv) -import Wallet.Effects (NodeClientEffect, WalletEffect) -import Wallet.Emulator.Error (WalletAPIError) -import Wallet.Emulator.LogMessages (TxBalanceMsg) -import Wallet.Emulator.Wallet (Wallet (..), WalletId (..), WalletState (..)) +import Cardano.BM.Data.Tracer (ToObject (..)) +import Cardano.BM.Data.Tracer.Extras (Tagged (..), mkObjectStr) +import Cardano.ChainIndex.Types (ChainIndexUrl) +import Control.Monad.Freer (Eff) +import Control.Monad.Freer.Error (Error) +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.Default (Default, def) +import Data.Map.Strict (Map) +import Data.Text (Text) +import Data.Text.Prettyprint.Doc (Pretty (..), (<+>)) +import GHC.Generics (Generic) +import Ledger (PubKeyHash) +import Plutus.ChainIndex (ChainIndexQueryEffect) +import Plutus.PAB.Arbitrary () +import Servant (ServerError (..)) +import Servant.Client (BaseUrl (..), ClientError, Scheme (..)) +import Servant.Client.Internal.HttpClient (ClientEnv) +import Wallet.Effects (NodeClientEffect, WalletEffect) +import Wallet.Emulator.Error (WalletAPIError) +import Wallet.Emulator.LogMessages (TxBalanceMsg) +import Wallet.Emulator.Wallet (Wallet (..), WalletId (..), WalletState (..), toMockWallet, + walletPubKeyHash) -- | Information about an emulated wallet. data WalletInfo = WalletInfo { wiWallet :: Wallet - , wiPubKey :: Maybe PubKey -- ^ Public key of the wallet (if known) - , wiPubKeyHash :: PubKeyHash + , wiPubKeyHash :: PubKeyHash -- ^ Hash of the wallet's public key, serving as wallet ID } deriving stock (Show, Generic) deriving anyclass (ToJSON, FromJSON) @@ -80,14 +76,9 @@ 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 $ CardanoWallet $ Cardano.Wallet.WalletId $ digest $ _ - , wiPubKey = Just pk - , wiPubKeyHash = Crypto.pubKeyHash pk - } +fromWalletState WalletState{_mockWallet} = WalletInfo{wiWallet, wiPubKeyHash} where + wiWallet = toMockWallet _mockWallet + wiPubKeyHash = walletPubKeyHash wiWallet data MultiWalletEffect r where CreateWallet :: MultiWalletEffect WalletInfo diff --git a/plutus-pab/src/Plutus/PAB/Simulator.hs b/plutus-pab/src/Plutus/PAB/Simulator.hs index 96aaa1c8b5f..74c3288cdbd 100644 --- a/plutus-pab/src/Plutus/PAB/Simulator.hs +++ b/plutus-pab/src/Plutus/PAB/Simulator.hs @@ -93,6 +93,7 @@ import Data.Default (Default (..)) import Data.Foldable (fold, traverse_) import Data.Map (Map) import qualified Data.Map as Map +import Data.Maybe (fromMaybe) import Data.Set (Set) import Data.Text (Text) import qualified Data.Text as Text @@ -103,6 +104,8 @@ import Data.Time.Units (Millisecond) import Ledger (Address (..), Blockchain, PubKeyHash, Tx, TxId, TxOut (..), eitherTx, txFee, txId) import qualified Ledger.Ada as Ada +import Ledger.CardanoWallet (MockWallet) +import qualified Ledger.CardanoWallet as CW import Ledger.Crypto (PubKey) import Ledger.Fee (FeeConfig) import qualified Ledger.Index as UtxoIndex @@ -156,13 +159,12 @@ data AgentState t = makeLenses ''AgentState -initialAgentState :: forall t. Wallet -> AgentState t -initialAgentState (Wallet (MockWallet privKey)) = +initialAgentState :: forall t. MockWallet -> AgentState t +initialAgentState mw= AgentState - { _walletState = Wallet.emptyWalletState privKey + { _walletState = Wallet.fromMockWallet mw , _submittedFees = mempty } -initialAgentState (Wallet _) = error "Only mock wallets supported in the simulator" data SimulatorState t = SimulatorState @@ -179,7 +181,7 @@ initialState :: forall t. IO (SimulatorState t) initialState = do let initialDistribution = Map.fromList $ fmap (, Ada.adaValueOf 100_000) knownWallets Emulator.EmulatorState{Emulator._chainState} = Emulator.initialState (def & Emulator.initialChainState .~ Left initialDistribution) - initialWallets = Map.fromList $ fmap (\w -> (w, initialAgentState w)) knownWallets + initialWallets = Map.fromList $ fmap (\w -> (Wallet.Wallet $ Wallet.WalletId $ CW.mwWalletId w, initialAgentState w)) CW.knownWallets STM.atomically $ SimulatorState <$> STM.newTQueue @@ -300,6 +302,8 @@ handleServicesSimulator feeCfg slotCfg wallet = . reinterpret (runWalletState @t wallet) . reinterpretN @'[State Wallet.WalletState, Error WAPI.WalletAPIError, LogMsg TxBalanceMsg] (Wallet.handleWallet feeCfg) +initialStateFromWallet = maybe (error "runWalletState") (initialAgentState . Wallet._mockWallet) . Wallet.emptyWalletState + -- | Handle the 'State WalletState' effect by reading from and writing -- to a TVar in the 'SimulatorState' runWalletState :: @@ -326,7 +330,8 @@ runWalletState wallet = \case mp <- STM.readTVar _agentStates case Map.lookup wallet mp of Nothing -> do - let newState = initialAgentState wallet & walletState .~ s + let ws = maybe (error "runWalletState") (initialAgentState . Wallet._mockWallet) (Wallet.emptyWalletState wallet) + newState = ws & walletState .~ s STM.writeTVar _agentStates (Map.insert wallet newState mp) Just s' -> do let newState = s' & walletState .~ s @@ -538,7 +543,7 @@ handleNodeClient slotCfg wallet = \case mp <- STM.readTVar _agentStates case Map.lookup wallet mp of Nothing -> do - let newState = initialAgentState wallet & submittedFees . at (txId tx) ?~ txFee tx + let newState = initialStateFromWallet wallet & submittedFees . at (txId tx) ?~ txFee tx STM.writeTVar _agentStates (Map.insert wallet newState mp) Just s' -> do let newState = s' & submittedFees . at (txId tx) ?~ txFee tx @@ -733,7 +738,7 @@ instanceActivity = Core.instanceActivity addWallet :: forall t. Simulation t (Wallet,PubKey) addWallet = do SimulatorState{_agentStates} <- Core.askUserEnv @t @(SimulatorState t) - (newWallet, newState, walletKey) <- MockWallet.newWallet + mockWallet <- MockWallet.newWallet void $ liftIO $ STM.atomically $ do currentWallets <- STM.readTVar _agentStates let newWallets = currentWallets & at newWallet ?~ AgentState newState mempty diff --git a/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs b/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs index 9d071de8b5d..719e2d93cdc 100644 --- a/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs +++ b/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs @@ -55,7 +55,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, walletPubKey) +import Wallet.Emulator.Wallet (Wallet (..), WalletId, knownWallet) import Wallet.Types (ContractActivityStatus, ContractInstanceId (..), parseContractActivityStatus) @@ -206,7 +206,7 @@ walletProxy :: walletProxy createNewWallet = createNewWallet :<|> (\w tx -> fmap (const NoContent) (Core.handleAgentThread (Wallet w) $ Wallet.Effects.submitTxn tx)) - :<|> (\w -> (\pkh -> WalletInfo{wiWallet=Wallet w, wiPubKey = walletPubKey (Wallet w), wiPubKeyHash = pkh }) <$> Core.handleAgentThread (Wallet w) Wallet.Effects.ownPubKeyHash) + :<|> (\w -> (\pkh -> WalletInfo{wiWallet=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)