Fix marlowe-chain-sync redeemer extraction

cabal.project

@@ -10,8 +10,8 @@ repository cardano-haskell-packages
     d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee
 
 index-state:
-  , hackage.haskell.org 2024-06-23T23:01:13Z
-  , cardano-haskell-packages 2024-07-24T14:16:32Z 
+  , hackage.haskell.org 2024-08-07T14:18:16Z
+  , cardano-haskell-packages 2024-08-28T06:44:16Z
 
 packages:
   async-components
@@ -205,9 +205,10 @@ source-repository-package
 source-repository-package
    type: git
    location: https://github.com/input-output-hk/marlowe
-   tag: c144edd67361eccb0aabe15403e9f0788ccc6d56
+   tag: e94fab24826f5b095e8fc7c5a41fac939e5fb9ae
    subdir: marlowe-spec-test
            isabelle
-   --sha256: sha256-ento9kEmQnblcqLcvbc6R6DdF0izqb8ROl7t3yE99M4=
+   --sha256: sha256-29HMWsmDsRTyuJVJE+yc1rujNX6U6oVZ2homTab1syw=
+
 
 

libs/cardano-debug/cardano-debug.cabal

@@ -56,7 +56,7 @@ library
     , aeson
     , base >=4.9 && <5
     , bytestring
-    , cardano-api ^>=9.1
+    , cardano-api ^>=9.2
     , cardano-ledger-core
     , cardano-ledger-shelley
     , containers

libs/plutus-ledger-ada/plutus-ledger-ada.cabal

@@ -46,8 +46,8 @@ library
   -- Other IOG dependencies
   --------------------------
   build-depends:
-    , plutus-ledger-api ^>=1.30
-    , plutus-tx ^>=1.30
+    , plutus-ledger-api ^>=1.31
+    , plutus-tx ^>=1.31
 
   ------------------------
   -- Non-IOG dependencies

libs/plutus-ledger-aeson/plutus-ledger-aeson.cabal

@@ -40,9 +40,9 @@ library
   -- Other IOG dependencies
   --------------------------
   build-depends:
-    , plutus-core ^>=1.30
-    , plutus-ledger-api ^>=1.30
-    , plutus-tx ^>=1.30
+    , plutus-core ^>=1.31
+    , plutus-ledger-api ^>=1.31
+    , plutus-tx ^>=1.31
 
   ------------------------
   -- Non-IOG dependencies

libs/plutus-ledger-slot/plutus-ledger-slot.cabal

@@ -48,8 +48,8 @@ library
   -- Other IOG dependencies
   --------------------------
   build-depends:
-    , plutus-ledger-api ^>=1.30
-    , plutus-tx ^>=1.30
+    , plutus-ledger-api ^>=1.31
+    , plutus-tx ^>=1.31
 
   -- We don't need plutus ledger here but
   -- we have orphans collision.

marlowe-actus/marlowe-actus.cabal

@@ -37,7 +37,7 @@ library
     , base
     , marlowe-cardano
     , mtl
-    , plutus-ledger-api ^>=1.30
+    , plutus-ledger-api ^>=1.31
     , plutus-tx
     , time
     , validation

marlowe-adapter/marlowe-adapter.cabal

@@ -42,7 +42,7 @@ library
   build-depends:
     , aeson
     , base >=4.9 && <5
-    , plutus-tx ^>=1.30
+    , plutus-tx ^>=1.31
     , time
 
   ghc-options:      -fprint-potential-instances

marlowe-apps/marlowe-apps.cabal

@@ -30,7 +30,7 @@ library
     , async
     , base >=4.9 && <5
     , bytestring
-    , cardano-api ^>=9.1
+    , cardano-api ^>=9.2
     , containers
     , data-default
     , eventuo11y >=0.9 && <0.11
@@ -99,7 +99,7 @@ executable marlowe-oracle
     , base >=4.9 && <5
     , base16-aeson
     , bytestring
