Skip to content
This repository has been archived by the owner on Dec 2, 2024. It is now read-only.

Commit

Permalink
next-node is the new merge (ends PLT-558) (#745)
Browse files Browse the repository at this point in the history
* SCP-3855: update node dep (#449)

* Update Cardano node et al. dependencies for the Vasil HF

* The Cardano node version will only work on a network with the Vasil release.

* Solve some compile issues

* wip: recovering instances for types from plutus-ledger-api

* wip

* plutus-ledger compiles

* plutus-ledger-constraints compiles

* Fixed warnings in Ledger.Tx.CardanoAPI for fields introduced by the Babbage era. Also adapted hashing functions for PlutusV1 scripts to work on PlutusV2

* Fixed warnings in Ledger.Tx.CardanoAPITemp and added implementation to undefined value

* plutus-contract compiles

* Added alonzoGenesisDefaults implementation (copied from cardano-node because it was deleted over there) to Ledger.Validation

* plutus-chain-index-core compiles

* Fixed compilation errors in playground-common and plutus-contract

* Fix compile errors in plutus-example

* Fix compile errors in plutus-pab

* Fix compile errors in plutus-playground-server

* WIP on plutus-use-cases

* Split Tx.Orphans into multiple Orphans

* Fix compilation errors on plutus-use-cases

* fix compilation issues

* Update nix

* fix formatting

* Remove wrongly commited files

* Update purescript modules

* Commented test on plutus-ledger temporarely until cardano-node is updated

* Update cardano-wallet with fixes for haddock

* Fix plutus-playground-client purescript imports

* Fix warnings in plutus-example

* Fix plutus-uniswap cabal

* Try to turn-off haddock for cardano-wallet

* [plutus-contract]: fix golden tests and commented test until cardano-node is updated

* Add cardano-cli/.../genesis.alonzo.spec.json to fix plutus-example

* Fix comment link to PR

* Comment out the test properly

* Update scripts/protocol-parameters with fresh plutusV1 cost parameters

Co-authored-by: Konstantinos Lambrou-Latreille <[email protected]>

* [chain-index]: export all servant client functions (#492)

* Fix playground client

* Fix streaming

* Fix purescript

* Create separate directories for v1 and v2 plutus scripts (#486)

* Reorganize the plutus-example library to distinguish clearly between V1
and V2 scripts.

* plutus-example reorganization
create v2 example script

* Modify the ScriptContextChecker module to be more generic

* Propagate the changes to the plutus-example apps and tests

* Update required-redeemer.plutus to also check for an inline datum of 42
and to check for an inline datum of 42 in the reference inputs

* Add PlutusV2 minting and staking scripts (#528)

* [chain-index]: add inline datums support and update cardano-node (#488)

* PLT-484 Upgraded cardano-node version to the official 1.35.0 release. (#551)

* Also upgraded cardano-wallet, plutus et al. versions that work with v1.35.0 of the node.

* Updated golden tests in plutus-use-cases and plutus-contract

* Updated version of components to 1.0.0 with cardano-node (#560)

* Updated the cardano-node bundled with plutus-apps to v1.35.0

* Updated version of all components in their respective cabal files to 1.0.0

* Update cardano-node dependency to 1.35.1

* Updated cardano-wallet, plutus and cardano-ledger to match the node
  version.

* Add script equivalence context test for the V2 context. (#588)

* Remove withIsCardanoEra workaround. (#607)

* BlockInMode now carries a IsCardanoEra constraint

* Increase the delay of awaiting in plutus-pab-executables tests (#565)

Set slot's length to 1s for awaiting tx/out status tests to make them stable

* [PLT-81] plutus-chain-index: support inline scripts when querying TxOut of a TxOutRef (#613)

* Make plutus-ledger-api version explicit in Ledger.Tx

* Make pattern match explicit

* Reorder ScriptChainIndexTxOut fields

To highlight they are the same as PublicKeyChainIndexTxOut.

* Add datum to both branches of ChainIndexTxOut

- Unfortunately we need to rename the fields because they have now
  different types.
- In the PublicKeyChainIndexTxOut case, the output datum is optional and
  we can use plutus-ledger-api OutputDatum type.
- In the ScriptChainIndexTxOut case, the output datum is required,
  nothing changes here but the name.

* Add ReferenceScript to ChainIndexTxOut

* Remove old comment

* Rename _ciTxOutDatumPublicKey and _ciTxOutDatumScript into _ciTxOutPublicKeyDatum and _ciTxOutScriptDatum

* Introduce fromReferenceScript

* Add comments to ChainIndexTxOut

* Add minting context equivalent test plutus script (#631)

* Add missing record field `localTxMonitoringClient` (#617)

* PLT-568: Switch to Babbage era (#614)

* Make Babbage the default era for the emulator

* Clean up

* Accept changes in test output

* Workaround for parseBabbageEraInCardanoModeTx

* Fix minAda calculation

* [next-node]: Bump wallet, plutus, ledger, node (#616)

* Bump cardano-node to 1.35.2 and rest of dependencies based on cardano-wallet

* Use '[TxIn]' instead of 'Set TxIn' in 'data Tx' (#623)

* [plutus-ledger]: Use '[TxIn]' instead of 'Set TxIn' in 'data Tx'.
* Add a property test to check Ord instances of TxIn.
* Sort the inputs in fromOnChainTx
* Sort the inputs in `Emulator.Wallet`
* Fix the review notes and the problem with getInput in StateMachine tests

* PLT-445 Add `mustReferencePubKeyOutput` in constraints library (#640)

* PLT-445 Add mustReferencePubKeyOutput in constraints library

* Added the mustReferencePubKeyOutput constraint in
  plutus-ledger-constraints

* Added a test case for the mustReferencePubKeyOutput

* Refactored Ledger.Tx.CardanoAPI to work with PlutusV2 alongside PlutusV1 scripts in the tx inputs.

* Use existing unitRedeemer

* Move TxIn and TxInType to Ledger.Tx

* Add plutus version to ConsumeScriptAddress constructor

* Add costModelParams for PlutusScriptV2

* Fix error codes.

* Renamed mkTxInfo to mkPV1TxInfo, added test for plutus-tx-constraints without implementation and commented for now the off-chain validation in Ledger.Index

* Implement reference inputs in makeTransactionBody'

* Fixed failing test cases for Ledger.Constraints.mustReferencePubKeyOutput

* Add MustUseOutputAsCollateral

* Fix V2 tests. But issues with V1 tests.

* Disable tests

* WIP

* Remove unused code

* PR feedback

* Remove unused code.

* Clean up

* Added additional info in TODO

* Add Arbitrary instances

* Convert plutus-ledger-constraint tests to PV2

* Fixed test in plutus-ledger-constraints

* Fixed PS generator error in playground

* Fix build

* Fix PS

* Fix PS

* More support of plutus version in constraints libs

* Default to PlutusV1 for now

Co-authored-by: Sjoerd Visscher <[email protected]>
Co-authored-by: Sjoerd Visscher <[email protected]>

* Update cardano-node to 1.35.3-rc1 with deps (#647)

* Upgraded to a cardano-wallet compatible with node 1.35.3-rc1 (#657)

* Reorganized dependencies based on cardano-wallet's cabal.project

* Added the new 'protocolParamUTxOCostPerByte' in 'Ledger.Params' which replaces 'protocolParamUTxOCostPerWord'

* Fixed the `Plutus.Contract.Wallet.mkMintingRedeemers` which triggered an error if the redeemers in the tx contained spending redeemers.

* Simplify MustReferencePubKeyOutput to MustReferenceOutput (#661)

* Replace LedgerPlutusVersion with Language type (#662)

* PLT-494: PlutusV2 TypedValidators (#666)

* Move common code to Plutus.Script.Utils.Typed

* Enable V2 TypedValidators

* Enable and fix reference output tests

* Update cardano-node 1.35.3-rc1 -> 1.35.3 (#669)

* PLT-448: inline scripts in constraint libraries (#678)

* Add inline script support to plutus-tx-constraints.

* Add mustOutputInlineValidator and mustOutputInlineMintingPolicy

* Add documentation

* Check there's no inline script in V1

* Fix wrong minAdaTxOut use

* Update renderGuess.txt

* Naming

* PLT-738: Include plutus language versions with scripts (#681)

* Store Plutus language versions in chain-index

* Introduce Versioned scripts

Remove openapi3 as a dependency of plutus-script-utils

* Add hashing for versioned scripts

* PLT-454: mustUseOutputAsCollateral (#690)

* Finish mustUseOutputAsCollateral implementation

* Add testcase

* Add documentation

* Add missing fields to Ledger.Tx.Internal.Tx (#468)

Add missing fields to Ledger.Tx.Internal.Tx.

  * Add certificates and withdrawals to Tx.

  * Move script witnesses to txScripts.

  * Modify TxIn type, rename to TxInput.

  * Put redeemers together with minting scripts.

  * Translate withdrawals in toCardanoTxBody.

  * Export redeemers for signing with wallet.

* Add tests for mustIncludeDatum tx constraint (#700)

* Add tests for mustIncludeDatum tx constraint (3 failing tests need fix)

* run checks

* Add tests for MustPayToPubKeyAddress tx constraint (#701)

* Add tests for mustSpendScriptOutput and mustSpendScriptOutputWithMatchingDatumAndValue tx constraints (#706)

* Add tests for mustSpendScriptOutput and mustSpendScriptOutputWithMatchingDatumAndValue tx constraints

* Fixed the 'Ledger.Constraints.OffChain.typedValidatorLookups' lookup
function so that it adds the validator inside the 'TypedValidator' in
the 'slOtherScripts' lookup value.

Co-authored-by: Konstantinos Lambrou-Latreille <[email protected]>

* plutus-contract emulator: Change the tx output representation of EmulatorTx to use Cardano.Api.TxOut (#698)

* First draft done for plutus-ledger

* plutus-ledger-constraints use Cardano.Tx

* use C.Tx in plutus-tx-constraints

* plutus-chain-index uses C.TxOut

* Forgot to add file

* Fixing my mess with CardanoAPI

* encoding via plutus.TxOut (can't work, no NetworkId)

* Fix code for the use cases

* Fix a bug in balanceTx

* Fix 0 ada outputs error

* Dirty fix for the uniswap check

* Use Cardano.Tx txId

* fix uniswap test

* Fix double satisfaction

* Fix Marconi

* Add TxOut typeclasses

* Remove unused imports

* Fix failing tests

* Clean import

* Fix pab

* Fix golden values

* Fix golden test

* Fix more plutus packages

* Rmove useless param from ChainIndex.Lib

* Fik playground

* Remove commented code

* Include several fixes following Konstantinos' review

* Add a Pretty TxOut and clean uniswap

* Remove useless stuff in playground

* error in generators display the original cause

* Fix imports

* prettier pretty

* Fix golden tests

* Fix uniswap

* Fix golden tests

* Restore deleted constraints

* Integrate more Sjoerd's comments

* Add tests for mustPayToOtherScript tx constraint (#710)

* Add tests for mustPayToOtherScript tx constraint and 2 more for mustPayToPubKeyAddress

* Fix failing test and reference two PLT tickets

* Refactored MustMint tests to use minting policies and added tests for token burning (#719)

* MustSpendScriptOutput and MustSpendScriptOutputWithMatchingDatumAndValue check the redeemer's presence (#723)

* Add inline datum supports for mustPayToPubKey and mustPayToOtherScript (#721)

* Incremental change for datum

* Work but no inlining

* First working inline datum with V2

* Add tests for inline datum

* add smart constructors for inline datum

* fix PAB

* fixing tx-constraints

* clean up tests

* Address some of Konstantinos' comments

* Separate test group for plutus v2

* Refactor tests in MustPayToPubKeyAddress to ease version handling

* Code clean up

* Code clean up

* Fix unused imports

* Add a way to switch to cardano constraints in MustPayToOtherAddress tests

* more clean up

* PR feedbacks

* Remove dead code

* Add refactoring for MustPayToOtherScript tests

* typo

* clean test suites

* Clean up imports

* Fix some false-positives MustSpendScriptOutput tests using versioned minting policies (#725)

* Fix some false-positives MustSpendScriptOutput tests and refactor to use minting policies

* Use Versioned MintingPolicy and add tests for V2 scripts for MustSpendScriptOutput

* Further refactoring

* Improve onchain check for MustSpendScriptOutput and MustSpendScriptOutputWithMatchingDatumAndValue constraints

* tidy up onchain check

* PLT-448: must spend script output with reference (#716)

* Add ownAddress (singular)

* Support reference scripts in TxIn

* Add mustSpendScriptOutputWithReference

* Test using reference scripts

* Fix merge issues

* Direct conversion from ChainIndexTxOut to the new TxOut

* Push Versioned inside Either

* Accept test outputs

* Fix reference script support in ledger-constraints

* Fix comments

* Add ownAddress (singular)

* Support reference scripts in TxIn

* Add mustSpendScriptOutputWithReference

* Test using reference scripts

* Fix merge issues

* Direct conversion from ChainIndexTxOut to the new TxOut

* Push Versioned inside Either

* Accept test outputs

* Fix reference script support in ledger-constraints

* Fix comments

* PR feedback

* More PR feedback

* Fix merge issues

* PLT-807 Change behavior of MustPayToPubKeyAddress and MustPayToOtherScript w.r.t datum in transaction body (#705)

* Changed `MustPayToPubKeyAddress` and `MustPayToOtherScript` so that
  the user needs to explicitly specify if he wants:
    * the datum to only be included as a hash in the transaction
      output
    * the datum to be included as a hash in the transaction output
      as well as in the transaction body
    * the datum to be inlined in the transaction output

* Changed the name of the constraint `MustIncludeDatum` to
  `MustIncludeDatumInTx` and `MustHashDatum` to
  `MustIncludeDatumInTxWithHash`. These constraint don't modify the
  transaction anymore, but simply check that the datum is part of the
  transaction body.

* Added a note on the 'Plutus.Contract.Oracle' module explaining why it
  doesn't work in it's current form.

* Commented out failing test cases in `plutus-use-cases` that use the
  'Plutus.Contract.Oracle' module.

* PLT-511: collateral output in chain index (#730)

* Add collateral output support to chain index

* Generate invalid transactions in tests too

* PR feedback

* PLT-990 Removed Plutus.Contract.Wallet.finalize as we instead set the validity range of a transaction directly in `plutus-ledger-constraints` (since we now have access to the `SlotConfig`) (#741)

* Update the contributing guide (#729)

Co-authored-by: Evgenii Akentev <[email protected]>
Co-authored-by: Konstantinos Lambrou-Latreille <[email protected]>
Co-authored-by: Jordan Millar <[email protected]>
Co-authored-by: Andrea Bedini <[email protected]>
Co-authored-by: Markus Läll <[email protected]>
Co-authored-by: Sjoerd Visscher <[email protected]>
Co-authored-by: Sjoerd Visscher <[email protected]>
Co-authored-by: Jamie Bertram <[email protected]>
Co-authored-by: Karol Ochman-Milarski <[email protected]>
Co-authored-by: James <[email protected]>
Co-authored-by: Ziyang Liu <[email protected]>
  • Loading branch information
12 people authored Oct 11, 2022
1 parent 14dd9d7 commit 465e6ee
Show file tree
Hide file tree
Showing 11 changed files with 82 additions and 293 deletions.
15 changes: 6 additions & 9 deletions cardano-streaming/cardano-streaming.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,7 @@ library
-- Other IOG dependencies
--------------------------
build-depends:
, cardano-api
, cardano-api >=1.35
, ouroboros-network

------------------------
Expand All @@ -62,15 +62,14 @@ executable cardano-streaming-example-1
--------------------------
-- Other IOG dependencies
--------------------------
build-depends: cardano-api
build-depends: cardano-api >=1.35

------------------------
-- Non-IOG dependencies
------------------------
build-depends:
, aeson
, base >=4.9 && <5
, base16-bytestring
, bytestring
, optparse-applicative
, streaming
Expand All @@ -89,20 +88,19 @@ executable cardano-streaming-example-2
--------------------
build-depends:
, cardano-streaming
, plutus-ledger
, plutus-ledger >=1.0.0

--------------------------
-- Other IOG dependencies
--------------------------
build-depends: cardano-api
build-depends: cardano-api >=1.35

------------------------
-- Non-IOG dependencies
------------------------
build-depends:
, aeson
, base >=4.9 && <5
, base16-bytestring
, bytestring
, optparse-applicative
, streaming
Expand All @@ -120,20 +118,19 @@ executable cardano-streaming-example-3
--------------------
build-depends:
, cardano-streaming
, plutus-chain-index-core
, plutus-chain-index-core >=1.0.0

--------------------------
-- Other IOG dependencies
--------------------------
build-depends: cardano-api
build-depends: cardano-api >=1.35

------------------------
-- Non-IOG dependencies
------------------------
build-depends:
, aeson
, base >=4.9 && <5
, base16-bytestring
, bytestring
, optparse-applicative
, streaming
1 change: 1 addition & 0 deletions cardano-streaming/examples/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -74,4 +74,5 @@ workaround k Cardano.Api.ShelleyEraInCardanoMode = k Cardano.Api.ShelleyEraInCar
workaround k Cardano.Api.AllegraEraInCardanoMode = k Cardano.Api.AllegraEraInCardanoMode
workaround k Cardano.Api.MaryEraInCardanoMode = k Cardano.Api.MaryEraInCardanoMode
workaround k Cardano.Api.AlonzoEraInCardanoMode = k Cardano.Api.AlonzoEraInCardanoMode
workaround k Cardano.Api.BabbageEraInCardanoMode = k Cardano.Api.BabbageEraInCardanoMode

18 changes: 8 additions & 10 deletions cardano-streaming/examples/Example3.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,16 +19,14 @@ utxoState =
S.scanned step initial projection
where
step index (RollForward block _) =
case CI.fromCardanoBlock block of
Left err -> error ("FromCardanoError: " <> show err)
Right txs ->
let tip = CI.tipFromCardanoBlock block
balance = TxUtxoBalance.fromBlock tip txs
in case UtxoState.insert balance index of
Left err ->
error (show err)
Right (UtxoState.InsertUtxoSuccess newIndex _insertPosition) ->
newIndex
let txs = CI.fromCardanoBlock block
tip = CI.tipFromCardanoBlock block
balance = TxUtxoBalance.fromBlock tip txs
in case UtxoState.insert balance index of
Left err ->
error (show err)
Right (UtxoState.InsertUtxoSuccess newIndex _insertPosition) ->
newIndex
step index (RollBackward cardanoPoint _) =
let point = CI.fromCardanoPoint cardanoPoint
in case TxUtxoBalance.rollback point index of
Expand Down
20 changes: 1 addition & 19 deletions cardano-streaming/examples/Orphans.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,28 +3,10 @@

module Orphans where

import Cardano.Api (BlockHeader (BlockHeader), BlockNo, ChainPoint (ChainPoint, ChainPointAtGenesis),
HasTypeProxy (proxyToAsType), Hash, SerialiseAsRawBytes (deserialiseFromRawBytes), ToJSON)
import Cardano.Api (BlockHeader (BlockHeader), BlockNo, ChainPoint (ChainPoint, ChainPointAtGenesis), ToJSON)
import Cardano.Streaming (ChainSyncEvent)
import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Char8 qualified as C8
import Data.Proxy (Proxy (Proxy))
import Data.String (IsString (fromString))
import GHC.Generics (Generic)

-- https://github.com/input-output-hk/cardano-node/pull/3608
instance IsString (Hash BlockHeader) where
fromString = either error id . deserialiseFromRawBytesBase16 . C8.pack
where
deserialiseFromRawBytesBase16 str =
case Base16.decode str of
Right raw -> case deserialiseFromRawBytes ttoken raw of
Just x -> Right x
Nothing -> Left ("cannot deserialise " ++ show str)
Left msg -> Left ("invalid hex " ++ show str ++ ", " ++ msg)
where
ttoken = proxyToAsType (Proxy :: Proxy a)

deriving instance Generic ChainPoint

instance ToJSON ChainPoint
Expand Down
7 changes: 4 additions & 3 deletions cardano-streaming/src/Cardano/Streaming.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ where
import Cardano.Api (BlockInMode, CardanoMode, ChainPoint, ChainSyncClient (ChainSyncClient), ChainTip,
ConsensusModeParams (CardanoModeParams), EpochSlots (EpochSlots),
LocalChainSyncClient (LocalChainSyncClient),
LocalNodeClientProtocols (LocalNodeClientProtocols, localChainSyncClient, localStateQueryClient, localTxSubmissionClient),
LocalNodeClientProtocols (LocalNodeClientProtocols, localChainSyncClient, localStateQueryClient, localTxMonitoringClient, localTxSubmissionClient),
LocalNodeConnectInfo (LocalNodeConnectInfo, localConsensusModeParams, localNodeNetworkId, localNodeSocketPath),
NetworkId, connectToLocalNode)
import Cardano.Api.ChainSync.Client (ClientStIdle (SendMsgFindIntersect, SendMsgRequestNext),
Expand Down Expand Up @@ -69,8 +69,9 @@ withChainSyncEventStream socketPath networkId point consumer = do
localNodeClientProtocols =
LocalNodeClientProtocols
{ localChainSyncClient = LocalChainSyncClient client,
localTxSubmissionClient = Nothing,
localStateQueryClient = Nothing
localStateQueryClient = Nothing,
localTxMonitoringClient = Nothing,
localTxSubmissionClient = Nothing
}

connectInfo =
Expand Down
5 changes: 4 additions & 1 deletion marconi/src/Marconi/CLI.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,4 +16,7 @@ chainPointParser =
)
where
maybeParseHashBlockHeader :: String -> Maybe (C.Hash C.BlockHeader)
maybeParseHashBlockHeader = C.deserialiseFromRawBytesHex (C.proxyToAsType Proxy) . C8.pack
maybeParseHashBlockHeader =
either (const Nothing) Just
. C.deserialiseFromRawBytesHex (C.proxyToAsType Proxy)
. C8.pack
2 changes: 1 addition & 1 deletion marconi/src/Marconi/Index/Datum.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ import Database.SQLite.Simple.FromField (FromField (fromField), ResultError (Con
import Database.SQLite.Simple.ToField (ToField (toField))

import Cardano.Api (SlotNo (SlotNo))
import Plutus.V1.Ledger.Api (Datum, DatumHash)
import Ledger.Scripts (Datum, DatumHash)
import RewindableIndex.Index.VSqlite (SqliteIndex)
import RewindableIndex.Index.VSqlite qualified as Ix

Expand Down
16 changes: 14 additions & 2 deletions marconi/src/Marconi/Index/ScriptTx.hs
Original file line number Diff line number Diff line change
Expand Up @@ -168,10 +168,22 @@ fromShelleyBasedScript era script =
Shelley.ScriptInEra Shelley.PlutusScriptV1InAlonzo $
Shelley.PlutusScript Shelley.PlutusScriptV1 $
Shelley.PlutusScriptSerialised s
Alonzo.PlutusScript Alonzo.PlutusV2 _ ->
error "fromShelleyBasedScript: PlutusV2 not supported in Alonzo era"
Shelley.ShelleyBasedEraBabbage ->
case script of
Alonzo.TimelockScript s ->
Shelley.ScriptInEra Shelley.SimpleScriptV2InBabbage $
Shelley.SimpleScript Shelley.SimpleScriptV2 $
fromAllegraTimelock Shelley.TimeLocksInSimpleScriptV2 s
Alonzo.PlutusScript Alonzo.PlutusV1 s ->
Shelley.ScriptInEra Shelley.PlutusScriptV1InBabbage $
Shelley.PlutusScript Shelley.PlutusScriptV1 $
Shelley.PlutusScriptSerialised s
Alonzo.PlutusScript Alonzo.PlutusV2 s ->
Shelley.ScriptInEra Shelley.PlutusScriptV2InAlonzo $
Shelley.ScriptInEra Shelley.PlutusScriptV2InBabbage $
Shelley.PlutusScript Shelley.PlutusScriptV2 $
Shelley.PlutusScriptSerialised s
Shelley.PlutusScriptSerialised s

where
fromAllegraTimelock :: Shelley.TimeLocksSupported lang
Expand Down
27 changes: 15 additions & 12 deletions marconi/src/Marconi/Indexers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -21,14 +21,14 @@ import Streaming.Prelude qualified as S
import Cardano.Api (Block (Block), BlockHeader (BlockHeader), BlockInMode (BlockInMode), CardanoMode, SlotNo, Tx (Tx),
chainPointToSlotNo)
import Cardano.Api qualified as C
import Cardano.Streaming (ChainSyncEvent (RollBackward, RollForward))
-- TODO Remove the following dependencies from cardano-ledger, and
-- then also the package dependency from this package's cabal
-- file. Tracked with: https://input-output.atlassian.net/browse/PLT-777
import Cardano.Streaming (ChainSyncEvent (RollBackward, RollForward))
import Ledger (TxIn (TxIn), TxOut, TxOutRef (TxOutRef, txOutRefId, txOutRefIdx), txInRef)
import Ledger (TxIn (TxIn), TxOut (TxOut), TxOutRef (TxOutRef, txOutRefId, txOutRefIdx), txInRef)
import Ledger.Scripts (Datum, DatumHash)
import Ledger.Tx.CardanoAPI (fromCardanoTxId, fromCardanoTxIn, fromCardanoTxOut, fromTxScriptValidity,
scriptDataFromCardanoTxBody, withIsCardanoEra)
import Ledger.Tx.CardanoAPI (fromCardanoTxId, fromCardanoTxIn, fromTxScriptValidity, scriptDataFromCardanoTxBody,
withIsCardanoEra)
import Marconi.Index.Datum (DatumIndex)
import Marconi.Index.Datum qualified as Datum
import Marconi.Index.ScriptTx qualified as ScriptTx
Expand All @@ -48,23 +48,25 @@ getDatums (BlockInMode (Block (BlockHeader slotNo _ _) txs) _) = concatMap extra
in map (slotNo,) hashes

isTargetTxOut :: TargetAddresses -> C.TxOut C.CtxTx era -> Bool
isTargetTxOut targetAddresses (C.TxOut address _ _) = case address of
isTargetTxOut targetAddresses (C.TxOut address _ _ _) = case address of
(C.AddressInEra (C.ShelleyAddressInEra _) addr) -> addr `elem` targetAddresses
_ -> False

-- UtxoIndexer
type TargetAddresses = NonEmpty.NonEmpty (C.Address C.ShelleyAddr )

getOutputs
:: Maybe TargetAddresses
:: C.IsCardanoEra era
=> Maybe TargetAddresses
-> C.Tx era
-> Maybe [(TxOut, TxOutRef)]
getOutputs maybeTargetAddresses (C.Tx txBody@(C.TxBody C.TxBodyContent{C.txOuts}) _) = do
outs <- case maybeTargetAddresses of
Just targetAddresses ->
either (const Nothing) Just $ traverse fromCardanoTxOut . filter (isTargetTxOut targetAddresses) $ txOuts
Nothing ->
either (const Nothing) Just $ traverse fromCardanoTxOut txOuts
outs <-
either (const Nothing) (Just . map TxOut)
. traverse (C.eraCast C.BabbageEra)
$ case maybeTargetAddresses of
Just targetAddresses -> filter (isTargetTxOut targetAddresses) txOuts
Nothing -> txOuts
pure $ outs & zip ([0..] :: [Integer])
<&> (\(ix, out) -> (out, TxOutRef { txOutRefId = fromCardanoTxId (C.getTxId txBody)
, txOutRefIdx = ix
Expand All @@ -83,7 +85,8 @@ getInputs (C.Tx (C.TxBody C.TxBodyContent{C.txIns, C.txScriptValidity, C.txInsCo
in Set.fromList $ fmap (txInRef . (`TxIn` Nothing) . fromCardanoTxIn) inputs

getUtxoUpdate
:: SlotNo
:: C.IsCardanoEra era
=> SlotNo
-> [C.Tx era]
-> Maybe TargetAddresses
-> UtxoUpdate
Expand Down
29 changes: 18 additions & 11 deletions marconi/test/Integration.hs
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@ import Hedgehog.Extras.Stock.IO.Network.Sprocket qualified as IO
import Hedgehog.Extras.Test qualified as HE
import Hedgehog.Extras.Test.Base qualified as H
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Hedgehog (testProperty)
import Test.Tasty.Hedgehog (testPropertyNamed)

import Cardano.Api qualified as C
import Cardano.Api.Shelley qualified as C
Expand All @@ -59,7 +59,8 @@ import Marconi.Logging ()

tests :: TestTree
tests = testGroup "Integration"
[ testProperty "prop_script_hash_in_local_testnet_tx_match" testIndex ]
[ testPropertyNamed "prop_script_hash_in_local_testnet_tx_match" "testIndex" testIndex
]

{- | We test the script transaction indexer by setting up a testnet,
adding a script to it and then spending it, and then see if the
Expand Down Expand Up @@ -157,7 +158,7 @@ testIndex = H.integration . HE.runFinallies . workspace "chairman" $ \tempAbsBas
, C.localNodeSocketPath = socketPathAbs
}

(tx1in, C.TxOut _ v _) <- do
(tx1in, C.TxOut _ v _ _) <- do
utxo <- findUTxOByAddress localNodeConnectInfo (C.toAddressAny address)
headM $ Map.toList $ C.unUTxO utxo
let totalLovelace = C.txOutValueToLovelace v
Expand All @@ -181,18 +182,23 @@ testIndex = H.integration . HE.runFinallies . workspace "chairman" $ \tempAbsBas
(C.AddressInEra (C.ShelleyAddressInEra C.ShelleyBasedEraAlonzo) plutusScriptAddr)
(C.TxOutValue C.MultiAssetInAlonzoEra $ C.lovelaceToValue amountPaid)
(C.TxOutDatumHash C.ScriptDataInAlonzoEra scriptDatumHash)
C.ReferenceScriptNone
txOut2 :: C.TxOut ctx C.AlonzoEra
txOut2 =
C.TxOut
(C.AddressInEra (C.ShelleyAddressInEra C.ShelleyBasedEraAlonzo) address)
(C.TxOutValue C.MultiAssetInAlonzoEra $ C.lovelaceToValue amountReturned)
C.TxOutDatumNone
C.ReferenceScriptNone
txBodyContent :: C.TxBodyContent C.BuildTx C.AlonzoEra
txBodyContent =
C.TxBodyContent {
C.txIns = [(tx1in, C.BuildTxWith $ C.KeyWitness C.KeyWitnessForSpending)],
C.txInsCollateral = C.TxInsCollateralNone,
C.txInsReference = C.TxInsReferenceNone,
C.txOuts = [txOut1, txOut2],
C.txTotalCollateral = C.TxTotalCollateralNone,
C.txReturnCollateral = C.TxReturnCollateralNone,
C.txFee = C.TxFeeExplicit C.TxFeesExplicitInAlonzoEra tx1fee,
C.txValidityRange = (C.TxValidityNoLowerBound, C.TxValidityNoUpperBound C.ValidityNoUpperBoundInAlonzoEra),
C.txMetadata = C.TxMetadataNone,
Expand All @@ -219,7 +225,7 @@ testIndex = H.integration . HE.runFinallies . workspace "chairman" $ \tempAbsBas

tx2collateralTxIn <- headM . Map.keys . C.unUTxO =<< findUTxOByAddress localNodeConnectInfo (C.toAddressAny address)

(scriptTxIn, C.TxOut _ valueAtScript _) <- do
(scriptTxIn, C.TxOut _ valueAtScript _ _) <- do
scriptUtxo <- findUTxOByAddress localNodeConnectInfo $ C.toAddressAny plutusScriptAddr
headM $ Map.toList $ C.unUTxO scriptUtxo

Expand All @@ -238,7 +244,7 @@ testIndex = H.integration . HE.runFinallies . workspace "chairman" $ \tempAbsBas

scriptWitness :: C.Witness C.WitCtxTxIn C.AlonzoEra
scriptWitness = C.ScriptWitness C.ScriptWitnessForSpending $
C.PlutusScriptWitness C.PlutusScriptV1InAlonzo C.PlutusScriptV1 plutusScript
C.PlutusScriptWitness C.PlutusScriptV1InAlonzo C.PlutusScriptV1 (C.PScript plutusScript)
(C.ScriptDatumForTxIn scriptDatum) redeemer executionUnits

collateral = C.TxInsCollateral C.CollateralInAlonzoEra [tx2collateralTxIn]
Expand All @@ -250,13 +256,17 @@ testIndex = H.integration . HE.runFinallies . workspace "chairman" $ \tempAbsBas
-- send ADA back to the original genesis address ^
(C.TxOutValue C.MultiAssetInAlonzoEra $ C.lovelaceToValue $ lovelaceAtScript - tx2fee)
C.TxOutDatumNone
C.ReferenceScriptNone

tx2bodyContent :: C.TxBodyContent C.BuildTx C.AlonzoEra
tx2bodyContent =
C.TxBodyContent {
C.txIns = [(scriptTxIn, C.BuildTxWith scriptWitness)],
C.txInsCollateral = collateral,
C.txInsReference = C.TxInsReferenceNone,
C.txOuts = [tx2out],
C.txTotalCollateral = C.TxTotalCollateralNone,
C.txReturnCollateral = C.TxReturnCollateralNone,
C.txFee = C.TxFeeExplicit C.TxFeesExplicitInAlonzoEra tx2fee,
C.txValidityRange = (C.TxValidityNoLowerBound, C.TxValidityNoUpperBound C.ValidityNoUpperBoundInAlonzoEra),
C.txMetadata = C.TxMetadataNone,
Expand Down Expand Up @@ -318,15 +328,12 @@ startTestnet base tempAbsBasePath' = do
Nothing
assert $ tempAbsPath == (tempAbsBasePath' <> "/")
&& tempAbsPath == (tempBaseAbsPath <> "/")
TN.TestnetRuntime { TN.bftSprockets, TN.testnetMagic } <- TN.testnet TN.defaultTestnetOptions conf
let networkId = C.Testnet $ C.NetworkMagic $ fromIntegral testnetMagic
socketPath <- IO.sprocketArgumentName <$> headM bftSprockets
tn <- TN.testnet TN.defaultTestnetOptions conf
let networkId = C.Testnet $ C.NetworkMagic $ fromIntegral (TN.testnetMagic tn)
socketPath <- IO.sprocketArgumentName <$> headM (TN.nodeSprocket <$> TN.bftNodes tn)
socketPathAbs <- H.note =<< (liftIO $ IO.canonicalizePath $ tempAbsPath </> socketPath)
pure (socketPathAbs, networkId, tempAbsPath)

deriving instance Real C.Lovelace
deriving instance Integral C.Lovelace

readAs :: (C.HasTextEnvelope a, MonadIO m, MonadTest m) => C.AsType a -> FilePath -> m a
readAs as path = H.leftFailM . liftIO $ C.readFileTextEnvelope as path

Expand Down
Loading

0 comments on commit 465e6ee

Please sign in to comment.