Updates

plutus-pab/src/Cardano/Node/Types.hs

@@ -61,14 +61,14 @@ 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 (..))
 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)

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

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)

plutus-pab/src/Cardano/Wallet/Mock/Types.hs

@@ -38,56 +38,47 @@ 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)
 
 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

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

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)