-    , cardano-api ^>=9.1
+    , cardano-api ^>=9.2
     , eventuo11y >=0.9 && <0.11
     , eventuo11y-dsl ^>=0.2
     , eventuo11y-json ^>=0.3.0.3
@@ -111,7 +111,7 @@ executable marlowe-oracle
     , marlowe-runtime
     , mtl
     , optparse-applicative
-    , plutus-ledger-api ^>=1.30
+    , plutus-ledger-api ^>=1.31
     , process
     , servant
     , servant-client

marlowe-chain-sync/marlowe-chain-sync.cabal

@@ -75,7 +75,7 @@ library
     , base16 ^>=0.3.2
     , binary ^>=0.8.8
     , bytestring >=0.10.12 && <0.12
-    , cardano-api ^>=9.1
+    , cardano-api ^>=9.2
     , cardano-api:internal
     , cardano-binary
     , cardano-crypto-class
@@ -97,11 +97,12 @@ 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
-    , plutus-core ^>=1.30
-    , plutus-ledger-api ^>=1.30
+    , plutus-core ^>=1.31
+    , plutus-ledger-api ^>=1.31
     , postgresql-simple
     , reflection
     , scientific
@@ -132,7 +133,7 @@ library libchainsync
     , async-components ==0.1.1.0
     , base >=4.9 && <5
     , bytestring >=0.10.12 && <0.12
-    , cardano-api ^>=9.1
+    , cardano-api ^>=9.2
     , cardano-api:internal
     , cardano-binary
     , cardano-ledger-binary ^>=1.3.3
@@ -175,7 +176,7 @@ library chain-indexer
     , base >=4.9 && <5
     , base16 ^>=0.3.2
     , bytestring >=0.10.12 && <0.12
-    , cardano-api ^>=9.1
+    , cardano-api ^>=9.2
     , cardano-api:internal
     , cardano-crypto-wrapper ^>=1.5
     , cardano-ledger-alonzo ^>=1.10
@@ -218,13 +219,13 @@ library plutus-compat
   build-depends:
     , base >=4.9 && <5
     , base16 ^>=0.3.2
-    , cardano-api ^>=9.1
+    , cardano-api ^>=9.2
     , cardano-ledger-binary ^>=1.3.3
     , cardano-ledger-byron ^>=1.0.1
     , containers ^>=0.6.5
     , marlowe-chain-sync ==1.0.0
-    , plutus-ledger-api ^>=1.30
-    , plutus-tx ^>=1.30
+    , plutus-ledger-api ^>=1.31
+    , plutus-tx ^>=1.31
 
 library gen
   import:          lang
@@ -235,7 +236,7 @@ library gen
   build-depends:
     , base >=4.9 && <5
     , bytestring >=0.10.12 && <0.12
-    , cardano-api ^>=9.1
+    , cardano-api ^>=9.2
     , cardano-api-gen ^>=8.1
     , cardano-api:internal
     , containers ^>=0.6.5
@@ -286,7 +287,7 @@ executable marlowe-chain-indexer
     , async-components ==0.1.1.0
     , base >=4.9 && <5
     , bytestring >=0.10.12 && <0.12
-    , cardano-api ^>=9.1
+    , cardano-api ^>=9.2
     , cardano-api:internal
     , cardano-crypto-wrapper ^>=1.5
     , cardano-ledger-byron ^>=1.0.1
@@ -320,7 +321,7 @@ executable marlowe-chain-sync
     , async-components ==0.1.1.0
     , base >=4.9 && <5
     , bytestring >=0.10.12 && <0.12
-    , cardano-api ^>=9.1
+    , cardano-api ^>=9.2
     , cardano-api:internal
     , eventuo11y >=0.9 && <0.11
     , eventuo11y-extras ==0.1.1.0
@@ -351,7 +352,7 @@ executable marlowe-chain-copy
   build-depends:
     , base >=4.9 && <5
     , bytestring >=0.10.12 && <0.12
-    , cardano-api ^>=9.1
+    , cardano-api ^>=9.2
     , cardano-api:internal
     , cassava
     , marlowe-chain-sync ==1.0.0

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