From 84a8453d4dd99335749dfbe8cd2dcff0e881ae9e Mon Sep 17 00:00:00 2001 From: Kris Jenkins Date: Mon, 4 Mar 2019 16:11:02 +0000 Subject: [PATCH] Playground: Adding an experimental new transaction visualisation. --- plutus-playground-client/src/Chain.purs | 259 +++++++++++-- plutus-playground-client/src/Icons.purs | 2 + plutus-playground-client/src/Types.purs | 4 +- plutus-playground-client/static/main.scss | 88 ++++- plutus-playground-client/static/tx-arrows.svg | 9 + .../static/variables.scss | 2 +- .../test/BridgeTests.purs | 23 +- .../test/compilation_response1.json | 281 ++++++++++++++ .../test/evaluation_response1.json | 365 ++++++++++++------ .../test/evaluation_response2.json | 209 ---------- plutus-playground-client/webpack.config.js | 2 +- plutus-playground-lib/src/Playground/API.hs | 4 +- plutus-playground-server/app/PSGenerator.hs | 12 +- .../src/Playground/Server.hs | 3 +- 14 files changed, 887 insertions(+), 376 deletions(-) create mode 100644 plutus-playground-client/static/tx-arrows.svg create mode 100644 plutus-playground-client/test/compilation_response1.json delete mode 100644 plutus-playground-client/test/evaluation_response2.json diff --git a/plutus-playground-client/src/Chain.purs b/plutus-playground-client/src/Chain.purs index 429c56c55eb..163a60e6660 100644 --- a/plutus-playground-client/src/Chain.purs +++ b/plutus-playground-client/src/Chain.purs @@ -7,14 +7,21 @@ module Chain import Bootstrap (empty, nbsp) import Color (Color, rgb, white) import Control.Monad.Aff.Class (class MonadAff) +import Data.Array (mapWithIndex) import Data.Array as Array import Data.Foldable (traverse_) -import Data.Generic (gShow) +import Data.Generic (class Generic, gShow) import Data.Int as Int import Data.Lens (to, toListOf, traversed) -import Data.Maybe (Maybe(Nothing)) +import Data.Map (Map) +import Data.Map as Map +import Data.Maybe (Maybe(..), maybe) import Data.Newtype (unwrap) -import Data.Tuple.Nested ((/\)) +import Data.Set (Set) +import Data.Set as Set +import Data.String as String +import Data.Tuple (Tuple(Tuple), fst, snd) +import Data.Tuple.Nested (tuple3, (/\)) import ECharts.Commands (addItem, addLink, axisLine, axisType, backgroundColor, bar, bottom, buildItems, buildLinks, color, colorSource, colors, formatterString, itemStyle, items, label, left, lineStyle, name, nameGap, nameLocationMiddle, nameRotate, normal, right, sankey, series, sourceName, splitLine, targetName, textStyle, tooltip, top, trigger, value, xAxis, yAxis) as E import ECharts.Extras (focusNodeAdjacencyAllEdges, orientVertical, positionBottom) import ECharts.Monad (CommandsT, DSL) as E @@ -23,30 +30,60 @@ import ECharts.Types.Phantom (I) import Halogen (HTML) import Halogen.Component (ParentHTML) import Halogen.ECharts (EChartsEffects, echarts) -import Halogen.HTML (ClassName(ClassName), br_, div, div_, h2_, slot', text) +import Halogen.HTML (ClassName(ClassName), br_, div, div_, h2, h2_, h3, slot', strong_, table, tbody_, td, text, th, thead_, tr_) import Halogen.HTML.Events (input) -import Halogen.HTML.Properties (class_) +import Halogen.HTML.Properties (class_, classes, colSpan) +import Ledger.Ada.TH (Ada(..)) import Ledger.Interval (Slot(..)) -import Ledger.Types (TxIdOf(..)) +import Ledger.Types (DataScript(..), PubKey(PubKey), RedeemerScript(..), Signature(Signature), Tx(Tx), TxIdOf(TxIdOf), TxInOf(TxInOf), TxInType(..), TxOutOf(TxOutOf), TxOutRefOf(TxOutRefOf), TxOutType(..)) +import Ledger.Value.TH (CurrencySymbol(..), Value(..)) +import Partial.Unsafe (unsafePartial) import Playground.API (EvaluationResult(EvaluationResult), SimulatorWallet) -import Prelude (class Monad, Unit, discard, show, unit, ($), (<$>), (<<<), (<>)) -import Types (BalancesChartSlot(BalancesChartSlot), ChildQuery, ChildSlot, MockchainChartSlot(MockchainChartSlot), Query(HandleBalancesChartMessage, HandleMockchainChartMessage), _ada, _simulatorWalletBalance, _simulatorWalletWallet, _walletId, cpBalancesChart, cpMockchainChart) +import Prelude (class Eq, class Monad, class Ord, class Semigroup, class Show, Unit, discard, map, show, unit, (#), ($), (+), (<#>), (<$>), (<*>), (<<<), (<>), (==)) +import Types (BalancesChartSlot(BalancesChartSlot), ChildQuery, ChildSlot, MockchainChartSlot(MockchainChartSlot), Query(HandleBalancesChartMessage, HandleMockchainChartMessage), Blockchain, _ada, _simulatorWalletBalance, _simulatorWalletWallet, _walletId, cpBalancesChart, cpMockchainChart) import Wallet.Emulator.Types (EmulatorEvent(..), Wallet(..)) import Wallet.Graph (FlowGraph(FlowGraph), FlowLink(FlowLink), TxRef(TxRef)) +type SlotId = Int +type StepId = Int +type Hash = String + +data Column + = ForgeIx + | FeeIx + | OwnerIx Int Hash + | ScriptIx String Hash + +derive instance genericColumn :: Generic Column +derive instance eqColumn :: Eq Column +derive instance ordColumn :: Ord Column + +instance showColumn :: Show Column where + show FeeIx = "Fee" + show ForgeIx = "Forge" + show (OwnerIx owner hash) = show owner <> "-" <> String.take 7 hash + show (ScriptIx owner hash) = owner <> "-" <> String.take 7 hash + +type Row = Tuple SlotId StepId + +type BalanceMap = + Map (Tuple Column Row) Balance + evaluationPane:: forall m aff. MonadAff (EChartsEffects aff) m => EvaluationResult -> ParentHTML Query ChildQuery ChildSlot m -evaluationPane (EvaluationResult {emulatorLog}) = +evaluationPane e@(EvaluationResult {emulatorLog, resultBlockchain}) = div_ - [ div_ - [ h2_ [ text "Chain" ] - , slot' cpMockchainChart MockchainChartSlot + [ blockchainExploration resultBlockchain + , br_ + , div_ + [ h2_ [ text "Final Balances" ] + , slot' cpBalancesChart BalancesChartSlot (echarts Nothing) - ({width: 930, height: 600} /\ unit) - (input HandleMockchainChartMessage) + ({width: 930, height: 300} /\ unit) + (input HandleBalancesChartMessage) ] , br_ , div_ @@ -60,11 +97,11 @@ evaluationPane (EvaluationResult {emulatorLog}) = ] , br_ , div_ - [ h2_ [ text "Final Balances" ] - , slot' cpBalancesChart BalancesChartSlot + [ h2_ [ text "Chain" ] + , slot' cpMockchainChart MockchainChartSlot (echarts Nothing) - ({width: 930, height: 300} /\ unit) - (input HandleBalancesChartMessage) + ({width: 930, height: 600} /\ unit) + (input HandleMockchainChartMessage) ] ] @@ -99,9 +136,6 @@ emulatorEventPane (WalletInfo (Wallet walletId) info) = ------------------------------------------------------------ -offWhite :: Color -offWhite = rgb 188 188 193 - lightPurple :: Color lightPurple = rgb 163 128 188 @@ -111,13 +145,6 @@ lightBlue = rgb 88 119 182 fadedBlue :: Color fadedBlue = rgb 35 39 64 -softPalette :: Array Color -softPalette = - [ rgb 55 68 106 - , rgb 54 93 72 - , rgb 94 50 62 - ] - hardPalette :: Array Color hardPalette = [ rgb 210 112 240 @@ -127,6 +154,7 @@ hardPalette = , rgb 163 128 188 , rgb 112 156 240 ] + ------------------------------------------------------------ -- | Remember here that the Blockchain is latest-block *first*. @@ -206,3 +234,178 @@ balancesChartOptions wallets = do E.axisLine $ E.lineStyle $ E.color lightBlue E.splitLine $ E.lineStyle $ E.color lightBlue formatWalletId id = "Wallet #" <> show id + +------------------------------------------------------------ + +data Balance + = AdaBalance Ada + | CurrencyBalance (Array (Tuple CurrencySymbol Int)) + | Remainder + +-- | TODO this is not even close to right. +instance semigroupBalance :: Partial => Semigroup Balance where + append Remainder Remainder = Remainder + append (CurrencyBalance x) (CurrencyBalance y) = CurrencyBalance (x <> y) + append (AdaBalance (Ada {getAda: x})) (AdaBalance (Ada {getAda: y})) = AdaBalance (Ada { getAda: x + y }) + +blockchainExploration :: forall p i. Blockchain -> HTML p i +blockchainExploration blockchain = + div_ [ h2_ [ text "Blockchain" ] + , blockchainTable + ] + where + blockchainTable = + table [ classes [ ClassName "table" + , ClassName "balance-map" + ] + ] + [ thead_ + [ tr_ $ columns + # Set.map (tuple3 <$> columnHeading <*> matchCount <*> columnClass) + # Set.toUnfoldable + <#> \(heading /\ count /\ cssClass /\ _) -> th [ colSpan count ] + [ h2 [ class_ cssClass ] + [ text heading ] + ] + , tr_ $ columns + # Set.toUnfoldable + <#> \column -> th [] + [ h3 [ class_ $ columnClass column ] + [ text $ columnSubheading column ] + ] + ] + , tbody_ $ Array.reverse (Set.toUnfoldable rows) <#> + (\row -> tr_ $ columns + # Set.toUnfoldable + # Array.sortWith columnHeading + <#> \column -> + let mBalance = Map.lookup (Tuple column row) balanceMap + in td + [ class_ $ columnClass column ] + [ maybe nbsp balanceView mBalance ] + ) + ] + + balanceMap = toBalanceMap blockchain + + columnHeading FeeIx = "Fee" + columnHeading ForgeIx = "Forge" + columnHeading (OwnerIx owner hash) = "Wallet #" <> show owner + columnHeading (ScriptIx owner hash) = "Script #" <> owner + + columnSubheading FeeIx = "" + columnSubheading ForgeIx = "" + columnSubheading (OwnerIx owner hash) = "Tx/" <> String.take 10 hash <> "..." + columnSubheading (ScriptIx owner hash) = "Tx/" <> String.take 10 hash <> "..." + + matchCount :: Column -> Int + matchCount owner = Array.length $ Array.filter (isOwner owner) $ Set.toUnfoldable columns + + isOwner :: Column -> Column -> Boolean + isOwner FeeIx FeeIx = true + isOwner ForgeIx ForgeIx = true + isOwner (OwnerIx owner1 _) (OwnerIx owner2 _) = owner1 == owner2 + isOwner (ScriptIx owner1 _) (ScriptIx owner2 _) = owner1 == owner2 + isOwner _ _ = false + + columnClass :: Column -> ClassName + columnClass ForgeIx = ClassName "forge" + columnClass FeeIx = ClassName "fee" + columnClass (OwnerIx _ _) = ClassName "owner" + columnClass (ScriptIx _ _) = ClassName "script" + + columns :: Set Column + columns = Set.fromFoldable $ map fst $ Map.keys $ balanceMap + + rows :: Set Row + rows = Set.fromFoldable $ map snd $ Map.keys $ balanceMap + +toBalanceMap :: Blockchain -> Map (Tuple Column (Tuple Int Int)) Balance +toBalanceMap = + Map.fromFoldableWith (unsafePartial (<>)) + <<< Array.concat + <<< Array.concat + <<< mapWithIndex (\slotId -> mapWithIndex + (\stepId tx -> + let row = Tuple slotId stepId + in [ forgeTransactions row tx + , feeTransactions row tx + ] + <> inputTransactions row tx + <> outputTransactions row tx + )) + where + forgeTransactions :: Row -> Tuple (TxIdOf String) Tx -> Tuple (Tuple Column Row) Balance + forgeTransactions row (Tuple _ (Tx {txForge: (Value { getValue: value})})) = + Tuple (Tuple ForgeIx row) (CurrencyBalance value) + + feeTransactions :: Row -> Tuple (TxIdOf String) Tx -> Tuple (Tuple Column Row) Balance + feeTransactions row (Tuple _ (Tx {txFee: ada})) = + Tuple (Tuple FeeIx row) (AdaBalance ada) + + inputTransactions :: Row -> Tuple (TxIdOf String) Tx -> Array (Tuple (Tuple Column Row) Balance) + inputTransactions row (Tuple _ (Tx {txInputs})) = + fromTxIn <$> txInputs + where + fromTxIn :: TxInOf String -> Tuple (Tuple Column Row) Balance + fromTxIn (TxInOf { txInRef: (TxOutRefOf {txOutRefId: (TxIdOf {getTxId: hash})}) + , txInType: (ConsumePublicKeyAddress (Signature { getSignature: owner })) + }) + = Tuple (Tuple (OwnerIx owner hash) row) Remainder + fromTxIn (TxInOf { txInRef: (TxOutRefOf {txOutRefId: (TxIdOf {getTxId: hash})}) + , txInType: (ConsumeScriptAddress _ (RedeemerScript { getRedeemer: owner })) + }) + = Tuple (Tuple (ScriptIx owner hash) row) Remainder + + outputTransactions :: Row -> Tuple (TxIdOf String) Tx -> Array (Tuple (Tuple Column Row) Balance) + outputTransactions row (Tuple (TxIdOf {getTxId: hash}) (Tx {txOutputs})) = + fromTxOut <$> txOutputs + where + fromTxOut :: TxOutOf String -> Tuple (Tuple Column Row) Balance + fromTxOut (TxOutOf { txOutType: (PayToPubKey (PubKey { getPubKey: owner })) + , txOutValue: (Value { getValue: currencyBalances }) + }) + = Tuple (Tuple (OwnerIx owner hash) row) (CurrencyBalance currencyBalances) + fromTxOut (TxOutOf { txOutType: (PayToScript (DataScript { getDataScript: owner })) + , txOutValue: (Value { getValue: currencyBalances }) + }) + = Tuple (Tuple (ScriptIx owner hash) row) (CurrencyBalance currencyBalances) + +balanceClassname :: ClassName +balanceClassname = ClassName "balance" + +balanceView :: forall p i. Balance -> HTML p i +balanceView (AdaBalance (Ada {getAda: ada})) = + div [ classes [ balanceClassname + , if ada == 0 + then ClassName "balance-no-ada" + else ClassName "balance-ada" + ] + ] + [ amountView "ADA" ada ] + +balanceView (CurrencyBalance currencyBalances) = + div [ classes [ balanceClassname + , if Array.null currencyBalances + then ClassName "balance-no-currencies" + else ClassName "balance-currencies" + ] + ] + (map valueView currencyBalances) + +balanceView Remainder = + div [ classes [ balanceClassname + , ClassName "balance-remainder" + ] + ] + [] + +valueView :: forall p i. Tuple CurrencySymbol Int -> HTML p i +valueView (Tuple (CurrencySymbol sym) balance) = + amountView (show sym) balance + +amountView :: forall p i. String -> Int -> HTML p i +amountView name balance = + div_ [ strong_ [ text name ] + , text $ ": " <> show balance + ] diff --git a/plutus-playground-client/src/Icons.purs b/plutus-playground-client/src/Icons.purs index 091b329d08a..746fef7b40a 100644 --- a/plutus-playground-client/src/Icons.purs +++ b/plutus-playground-client/src/Icons.purs @@ -13,6 +13,7 @@ data Icon | Plus | Trash | Spinner + | SignIn icon :: forall p i. Icon -> HTML p i icon iconType = @@ -29,3 +30,4 @@ iconClass Github = ClassName "fa-github" iconClass Plus = ClassName "fa-plus" iconClass Trash = ClassName "fa-trash" iconClass Spinner = ClassName "fa-spinner fa-pulse" +iconClass SignIn = ClassName "fa-sign-in" diff --git a/plutus-playground-client/src/Types.purs b/plutus-playground-client/src/Types.purs index a20f3f01459..a770d1d6259 100644 --- a/plutus-playground-client/src/Types.purs +++ b/plutus-playground-client/src/Types.purs @@ -32,7 +32,7 @@ import Halogen.Component.ChildPath (ChildPath, cp1, cp2, cp3) import Halogen.ECharts (EChartsMessage, EChartsQuery) import Language.Haskell.Interpreter (CompilationError) import Ledger.Ada.TH (Ada, _Ada) -import Ledger.Types (Tx) +import Ledger.Types (Tx, TxIdOf) import Matryoshka (class Corecursive, class Recursive, Algebra, cata) import Network.RemoteData (RemoteData) import Playground.API (CompilationResult, EvaluationResult, FunctionSchema, SimpleArgumentSchema(..), SimulatorWallet, _FunctionSchema, _SimulatorWallet) @@ -213,7 +213,7 @@ cpBalancesChart = cp3 ----------------------------------------------------------- -type Blockchain = Array (Array Tx) +type Blockchain = Array (Array (Tuple (TxIdOf String) Tx)) type Signatures = Array (FunctionSchema SimpleArgumentSchema) type Simulation = { signatures :: Signatures diff --git a/plutus-playground-client/static/main.scss b/plutus-playground-client/static/main.scss index f16c2d143ad..9d4fa23ce5f 100644 --- a/plutus-playground-client/static/main.scss +++ b/plutus-playground-client/static/main.scss @@ -11,7 +11,7 @@ @import './node_modules/bootstrap/scss/images'; @import './node_modules/bootstrap/scss/code'; @import './node_modules/bootstrap/scss/grid'; -// @import './node_modules/bootstrap/scss/tables'; +@import './node_modules/bootstrap/scss/tables'; @import './node_modules/bootstrap/scss/forms'; @import './node_modules/bootstrap/scss/buttons'; @import './node_modules/bootstrap/scss/transitions'; @@ -40,7 +40,7 @@ body { font-family: 'Open Sans', sans-serif; - background:#121326; + background: $body-bg; padding-top: 15px; padding-bottom: 15px; } @@ -205,7 +205,7 @@ h2 { font-size: 100%; background: $lightPurple; border-radius: 1.5rem; - color: #1e1f30; + color: $gray-900; line-height: inherit; position: absolute; top: -1rem; @@ -241,7 +241,7 @@ h2 { } .ace-monokai { - background: #1e1f30; + background: $gray-900; .ace_gutter, .ace_marker-layer .ace_active-line { background:#1a1b2c; } @@ -255,3 +255,83 @@ h2 { color:#9bfbfa; } } + +.nav-tabs { + border-bottom: dashed 1px $lightPurple; + + .nav-link { + &.active, + &:hover { + color: $lightPurple; + border: dashed 1px $lightPurple; + border-bottom: solid 1px transparent; + } + } +} + +table.balance-map { + overflow: hidden; + border: 2px solid $gray-700; + + thead { + h3 { + font-size: 0.6rem; + } + } + + tbody { + tr:hover { + background-color: $gray-800; + + .balance-remainder::after { + content: ""; + position: absolute; + background-color: $gray-800; + bottom: 0; + left: -10%; + height: 10000px; + width: 120%; + z-index: -1; + } + } + } + + .forge { + .balance { + border-color: darken($green, 20%); + background-color: $green; + } + } + + .balance { + position: relative; + border: solid 1px darken($blue, 20%); + background-color: $blue; + color: $gray-300; + min-height: 3rem; + padding: 3px; + min-width: 5rem; + + &.balance-remainder { + background: url(tx-arrows.svg); + background-repeat: no-repeat; + background-position: center; + background-size: contain; + border: none; + } + + &.balance-no-currencies { + background-color: transparent; + border: none; + } + + & div { + min-height: 2rem; + border-top: dashed 1px $blue; + } + + & div:first-child { + border-top: none; + } + } +} diff --git a/plutus-playground-client/static/tx-arrows.svg b/plutus-playground-client/static/tx-arrows.svg new file mode 100644 index 00000000000..ab7f837a03a --- /dev/null +++ b/plutus-playground-client/static/tx-arrows.svg @@ -0,0 +1,9 @@ + + + + tx-arrows + Created with Sketch. + + + + diff --git a/plutus-playground-client/static/variables.scss b/plutus-playground-client/static/variables.scss index ff683233e85..dfb99512a4c 100644 --- a/plutus-playground-client/static/variables.scss +++ b/plutus-playground-client/static/variables.scss @@ -28,7 +28,7 @@ $info: $gray-800; $warning: $yellow; $danger: $red; $light: $gray-800; -$dark: #131325; +$dark: #121326; $body-bg: $dark; $body-color: rgba($white, .65); $link-color: $red; diff --git a/plutus-playground-client/test/BridgeTests.purs b/plutus-playground-client/test/BridgeTests.purs index 07939b6e018..674239c6790 100644 --- a/plutus-playground-client/test/BridgeTests.purs +++ b/plutus-playground-client/test/BridgeTests.purs @@ -2,6 +2,8 @@ module BridgeTests ( all ) where +import Prelude + import Control.Monad.Eff.Class (class MonadEff, liftEff) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) @@ -12,11 +14,9 @@ import Data.Generic (class Generic) import Language.Haskell.Interpreter (CompilationError) import Node.Encoding (Encoding(UTF8)) import Node.FS (FS) -import Playground.API (EvaluationResult) import Node.FS.Sync as FS -import Prelude +import Playground.API (CompilationResult, EvaluationResult) import Test.Unit (TestSuite, Test, failure, success, suite, test) -import Types (Blockchain) all :: forall eff. TestSuite (exception :: EXCEPTION, fs :: FS, random :: RANDOM | eff) all = @@ -25,13 +25,16 @@ all = jsonHandling :: forall eff. TestSuite (exception :: EXCEPTION, fs :: FS, random :: RANDOM | eff) jsonHandling = do - test "Json handling" do - response1 :: Either String Blockchain <- decodeFile "test/evaluation_response1.json" - assertRight response1 - response2 :: Either String EvaluationResult <- decodeFile "test/evaluation_response2.json" - assertRight response2 - error1 :: Either String (Array CompilationError) <- decodeFile "test/evaluation_error1.json" - assertRight error1 + suite "Json handling" do + test "Decode a CompilationResult." do + compilation1 :: Either String (Either (Array CompilationError) CompilationResult) <- decodeFile "test/compilation_response1.json" + assertRight compilation1 + test "Decode an EvaluationResult." do + evaluation1 :: Either String EvaluationResult <- decodeFile "test/evaluation_response1.json" + assertRight evaluation1 + test "Decode a CompilationError." do + error1 :: Either String (Array CompilationError) <- decodeFile "test/evaluation_error1.json" + assertRight error1 assertRight :: forall e a. Either String a -> Test e assertRight (Left err) = failure err diff --git a/plutus-playground-client/test/compilation_response1.json b/plutus-playground-client/test/compilation_response1.json new file mode 100644 index 00000000000..94b54b97930 --- /dev/null +++ b/plutus-playground-client/test/compilation_response1.json @@ -0,0 +1,281 @@ +{ + "Right": { + "functionSchema": [ + { + "argumentSchema": [ + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "vestingOwner", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getPubKey", + { + "tag": "SimpleIntSchema" + } + ] + ] + } + ], + [ + "vestingTranche2", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "vestingTrancheAmount", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getAda", + { + "tag": "SimpleIntSchema" + } + ] + ] + } + ], + [ + "vestingTrancheDate", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getSlot", + { + "tag": "SimpleIntSchema" + } + ] + ] + } + ] + ] + } + ], + [ + "vestingTranche1", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "vestingTrancheAmount", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getAda", + { + "tag": "SimpleIntSchema" + } + ] + ] + } + ], + [ + "vestingTrancheDate", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getSlot", + { + "tag": "SimpleIntSchema" + } + ] + ] + } + ] + ] + } + ] + ] + }, + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getAda", + { + "tag": "SimpleIntSchema" + } + ] + ] + } + ], + "functionName": "vestFunds" + }, + { + "argumentSchema": [ + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "vestingOwner", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getPubKey", + { + "tag": "SimpleIntSchema" + } + ] + ] + } + ], + [ + "vestingTranche2", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "vestingTrancheAmount", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getAda", + { + "tag": "SimpleIntSchema" + } + ] + ] + } + ], + [ + "vestingTrancheDate", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getSlot", + { + "tag": "SimpleIntSchema" + } + ] + ] + } + ] + ] + } + ], + [ + "vestingTranche1", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "vestingTrancheAmount", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getAda", + { + "tag": "SimpleIntSchema" + } + ] + ] + } + ], + [ + "vestingTrancheDate", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getSlot", + { + "tag": "SimpleIntSchema" + } + ] + ] + } + ] + ] + } + ] + ] + } + ], + "functionName": "registerVestingOwner" + }, + { + "argumentSchema": [ + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "ivTo", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getSlot", + { + "tag": "SimpleIntSchema" + } + ] + ] + } + ], + [ + "ivFrom", + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getSlot", + { + "tag": "SimpleIntSchema" + } + ] + ] + } + ] + ] + }, + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getValue", + { + "tag": "SimpleArraySchema", + "contents": { + "tag": "SimpleTupleSchema", + "contents": [ + { + "tag": "SimpleIntSchema" + }, + { + "tag": "SimpleIntSchema" + } + ] + } + } + ] + ] + }, + { + "tag": "SimpleObjectSchema", + "contents": [ + [ + "getPubKey", + { + "tag": "SimpleIntSchema" + } + ] + ] + } + ], + "functionName": "payToPublicKey_" + } + ], + "warnings": [] + } +} diff --git a/plutus-playground-client/test/evaluation_response1.json b/plutus-playground-client/test/evaluation_response1.json index ec9fc1ca316..c501a30286d 100644 --- a/plutus-playground-client/test/evaluation_response1.json +++ b/plutus-playground-client/test/evaluation_response1.json @@ -1,137 +1,278 @@ -[ - [ +{ + "emulatorLog": [ { - "txInputs": [ + "tag": "SlotAdd", + "contents": { + "getSlot": 2 + } + }, + { + "tag": "TxnValidate", + "contents": { + "getTxId": "nxh9GM8YMgEXGPIY3xg3GHcYdBhcGDEYSBYYjhg1GJkYihiPGMsTGF0BGBgY4xg9GMAYuBjfGGcYfRjR/w==" + } + }, + { + "tag": "TxnSubmit", + "contents": { + "getTxId": "nxh9GM8YMgEXGPIY3xg3GHcYdBhcGDEYSBYYjhg1GJkYihiPGMsTGF0BGBgY4xg9GMAYuBjfGGcYfRjR/w==" + } + }, + { + "tag": "SlotAdd", + "contents": { + "getSlot": 1 + } + }, + { + "tag": "TxnValidate", + "contents": { + "getTxId": "nxhZGNYYLRhkGOsYlxj2GNwYixhmGHEYrhh2GMoYQBhFGBsY0hj5GFgY9xgkGJEPGIkYehi9GMsY/hjvGDQYlP8=" + } + } + ], + "resultBlockchain": [ + [ + [ { - "txInType": { - "tag": "ConsumePublicKeyAddress", - "contents": { - "getSignature": 2 + "getTxId": "nxh9GM8YMgEXGPIY3xg3GHcYdBhcGDEYSBYYjhg1GJkYihiPGMsTGF0BGBgY4xg9GMAYuBjfGGcYfRjR/w==" + }, + { + "txInputs": [ + { + "txInType": { + "tag": "ConsumePublicKeyAddress", + "contents": { + "getSignature": 1 + } + }, + "txInRef": { + "txOutRefIdx": 0, + "txOutRefId": { + "getTxId": "nxhZGNYYLRhkGOsYlxj2GNwYixhmGHEYrhh2GMoYQBhFGBsY0hj5GFgY9xgkGJEPGIkYehi9GMsY/hjvGDQYlP8=" + } + } } + ], + "txFee": { + "getAda": 0 }, - "txInRef": { - "txOutRefIdx": 1, - "txOutRefId": { - "getTxId": "nxixGGwYuQ8Y4gAY8RjcGOQYVBjEARhUGOAYohhtGJgYmxMYcBhNGJcYwgQYPBisGOkYKRhGGIcYcBij/w==" + "txValidRange": { + "ivTo": { + "getSlot": 50 + }, + "ivFrom": { + "getSlot": 0 } - } - } - ], - "txFee": { - "getAda": 0 - }, - "txForge": { - "getValue": [] - }, - "txOutputs": [ - { - "txOutValue": { - "getValue": [[0,26]] }, - "txOutAddress": { - "getAddress": "nxgcGMMYrRjqGEAY6xj9GJQYQxg6GMAEGHcYfRhoFQwYzhidGLQYxxhxGLwYfRjhGLIYlxinGLcYlRi7GLr/" + "txForge": { + "getValue": [] }, - "txOutType": { - "tag": "PayToPubKey", - "contents": { - "getPubKey": 2 + "txOutputs": [ + { + "txOutValue": { + "getValue": [ + [ + 0, + 5 + ] + ] + }, + "txOutAddress": { + "getAddress": "nxgcGMMYrRjqGEAY6xj9GJQYQxg6GMAEGHcYfRhoFQwYzhidGLQYxxhxGLwYfRjhGLIYlxinGLcYlRi7GLr/" + }, + "txOutType": { + "tag": "PayToPubKey", + "contents": { + "getPubKey": 2 + } + } + }, + { + "txOutValue": { + "getValue": [ + [ + 0, + 5 + ] + ] + }, + "txOutAddress": { + "getAddress": "nxicEhjPGNwEGMcYRRiEGNcYhxisGD0YIxh3GCEYMhjBGIUYJBi8GHoYshiNGOwYQhgZGLgY/BhbGEIYXxhw/w==" + }, + "txOutType": { + "tag": "PayToPubKey", + "contents": { + "getPubKey": 1 + } + } } - } + ] + } + ] + ], + [ + [ + { + "getTxId": "nxhZGNYYLRhkGOsYlxj2GNwYixhmGHEYrhh2GMoYQBhFGBsY0hj5GFgY9xgkGJEPGIkYehi9GMsY/hjvGDQYlP8=" }, { - "txOutValue": { - "getValue": [[0,4]] + "txInputs": [], + "txFee": { + "getAda": 0 }, - "txOutAddress": { - "getAddress": "nxicEhjPGNwEGMcYRRiEGNcYhxisGD0YIxh3GCEYMhjBGIUYJBi8GHoYshiNGOwYQhgZGLgY/BhbGEIYXxhw/w==" + "txValidRange": { + "ivTo": null, + "ivFrom": { + "getSlot": 0 + } + }, + "txForge": { + "getValue": [ + [ + 0, + 20 + ] + ] }, - "txOutType": { - "tag": "PayToPubKey", - "contents": { - "getPubKey": 1 + "txOutputs": [ + { + "txOutValue": { + "getValue": [ + [ + 0, + 10 + ] + ] + }, + "txOutAddress": { + "getAddress": "nxicEhjPGNwEGMcYRRiEGNcYhxisGD0YIxh3GCEYMhjBGIUYJBi8GHoYshiNGOwYQhgZGLgY/BhbGEIYXxhw/w==" + }, + "txOutType": { + "tag": "PayToPubKey", + "contents": { + "getPubKey": 1 + } + } + }, + { + "txOutValue": { + "getValue": [ + [ + 0, + 10 + ] + ] + }, + "txOutAddress": { + "getAddress": "nxgcGMMYrRjqGEAY6xj9GJQYQxg6GMAEGHcYfRhoFQwYzhidGLQYxxhxGLwYfRjhGLIYlxinGLcYlRi7GLr/" + }, + "txOutType": { + "tag": "PayToPubKey", + "contents": { + "getPubKey": 2 + } + } } - } - } - ], - "txValidRange": { - "ivTo" : null, - "ivFrom" : null - }, - "txSignatures": [ - { - "getSignature": 2 + ] } ] - } + ] ], - [], - [], - [], - [], - [], - [], - [], - [], - [], - [], - [ - { - "txInputs": [], - "txFee": { - "getAda": 0 - }, - "txForge": { - "getValue": [[0,50]] + "resultGraph": { + "flowGraphNodes": [ + "59d62d64", + "7dcf3201", + "utxo 59d62d64 1", + "utxo 7dcf3201 0", + "utxo 7dcf3201 1" + ], + "flowGraphLinks": [ + { + "flowLinkOwner": { + "tag": "PubKeyOwner", + "contents": { + "getPubKey": 2 + } + }, + "flowLinkValue": 10, + "flowLinkSourceLoc": { + "utxoLocBlock": 1, + "utxoLocBlockIdx": 1 + }, + "flowLinkSource": "59d62d64", + "flowLinkTargetLoc": null, + "flowLinkTarget": "utxo 59d62d64 1" }, - "txOutputs": [ - { - "txOutValue": { - "getValue": [[0,10]] - }, - "txOutAddress": { - "getAddress": "nxicEhjPGNwEGMcYRRiEGNcYhxisGD0YIxh3GCEYMhjBGIUYJBi8GHoYshiNGOwYQhgZGLgY/BhbGEIYXxhw/w==" - }, - "txOutType": { - "tag": "PayToPubKey", - "contents": { - "getPubKey": 1 - } + { + "flowLinkOwner": { + "tag": "PubKeyOwner", + "contents": { + "getPubKey": 2 } }, - { - "txOutValue": { - "getValue": [[0,30]] - }, - "txOutAddress": { - "getAddress": "nxgcGMMYrRjqGEAY6xj9GJQYQxg6GMAEGHcYfRhoFQwYzhidGLQYxxhxGLwYfRjhGLIYlxinGLcYlRi7GLr/" - }, - "txOutType": { - "tag": "PayToPubKey", - "contents": { - "getPubKey": 2 - } + "flowLinkValue": 5, + "flowLinkSourceLoc": { + "utxoLocBlock": 2, + "utxoLocBlockIdx": 1 + }, + "flowLinkSource": "7dcf3201", + "flowLinkTargetLoc": null, + "flowLinkTarget": "utxo 7dcf3201 0" + }, + { + "flowLinkOwner": { + "tag": "PubKeyOwner", + "contents": { + "getPubKey": 1 } }, - { - "txOutValue": { - "getValue": [[0,10]] - }, - "txOutAddress": { - "getAddress": "nxjJGEIYoBhsEhh8GCwYGAIYJhh3GOgYiAIKGPsXGEIIGNIYmRg1GE8YPhjPGO0YsRgkGKEY8xj6GEX/" - }, - "txOutType": { - "tag": "PayToPubKey", - "contents": { - "getPubKey": 3 - } + "flowLinkValue": 5, + "flowLinkSourceLoc": { + "utxoLocBlock": 2, + "utxoLocBlockIdx": 1 + }, + "flowLinkSource": "7dcf3201", + "flowLinkTargetLoc": null, + "flowLinkTarget": "utxo 7dcf3201 1" + }, + { + "flowLinkOwner": { + "tag": "PubKeyOwner", + "contents": { + "getPubKey": 1 } - } - ], - "txValidRange": { - "ivTo" : null, - "ivFrom" : null + }, + "flowLinkValue": 10, + "flowLinkSourceLoc": { + "utxoLocBlock": 1, + "utxoLocBlockIdx": 1 + }, + "flowLinkSource": "59d62d64", + "flowLinkTargetLoc": { + "utxoLocBlock": 2, + "utxoLocBlockIdx": 1 + }, + "flowLinkTarget": "7dcf3201" + } + ] + }, + "fundsDistribution": [ + { + "simulatorWalletBalance": { + "getAda": 5 + }, + "simulatorWalletWallet": { + "getWallet": 1 + } + }, + { + "simulatorWalletBalance": { + "getAda": 15 }, - "txSignatures": [] + "simulatorWalletWallet": { + "getWallet": 2 + } } ] -] +} diff --git a/plutus-playground-client/test/evaluation_response2.json b/plutus-playground-client/test/evaluation_response2.json deleted file mode 100644 index 43be115bdc4..00000000000 --- a/plutus-playground-client/test/evaluation_response2.json +++ /dev/null @@ -1,209 +0,0 @@ -{ - "emulatorLog": [ - { - "tag": "SlotAdd", - "contents": { - "getSlot": 11 - } - }, - { - "tag": "SlotAdd", - "contents": { - "getSlot": 10 - } - }, - { - "tag": "SlotAdd", - "contents": { - "getSlot": 9 - } - }, - { - "tag": "SlotAdd", - "contents": { - "getSlot": 8 - } - }, - { - "tag": "SlotAdd", - "contents": { - "getSlot": 7 - } - }, - { - "tag": "SlotAdd", - "contents": { - "getSlot": 6 - } - }, - { - "tag": "SlotAdd", - "contents": { - "getSlot": 5 - } - }, - { - "tag": "SlotAdd", - "contents": { - "getSlot": 4 - } - }, - { - "tag": "SlotAdd", - "contents": { - "getSlot": 3 - } - }, - { - "tag": "SlotAdd", - "contents": { - "getSlot": 2 - } - }, - { - "tag": "SlotAdd", - "contents": { - "getSlot": 1 - } - }, - { - "tag": "TxnValidate", - "contents": { - "getTxId": "nxi5GGYYkxgjGJEYzBiAGB4YxBjyGFUYlRgtGLQYXxgbGNEYHBjTGM0YgxiOGEUYjBijGNgYJhhlGKEY7BjAGH7/" - } - } - ], - "resultBlockchain": [ - [], - [], - [], - [], - [], - [], - [], - [], - [], - [], - [ - { - "txInputs": [], - "txFee": { - "getAda": 0 - }, - "txValidRange": { - "ivTo": null, - "ivFrom": { - "getSlot": 0 - } - }, - "txForge": { - "getValue": [ - [ - 0, - 21 - ] - ] - }, - "txOutputs": [ - { - "txOutValue": { - "getValue": [ - [ - 0, - 11 - ] - ] - }, - "txOutAddress": { - "getAddress": "nxicEhjPGNwEGMcYRRiEGNcYhxisGD0YIxh3GCEYMhjBGIUYJBi8GHoYshiNGOwYQhgZGLgY/BhbGEIYXxhw/w==" - }, - "txOutType": { - "tag": "PayToPubKey", - "contents": { - "getPubKey": 1 - } - } - }, - { - "txOutValue": { - "getValue": [ - [ - 0, - 10 - ] - ] - }, - "txOutAddress": { - "getAddress": "nxgcGMMYrRjqGEAY6xj9GJQYQxg6GMAEGHcYfRhoFQwYzhidGLQYxxhxGLwYfRjhGLIYlxinGLcYlRi7GLr/" - }, - "txOutType": { - "tag": "PayToPubKey", - "contents": { - "getPubKey": 2 - } - } - } - ] - } - ] - ], - "resultGraph": { - "flowGraphNodes": [ - "b9669323", - "utxo b9669323 0", - "utxo b9669323 1" - ], - "flowGraphLinks": [ - { - "flowLinkOwner": { - "tag": "PubKeyOwner", - "contents": { - "getPubKey": 1 - } - }, - "flowLinkValue": 11, - "flowLinkSourceLoc": { - "utxoLocBlock": 1, - "utxoLocBlockIdx": 1 - }, - "flowLinkSource": "b9669323", - "flowLinkTargetLoc": null, - "flowLinkTarget": "utxo b9669323 0" - }, - { - "flowLinkOwner": { - "tag": "PubKeyOwner", - "contents": { - "getPubKey": 2 - } - }, - "flowLinkValue": 10, - "flowLinkSourceLoc": { - "utxoLocBlock": 1, - "utxoLocBlockIdx": 1 - }, - "flowLinkSource": "b9669323", - "flowLinkTargetLoc": null, - "flowLinkTarget": "utxo b9669323 1" - } - ] - }, - "fundsDistribution": [ - { - "simulatorWalletBalance": { - "getAda": 11 - }, - "simulatorWalletWallet": { - "getWallet": 1 - } - }, - { - "simulatorWalletBalance": { - "getAda": 10 - }, - "simulatorWalletWallet": { - "getWallet": 2 - } - } - ] -} diff --git a/plutus-playground-client/webpack.config.js b/plutus-playground-client/webpack.config.js index f8f1c5f1ee3..3d8c4c5edef 100644 --- a/plutus-playground-client/webpack.config.js +++ b/plutus-playground-client/webpack.config.js @@ -45,7 +45,7 @@ module.exports = { module: { rules: [ { test: /\.woff(2)?(\?v=[0-9]\.[0-9]\.[0-9])?$/, loader: "url-loader?limit=10000&mimetype=application/font-woff" }, - { test: /\.(ttf|eot|svg)(\?v=[0-9]\.[0-9]\.[0-9])?$/, loader: "file-loader" }, + { test: /fontawesome-.*\.(ttf|eot|svg)(\?v=[0-9]\.[0-9]\.[0-9])?$/, loader: "file-loader" }, { test: /\.purs$/, use: [ diff --git a/plutus-playground-lib/src/Playground/API.hs b/plutus-playground-lib/src/Playground/API.hs index c1a91a3086b..8a8f30a7d95 100644 --- a/plutus-playground-lib/src/Playground/API.hs +++ b/plutus-playground-lib/src/Playground/API.hs @@ -33,7 +33,7 @@ import Language.Haskell.Interpreter (CompilationError (CompilationErro text) import qualified Language.Haskell.TH.Syntax as TH import Ledger.Ada (Ada) -import Ledger.Types (Blockchain, PubKey) +import Ledger.Types (Tx, TxId, Blockchain, PubKey) import Servant.API ((:<|>), (:>), Get, JSON, Post, ReqBody) import Text.Read (readMaybe) import Wallet.Emulator.Types (EmulatorEvent, Wallet) @@ -82,7 +82,7 @@ pubKeys :: Evaluation -> [PubKey] pubKeys Evaluation{..} = pack . unpack . simulatorWalletWallet <$> wallets data EvaluationResult = EvaluationResult - { resultBlockchain :: Blockchain + { resultBlockchain :: [[(TxId, Tx)]] -- Blockchain annotated with hashes. , resultGraph :: FlowGraph , emulatorLog :: [EmulatorEvent] , fundsDistribution :: [SimulatorWallet] diff --git a/plutus-playground-server/app/PSGenerator.hs b/plutus-playground-server/app/PSGenerator.hs index 796741128c3..a5eee1282c3 100644 --- a/plutus-playground-server/app/PSGenerator.hs +++ b/plutus-playground-server/app/PSGenerator.hs @@ -29,7 +29,7 @@ import qualified Data.Text.IO as T () import Gist (Gist, GistFile, GistId, NewGist, NewGistFile, Owner) import Language.Haskell.Interpreter (CompilationError) import Language.PureScript.Bridge (BridgePart, Language (Haskell), PSType, SumType, - TypeInfo (TypeInfo), buildBridge, equal, mkSumType, + TypeInfo (TypeInfo), buildBridge, equal, mkSumType, order, psTypeParameters, typeModule, typeName, writePSTypes, (^==)) import Language.PureScript.Bridge.PSTypes (psArray, psInt, psString) import Language.PureScript.Bridge.TypeParameters (A) @@ -157,8 +157,9 @@ myTypes = , (equal <*> mkSumType) (Proxy @Wallet) , (equal <*> mkSumType) (Proxy @SimulatorWallet) , mkSumType (Proxy @DataScript) - , mkSumType (Proxy @ValidatorScript) - , mkSumType (Proxy @RedeemerScript) + , (equal <*> (order <*> mkSumType)) (Proxy @ValidatorScript) + , (equal <*> (order <*> mkSumType)) (Proxy @RedeemerScript) + , (equal <*> (order <*> mkSumType)) (Proxy @Signature) , mkSumType (Proxy @CompilationError) , mkSumType (Proxy @Expression) , mkSumType (Proxy @Evaluation) @@ -173,10 +174,9 @@ myTypes = , mkSumType (Proxy @TxOutType) , mkSumType (Proxy @(TxOutOf A)) , mkSumType (Proxy @(TxIdOf A)) - , mkSumType (Proxy @TxInType) - , mkSumType (Proxy @Signature) + , (equal <*> (order <*> mkSumType)) (Proxy @TxInType) , mkSumType (Proxy @Value) - , mkSumType (Proxy @PubKey) + , (equal <*> (order <*> mkSumType)) (Proxy @PubKey) , mkSumType (Proxy @(AddressOf A)) , mkSumType (Proxy @FlowLink) , mkSumType (Proxy @TxRef) diff --git a/plutus-playground-server/src/Playground/Server.hs b/plutus-playground-server/src/Playground/Server.hs index 598d5bb5cae..6062ecffc16 100644 --- a/plutus-playground-server/src/Playground/Server.hs +++ b/plutus-playground-server/src/Playground/Server.hs @@ -18,6 +18,7 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as Text import Language.Haskell.Interpreter (CompilationError) +import Ledger.Types (hashTx) import Network.HTTP.Types (hContentType) import Playground.API (API, CompilationResult, Evaluation, EvaluationResult (EvaluationResult), PlaygroundError (PlaygroundTimeout), SourceCode (SourceCode), @@ -63,7 +64,7 @@ runFunction evaluation = do let flowgraph = V.graph $ V.txnFlows pubKeys blockchain pure $ EvaluationResult - blockchain + (fmap (\tx -> (hashTx tx, tx)) <$> blockchain) flowgraph emulatorLog fundsDistribution