From f71f4f618e2c1fe94ba6954db30a7989cb3d2392 Mon Sep 17 00:00:00 2001 From: Tomasz Rybarczyk Date: Wed, 28 Aug 2024 10:50:01 +0200 Subject: [PATCH] Fix marlowe-chain-sync redeemer extraction --- marlowe-chain-sync/marlowe-chain-sync.cabal | 1 + .../ChainSync/Database/PostgreSQL/Alonzo.hs | 55 +++++++++++++++--- .../ChainSync/Database/PostgreSQL/Conway.hs | 57 +++++++++++++++---- 3 files changed, 94 insertions(+), 19 deletions(-) diff --git a/marlowe-chain-sync/marlowe-chain-sync.cabal b/marlowe-chain-sync/marlowe-chain-sync.cabal index 08d15ed0f3..9bbaa30abd 100644 --- a/marlowe-chain-sync/marlowe-chain-sync.cabal +++ b/marlowe-chain-sync/marlowe-chain-sync.cabal @@ -97,6 +97,7 @@ library , hashable >=1.3 && <2 , hs-opentelemetry-api ^>=0.0.3 , marlowe-protocols ==0.3.0.0 + , microlens , nonempty-containers ^>=0.3.4 , ouroboros-consensus ^>=0.20 , ouroboros-consensus-cardano ^>=0.18 diff --git a/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Alonzo.hs b/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Alonzo.hs index 93c3b61b3b..88efa9437b 100644 --- a/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Alonzo.hs +++ b/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Alonzo.hs @@ -7,7 +7,6 @@ module Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Alonzo where import Cardano.Binary (serialize') import Cardano.Ledger.Allegra.Core ( - EraTx (Tx), EraTxAuxData (TxAuxData), ValidityInterval, ) @@ -17,24 +16,41 @@ import Cardano.Ledger.Alonzo ( AlonzoTxAuxData, AlonzoTxOut, ) -import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..), IsValid (..), txdats') +import Cardano.Ledger.Alonzo.Core ( + AlonzoEraTxWits (rdmrsTxWitsL), + AsIxItem (..), + Era (EraCrypto), + EraTxBody, + PlutusPurpose, + inputsTxBodyL, + ) +import Cardano.Ledger.Alonzo.Scripts ( + AlonzoEraScript (hoistPlutusPurpose), + AlonzoPlutusPurpose (AlonzoSpending), + toAsIx, + ) +import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..), IsValid (..), bodyAlonzoTxL, witsAlonzoTxL) import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..)) import Cardano.Ledger.Alonzo.TxBody (AlonzoTxBody (..), AlonzoTxOut (..)) -import Cardano.Ledger.Alonzo.TxWits (TxDats) +import Cardano.Ledger.Alonzo.TxWits (AlonzoTxWits (..), TxDats, lookupRedeemer) import qualified Cardano.Ledger.Alonzo.TxWits as Alonzo +import Cardano.Ledger.Alonzo.UTxO (zipAsIxItem) import Cardano.Ledger.BaseTypes (shelleyProtVer) import qualified Cardano.Ledger.Binary as L import Cardano.Ledger.Crypto (StandardCrypto) +import Cardano.Ledger.Plutus (dataToBinaryData) import Cardano.Ledger.Shelley.API ( ScriptHash (..), ShelleyTxOut (ShelleyTxOut), StrictMaybe, TxIn, ) +import Control.Monad (join) import Data.ByteString (ByteString) import Data.Foldable (Foldable (..)) import Data.Int (Int16, Int64) import qualified Data.Map as Map +import Data.Maybe (listToMaybe) import qualified Data.Set as Set import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Mary (maryAssetMintRows, maryTxOutRow, maryTxRow) import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Shelley ( @@ -55,6 +71,7 @@ import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Types ( TxRowGroup, ) import qualified Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Types as Marlowe +import Lens.Micro ((^.)) alonzoTxToRows :: Int64 -> Bytea -> Bytea -> AlonzoTx (AlonzoEra StandardCrypto) -> TxRowGroup alonzoTxToRows slotNo blockHash txId tx@AlonzoTx{..} = @@ -96,10 +113,15 @@ convertIsValid :: IsValid -> SqlBool convertIsValid (IsValid b) = SqlBool b alonzoTxInRows - :: Int64 + :: forall era + . (AlonzoEraTxWits era) + => (StandardCrypto ~ EraCrypto era) + => (PlutusPurpose AsIxItem era ~ AlonzoPlutusPurpose AsIxItem era) + => (EraTxBody era) + => Int64 -> Bytea -> IsValid - -> Tx era + -> AlonzoTx era -> Set.Set (TxIn StandardCrypto) -> Set.Set (TxIn StandardCrypto) -> [TxInRow] @@ -110,12 +132,27 @@ alonzoTxInRows slot txId (IsValid isValid) tx inputs collateralInputs pure TxInRow{isCollateral = SqlBool True, ..} alonzoTxInRow - :: Int64 + :: forall era + . (AlonzoEraTxWits era) + => (StandardCrypto ~ EraCrypto era) + => (PlutusPurpose AsIxItem era ~ AlonzoPlutusPurpose AsIxItem era) + => (EraTxBody era) + => Int64 -> Bytea - -> Tx era - -> TxIn StandardCrypto + -> AlonzoTx era + -> TxIn (EraCrypto era) -> TxInRow -alonzoTxInRow slotNo txInId _ = shelleyTxInRow slotNo txInId +alonzoTxInRow slotNo txInId tx txIn = + (shelleyTxInRow slotNo txInId txIn) + { redeemerDatumBytes = do + let redeemers = tx ^. witsAlonzoTxL . rdmrsTxWitsL + inputs = tx ^. bodyAlonzoTxL . inputsTxBodyL + index <- listToMaybe $ join $ zipAsIxItem (Set.toList inputs) $ \asIxItem@(AsIxItem _ txIn') -> + [asIxItem | txIn == txIn'] + let purpose = AlonzoSpending @AsIxItem @era index + (datum, _) <- lookupRedeemer (hoistPlutusPurpose toAsIx purpose) redeemers + pure $ originalBytea $ dataToBinaryData datum + } alonzoTxOutRow :: Int64 diff --git a/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Conway.hs b/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Conway.hs index f4d7d926fb..c30033cc5b 100644 --- a/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Conway.hs +++ b/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Conway.hs @@ -6,10 +6,11 @@ module Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Conway where import Cardano.Ledger.Allegra.TxBody (StrictMaybe (..)) -import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..)) - +import Cardano.Ledger.Alonzo.Scripts (toAsIx) +import Cardano.Ledger.Alonzo.Tx (bodyAlonzoTxL, witsAlonzoTxL) import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..)) -import Cardano.Ledger.Alonzo.TxWits (TxDats (..)) +import Cardano.Ledger.Alonzo.TxWits (TxDats (..), lookupRedeemer) +import Cardano.Ledger.Alonzo.UTxO (zipAsIxItem) import Cardano.Ledger.Babbage (BabbageEra, BabbageTxOut) import Cardano.Ledger.Babbage.Tx ( IsValid (..), @@ -18,26 +19,41 @@ import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..)) import Cardano.Ledger.Binary (Sized (..), shelleyProtVer) import qualified Cardano.Ledger.Binary as L import Cardano.Ledger.Conway (ConwayEra) -import Cardano.Ledger.Conway.Core (EraTx (Tx), hashScript) +import Cardano.Ledger.Conway.Core ( + AlonzoEraTxWits, + AsIxItem (..), + Era (EraCrypto), + EraTx, + EraTxBody (inputsTxBodyL), + PlutusPurpose, + hashScript, + hoistPlutusPurpose, + ) import Cardano.Ledger.Conway.Scripts ( AlonzoScript (..), + ConwayPlutusPurpose (ConwaySpending), ) +import Cardano.Ledger.Conway.Tx (AlonzoTx (..)) import Cardano.Ledger.Conway.TxBody (ConwayTxBody (..)) -import Cardano.Ledger.Conway.TxWits (AlonzoTxWits (..)) +import Cardano.Ledger.Conway.TxWits (AlonzoEraTxWits (rdmrsTxWitsL), AlonzoTxWits (..)) import Cardano.Ledger.Core (ScriptHash (..)) import Cardano.Ledger.Crypto (StandardCrypto) +import Cardano.Ledger.Plutus.Data (dataToBinaryData) import Cardano.Ledger.Shelley.API (TxIn) import Control.Arrow (Arrow (..)) +import Control.Monad (join) import Data.ByteString (ByteString) import Data.Foldable (Foldable (..)) import Data.Int (Int64) import qualified Data.Map as Map +import Data.Maybe (listToMaybe) import qualified Data.Set as Set import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Alonzo (alonzoTxRow) import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Babbage (babbageTxOutRows) import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Mary (maryAssetMintRows) import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Shelley ( hashToBytea, + originalBytea, serializeBytea, shelleyTxInRow, ) @@ -48,6 +64,7 @@ import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Types ( TxInRow (..), TxRowGroup, ) +import Lens.Micro ((^.)) import Unsafe.Coerce (unsafeCoerce) conwayTxToRows :: Int64 -> Bytea -> Bytea -> AlonzoTx (ConwayEra StandardCrypto) -> TxRowGroup @@ -97,10 +114,15 @@ coerceDats :: TxDats (ConwayEra StandardCrypto) -> TxDats (BabbageEra StandardCr coerceDats = unsafeCoerce conwayTxInRows - :: Int64 + :: forall era + . (EraTx era) + => (EraCrypto era ~ StandardCrypto) + => (PlutusPurpose AsIxItem era ~ ConwayPlutusPurpose AsIxItem era) + => (AlonzoEraTxWits era) + => Int64 -> Bytea -> Cardano.Ledger.Babbage.Tx.IsValid - -> Tx era + -> AlonzoTx era -> Set.Set (TxIn StandardCrypto) -> Set.Set (TxIn StandardCrypto) -> [TxInRow] @@ -111,9 +133,24 @@ conwayTxInRows slot txId (Cardano.Ledger.Babbage.Tx.IsValid isValid) tx inputs c pure TxInRow{isCollateral = SqlBool True, ..} conwayTxInRow - :: Int64 + :: forall era + . (EraTx era) + => (EraCrypto era ~ StandardCrypto) + => (PlutusPurpose AsIxItem era ~ ConwayPlutusPurpose AsIxItem era) + => (AlonzoEraTxWits era) + => Int64 -> Bytea - -> Tx era + -> AlonzoTx era -> TxIn StandardCrypto -> TxInRow -conwayTxInRow slotNo txInId _ = shelleyTxInRow slotNo txInId +conwayTxInRow slotNo txInId tx txIn = + (shelleyTxInRow slotNo txInId txIn) + { redeemerDatumBytes = do + let redeemers = tx ^. witsAlonzoTxL . rdmrsTxWitsL + inputs = tx ^. bodyAlonzoTxL . inputsTxBodyL + index <- listToMaybe $ join $ zipAsIxItem (Set.toList inputs) $ \asIxItem@(AsIxItem _ txIn') -> + [asIxItem | txIn == txIn'] + let purpose = ConwaySpending @AsIxItem @era index + (datum, _) <- lookupRedeemer (hoistPlutusPurpose toAsIx purpose) redeemers + pure $ originalBytea $ dataToBinaryData datum + }