From 5d5b5e57c374b801cbfb62c37b11274978231c2a Mon Sep 17 00:00:00 2001 From: nhenin Date: Tue, 20 Feb 2024 12:24:43 +0100 Subject: [PATCH] wip --- ghc-tags.yaml | 23 -- hie.yaml | 379 +----------------- marlowe-chain-sync/marlowe-chain-sync.cabal | 1 + .../Language/Marlowe/Runtime/ChainSync/Api.hs | 3 + .../ChainSync/Database/PostgreSQL/Alonzo.hs | 42 +- .../ChainSync/Database/PostgreSQL/Babbage.hs | 4 +- .../ChainSync/Database/PostgreSQL/Cardano.hs | 4 +- .../ChainSync/Database/PostgreSQL/Conway.hs | 67 +++- .../ChainSync/Database/PostgreSQL/Mary.hs | 22 +- .../src/Language/Marlowe/CLI/Analyze.hs | 3 +- marlowe-cli/src/Language/Marlowe/CLI/IO.hs | 5 +- .../src/Language/Marlowe/CLI/Transaction.hs | 5 +- .../src/Language/Marlowe/Core/V1/Semantics.hs | 1 + .../Marlowe/Core/V1/Semantics/Types.hs | 1 + 14 files changed, 130 insertions(+), 430 deletions(-) delete mode 100644 ghc-tags.yaml diff --git a/ghc-tags.yaml b/ghc-tags.yaml deleted file mode 100644 index 54f5ba5c98..0000000000 --- a/ghc-tags.yaml +++ /dev/null @@ -1,23 +0,0 @@ -language : Haskell2010 -extensions : - - DeriveFoldable - - DeriveFunctor - - DeriveGeneric - - DeriveLift - - DeriveTraversable - - ExplicitForAll - - FlexibleContexts - - GeneralizedNewtypeDeriving - - ImportQualifiedPost - - MultiParamTypeClasses - - ScopedTypeVariables - - StandaloneDeriving - - LambdaCase - - DataKinds - - DuplicateRecordFields - - FlexibleInstances - - MultiParamTypeClasses - - OverloadedLists - - StrictData - - TypeFamilies - - UndecidableInstances \ No newline at end of file diff --git a/hie.yaml b/hie.yaml index 1dce2cf914..f0c7014d7f 100644 --- a/hie.yaml +++ b/hie.yaml @@ -1,379 +1,2 @@ cradle: - cabal: - - path: "async-components/src" - component: "lib:async-components" - - - path: "cardano-integration/src" - component: "lib:cardano-integration" - - - path: "cardano-integration/create-testnet/Main.hs" - component: "cardano-integration:exe:create-testnet" - - - path: "eventuo11y-extras/src" - component: "lib:eventuo11y-extras" - - - path: "hasql-dynamic-syntax/src" - component: "lib:hasql-dynamic-syntax" - - - path: "hasql-dynamic-syntax/test" - component: "hasql-dynamic-syntax:test:hasql-dynamic-syntax-test" - - - path: "libs/aeson-record/src" - component: "lib:aeson-record" - - - path: "libs/aeson-via-serialise/src" - component: "lib:aeson-via-serialise" - - - path: "libs/base16-aeson/src" - component: "lib:base16-aeson" - - - path: "libs/plutus-ledger-ada/src" - component: "lib:plutus-ledger-ada" - - - path: "libs/plutus-ledger-aeson/src" - component: "lib:plutus-ledger-aeson" - - - path: "libs/plutus-ledger-slot/src" - component: "lib:plutus-ledger-slot" - - - path: "marlowe/src" - component: "lib:marlowe-cardano" - - - path: "marlowe-actus/src" - component: "lib:marlowe-actus" - - - path: "marlowe-actus/test" - component: "marlowe-actus:test:marlowe-actus-test" - - - path: "marlowe-apps/src" - component: "lib:marlowe-apps" - - - path: "marlowe-apps/pipe/Main.hs" - component: "marlowe-apps:exe:marlowe-pipe" - - - path: "marlowe-apps/oracle/Main.hs" - component: "marlowe-apps:exe:marlowe-oracle" - - - path: "marlowe-apps/oracle/Language/Marlowe/Oracle/Detect.hs" - component: "marlowe-apps:exe:marlowe-oracle" - - - path: "marlowe-apps/oracle/Language/Marlowe/Oracle/Process.hs" - component: "marlowe-apps:exe:marlowe-oracle" - - - path: "marlowe-apps/oracle/Language/Marlowe/Oracle/Types.hs" - component: "marlowe-apps:exe:marlowe-oracle" - - - path: "marlowe-apps/oracle/Network/Oracle.hs" - component: "marlowe-apps:exe:marlowe-oracle" - - - path: "marlowe-apps/oracle/Network/Oracle/CoinGecko.hs" - component: "marlowe-apps:exe:marlowe-oracle" - - - path: "marlowe-apps/oracle/Network/Oracle/Random.hs" - component: "marlowe-apps:exe:marlowe-oracle" - - - path: "marlowe-apps/oracle/Network/Oracle/Sofr.hs" - component: "marlowe-apps:exe:marlowe-oracle" - - - path: "marlowe-benchmark/app/Main.hs" - component: "marlowe-benchmark:exe:marlowe-benchmark" - - - path: "marlowe-benchmark/app/Language/Marlowe/Runtime/Benchmark.hs" - component: "marlowe-benchmark:exe:marlowe-benchmark" - - - path: "marlowe-benchmark/app/Language/Marlowe/Runtime/Benchmark/BulkSync.hs" - component: "marlowe-benchmark:exe:marlowe-benchmark" - - - path: "marlowe-benchmark/app/Language/Marlowe/Runtime/Benchmark/HeaderSync.hs" - component: "marlowe-benchmark:exe:marlowe-benchmark" - - - path: "marlowe-benchmark/app/Language/Marlowe/Runtime/Benchmark/Lifecycle.hs" - component: "marlowe-benchmark:exe:marlowe-benchmark" - - - path: "marlowe-benchmark/app/Language/Marlowe/Runtime/Benchmark/Lifecycle/Scenario.hs" - component: "marlowe-benchmark:exe:marlowe-benchmark" - - - path: "marlowe-benchmark/app/Language/Marlowe/Runtime/Benchmark/Query.hs" - component: "marlowe-benchmark:exe:marlowe-benchmark" - - - path: "marlowe-benchmark/app/Language/Marlowe/Runtime/Benchmark/Query/Generate.hs" - component: "marlowe-benchmark:exe:marlowe-benchmark" - - - path: "marlowe-benchmark/app/Language/Marlowe/Runtime/Benchmark/Sync.hs" - component: "marlowe-benchmark:exe:marlowe-benchmark" - - - path: "marlowe-benchmark/app/Paths_marlowe_benchmark.hs" - component: "marlowe-benchmark:exe:marlowe-benchmark" - - - path: "marlowe-chain-sync/src" - component: "lib:marlowe-chain-sync" - - - path: "marlowe-chain-sync/libchainsync" - component: "marlowe-chain-sync:lib:libchainsync" - - - path: "marlowe-chain-sync/chain-indexer" - component: "marlowe-chain-sync:lib:chain-indexer" - - - path: "marlowe-chain-sync/plutus-compat" - component: "marlowe-chain-sync:lib:plutus-compat" - - - path: "marlowe-chain-sync/gen" - component: "marlowe-chain-sync:lib:gen" - - - path: "marlowe-chain-sync/test" - component: "marlowe-chain-sync:test:marlowe-chain-sync-test" - - - path: "marlowe-chain-sync/marlowe-chain-indexer/Main.hs" - component: "marlowe-chain-sync:exe:marlowe-chain-indexer" - - - path: "marlowe-chain-sync/marlowe-chain-indexer/Logging.hs" - component: "marlowe-chain-sync:exe:marlowe-chain-indexer" - - - path: "marlowe-chain-sync/marlowe-chain-indexer/Options.hs" - component: "marlowe-chain-sync:exe:marlowe-chain-indexer" - - - path: "marlowe-chain-sync/marlowe-chain-sync/Main.hs" - component: "marlowe-chain-sync:exe:marlowe-chain-sync" - - - path: "marlowe-chain-sync/marlowe-chain-sync/Logging.hs" - component: "marlowe-chain-sync:exe:marlowe-chain-sync" - - - path: "marlowe-chain-sync/marlowe-chain-sync/Options.hs" - component: "marlowe-chain-sync:exe:marlowe-chain-sync" - - - path: "marlowe-chain-sync/marlowe-chain-copy/Main.hs" - component: "marlowe-chain-sync:exe:marlowe-chain-copy" - - - path: "marlowe-chain-sync/marlowe-chain-copy/Options.hs" - component: "marlowe-chain-sync:exe:marlowe-chain-copy" - - - path: "marlowe-cli/src" - component: "lib:marlowe-cli" - - - path: "marlowe-cli/cli-test" - component: "marlowe-cli:lib:cli-test" - - - path: "marlowe-cli/command" - component: "marlowe-cli:lib:command" - - - path: "marlowe-cli/app/Main.hs" - component: "marlowe-cli:exe:marlowe-cli" - - - path: "marlowe-cli/tests" - component: "marlowe-cli:test:marlowe-cli-test" - - - path: "marlowe-client/src" - component: "lib:marlowe-client" - - - path: "marlowe-contracts/src" - component: "lib:marlowe-contracts" - - - path: "marlowe-contracts/test" - component: "marlowe-contracts:test:marlowe-contracts-test" - - - path: "marlowe-integration/src" - component: "lib:marlowe-integration" - - - path: "marlowe-integration-tests/test/Spec.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/ApplyInputs.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Basic.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Common.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Contract.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Create.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Intersections.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/MarloweQuery.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/OpenRoles.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/StandardContract.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Withdraw.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/IntegrationSpec.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Contract/Get.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Contract/Next/Get.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Contract/Post.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Contract/Put.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Get.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Transactions/Get.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Transactions/Transaction/Get.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Transactions/Transaction/Post.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Transactions/Transaction/Put.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/StandardContract.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Post.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Put.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-integration-tests/test/Language/Marlowe/Runtime/WebSpec.hs" - component: "marlowe-integration-tests:exe:marlowe-integration-tests" - - - path: "marlowe-object/src" - component: "lib:marlowe-object" - - - path: "marlowe-object/gen" - component: "marlowe-object:lib:gen" - - - path: "marlowe-object/test" - component: "marlowe-object:test:marlowe-object-test" - - - path: "marlowe-protocols/src" - component: "lib:marlowe-protocols" - - - path: "marlowe-runtime/src" - component: "lib:marlowe-runtime" - - - path: "marlowe-runtime/schema" - component: "marlowe-runtime:lib:schema" - - - path: "marlowe-runtime/gen" - component: "marlowe-runtime:lib:gen" - - - path: "marlowe-runtime/indexer" - component: "marlowe-runtime:lib:indexer" - - - path: "marlowe-runtime/sync-api" - component: "marlowe-runtime:lib:sync-api" - - - path: "marlowe-runtime/contract-api" - component: "marlowe-runtime:lib:contract-api" - - - path: "marlowe-runtime/contract" - component: "marlowe-runtime:lib:contract" - - - path: "marlowe-runtime/sync" - component: "marlowe-runtime:lib:sync" - - - path: "marlowe-runtime/tx-api" - component: "marlowe-runtime:lib:tx-api" - - - path: "marlowe-runtime/tx" - component: "marlowe-runtime:lib:tx" - - - path: "marlowe-runtime/proxy-api" - component: "marlowe-runtime:lib:proxy-api" - - - path: "marlowe-runtime/proxy" - component: "marlowe-runtime:lib:proxy" - - - path: "marlowe-runtime/runtime" - component: "marlowe-runtime:lib:runtime" - - - path: "marlowe-runtime/config" - component: "marlowe-runtime:lib:config" - - - path: "marlowe-runtime/marlowe-indexer/Main.hs" - component: "marlowe-runtime:exe:marlowe-indexer" - - - path: "marlowe-runtime/marlowe-indexer/Logging.hs" - component: "marlowe-runtime:exe:marlowe-indexer" - - - path: "marlowe-runtime/marlowe-sync/Main.hs" - component: "marlowe-runtime:exe:marlowe-sync" - - - path: "marlowe-runtime/marlowe-sync/Logging.hs" - component: "marlowe-runtime:exe:marlowe-sync" - - - path: "marlowe-runtime/marlowe-tx/Main.hs" - component: "marlowe-runtime:exe:marlowe-tx" - - - path: "marlowe-runtime/marlowe-tx/Logging.hs" - component: "marlowe-runtime:exe:marlowe-tx" - - - path: "marlowe-runtime/marlowe-contract/Main.hs" - component: "marlowe-runtime:exe:marlowe-contract" - - - path: "marlowe-runtime/marlowe-contract/Logging.hs" - component: "marlowe-runtime:exe:marlowe-contract" - - - path: "marlowe-runtime/marlowe-proxy/Main.hs" - component: "marlowe-runtime:exe:marlowe-proxy" - - - path: "marlowe-runtime/marlowe-proxy/Logging.hs" - component: "marlowe-runtime:exe:marlowe-proxy" - - - path: "marlowe-runtime/marlowe-runtime/Main.hs" - component: "marlowe-runtime:exe:marlowe-runtime" - - - path: "marlowe-runtime/marlowe-runtime/Logging.hs" - component: "marlowe-runtime:exe:marlowe-runtime" - - - path: "marlowe-runtime/test" - component: "marlowe-runtime:test:marlowe-runtime-test" - - - path: "marlowe-runtime/indexer-test" - component: "marlowe-runtime:test:indexer-test" - - - path: "marlowe-runtime-web/src" - component: "lib:marlowe-runtime-web" - - - path: "marlowe-runtime-web/server" - component: "marlowe-runtime-web:lib:server" - - - path: "marlowe-runtime-web/app/Main.hs" - component: "marlowe-runtime-web:exe:marlowe-web-server" - - - path: "marlowe-runtime-web/app/Options.hs" - component: "marlowe-runtime-web:exe:marlowe-web-server" - - - path: "marlowe-runtime-web/app/Paths_marlowe_runtime_web.hs" - component: "marlowe-runtime-web:exe:marlowe-web-server" - - - path: "marlowe-runtime-web/test" - component: "marlowe-runtime-web:test:marlowe-runtime-web-test" - - - path: "marlowe-test/src" - component: "lib:marlowe-test" - - - path: "marlowe-test/test" - component: "marlowe-test:test:marlowe-test" - - - path: "marlowe-test/spec-client/Main.hs" - component: "marlowe-test:exe:marlowe-spec-client" - - - path: "marlowe-test/reference/Main.hs" - component: "marlowe-test:exe:marlowe-reference" + cabal: \ No newline at end of file diff --git a/marlowe-chain-sync/marlowe-chain-sync.cabal b/marlowe-chain-sync/marlowe-chain-sync.cabal index b72f0f6112..149c6c3fae 100644 --- a/marlowe-chain-sync/marlowe-chain-sync.cabal +++ b/marlowe-chain-sync/marlowe-chain-sync.cabal @@ -76,6 +76,7 @@ library , binary ^>=0.8.8 , bytestring >=0.10.12 && <0.12 , cardano-api ^>=8.38 + , cardano-api:internal ^>=8.38 , cardano-binary , cardano-crypto-class , cardano-crypto-wrapper ^>=1.5 diff --git a/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Api.hs b/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Api.hs index e359cf9726..3d2fb82f5c 100644 --- a/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Api.hs +++ b/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Api.hs @@ -138,6 +138,7 @@ import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultCostModelParams import qualified PlutusLedgerApi.V1 as Plutus import Text.Read (readMaybe) import Unsafe.Coerce (unsafeCoerce) +import qualified Cardano.Ledger.BaseTypes as C -- | Extends a type with a "Genesis" member. data WithGenesis a = Genesis | At a @@ -1581,6 +1582,8 @@ instance Variations C.Lovelace where instance Variations C.EpochNo +instance Variations C.EpochInterval + instance Variations C.AnyPlutusScriptVersion where variations = NE.fromList 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 902112f657..fd581d5f1c 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 @@ -3,25 +3,28 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} + + module Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Alonzo where import Cardano.Binary (serialize') +import Cardano.Ledger.Alonzo.Scripts ( AsItem (..), AlonzoEraScript (PlutusPurpose), AlonzoPlutusPurpose (AlonzoSpending) ) import Cardano.Ledger.Alonzo -import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..), IsValid (..), ScriptPurpose (Spending), indexedRdmrs, txdats') + ( AlonzoEra, AlonzoTxAuxData, AlonzoTxOut ) +import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..), IsValid (..), txdats', indexRedeemers) import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..)) -import Cardano.Ledger.Alonzo.TxBody (AlonzoTxBody (..), AlonzoTxOut (..)) +import Cardano.Ledger.Alonzo.TxBody (AlonzoTxBody (..), AlonzoTxOut (..), AlonzoEraTxBody) import Cardano.Ledger.Alonzo.TxWits (AlonzoEraTxWits, TxDats) import qualified Cardano.Ledger.Alonzo.TxWits as Alonzo import Cardano.Ledger.BaseTypes (shelleyProtVer) import qualified Cardano.Ledger.Binary as L -import Cardano.Ledger.Core (Era (..), EraTx, Tx, TxAuxData) -import Cardano.Ledger.Crypto -import Cardano.Ledger.Mary.TxBody (MaryEraTxBody, ValidityInterval) +import Cardano.Ledger.Crypto ( StandardCrypto ) import Cardano.Ledger.Plutus.Data (dataToBinaryData) import Cardano.Ledger.Shelley.API + ( StrictMaybe, TxIn, ShelleyTxOut(ShelleyTxOut) ) import Data.ByteString (ByteString) import Data.Foldable (Foldable (..)) -import Data.Int +import Data.Int ( Int16, Int64 ) import qualified Data.Map as Map import qualified Data.Set as Set import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Mary (maryAssetMintRows, maryTxOutRow, maryTxRow) @@ -31,7 +34,20 @@ import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Shelley ( shelleyTxInRow, ) import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Types + ( TxOutRowGroup, + TxRowGroup, + TxInRow(..), + TxOutRow(datumBytes, datumHash), + TxRow, + SqlBool(..), + Bytea(..) ) import qualified Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Types as Marlowe +import Cardano.Ledger.Allegra.Core + ( Era(EraCrypto), + EraTx(Tx), + ValidityInterval, + EraTxAuxData(TxAuxData) ) + alonzoTxToRows :: Int64 -> Bytea -> Bytea -> AlonzoTx (AlonzoEra StandardCrypto) -> TxRowGroup alonzoTxToRows slotNo blockHash txId tx@AlonzoTx{..} = @@ -62,10 +78,12 @@ convertIsValid :: IsValid -> SqlBool convertIsValid (IsValid b) = SqlBool b alonzoTxInRows - :: ( MaryEraTxBody era + :: ( AlonzoEraTxBody era , AlonzoEraTxWits era , EraTx era , EraCrypto era ~ StandardCrypto + , PlutusPurpose AsItem era + ~ AlonzoPlutusPurpose AsItem era ) => Int64 -> Bytea @@ -81,12 +99,14 @@ alonzoTxInRows slot txId (IsValid isValid) tx inputs collateralInputs pure TxInRow{isCollateral = SqlBool True, ..} alonzoTxInRow - :: ( MaryEraTxBody era + :: ( AlonzoEraTxBody era , AlonzoEraTxWits era , EraTx era , EraCrypto era ~ StandardCrypto + , PlutusPurpose AsItem era + ~ AlonzoPlutusPurpose AsItem era ) - => Int64 + =>Int64 -> Bytea -> Tx era -> TxIn StandardCrypto @@ -94,10 +114,12 @@ alonzoTxInRow alonzoTxInRow slotNo txInId tx txIn = (shelleyTxInRow slotNo txInId txIn) { redeemerDatumBytes = do - (datum, _) <- indexedRdmrs tx $ Spending txIn + (datum, _) <- indexRedeemers tx $ AlonzoSpending (AsItem txIn) pure $ originalBytea $ dataToBinaryData datum } + + alonzoTxOutRow :: Int64 -> Bytea diff --git a/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Babbage.hs b/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Babbage.hs index 7f32454c78..edc8e38722 100644 --- a/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Babbage.hs +++ b/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Babbage.hs @@ -11,11 +11,11 @@ import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..)) import Cardano.Ledger.Alonzo.TxWits (TxDats, unTxDats) import Cardano.Ledger.Babbage (BabbageEra, BabbageTxOut) import Cardano.Ledger.Babbage.Tx (IsValid (..)) -import Cardano.Ledger.Babbage.TxBody (BabbageTxBody (..), BabbageTxOut (..), Datum (..)) +import Cardano.Ledger.Babbage.TxBody (BabbageTxBody (..), BabbageTxOut (..)) import Cardano.Ledger.Binary (Sized (..), shelleyProtVer) import qualified Cardano.Ledger.Binary as L import Cardano.Ledger.Crypto -import Cardano.Ledger.Plutus.Data (binaryDataToData, hashBinaryData) +import Cardano.Ledger.Plutus.Data (binaryDataToData, hashBinaryData, Datum (..)) import Cardano.Ledger.Shelley.API (ShelleyTxOut (..), StrictMaybe (..)) import Data.ByteString (ByteString) import Data.Foldable (Foldable (..)) diff --git a/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Cardano.hs b/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Cardano.hs index e46308571c..2a7f2b04a2 100644 --- a/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Cardano.hs +++ b/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Cardano.hs @@ -3,7 +3,8 @@ module Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Cardano where -import Cardano.Api +import Cardano.Api +import Cardano.Api.Block (Block(..)) import Cardano.Api.Shelley (Tx (ShelleyTx)) import qualified Cardano.Chain.Block as LB import Cardano.Chain.UTxO (ATxAux (aTaTx), ATxPayload (aUnTxPayload), taTx) @@ -19,6 +20,7 @@ import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Shelley (shelleyTx import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Types import qualified Ouroboros.Consensus.Byron.Ledger as C + blockToRows :: BlockInMode -> BlockRowGroup blockToRows (BlockInMode _ block) = ( BlockRow{..} 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 007423f1cf..875007b635 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,7 +6,6 @@ module Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Conway where import Cardano.Ledger.Allegra.TxBody (StrictMaybe (..)) -import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..), txdats') import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..)) import Cardano.Ledger.Alonzo.TxWits (TxDats (..)) import Cardano.Ledger.Babbage (BabbageEra, BabbageTxOut) @@ -15,20 +14,35 @@ import Cardano.Ledger.Binary (Sized (..), shelleyProtVer) import qualified Cardano.Ledger.Binary as L import Cardano.Ledger.Conway (ConwayEra) import Cardano.Ledger.Conway.TxBody (ConwayTxBody (..)) -import Cardano.Ledger.Crypto +import Cardano.Ledger.Crypto ( StandardCrypto ) import Data.ByteString (ByteString) import Data.Foldable (Foldable (..)) -import Data.Int -import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Alonzo (alonzoTxInRows, alonzoTxRow) +import Data.Int ( Int64 ) +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.Types + ( Bytea, SqlBool(SqlBool), TxInRow(..), TxRowGroup ) import Unsafe.Coerce (unsafeCoerce) +import Cardano.Ledger.Conway.Core + ( Era(EraCrypto), + EraTx(Tx), + AlonzoEraScript(PlutusPurpose), + AsItem(AsItem), + ConwayEraTxBody, + AlonzoEraTxWits ) +import Cardano.Ledger.Conway.Scripts (ConwayPlutusPurpose (ConwaySpending)) +import Cardano.Ledger.Babbage.Tx + ( txdats', AlonzoTx(..), indexRedeemers, IsValid(..) ) +import Cardano.Ledger.Shelley.API (TxIn) +import qualified Data.Set as Set +import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Shelley (shelleyTxInRow, originalBytea) +import Cardano.Ledger.Plutus.Data (dataToBinaryData) conwayTxToRows :: Int64 -> Bytea -> Bytea -> AlonzoTx (ConwayEra StandardCrypto) -> TxRowGroup conwayTxToRows slotNo blockHash txId tx@AlonzoTx{..} = ( alonzoTxRow encodeConwayMetadata slotNo blockHash txId (ctbVldt body) auxiliaryData isValid - , alonzoTxInRows slotNo txId isValid tx (ctbSpendInputs body) (ctbCollateralInputs body) + , conwayTxInRows slotNo txId isValid tx (ctbSpendInputs body) (ctbCollateralInputs body) , babbageTxOutRows slotNo txId @@ -50,3 +64,46 @@ coerceTxOut (Sized (BabbageTxOut addr value datum _) size) = coerceDats :: TxDats (ConwayEra StandardCrypto) -> TxDats (BabbageEra StandardCrypto) coerceDats = unsafeCoerce + + +conwayTxInRows + :: ( ConwayEraTxBody era + , AlonzoEraTxWits era + , EraTx era + , EraCrypto era ~ StandardCrypto + , PlutusPurpose AsItem era + ~ ConwayPlutusPurpose AsItem era + ) + => Int64 + -> Bytea + -> IsValid + -> Tx era + -> Set.Set (TxIn StandardCrypto) + -> Set.Set (TxIn StandardCrypto) + -> [TxInRow] +conwayTxInRows slot txId (IsValid isValid) tx inputs collateralInputs + | isValid = conwayTxInRow slot txId tx <$> Set.toAscList inputs + | otherwise = do + TxInRow{..} <- shelleyTxInRow slot txId <$> Set.toAscList collateralInputs + pure TxInRow{isCollateral = SqlBool True, ..} + +conwayTxInRow + :: ( ConwayEraTxBody era + + , EraTx era + , EraCrypto era ~ StandardCrypto + , PlutusPurpose AsItem era + ~ ConwayPlutusPurpose AsItem era, AlonzoEraTxWits era + ) + => Int64 + -> Bytea + -> Tx era + -> TxIn StandardCrypto + -> TxInRow +conwayTxInRow slotNo txInId tx txIn = + (shelleyTxInRow slotNo txInId txIn) + { redeemerDatumBytes = do + (datum, _) <- indexRedeemers tx $ ConwaySpending (AsItem txIn) + pure $ originalBytea $ dataToBinaryData datum + } + diff --git a/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Mary.hs b/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Mary.hs index bf61a3bc63..081dfdb9ce 100644 --- a/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Mary.hs +++ b/marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL/Mary.hs @@ -9,20 +9,30 @@ import qualified Cardano.Ledger.Allegra.Scripts as Allegra import Cardano.Ledger.Allegra.TxAuxData (AllegraTxAuxData (..)) import Cardano.Ledger.Binary (serialize', shelleyProtVer) import Cardano.Ledger.Core (TxAuxData) -import Cardano.Ledger.Crypto -import Cardano.Ledger.Mary -import Cardano.Ledger.Mary.TxBody (MaryTxBody (..), ValidityInterval (..)) +import Cardano.Ledger.Crypto ( StandardCrypto ) +import Cardano.Ledger.Mary ( MaryEra, ShelleyTxOut, ShelleyTx ) +import Cardano.Ledger.Mary.TxBody (MaryTxBody (..)) import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..)) import Cardano.Ledger.Shelley.API + ( StrictMaybe, + ScriptHash(ScriptHash), + ShelleyTxOut(ShelleyTxOut), + ShelleyTx(ShelleyTx, body, auxiliaryData, wits) ) import Data.ByteString (ByteString) import Data.ByteString.Short (fromShort) import Data.Foldable (Foldable (..)) -import Data.Int +import Data.Int ( Int16, Int64 ) import qualified Data.Map as Map import qualified Data.Set as Set import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Allegra (allegraTxOutRow, allegraTxRow) import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Shelley (hashToBytea, shelleyTxInRow) import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL.Types + ( TxOutRowGroup, + TxRowGroup, + AssetMintRow(AssetMintRow), + AssetOutRow(AssetOutRow), + TxRow, + Bytea(..) ) maryTxToRows :: Int64 -> Bytea -> Bytea -> ShelleyTx (MaryEra StandardCrypto) -> TxRowGroup maryTxToRows slotNo blockHash txId ShelleyTx{..} = @@ -40,10 +50,10 @@ maryTxRow -> Int64 -> Bytea -> Bytea - -> ValidityInterval + -> Allegra.ValidityInterval -> StrictMaybe (TxAuxData era) -> TxRow -maryTxRow encodeMetadata slotNo blockHash txId ValidityInterval{..} = +maryTxRow encodeMetadata slotNo blockHash txId Allegra.ValidityInterval{..} = allegraTxRow encodeMetadata slotNo blockHash txId Allegra.ValidityInterval{..} maryTxOutRow :: Int64 -> Bytea -> Int16 -> ShelleyTxOut (MaryEra StandardCrypto) -> TxOutRowGroup diff --git a/marlowe-cli/src/Language/Marlowe/CLI/Analyze.hs b/marlowe-cli/src/Language/Marlowe/CLI/Analyze.hs index 7c35fefb21..90a84aa680 100644 --- a/marlowe-cli/src/Language/Marlowe/CLI/Analyze.hs +++ b/marlowe-cli/src/Language/Marlowe/CLI/Analyze.hs @@ -121,6 +121,7 @@ import PlutusLedgerApi.V2 (deserialiseScript) import PlutusLedgerApi.V2 qualified as P hiding (evaluateScriptCounting) import PlutusTx.AssocMap qualified as AM import PlutusTx.Prelude qualified as P +import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target(ImmutableTip)) -- | Analyze a Marlowe contract for protocol-limit or other violations. analyze @@ -157,7 +158,7 @@ analyze connection marloweFile preconditions roles tokens maximumValue minimumUt do protocol <- (liftCli <=< liftCliIO) - . Api.queryNodeLocalState connection Nothing + . Api.queryNodeLocalState connection ImmutableTip . Api.QueryInEra $ Api.QueryInShelleyBasedEra (Api.babbageEraOnwardsToShelleyBasedEra era) Api.QueryProtocolParameters result <- diff --git a/marlowe-cli/src/Language/Marlowe/CLI/IO.hs b/marlowe-cli/src/Language/Marlowe/CLI/IO.hs index 07a59a5965..7edcf276ec 100644 --- a/marlowe-cli/src/Language/Marlowe/CLI/IO.hs +++ b/marlowe-cli/src/Language/Marlowe/CLI/IO.hs @@ -138,6 +138,7 @@ import System.Directory.Internal.Prelude (fromMaybe) import System.Environment (lookupEnv) import System.IO (hPrint, hPutStrLn, stderr) import Text.Read (readMaybe) +import Ouroboros.Network.Protocol.LocalStateQuery.Type -- | Lift an 'Either' result into the CLI. liftCli @@ -324,7 +325,7 @@ queryInEra connection q = do era <- askEra res <- liftCliIO $ - queryNodeLocalState connection Nothing $ + queryNodeLocalState connection ImmutableTip $ QueryInEra $ QueryInShelleyBasedEra (babbageEraOnwardsToShelleyBasedEra era) q liftCli res @@ -377,7 +378,7 @@ getProtocolParams (QueryNode connection) = do getProtocolParams (PureQueryContext _ NodeStateInfo{nsiProtocolParameters}) = pure nsiProtocolParameters queryAny :: (MonadError CliError m, MonadIO m) => LocalNodeConnectInfo -> QueryInMode a -> m a -queryAny connection = liftCliIO . queryNodeLocalState connection Nothing +queryAny connection = liftCliIO . queryNodeLocalState connection ImmutableTip getSystemStart :: (MonadError CliError m) diff --git a/marlowe-cli/src/Language/Marlowe/CLI/Transaction.hs b/marlowe-cli/src/Language/Marlowe/CLI/Transaction.hs index 3beed71b4b..392ae0cfbb 100644 --- a/marlowe-cli/src/Language/Marlowe/CLI/Transaction.hs +++ b/marlowe-cli/src/Language/Marlowe/CLI/Transaction.hs @@ -287,6 +287,7 @@ import Ouroboros.Consensus.HardFork.History (interpreterToEpochInfo) import Plutus.V1.Ledger.SlotConfig (SlotConfig (..)) import PlutusLedgerApi.V1 (Datum (..), POSIXTime (..), Redeemer (..), TokenName (..), fromBuiltin, toData) import System.IO (hPutStrLn, stderr) +import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target(ImmutableTip)) -- | Build a non-Marlowe transaction. buildSimple @@ -1962,10 +1963,10 @@ querySlotConfig connection = epochNo <- queryInEra connection QueryEpoch systemStart <- liftCliIO $ - queryNodeLocalState connection Nothing QuerySystemStart + queryNodeLocalState connection ImmutableTip QuerySystemStart EraHistory interpreter <- liftCliIO - . queryNodeLocalState connection Nothing + . queryNodeLocalState connection ImmutableTip $ QueryEraHistory let epochInfo = hoistEpochInfo (liftCli . runExcept) $ diff --git a/marlowe/src/Language/Marlowe/Core/V1/Semantics.hs b/marlowe/src/Language/Marlowe/Core/V1/Semantics.hs index deec314966..e497723c58 100644 --- a/marlowe/src/Language/Marlowe/Core/V1/Semantics.hs +++ b/marlowe/src/Language/Marlowe/Core/V1/Semantics.hs @@ -29,6 +29,7 @@ -- A big hammer, but it helps. {-# OPTIONS_GHC -fno-specialise #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE ViewPatterns #-} {- HLINT ignore "Avoid restricted function" -} diff --git a/marlowe/src/Language/Marlowe/Core/V1/Semantics/Types.hs b/marlowe/src/Language/Marlowe/Core/V1/Semantics/Types.hs index ae8e7b7b3d..2fe00d0b39 100644 --- a/marlowe/src/Language/Marlowe/Core/V1/Semantics/Types.hs +++ b/marlowe/src/Language/Marlowe/Core/V1/Semantics/Types.hs @@ -28,6 +28,7 @@ {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -- A big hammer, but it helps. {-# OPTIONS_GHC -fno-specialise #-} +{-# LANGUAGE ViewPatterns #-} -- | Types for Marlowe semantics module Language.Marlowe.Core.V1.Semantics.Types (