plutus-pab: FixesQ

plutus-contract/src/Wallet/API.hs

@@ -29,6 +29,7 @@ module Wallet.API(
     getClientSlot,
     getClientSlotConfig,
     PubKey(..),
+    PubKeyHash(..),
     signTxAndSubmit,
     signTxAndSubmit_,
     payToPublicKeyHash,

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
 

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)

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

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 -------------------------------------------------------------------------------------------------------------
 

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)

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.

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))

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,23 +63,34 @@ 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)
     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 (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

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 =