From 28a1826be88f22833b9bc6f2e4bab1a732da579f Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Tue, 21 Sep 2021 01:53:25 +0200 Subject: [PATCH] Have abortTx redeem the txIn The abortTx would try to spend an input which is governed by the initial validator. --- hydra-node/src/Hydra/Chain/Direct/Tx.hs | 103 ++++++++++++------- hydra-node/test/Hydra/Chain/Direct/TxSpec.hs | 27 +++-- 2 files changed, 82 insertions(+), 48 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index d2cbaef11c9..39aae63d046 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs @@ -10,17 +10,19 @@ module Hydra.Chain.Direct.Tx where import Hydra.Prelude +import Cardano.Crypto.Hash (hashFromBytes) import Cardano.Ledger.Address (Addr (Addr)) import Cardano.Ledger.Alonzo (AlonzoEra) import Cardano.Ledger.Alonzo.Data (Data (Data), hashData) -import Cardano.Ledger.Alonzo.Scripts (Script (PlutusScript)) +import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), Script (PlutusScript), Tag (Spend)) import Cardano.Ledger.Alonzo.Tx (IsValid (IsValid), ValidatedTx (..)) import Cardano.Ledger.Alonzo.TxBody (TxBody (..), TxOut (TxOut)) -import Cardano.Ledger.Alonzo.TxWitness (Redeemers (..), TxDats (..), TxWitness (..), unTxDats) -import Cardano.Ledger.Crypto (StandardCrypto) +import Cardano.Ledger.Alonzo.TxWitness (RdmrPtr (RdmrPtr), Redeemers (..), TxDats (..), TxWitness (..), unTxDats) +import Cardano.Ledger.Crypto (Crypto (ADDRHASH), StandardCrypto) import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval (..)) import Cardano.Ledger.Val (inject) import qualified Data.Map as Map +import Data.Maybe (fromJust) import qualified Data.Sequence.Strict as StrictSeq import qualified Data.Set as Set import Hydra.Chain (HeadParameters (..), OnChainTx (OnInitTx), PostChainTx (InitTx)) @@ -28,11 +30,12 @@ import Hydra.Contract.Head (State (Initial)) import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime, contestationPeriodToDiffTime) import Hydra.Data.Party (partyFromVerKey, partyToVerKey) import Hydra.Party (anonymousParty, vkey) -import Plutus.V1.Ledger.Api (fromData, toBuiltinData, toData) +import Plutus.V1.Ledger.Api (ValidatorHash (ValidatorHash), fromBuiltin, fromData, toBuiltinData, toData) import Shelley.Spec.Ledger.API ( Coin (..), Credential (ScriptHashObj), Network (Testnet), + ScriptHash (ScriptHash), StakeReference (StakeRefNull), StrictMaybe (..), TxIn, @@ -44,29 +47,32 @@ import Shelley.Spec.Ledger.Tx (hashScript) network :: Network network = Testnet +type Era = AlonzoEra StandardCrypto + -- * Post Hydra Head transactions -- | Construct the Head protocol transactions as Alonzo 'Tx'. Note that -- 'ValidatedTx' this produces an unbalanced, unsigned transaction and this type -- was used (in contrast to 'TxBody') to be able to express included datums, -- onto which at least the 'initTx' relies on. -constructTx :: TxIn StandardCrypto -> PostChainTx tx -> ValidatedTx (AlonzoEra StandardCrypto) +constructTx :: TxIn StandardCrypto -> PostChainTx tx -> ValidatedTx Era constructTx txIn = \case InitTx p -> initTx p txIn - AbortTx _utxo -> abortTx + AbortTx _utxo -> abortTx txIn _ -> error "not implemented" -- | Create the init transaction from some 'HeadParameters' and a single TxIn -- which will be used as unique parameter for minting NFTs. -initTx :: HeadParameters -> TxIn StandardCrypto -> ValidatedTx (AlonzoEra StandardCrypto) +initTx :: HeadParameters -> TxIn StandardCrypto -> ValidatedTx Era initTx HeadParameters{contestationPeriod, parties} txIn = - mkUnsignedTx body dats + mkUnsignedTx body dats mempty where body = TxBody { inputs = Set.singleton txIn , collateral = mempty - , outputs = StrictSeq.singleton headOut + , -- TODO(SN): of course this is missing the PT outputs + outputs = StrictSeq.singleton headOut , txcerts = mempty , txwdrls = Wdrl mempty , txfee = Coin 0 @@ -84,36 +90,29 @@ initTx HeadParameters{contestationPeriod, parties} txIn = headOut = TxOut headAddress headValue (SJust headDatumHash) -- TODO(SN): The main Hydra Head script address. Will be parameterized by the - -- thread token eventually. For now, this is just some arbitrary address, as - -- it is also later quite arbitrary/different per Head. - headAddress :: Addr StandardCrypto - headAddress = - Addr - network - (ScriptHashObj $ hashScript @(AlonzoEra StandardCrypto) headScript) - -- REVIEW(SN): stake head funds? - StakeRefNull + -- thread token eventually. For now, this is just the initial script as well, + -- although this could be really some arbitrary address. After all it is also + -- later quite arbitrary/different per Head. + headAddress = validatorHashToAddr Initial.validatorHash -- REVIEW(SN): how much to store here / minUtxoValue / depending on assets? headValue = inject (Coin 0) - headDatumHash = hashData @(AlonzoEra StandardCrypto) headDatum + headDatumHash = hashData @Era headDatum headDatum = - Data . toData . toBuiltinData $ + Data . toData $ Initial (contestationPeriodFromDiffTime contestationPeriod) (map (partyFromVerKey . vkey) parties) - headScript = PlutusScript "some invalid plutus script" - -abortTx :: ValidatedTx (AlonzoEra StandardCrypto) -abortTx = - mkUnsignedTx body mempty +abortTx :: TxIn StandardCrypto -> ValidatedTx Era +abortTx txIn = + mkUnsignedTx body mempty redeemers where body = TxBody - { inputs = mempty + { inputs = Set.singleton txIn , collateral = mempty , outputs = mempty , txcerts = mempty @@ -128,14 +127,22 @@ abortTx = , txnetworkid = SNothing } + -- TODO(SN): dummy exUnits, balancing overrides them? + redeemers = Map.singleton (RdmrPtr Spend 0) (redeemerData, ExUnits 0 0) + + -- TODO(SN): This should be 'Abort' or so + redeemerData = Data $ toData () + +-- + -- * Observe Hydra Head transactions -observeTx :: ValidatedTx (AlonzoEra StandardCrypto) -> Maybe (OnChainTx tx) +observeTx :: ValidatedTx Era -> Maybe (OnChainTx tx) observeTx tx = observeInitTx tx <|> observeAbortTx tx -observeInitTx :: ValidatedTx (AlonzoEra StandardCrypto) -> Maybe (OnChainTx tx) +observeInitTx :: ValidatedTx Era -> Maybe (OnChainTx tx) observeInitTx ValidatedTx{wits} = do (Data d) <- firstDatum fromData d >>= \case @@ -149,26 +156,46 @@ observeInitTx ValidatedTx{wits} = do convertParty = anonymousParty . partyToVerKey -observeAbortTx :: ValidatedTx (AlonzoEra StandardCrypto) -> Maybe (OnChainTx tx) +observeAbortTx :: ValidatedTx Era -> Maybe (OnChainTx tx) observeAbortTx _ = Just OnAbortTx -- -- * Helpers mkUnsignedTx :: - TxBody (AlonzoEra StandardCrypto) -> - TxDats (AlonzoEra StandardCrypto) -> - ValidatedTx (AlonzoEra StandardCrypto) -mkUnsignedTx body datums = + TxBody Era -> + TxDats Era -> + Map RdmrPtr (Data Era, ExUnits) -> + ValidatedTx Era +mkUnsignedTx body datums redeemers = ValidatedTx { body , wits = TxWitness - mempty -- txwitsVKey - mempty -- txwitsBoot - mempty --txscripts - datums -- txdats - (Redeemers mempty) -- txrdmrs + { txwitsVKey = mempty + , txwitsBoot = mempty + , txscripts = mempty + , txdats = datums + , txrdmrs = Redeemers redeemers + } , isValid = IsValid True -- REVIEW(SN): no idea of the semantics of this , auxiliaryData = SNothing } + +-- | Convert a plutus address to the ledger representation +validatorHashToAddr :: ValidatorHash -> Addr StandardCrypto +validatorHashToAddr (ValidatorHash builtinByteString) = + Addr + network + (ScriptHashObj $ ScriptHash hash) + -- REVIEW(SN): stake head funds? + StakeRefNull + where + -- TODO(SN): this will likely fail, StandardCrypto uses Blake2b_224 and Plutus + -- seems to be giving us SHA256? + hash = + fromJust + (error $ "ValidatorHash is not (the right) hash: " <> show bytes) + $ hashFromBytes @(ADDRHASH StandardCrypto) bytes + + bytes = fromBuiltin builtinByteString diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs index 22762a85a11..ff8138b925c 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs @@ -9,16 +9,17 @@ import Test.Hydra.Prelude import Cardano.Binary (serialize) import Cardano.Ledger.Alonzo (TxOut) -import Cardano.Ledger.Alonzo.Data (Data (Data)) +import Cardano.Ledger.Alonzo.Data (Data (Data), hashData) import Cardano.Ledger.Alonzo.Language (Language (PlutusV1)) import Cardano.Ledger.Alonzo.Scripts (ExUnits) import Cardano.Ledger.Alonzo.Tools (ScriptFailure, evaluateTransactionExecutionUnits) -import Cardano.Ledger.Alonzo.Tx (ValidatedTx (ValidatedTx, body, wits), outputs) +import Cardano.Ledger.Alonzo.Tx (ValidatedTx (ValidatedTx, wits)) import Cardano.Ledger.Alonzo.TxBody (TxOut (TxOut)) -import Cardano.Ledger.Alonzo.TxWitness (RdmrPtr, TxWitness (txdats), nullDats, unTxDats) +import Cardano.Ledger.Alonzo.TxWitness (RdmrPtr, TxWitness (txdats), unTxDats) import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Mary.Value (AssetName, PolicyID, Value (Value)) import Cardano.Ledger.Slot (EpochSize (EpochSize)) +import Cardano.Ledger.Val (inject) import Cardano.Slotting.EpochInfo (fixedEpochInfo) import Cardano.Slotting.Time (SystemStart (..), mkSlotLength) import Data.Array (array) @@ -35,8 +36,8 @@ import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime) import Hydra.Data.Party (partyFromVerKey) import Hydra.Ledger.Simple (SimpleTx) import Hydra.Party (vkey) -import Plutus.V1.Ledger.Api (toBuiltinData, toData) -import Shelley.Spec.Ledger.API (UTxO) +import Plutus.V1.Ledger.Api (PubKeyHash (PubKeyHash), toBuiltinData, toData) +import Shelley.Spec.Ledger.API (Coin (Coin), StrictMaybe (SJust), UTxO (UTxO)) import Test.Cardano.Ledger.Alonzo.PlutusScripts (defaultCostModel) import Test.Cardano.Ledger.Alonzo.Serialisation.Generators () import Test.QuickCheck (counterexample, (===), (==>)) @@ -75,8 +76,8 @@ spec = in Map.elems (unTxDats dats) === [Data . toData $ toBuiltinData datum] describe "abortTx" $ do - it "transaction size below limit" $ - let tx = abortTx + prop "transaction size below limit" $ \txIn -> + let tx = abortTx txIn cbor = serialize tx len = LBS.length cbor in counterexample ("Tx: " <> show tx) $ @@ -85,9 +86,15 @@ spec = -- TODO(SN): this requires the abortTx to include a redeemer, for a TxIn, -- spending an Initial-validated output - it "validates against 'initial' script in haskell (unlimited budget)" $ - let tx = abortTx - results = validateTxScriptsUnlimited tx (error "utxo not provided") + prop "validates against 'initial' script in haskell (unlimited budget)" $ \txIn -> + let tx = abortTx txIn + -- input governed by initial script and a 'Plutus.PubKeyHash' datum + utxo = UTxO $ Map.singleton txIn txOut + txOut = TxOut initialAddress initialValue (SJust initialDatumHash) + initialAddress = validatorHashToAddr Initial.validatorHash + initialValue = inject (Coin 0) + initialDatumHash = hashData @Era . Data . toData $ PubKeyHash "not a PubKeyHash" + results = validateTxScriptsUnlimited tx utxo in -- TODO(SN): are the RdmrPtr keys useful? 1 == length (rights $ Map.elems results) & counterexample ("Evaluation results: " <> show results)