From 5bf764ac0e22a4614fa0fbd575e1355c951a9391 Mon Sep 17 00:00:00 2001 From: Kris Jenkins Date: Fri, 3 May 2019 12:01:56 +0100 Subject: [PATCH] Playground: The transaction table now shows friendly wallet IDs instead of hashes. Fixes #854. --- plutus-playground-client/src/Chain.purs | 11 +++++++---- .../src/Chain/BlockchainExploration.purs | 18 ++++++++++++------ plutus-playground-client/src/Types.purs | 4 ++++ 3 files changed, 23 insertions(+), 10 deletions(-) diff --git a/plutus-playground-client/src/Chain.purs b/plutus-playground-client/src/Chain.purs index 233c81af123..cf3d7ffd46d 100644 --- a/plutus-playground-client/src/Chain.purs +++ b/plutus-playground-client/src/Chain.purs @@ -12,9 +12,10 @@ import Control.Monad.Aff.Class (class MonadAff) import Data.Array as Array import Data.Generic (gShow) import Data.Int as Int -import Data.Lens (_Just, preview, toListOf, traversed, view) +import Data.Lens (_1, _Just, over, preview, toListOf, traversed, view) import Data.Lens.At (at) import Data.List (List) +import Data.Map as Map import Data.Maybe (Maybe(..), maybe) import Data.Newtype (unwrap) import Data.Set (Set) @@ -41,7 +42,7 @@ import Ledger.TxId (TxIdOf(TxIdOf)) import Ledger.Value.TH (CurrencySymbol, TokenName) import Playground.API (EvaluationResult(EvaluationResult), SimulatorWallet) import Prelude (class Monad, Unit, discard, map, show, unit, ($), (<$>), (<<<), (<>), (>>>)) -import Types (BalancesChartSlot(BalancesChartSlot), ChildQuery, ChildSlot, Query(HandleBalancesChartMessage), _simulatorWalletBalance, _simulatorWalletWallet, _tokenName, _value, _walletId, cpBalancesChart) +import Types (BalancesChartSlot(BalancesChartSlot), ChildQuery, ChildSlot, Query(HandleBalancesChartMessage), _pubKey, _simulatorWalletBalance, _simulatorWalletWallet, _tokenName, _value, _walletId, cpBalancesChart) import Wallet.Emulator.Types (EmulatorEvent(..), Wallet(..)) import Wallet.Graph (FlowGraph(FlowGraph), FlowLink(FlowLink), TxRef(TxRef)) @@ -50,9 +51,11 @@ evaluationPane:: MonadAff (EChartsEffects aff) m => EvaluationResult -> ParentHTML Query ChildQuery ChildSlot m -evaluationPane e@(EvaluationResult {emulatorLog, resultBlockchain}) = +evaluationPane e@(EvaluationResult {emulatorLog, walletKeys, resultBlockchain}) = div_ - [ blockchainExploration resultBlockchain + [ blockchainExploration + (Map.fromFoldable $ over (traversed <<< _1) (view _pubKey) walletKeys) + resultBlockchain , br_ , div_ [ h2_ [ text "Final Balances" ] diff --git a/plutus-playground-client/src/Chain/BlockchainExploration.purs b/plutus-playground-client/src/Chain/BlockchainExploration.purs index c4266750277..318ef02e8ee 100644 --- a/plutus-playground-client/src/Chain/BlockchainExploration.purs +++ b/plutus-playground-client/src/Chain/BlockchainExploration.purs @@ -8,9 +8,11 @@ import Bootstrap (nbsp) import Data.Array (mapWithIndex) import Data.Array as Array import Data.Generic (class Generic) +import Data.Lens (preview) +import Data.Lens.Index (ix) import Data.Map (Map) import Data.Map as Map -import Data.Maybe (Maybe(..), fromJust, maybe) +import Data.Maybe (Maybe(Nothing, Just), fromJust, maybe) import Data.Set (Set) import Data.Set as Set import Data.String as String @@ -25,11 +27,12 @@ import Ledger.Crypto (PubKey(PubKey)) import Ledger.Extra (LedgerMap(..), collapse) import Ledger.Extra as Ledger import Ledger.Scripts (DataScript(..), RedeemerScript(..)) -import Ledger.Tx (Tx(Tx), TxInOf(TxInOf), TxInType(..), TxOutOf(TxOutOf), TxOutRefOf(TxOutRefOf), TxOutType(..)) +import Ledger.Tx (Tx(Tx), TxInOf(TxInOf), TxInType(ConsumeScriptAddress, ConsumePublicKeyAddress), TxOutOf(TxOutOf), TxOutRefOf(TxOutRefOf), TxOutType(PayToScript, PayToPubKey)) import Ledger.TxId (TxIdOf(TxIdOf)) import Ledger.Value.TH (CurrencySymbol(..), TokenName(..), Value(..)) import Partial.Unsafe (unsafePartial) -import Types (Blockchain) +import Types (Blockchain, _walletId) +import Wallet.Emulator.Types (Wallet) type SlotId = Int type StepId = Int @@ -56,8 +59,8 @@ type Row = Tuple SlotId StepId type BalanceMap = Map (Tuple Column Row) Balance -blockchainExploration :: forall p i. Blockchain -> HTML p i -blockchainExploration blockchain = +blockchainExploration :: forall p i. Map String Wallet -> Blockchain -> HTML p i +blockchainExploration addressTargets blockchain = div_ [ h2_ [ text "Blockchain" ] , blockchainTable ] @@ -96,9 +99,12 @@ blockchainExploration blockchain = balanceMap = toBalanceMap blockchain + -- Attempt to replace the owner hash with a wallet ID. + formatOwner owner = maybe owner show $ preview (ix owner <<< _walletId) addressTargets + columnHeading FeeIx = "Fee" columnHeading ForgeIx = "Forge" - columnHeading (OwnerIx owner hash) = "Wallet #" <> abbreviate (show owner) + columnHeading (OwnerIx owner hash) = "Wallet #" <> abbreviate (formatOwner owner) columnHeading (ScriptIx owner hash) = "Script #" <> abbreviate owner columnSubheading FeeIx = "" diff --git a/plutus-playground-client/src/Types.purs b/plutus-playground-client/src/Types.purs index 33cddacc76f..067cd411547 100644 --- a/plutus-playground-client/src/Types.purs +++ b/plutus-playground-client/src/Types.purs @@ -35,6 +35,7 @@ import Gist (Gist) import Halogen.Component.ChildPath (ChildPath, cp1, cp2, cp3) import Halogen.ECharts (EChartsMessage, EChartsQuery) import Language.Haskell.Interpreter (SourceCode, InterpreterError, InterpreterResult) +import Ledger.Crypto (PubKey, _PubKey) import Ledger.Extra (LedgerMap) import Ledger.Tx (Tx) import Ledger.TxId (TxIdOf) @@ -61,6 +62,9 @@ _simulatorWalletBalance = _SimulatorWallet <<< prop (SProxy :: SProxy "simulator _walletId :: Lens' Wallet Int _walletId = _Wallet <<< prop (SProxy :: SProxy "getWallet") +_pubKey :: Lens' PubKey String +_pubKey = _PubKey <<< prop (SProxy :: SProxy "getPubKey") + _value :: Lens' Value (LedgerMap CurrencySymbol (LedgerMap TokenName Int)) _value = _Value <<< prop (SProxy :: SProxy "getValue")