diff --git a/cardano-node-emulator/changelog.d/20230302_122332_ak3n_drop_emulator_tx.md b/cardano-node-emulator/changelog.d/20230302_122332_ak3n_drop_emulator_tx.md new file mode 100644 index 0000000000..2e5bd5b4da --- /dev/null +++ b/cardano-node-emulator/changelog.d/20230302_122332_ak3n_drop_emulator_tx.md @@ -0,0 +1,3 @@ +### Removed + +- Remove `estimateTransactionFee`, `signTx`, `fromPlutusTx`, `fromPlutusTxSigned`, `fromPlutusTxSigned'` as the `Tx` was removed from `plutus-ledger`. \ No newline at end of file diff --git a/cardano-node-emulator/src/Cardano/Node/Emulator/Fee.hs b/cardano-node-emulator/src/Cardano/Node/Emulator/Fee.hs index a9cbad7f38..bbeb0e312d 100644 --- a/cardano-node-emulator/src/Cardano/Node/Emulator/Fee.hs +++ b/cardano-node-emulator/src/Cardano/Node/Emulator/Fee.hs @@ -7,7 +7,6 @@ {-# LANGUAGE TypeFamilies #-} -- | Calculating transaction fees in the emulator. module Cardano.Node.Emulator.Fee( - estimateTransactionFee, estimateCardanoBuildTxFee, makeAutoBalancedTransaction, makeAutoBalancedTransactionWithUtxoProvider, @@ -23,7 +22,7 @@ import Cardano.Api.Shelley qualified as C.Api import Cardano.Ledger.BaseTypes (Globals (systemStart)) import Cardano.Ledger.Core qualified as C.Ledger (Tx) import Cardano.Ledger.Shelley.API qualified as C.Ledger hiding (Tx) -import Cardano.Node.Emulator.Params (EmulatorEra, PParams, Params (emulatorPParams, pNetworkId), emulatorEraHistory, +import Cardano.Node.Emulator.Params (EmulatorEra, PParams, Params (emulatorPParams), emulatorEraHistory, emulatorGlobals, pProtocolParams) import Cardano.Node.Emulator.Validation (CardanoLedgerError, UTxO (..), makeTransactionBody) import Control.Arrow ((&&&)) @@ -36,26 +35,16 @@ import Data.Map qualified as Map import Data.Maybe (isNothing, listToMaybe) import Data.Ord (Down (Down)) import GHC.Generics (Generic) -import Ledger.Address (CardanoAddress, PaymentPubKeyHash) +import Ledger.Address (CardanoAddress) import Ledger.Index (UtxoIndex (UtxoIndex), ValidationError (..), ValidationPhase (Phase1), adjustCardanoTxOut, minAdaTxOutEstimated) -import Ledger.Tx (ToCardanoError (TxBodyError), Tx, TxOut, TxOutRef) +import Ledger.Tx (ToCardanoError (TxBodyError), TxOut, TxOutRef) import Ledger.Tx qualified as Tx import Ledger.Tx.CardanoAPI (CardanoBuildTx (..), fromPlutusIndex, getCardanoBuildTx, toCardanoFee, - toCardanoReturnCollateral, toCardanoTotalCollateral, toCardanoTxBodyContent) + toCardanoReturnCollateral, toCardanoTotalCollateral) import Ledger.Tx.CardanoAPI qualified as CardanoAPI import Ledger.Value.CardanoAPI (isZero, lovelaceToValue, split, valueGeq) -estimateTransactionFee - :: Params - -> UTxO EmulatorEra - -> [PaymentPubKeyHash] - -> Tx - -> Either CardanoLedgerError C.Lovelace -estimateTransactionFee params utxo requiredSigners tx = do - txBodyContent <- first Right $ toCardanoTxBodyContent (pNetworkId params) (emulatorPParams params) requiredSigners tx - estimateCardanoBuildTxFee params utxo txBodyContent - estimateCardanoBuildTxFee :: Params -> UTxO EmulatorEra diff --git a/cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs b/cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs index 5c3a472473..aa73f2bd39 100644 --- a/cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs +++ b/cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs @@ -49,7 +49,6 @@ module Cardano.Node.Emulator.Generators( splitVal, validateMockchain, signAll, - signTx, CW.knownAddresses, CW.knownPaymentPublicKeys, CW.knownPaymentPrivateKeys, @@ -57,7 +56,8 @@ module Cardano.Node.Emulator.Generators( knownXPrvs, alwaysSucceedPolicy, alwaysSucceedPolicyId, - someTokenValue + someTokenValue, + emptyTxBodyContent ) where import Control.Monad (guard, replicateM) @@ -86,15 +86,14 @@ import Cardano.Crypto.Wallet qualified as Crypto import Cardano.Node.Emulator.Params (Params (pSlotConfig)) import Cardano.Node.Emulator.TimeSlot (SlotConfig) import Cardano.Node.Emulator.TimeSlot qualified as TimeSlot -import Cardano.Node.Emulator.Validation (fromPlutusTxSigned, validateCardanoTx) +import Cardano.Node.Emulator.Validation (validateCardanoTx) import Control.Lens.Lens ((<&>)) import Data.Functor (($>)) import Data.String (fromString) import Gen.Cardano.Api.Typed (genTxIn) -import Ledger (CardanoTx (CardanoApiTx), Interval, MintingPolicy (getMintingPolicy), +import Ledger (CardanoTx (CardanoEmulatorEraTx), Interval, MintingPolicy (getMintingPolicy), POSIXTime (POSIXTime, getPOSIXTime), POSIXTimeRange, Passphrase (Passphrase), PaymentPrivateKey (unPaymentPrivateKey), PaymentPubKey, Slot (Slot), SlotRange, - SomeCardanoApiTx (CardanoApiEmulatorEraTx), TxInType (ConsumePublicKeyAddress, ConsumeSimpleScriptAddress, ScriptAddress), TxInput, TxInputType, TxOut, TxOutRef (TxOutRef), ValidationErrorInPhase, addCardanoTxSignature, maxFee, minAdaTxOutEstimated, minLovelaceTxOutEstimated, pubKeyTxOut, txOutValue, validatorHash) @@ -163,11 +162,10 @@ genMockchain' gm = do slotCfg <- genSlotConfig (txn, ot) <- genInitialTransaction gm let params = def { pSlotConfig = slotCfg } - signedTx = signTx params mempty txn -- There is a problem that txId of emulator tx and tx of cardano tx are different. -- We convert the emulator tx to cardano tx here to get the correct transaction id -- because later we anyway will use the converted cardano tx so the utxo should match it. - tid = Tx.getCardanoTxId signedTx + tid = Tx.getCardanoTxId txn pure Mockchain { mockchainInitialTxPool = [txn], mockchainUtxo = Map.fromList $ first (TxOutRef tid) <$> zip [0..] ot, @@ -188,6 +186,27 @@ genInitialTransaction g = do (body, o) <- initialTxBody g (,o) <$> makeTx body +emptyTxBodyContent :: C.TxBodyContent C.BuildTx C.BabbageEra +emptyTxBodyContent = C.TxBodyContent + { txIns = [] + , txInsCollateral = C.TxInsCollateralNone + , txMintValue = C.TxMintNone + , txFee = C.toCardanoFee 0 + , txOuts = [] + , txProtocolParams = C.BuildTxWith $ Just $ C.fromLedgerPParams C.ShelleyBasedEraBabbage def + , txInsReference = C.TxInsReferenceNone + , txTotalCollateral = C.TxTotalCollateralNone + , txReturnCollateral = C.TxReturnCollateralNone + , txValidityRange = ( C.TxValidityNoLowerBound + , C.TxValidityNoUpperBound C.ValidityNoUpperBoundInBabbageEra) + , txScriptValidity = C.TxScriptValidityNone + , txExtraKeyWits = C.TxExtraKeyWitnessesNone + , txMetadata = C.TxMetadataNone + , txAuxScripts = C.TxAuxScriptsNone + , txWithdrawals = C.TxWithdrawalsNone + , txCertificates = C.TxCertificatesNone + , txUpdateProposal = C.TxUpdateProposalNone + } initialTxBody :: GeneratorModel @@ -198,27 +217,9 @@ initialTxBody GeneratorModel{..} = do -- we use a generated tx in input it's unbalanced but it's "fine" as we don't validate this tx txIns <- map (, C.BuildTxWith (C.KeyWitness C.KeyWitnessForSpending)) <$> Gen.list (Range.constant 1 10) genTxIn - pure (C.TxBodyContent - { txIns - , txInsCollateral = C.TxInsCollateralNone - , txMintValue = C.TxMintNone - , txFee = C.toCardanoFee 0 - , txOuts = Tx.getTxOut <$> o - -- unused: - , txProtocolParams = C.BuildTxWith $ Just $ C.fromLedgerPParams C.ShelleyBasedEraBabbage def - , txInsReference = C.TxInsReferenceNone - , txTotalCollateral = C.TxTotalCollateralNone - , txReturnCollateral = C.TxReturnCollateralNone - , txValidityRange = ( C.TxValidityNoLowerBound - , C.TxValidityNoUpperBound C.ValidityNoUpperBoundInBabbageEra) - , txScriptValidity = C.TxScriptValidityNone - , txExtraKeyWits = C.TxExtraKeyWitnessesNone - , txMetadata = C.TxMetadataNone - , txAuxScripts = C.TxAuxScriptsNone - , txWithdrawals = C.TxWithdrawalsNone - - , txCertificates = C.TxCertificatesNone - , txUpdateProposal = C.TxUpdateProposalNone + pure (emptyTxBodyContent + { C.txIns + , C.txOuts = Tx.getTxOut <$> o }, o) -- | Generate a valid transaction, using the unspent outputs provided. @@ -269,7 +270,7 @@ makeTx -> m CardanoTx makeTx bodyContent = do txBody <- either (fail . ("Can't create TxBody" <>) . show) pure $ C.makeTransactionBody bodyContent - pure $ signAll $ CardanoApiTx $ CardanoApiEmulatorEraTx $ C.Tx txBody [] + pure $ signAll $ CardanoEmulatorEraTx $ C.Tx txBody [] -- | Generate a valid transaction, using the unspent outputs provided. -- Fails if the there are no unspent outputs, or if the total value @@ -333,27 +334,12 @@ genValidTransactionBodySpending' g ins totalVal = do (fail "Cannot gen collateral") (failOnCardanoError . (C.toCardanoTxInsCollateral . map toTxInput . flip take ins . fromIntegral)) (gmMaxCollateralInputs g) - pure $ C.TxBodyContent - { txIns - , txInsCollateral - , txMintValue - , txFee = C.toCardanoFee fee' - , txOuts = Tx.getTxOut <$> txOutputs - -- unused: - , txProtocolParams = C.BuildTxWith $ Just $ C.fromLedgerPParams C.ShelleyBasedEraBabbage def - , txInsReference = C.TxInsReferenceNone - , txTotalCollateral = C.TxTotalCollateralNone - , txReturnCollateral = C.TxReturnCollateralNone - , txValidityRange = ( C.TxValidityNoLowerBound - , C.TxValidityNoUpperBound C.ValidityNoUpperBoundInBabbageEra) - , txScriptValidity = C.TxScriptValidityNone - , txExtraKeyWits = C.TxExtraKeyWitnessesNone - , txMetadata = C.TxMetadataNone - , txAuxScripts = C.TxAuxScriptsNone - , txWithdrawals = C.TxWithdrawalsNone - - , txCertificates = C.TxCertificatesNone - , txUpdateProposal = C.TxUpdateProposalNone + pure $ emptyTxBodyContent + { C.txIns + , C.txInsCollateral + , C.txMintValue + , C.txFee = C.toCardanoFee fee' + , C.txOuts = Tx.getTxOut <$> txOutputs } where -- | Translate TxIn to TxInput taking out data witnesses if present. @@ -379,18 +365,11 @@ genValidTransactionBodySpending' g ins totalVal = do toTxInType Tx.ConsumePublicKeyAddress = Tx.TxConsumePublicKeyAddress toTxInType (Tx.ScriptAddress valOrRef rd dat) = Tx.TxScriptAddress rd (first validatorHash valOrRef) $ fmap datumHash dat -signTx :: Params -> Map TxOutRef TxOut -> CardanoTx -> CardanoTx -signTx params utxo = let - cUtxoIndex = either (error . show) id $ fromPlutusIndex (Index.UtxoIndex utxo) - in Tx.onCardanoTx - (\t -> fromPlutusTxSigned params cUtxoIndex t CW.knownPaymentKeys) - Tx.CardanoApiTx - -- | Validate a transaction in a mockchain. validateMockchain :: Mockchain -> CardanoTx -> Maybe Ledger.ValidationErrorInPhase validateMockchain (Mockchain _ utxo params) tx = result where cUtxoIndex = either (error . show) id $ fromPlutusIndex (Index.UtxoIndex utxo) - result = leftToMaybe $ validateCardanoTx params 1 cUtxoIndex (signTx params utxo tx) + result = leftToMaybe $ validateCardanoTx params 1 cUtxoIndex tx -- | Generate an 'Interval where the lower bound if less or equal than the -- upper bound. diff --git a/cardano-node-emulator/src/Cardano/Node/Emulator/Validation.hs b/cardano-node-emulator/src/Cardano/Node/Emulator/Validation.hs index b49ae279e1..e0c5795f9b 100644 --- a/cardano-node-emulator/src/Cardano/Node/Emulator/Validation.hs +++ b/cardano-node-emulator/src/Cardano/Node/Emulator/Validation.hs @@ -6,6 +6,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} + {-| Transaction validation using 'cardano-ledger-specs' -} module Cardano.Node.Emulator.Validation( @@ -19,9 +21,6 @@ module Cardano.Node.Emulator.Validation( hasValidationErrors, makeTransactionBody, validateCardanoTx, - fromPlutusTx, - fromPlutusTxSigned, - fromPlutusTxSigned', -- * Modifying the state makeBlock, setSlot, @@ -37,7 +36,6 @@ module Cardano.Node.Emulator.Validation( emulatorGlobals, ) where -import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C.Api import Cardano.Ledger.Alonzo.PlutusScriptApi (collectTwoPhaseScriptInputs, evalScripts) import Cardano.Ledger.Alonzo.Rules.Utxos (UtxosPredicateFailure (CollectErrors)) @@ -58,29 +56,22 @@ import Cardano.Ledger.Shelley.LedgerState (LedgerState (..), UTxOState (..), sma import Cardano.Ledger.Shelley.Rules.Utxo (UtxoEnv (..)) import Cardano.Ledger.Shelley.TxBody (DCert, Wdrl) import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval) -import Cardano.Node.Emulator.Params (EmulatorEra, Params (emulatorPParams, pNetworkId), emulatorGlobals, - emulatorPParams) +import Cardano.Node.Emulator.Params (EmulatorEra, Params (emulatorPParams), emulatorGlobals, emulatorPParams) import Cardano.Slotting.Slot (SlotNo (..)) import Control.Lens (makeLenses, over, (&), (.~), (^.)) import Control.Monad.Except (MonadError (throwError)) import Data.Array (array) import Data.Bifunctor (Bifunctor (..)) import Data.Default (def) -import Data.Foldable (foldl') import Data.Map qualified as Map -import Data.Maybe (mapMaybe) import Data.Sequence.Strict (StrictSeq) import Data.Set (Set) import Data.Text qualified as Text import GHC.Records (HasField (..)) -import Ledger.Address qualified as P -import Ledger.Crypto qualified as Crypto import Ledger.Index.Internal qualified as P import Ledger.Slot (Slot) -import Ledger.Tx (CardanoTx (CardanoApiTx), SomeCardanoApiTx (CardanoApiEmulatorEraTx, SomeTx), addCardanoTxSignature, - onCardanoTx) +import Ledger.Tx (CardanoTx (CardanoEmulatorEraTx)) import Ledger.Tx.CardanoAPI qualified as P -import Ledger.Tx.Internal qualified as P import Plutus.V1.Ledger.Api qualified as V1 hiding (TxOut (..)) import Plutus.V1.Ledger.Scripts qualified as P @@ -261,11 +252,9 @@ validateCardanoTx -> UTxO EmulatorEra -> CardanoTx -> Either P.ValidationErrorInPhase P.ValidationSuccess -validateCardanoTx params slot utxo@(UTxO utxoMap) = - onCardanoTx - (\_ -> error "validateCardanoTx: EmulatorTx is not supported") - (\(CardanoApiEmulatorEraTx tx) -> if Map.null utxoMap then Right Map.empty else - hasValidationErrors params (fromIntegral slot) utxo tx) +validateCardanoTx params slot utxo@(UTxO utxoMap) (CardanoEmulatorEraTx tx) = + if Map.null utxoMap then Right Map.empty else + hasValidationErrors params (fromIntegral slot) utxo tx getTxExUnitsWithLogs :: Params -> UTxO EmulatorEra -> C.Api.Tx C.Api.BabbageEra -> Either P.ValidationErrorInPhase P.ValidationSuccess getTxExUnitsWithLogs params utxo (C.Api.ShelleyTx _ tx) = @@ -292,41 +281,3 @@ makeTransactionBody params utxo txBodyContent = do txTmp <- bimap Right (C.Api.makeSignedTransaction []) $ P.makeTransactionBody (Just $ emulatorPParams params) mempty txBodyContent exUnits <- bimap Left (Map.map snd) $ getTxExUnitsWithLogs params utxo txTmp first Right $ P.makeTransactionBody (Just $ emulatorPParams params) exUnits txBodyContent - -fromPlutusTx - :: Params - -> UTxO EmulatorEra - -> [P.PaymentPubKeyHash] - -> P.Tx - -> Either CardanoLedgerError (C.Tx C.BabbageEra) -fromPlutusTx params utxo requiredSigners tx = do - txBodyContent <- first Right $ P.toCardanoTxBodyContent (pNetworkId params) (emulatorPParams params) requiredSigners tx - C.Api.makeSignedTransaction [] <$> makeTransactionBody params utxo txBodyContent - -fromPlutusTxSigned - :: Params - -> UTxO EmulatorEra - -> P.Tx - -> Map.Map P.PaymentPubKey P.PaymentPrivateKey - -> CardanoTx -fromPlutusTxSigned params utxo tx knownPaymentKeys = case fromPlutusTxSigned' params utxo tx knownPaymentKeys of - Left e -> error ("fromPlutusTxSigned: failed to convert " ++ show e) - Right t -> t - -fromPlutusTxSigned' - :: Params - -> UTxO EmulatorEra - -> P.Tx - -> Map.Map P.PaymentPubKey P.PaymentPrivateKey - -> Either CardanoLedgerError CardanoTx -fromPlutusTxSigned' params utxo tx knownPaymentKeys = - let - getPrivateKey = fmap P.unPaymentPrivateKey . flip Map.lookup knownPaymentKeys . P.PaymentPubKey - getPublicKeys = Map.keys . P.txSignatures - privateKeys = mapMaybe getPrivateKey $ getPublicKeys tx - signTx txn = foldl' (flip addCardanoTxSignature) txn privateKeys - convertTx t = - flip SomeTx C.BabbageEraInCardanoMode - <$> fromPlutusTx params utxo (P.PaymentPubKeyHash . Crypto.pubKeyHash <$> getPublicKeys t) t - in - signTx . CardanoApiTx <$> convertTx tx diff --git a/cardano-streaming/examples/Example2.hs b/cardano-streaming/examples/Example2.hs index 179ca7021b..0b8f1d464d 100644 --- a/cardano-streaming/examples/Example2.hs +++ b/cardano-streaming/examples/Example2.hs @@ -26,7 +26,7 @@ main = do flip map txs $ \tx@(Cardano.Api.Tx txBody _) -> let scriptData = Ledger.Tx.CardanoAPI.scriptDataFromCardanoTxBody txBody txId = Ledger.Tx.CardanoAPI.fromCardanoTxId $ Cardano.Api.getTxId txBody - txOutRefs = Ledger.Tx.CardanoAPI.txOutRefs (workaround (Ledger.Tx.CardanoAPI.SomeTx tx) eim) + txOutRefs = Ledger.Tx.CardanoAPI.txOutRefs (workaround (Ledger.Tx.CardanoAPI.CardanoTx tx) eim) in Aeson.object [ "txId" .= txId, "txOutRefs" .= txOutRefs, diff --git a/doc/plutus/tutorials/basic-apps-trace.txt b/doc/plutus/tutorials/basic-apps-trace.txt index 7420301ea7..4089c93ee6 100644 --- a/doc/plutus/tutorials/basic-apps-trace.txt +++ b/doc/plutus/tutorials/basic-apps-trace.txt @@ -1,4 +1,4 @@ -[INFO] Slot 0: TxnValidate 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84 [ ] +[INFO] Slot 0: TxnValidate d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d [ ] [INFO] Slot 1: 00000000-0000-4000-8000-000000000000 {Wallet W[1]}: Contract instance started [INFO] Slot 1: 00000000-0000-4000-8000-000000000000 {Wallet W[1]}: @@ -29,11 +29,11 @@ Requires signatures: Utxo index: [INFO] Slot 1: W[1]: Finished balancing: - Tx 4971ec8310b413ee54d21e1d62dd0cda373c6cec41cf159d832bdf7cfc1c266f: + Tx 3aed0c9c37edee742d00559de3471f4ad6b791522ba224c17fe188a0efcdcda5: {inputs: - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!50 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!50 - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!51 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!51 reference inputs: collateral inputs: @@ -54,17 +54,17 @@ <>>, 10000000> ) redeemers:} -[INFO] Slot 1: W[1]: Signing tx: 4971ec8310b413ee54d21e1d62dd0cda373c6cec41cf159d832bdf7cfc1c266f -[INFO] Slot 1: W[1]: Submitting tx: 4971ec8310b413ee54d21e1d62dd0cda373c6cec41cf159d832bdf7cfc1c266f -[INFO] Slot 1: W[1]: TxSubmit: 4971ec8310b413ee54d21e1d62dd0cda373c6cec41cf159d832bdf7cfc1c266f -[INFO] Slot 1: TxnValidate 4971ec8310b413ee54d21e1d62dd0cda373c6cec41cf159d832bdf7cfc1c266f [ ] +[INFO] Slot 1: W[1]: Signing tx: 3aed0c9c37edee742d00559de3471f4ad6b791522ba224c17fe188a0efcdcda5 +[INFO] Slot 1: W[1]: Submitting tx: 3aed0c9c37edee742d00559de3471f4ad6b791522ba224c17fe188a0efcdcda5 +[INFO] Slot 1: W[1]: TxSubmit: 3aed0c9c37edee742d00559de3471f4ad6b791522ba224c17fe188a0efcdcda5 +[INFO] Slot 1: TxnValidate 3aed0c9c37edee742d00559de3471f4ad6b791522ba224c17fe188a0efcdcda5 [ ] [INFO] Slot 2: 00000000-0000-4000-8000-000000000000 {Wallet W[1]}: Receive endpoint call on 'unlock' for Object (fromList [("contents",Array [Object (fromList [("getEndpointDescription",String "unlock")]),Object (fromList [("unEndpointValue",Object (fromList [("recipient1Address",String "addr_test1vz3vyrrh3pavu8xescvnunn4h27cny70645etn2ulnnqnssrz8utc"),("recipient2Address",String "addr_test1vzq2fazm26ug6yfemg3mcnpuwhkx6v558sy87fgtscvnefckqs3wk"),("totalAda",Object (fromList [("getLovelace",Number 1.0e7)]))]))])]),("tag",String "ExposeEndpointResp")]) [INFO] Slot 2: W[1]: Balancing an unbalanced transaction: Tx: - Tx 726adfb9e7c9773f7639540b564cbf67dbb897efcb011739e38e2816ff08e1e5: + Tx 91ed39867cbcc307d0beb619215e1c138e726105024dbb6668e5ffbfdd2fd754: {inputs: - - 4971ec8310b413ee54d21e1d62dd0cda373c6cec41cf159d832bdf7cfc1c266f!0 + - 3aed0c9c37edee742d00559de3471f4ad6b791522ba224c17fe188a0efcdcda5!0 reference inputs: collateral inputs: @@ -84,25 +84,25 @@ <>>, 10000000> ) redeemers: - RedeemerPtr Spend 0 : Redeemer {getRedeemer = Constr 0 []} + RedeemerPtr Spend 0 : Constr 0 [] attached scripts: PlutusScript PlutusV1 ScriptHash "3e4f54085c2eb253b81fb958f3c3369ab6139c12964ee894ae57a908"} Requires signatures: Utxo index: - ( 4971ec8310b413ee54d21e1d62dd0cda373c6cec41cf159d832bdf7cfc1c266f!0 + ( 3aed0c9c37edee742d00559de3471f4ad6b791522ba224c17fe188a0efcdcda5!0 , - 10000000 lovelace addressed to ScriptCredential: 3e4f54085c2eb253b81fb958f3c3369ab6139c12964ee894ae57a908 (no staking credential) with datum hash 43492163ee71f886ebc65c85f3dfa8db313f00d701b433b539811464d4355873 ) [INFO] Slot 2: W[1]: Finished balancing: - Tx fcef4d121ba88cef5c12d689427e73aec161154190e270c953b1a652037c7533: + Tx 6156586126d719203a5e22e67360550c8dd3d1565c2afeee576349b7ea84bc09: {inputs: - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!52 + - 3aed0c9c37edee742d00559de3471f4ad6b791522ba224c17fe188a0efcdcda5!0 - - 4971ec8310b413ee54d21e1d62dd0cda373c6cec41cf159d832bdf7cfc1c266f!0 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!52 reference inputs: collateral inputs: - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!52 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!52 outputs: - 5000000 lovelace addressed to @@ -126,13 +126,13 @@ <>>, 10000000> ) redeemers: - RedeemerPtr Spend 1 : Redeemer {getRedeemer = Constr 0 []} + RedeemerPtr Spend 0 : Constr 0 [] attached scripts: PlutusScript PlutusV1 ScriptHash "3e4f54085c2eb253b81fb958f3c3369ab6139c12964ee894ae57a908"} -[INFO] Slot 2: W[1]: Signing tx: fcef4d121ba88cef5c12d689427e73aec161154190e270c953b1a652037c7533 -[INFO] Slot 2: W[1]: Submitting tx: fcef4d121ba88cef5c12d689427e73aec161154190e270c953b1a652037c7533 -[INFO] Slot 2: W[1]: TxSubmit: fcef4d121ba88cef5c12d689427e73aec161154190e270c953b1a652037c7533 -[INFO] Slot 2: TxnValidate fcef4d121ba88cef5c12d689427e73aec161154190e270c953b1a652037c7533 [ Data decoded successfully +[INFO] Slot 2: W[1]: Signing tx: 6156586126d719203a5e22e67360550c8dd3d1565c2afeee576349b7ea84bc09 +[INFO] Slot 2: W[1]: Submitting tx: 6156586126d719203a5e22e67360550c8dd3d1565c2afeee576349b7ea84bc09 +[INFO] Slot 2: W[1]: TxSubmit: 6156586126d719203a5e22e67360550c8dd3d1565c2afeee576349b7ea84bc09 +[INFO] Slot 2: TxnValidate 6156586126d719203a5e22e67360550c8dd3d1565c2afeee576349b7ea84bc09 [ Data decoded successfully , Redeemer decoded successfully , Script context decoded successfully ] Final balances diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Tx.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Tx.hs index d97fefb27b..164e3ca974 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Tx.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Tx.hs @@ -40,21 +40,15 @@ module Plutus.ChainIndex.Tx( , _ValidTx ) where -import Data.List (sort) import Data.Map (Map) import Data.Map qualified as Map -import Data.Maybe (mapMaybe) import Data.Tuple (swap) -import Ledger (OnChainTx (..), ScriptTag (Cert, Mint, Reward), SomeCardanoApiTx (SomeTx), Tx (..), - TxInput (txInputType), TxOut (getTxOut), TxOutRef (..), onCardanoTx, txCertifyingRedeemers, txId, - txMintingRedeemers, txRewardingRedeemers) +import Ledger (CardanoTx (CardanoTx), OnChainTx (..), TxOutRef (..)) import Ledger.Address (CardanoAddress) import Ledger.Scripts (Redeemer, RedeemerHash) -import Ledger.Tx (TxInputType (TxScriptAddress), fillTxInputWitnesses) import Plutus.ChainIndex.Types -import Plutus.Contract.CardanoAPI (fromCardanoTx, fromCardanoTxOut, setValidity) +import Plutus.Contract.CardanoAPI (fromCardanoTx, setValidity) import Plutus.Script.Utils.Scripts (redeemerHash) -import Plutus.V1.Ledger.Tx (RedeemerPtr (RedeemerPtr), Redeemers, ScriptTag (Spend)) import Plutus.V2.Ledger.Api (Address (..), OutputDatum (..), Value (..)) -- | Get tx outputs from tx. @@ -90,64 +84,15 @@ validityFromChainIndex tx = -- | Convert a 'OnChainTx' to a 'ChainIndexTx'. An invalid 'OnChainTx' will not -- produce any 'ChainIndexTx' outputs and the collateral inputs of the -- 'OnChainTx' will be the inputs of the 'ChainIndexTx'. +-- +-- Cardano api transactions store validity internally. Our emulated blockchain stores validity outside of the transactions, +-- so we need to make sure these match up. fromOnChainTx :: OnChainTx -> ChainIndexTx fromOnChainTx = \case - Valid ctx -> - onCardanoTx - (\case tx@Tx{txInputs, txOutputs, txValidRange, txData, txScripts} -> - ChainIndexTx - { _citxTxId = txId tx - , _citxInputs = map (fillTxInputWitnesses tx) txInputs - , _citxOutputs = ValidTx $ map (fromCardanoTxOut . getTxOut) txOutputs - , _citxValidRange = txValidRange - , _citxData = txData - , _citxRedeemers = calculateRedeemerPointers tx - , _citxScripts = txScripts - , _citxCardanoTx = Nothing - } - ) - (fromOnChainCardanoTx True) - ctx - Invalid ctx -> - onCardanoTx - (\case tx@Tx{txCollateralInputs, txReturnCollateral, txValidRange, txData, txScripts} -> - ChainIndexTx - { _citxTxId = txId tx - , _citxInputs = map (fillTxInputWitnesses tx) txCollateralInputs - , _citxOutputs = InvalidTx $ fmap (fromCardanoTxOut . getTxOut) txReturnCollateral - , _citxValidRange = txValidRange - , _citxData = txData - , _citxRedeemers = calculateRedeemerPointers tx - , _citxScripts = txScripts - , _citxCardanoTx = Nothing - } - ) - (fromOnChainCardanoTx False) - ctx + Valid (CardanoTx tx era) -> fromCardanoTx era $ setValidity True tx + Invalid (CardanoTx tx era) -> fromCardanoTx era $ setValidity False tx txRedeemersWithHash :: ChainIndexTx -> Map RedeemerHash Redeemer txRedeemersWithHash ChainIndexTx{_citxRedeemers} = Map.fromList $ fmap (\r -> (redeemerHash r, r)) $ Map.elems _citxRedeemers - --- Cardano api transactions store validity internally. Our emulated blockchain stores validity outside of the transactions, --- so we need to make sure these match up. Once we only have cardano api txs this can be removed. -fromOnChainCardanoTx :: Bool -> SomeCardanoApiTx -> ChainIndexTx -fromOnChainCardanoTx validity (SomeTx tx era) = fromCardanoTx era $ setValidity validity tx - --- TODO: the index of the txin is probably incorrect as we take it from the set. --- To determine the proper index we have to convert the plutus's `TxIn` to cardano-api `TxIn` and --- sort them by using the standard `Ord` instance. -calculateRedeemerPointers :: Tx -> Redeemers -calculateRedeemerPointers tx = spends <> rewards <> mints <> certs - -- we sort the inputs to make sure that the indices match with redeemer pointers - - where - rewards = Map.fromList $ zipWith (\n (_, rd) -> (RedeemerPtr Reward n, rd)) [0..] $ sort $ Map.assocs $ txRewardingRedeemers tx - mints = Map.fromList $ zipWith (\n (_, rd) -> (RedeemerPtr Mint n, rd)) [0..] $ sort $ Map.assocs $ txMintingRedeemers tx - certs = Map.fromList $ zipWith (\n (_, rd) -> (RedeemerPtr Cert n, rd)) [0..] $ sort $ Map.assocs $ txCertifyingRedeemers tx - spends = Map.fromList $ mapMaybe (uncurry getRd) $ zip [0..] $ fmap txInputType $ sort $ txInputs tx - - getRd n = \case - TxScriptAddress rd _ _ -> Just (RedeemerPtr Spend n, rd) - _ -> Nothing diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs index 08ea4c3f1b..c52e7b4dc6 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs +++ b/plutus-chain-index-core/src/Plutus/ChainIndex/Types.hs @@ -90,8 +90,8 @@ import Data.Set qualified as Set import Data.Typeable (Proxy (Proxy), Typeable) import Data.Word (Word64) import GHC.Generics (Generic) -import Ledger (CardanoAddress, Language, SlotRange, SomeCardanoApiTx, TxIn (..), TxInType (..), TxOutRef (..), - Versioned, toPlutusAddress) +import Ledger (CardanoAddress, CardanoTx, Language, SlotRange, TxIn (..), TxInType (..), TxOutRef (..), Versioned, + toPlutusAddress) import Ledger.Blockchain (BlockId (..)) import Ledger.Blockchain qualified as Ledger import Ledger.Slot (Slot (Slot)) @@ -260,11 +260,11 @@ instance (Typeable era) => OpenApi.ToSchema (C.Tx era) where declareNamedSchema _ = do return $ NamedSchema (Just "Tx") byteSchema -instance OpenApi.ToSchema SomeCardanoApiTx where +instance OpenApi.ToSchema CardanoTx where declareNamedSchema _ = do txSchema <- declareSchemaRef (Proxy :: Proxy (C.Tx C.BabbageEra)) eraInModeSchema <- declareSchemaRef (Proxy :: Proxy (C.EraInMode C.BabbageEra C.CardanoMode)) - return $ NamedSchema (Just "SomeCardanoApiTx") $ mempty + return $ NamedSchema (Just "CardanoTx") $ mempty & type_ ?~ OpenApiObject & properties .~ InsOrdMap.fromList [ ("tx", txSchema) @@ -287,7 +287,7 @@ data ChainIndexTx = ChainIndexTx { -- ^ Redeemers of the minting scripts. _citxScripts :: Map ScriptHash (Versioned Script), -- ^ The scripts (validator, stake validator or minting) part of cardano tx. - _citxCardanoTx :: Maybe SomeCardanoApiTx + _citxCardanoTx :: Maybe CardanoTx -- ^ The full Cardano API tx which was used to populate the rest of the -- 'ChainIndexTx' fields. Useful because 'ChainIndexTx' doesn't have all the -- details of the tx, so we keep it as a safety net. Might be Nothing if we diff --git a/plutus-chain-index-core/src/Plutus/Contract/CardanoAPI.hs b/plutus-chain-index-core/src/Plutus/Contract/CardanoAPI.hs index a10f63a47c..12beba3e1d 100644 --- a/plutus-chain-index-core/src/Plutus/Contract/CardanoAPI.hs +++ b/plutus-chain-index-core/src/Plutus/Contract/CardanoAPI.hs @@ -64,7 +64,7 @@ fromCardanoTx eraInMode tx@(C.Tx txBody@(C.TxBody C.TxBodyContent{..}) _) = , _citxData = datums , _citxRedeemers = redeemers , _citxScripts = scriptMap - , _citxCardanoTx = Just $ SomeTx tx eraInMode + , _citxCardanoTx = Just $ CardanoTx tx eraInMode } fromCardanoTxOut :: C.IsCardanoEra era => C.TxOut C.CtxTx era -> ChainIndexTxOut diff --git a/plutus-contract/src/Plutus/Contract/Effects.hs b/plutus-contract/src/Plutus/Contract/Effects.hs index d69cfa37c8..2c4ed94194 100644 --- a/plutus-contract/src/Plutus/Contract/Effects.hs +++ b/plutus-contract/src/Plutus/Contract/Effects.hs @@ -103,7 +103,7 @@ import Ledger.Credential (Credential) import Ledger.Scripts (Validator) import Ledger.Slot (Slot, SlotRange) import Ledger.Time (POSIXTime, POSIXTimeRange) -import Ledger.Tx (CardanoTx, DecoratedTxOut, Versioned, getCardanoTxId, onCardanoTx) +import Ledger.Tx (CardanoTx, DecoratedTxOut, Versioned, getCardanoTxId) import Ledger.Tx.Constraints.OffChain (UnbalancedTx) import Plutus.ChainIndex (Page (pageItems), PageQuery) import Plutus.ChainIndex.Api (IsUtxoResponse (IsUtxoResponse), QueryResponse (QueryResponse), @@ -161,7 +161,7 @@ instance Pretty PABReq where OwnAddressesReq -> "Own addresses" ChainIndexQueryReq q -> "Chain index query:" <+> pretty q BalanceTxReq utx -> "Balance tx:" <+> pretty utx - WriteBalancedTxReq tx -> "Write balanced tx:" <+> onCardanoTx pretty (fromString . show) tx + WriteBalancedTxReq tx -> "Write balanced tx:" <+> (fromString $ show tx) ExposeEndpointReq ep -> "Expose endpoint:" <+> pretty ep PosixTimeRangeToContainedSlotRangeReq r -> "Posix time range to contained slot range:" <+> pretty r YieldUnbalancedTxReq utx -> "Yield unbalanced tx:" <+> pretty utx diff --git a/plutus-contract/src/Plutus/Contract/Test/ContractModel/Internal.hs b/plutus-contract/src/Plutus/Contract/Test/ContractModel/Internal.hs index cf7fecbae1..2fbdb4027e 100644 --- a/plutus-contract/src/Plutus/Contract/Test/ContractModel/Internal.hs +++ b/plutus-contract/src/Plutus/Contract/Test/ContractModel/Internal.hs @@ -193,7 +193,7 @@ instance HasChainIndex (EmulatorTraceWithInstances state) where $ Index.initialise (take 1 $ reverse (_chainNewestFirst cs)) } addBlock block (txs, state) = - ( txs ++ [ TxInState ((\(CardanoApiEmulatorEraTx tx) -> tx) . _cardanoApiTx . unOnChain $ tx) + ( txs ++ [ TxInState ((\(CardanoEmulatorEraTx tx) -> tx) . unOnChain $ tx) state (onChainTxIsValid tx) | tx <- block ] diff --git a/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs b/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs index a6fbfe0a79..1ead54865b 100644 --- a/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs +++ b/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs @@ -58,8 +58,7 @@ import Ledger (CardanoAddress, POSIXTime, POSIXTimeRange, Slot (..), SlotRange) import Ledger.Tx (CardanoTx) import Ledger.Tx.CardanoAPI (ToCardanoError) import Ledger.Tx.Constraints (UnbalancedTx) -import Ledger.Tx.Constraints qualified as Tx.Constraints -import Ledger.Tx.Constraints.OffChain qualified as Constraints +import Ledger.Tx.Constraints qualified as Constraints import Plutus.ChainIndex (ChainIndexQueryEffect) import Plutus.ChainIndex.Effects qualified as ChainIndexEff import Plutus.ChainIndex.Types (Tip (..)) @@ -309,11 +308,7 @@ handleAdjustUnbalancedTx = RequestHandler $ \utx -> surroundDebug @Text "handleAdjustUnbalancedTx" $ do params <- getClientParams - let - adjustUnbalancedTx = case Constraints.unBalancedTxTx utx of - Left _ -> Tx.Constraints.adjustUnbalancedTx - Right _ -> Constraints.adjustUnbalancedTx - forM (adjustUnbalancedTx (emulatorPParams params) utx) $ \(missingAdaCosts, adjusted) -> do + forM (Constraints.adjustUnbalancedTx (emulatorPParams params) utx) $ \(missingAdaCosts, adjusted) -> do logDebug $ AdjustingUnbalancedTx missingAdaCosts pure adjusted diff --git a/plutus-contract/src/Plutus/Trace/Emulator/Extract.hs b/plutus-contract/src/Plutus/Trace/Emulator/Extract.hs index 0095b16e19..bb713d3a26 100644 --- a/plutus-contract/src/Plutus/Trace/Emulator/Extract.hs +++ b/plutus-contract/src/Plutus/Trace/Emulator/Extract.hs @@ -19,17 +19,14 @@ import Control.Lens ((&), (.~)) import Control.Monad.Freer (run) import Data.Aeson qualified as Aeson import Data.Aeson.Encode.Pretty (encodePretty) -import Data.Bifunctor (Bifunctor (bimap)) import Data.ByteString.Lazy qualified as BSL import Data.Foldable (traverse_) import Data.Int (Int64) import Data.Monoid (Sum (..)) -import Data.Set qualified as Set import Ledger qualified import Ledger.Tx.CardanoAPI (fromPlutusIndex) import Ledger.Tx.Constraints.OffChain (UnbalancedTx (..)) -import Plutus.Contract.CardanoAPI qualified as CardanoAPI import Plutus.Contract.Request (MkTxLog) import Plutus.Trace.Emulator (EmulatorConfig (_params), EmulatorTrace) import Plutus.Trace.Emulator qualified as Trace @@ -119,12 +116,6 @@ writeTransaction params fp prefix idx utx = do BSL.writeFile filename1 $ encodePretty ctx where buildTx :: UnbalancedTx -> Either CardanoLedgerError (C.Tx C.BabbageEra) - buildTx (UnbalancedEmulatorTx tx sigs _) = - let requiredSigners = Set.toList sigs - in bimap - Right - (C.makeSignedTransaction []) - (CardanoAPI.toCardanoTxBody (pNetworkId params) (emulatorPParams params) requiredSigners tx) buildTx (UnbalancedCardanoTx tx utxos) = let fromCardanoTx ctx = do utxo <- fromPlutusIndex $ Ledger.UtxoIndex utxos diff --git a/plutus-contract/src/Wallet/Emulator/MultiAgent.hs b/plutus-contract/src/Wallet/Emulator/MultiAgent.hs index 2ba0724bf5..734a1a39ba 100644 --- a/plutus-contract/src/Wallet/Emulator/MultiAgent.hs +++ b/plutus-contract/src/Wallet/Emulator/MultiAgent.hs @@ -17,6 +17,11 @@ {-# OPTIONS_GHC -Wno-overlapping-patterns #-} module Wallet.Emulator.MultiAgent where +import Cardano.Api qualified as C +import Cardano.Api.Shelley qualified as C +import Cardano.Node.Emulator.Chain qualified as Chain +import Cardano.Node.Emulator.Generators (alwaysSucceedPolicy, alwaysSucceedPolicyId, emptyTxBodyContent, signAll) +import Cardano.Node.Emulator.Params (Params (..)) import Control.Lens (AReview, Getter, Lens', Prism', anon, at, folded, makeLenses, prism', reversed, review, to, unto, view, (&), (.~), (^.), (^..)) import Control.Monad (join) @@ -26,30 +31,27 @@ import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg, LogObserve, handleObs import Control.Monad.Freer.Extras.Modify (handleZoomedState, raiseEnd, writeIntoState) import Control.Monad.Freer.State (State, get) import Data.Aeson (FromJSON, ToJSON) -import Data.Default (def) +import Data.Foldable (fold) import Data.Map (Map) import Data.Map qualified as Map import Data.Maybe (fromMaybe, isNothing) import Data.Text qualified as T import Data.Text.Extras (tshow) import GHC.Generics (Generic) -import Prettyprinter (Pretty (pretty), colon, (<+>)) - -import Cardano.Api qualified as C -import Cardano.Api.Shelley qualified as C -import Cardano.Node.Emulator.Chain qualified as Chain -import Cardano.Node.Emulator.Params (Params (..)) -import Cardano.Node.Emulator.Validation qualified as Validation -import Data.Foldable (fold) import Ledger hiding (to, value) import Ledger.AddressMap qualified as AM -import Ledger.CardanoWallet qualified as CW import Ledger.Index qualified as Index +import Ledger.Tx qualified as Tx +import Ledger.Tx.CardanoAPI qualified as C hiding (makeTransactionBody) import Ledger.Tx.CardanoAPI qualified as CardanoAPI +import Ledger.Value.CardanoAPI qualified as CardanoAPI import Plutus.ChainIndex.Emulator qualified as ChainIndex import Plutus.Contract.Error (AssertionError (GenericAssertion)) import Plutus.Trace.Emulator.Types (ContractInstanceLog, EmulatedWalletEffects, EmulatedWalletEffects', UserThreadMsg) import Plutus.Trace.Scheduler qualified as Scheduler +import Plutus.V1.Ledger.Scripts qualified as Script +import PlutusTx (toData) +import Prettyprinter (Pretty (pretty), colon, (<+>)) import Wallet.API qualified as WAPI import Wallet.Emulator.LogMessages (RequestHandlerLogMsg, TxBalanceMsg) import Wallet.Emulator.NodeClient qualified as NC @@ -292,19 +294,36 @@ to be an Ada-only output. To make sure we always have an Ada-only output availab we create 10 Ada-only outputs per wallet here. -} +-- | cardano-ledger validation rules require the presence of inputs and +-- we have to provide a stub TxIn for the genesis transaction. +genesisTxIn :: C.TxIn +genesisTxIn = C.TxIn "01f4b788593d4f70de2a45c2e1e87088bfbdfa29577ae1b62aba60e095e3ab53" (C.TxIx 40214) + -- | Initialise the emulator state with a single pending transaction that -- creates the initial distribution of funds to public key addresses. emulatorStateInitialDist :: Params -> Map PaymentPubKeyHash C.Value -> Either ToCardanoError EmulatorState emulatorStateInitialDist params mp = do minAdaEmptyTxOut <- mMinAdaTxOut outs <- traverse (mkOutputs minAdaEmptyTxOut) (Map.toList mp) - let tx = mempty - { txOutputs = concat outs - , txMint = fold mp - , txValidRange = WAPI.defaultSlotRange + validityRange <- C.toCardanoValidityRange WAPI.defaultSlotRange + mintWitness <- either (error . show) pure $ C.PlutusScriptWitness C.PlutusScriptV2InBabbage C.PlutusScriptV2 + <$> (C.PScript <$> C.toCardanoPlutusScript + (C.AsPlutusScript C.AsPlutusScriptV2) + (getMintingPolicy alwaysSucceedPolicy)) + <*> pure C.NoScriptDatumForMint + <*> pure (C.fromPlutusData $ toData Script.unitRedeemer) + <*> pure C.zeroExecutionUnits + let + txBodyContent = emptyTxBodyContent + { C.txIns = [ (genesisTxIn, C.BuildTxWith (C.KeyWitness C.KeyWitnessForSpending)) ] + , C.txInsCollateral = C.TxInsCollateral C.CollateralInBabbageEra [genesisTxIn] + , C.txMintValue = C.TxMintValue C.MultiAssetInBabbageEra (fold $ Map.map CardanoAPI.noAdaValue mp) + (C.BuildTxWith (Map.singleton alwaysSucceedPolicyId mintWitness)) + , C.txOuts = Tx.getTxOut <$> concat outs + , C.txValidityRange = validityRange } - cUtxoIndex = either (error . show) id $ CardanoAPI.fromPlutusIndex mempty - cTx = Validation.fromPlutusTxSigned def cUtxoIndex tx CW.knownPaymentKeys + txBody <- either (error . ("Can't create TxBody" <>) . show) pure $ C.makeTransactionBody txBodyContent + let cTx = signAll $ CardanoEmulatorEraTx $ C.Tx txBody [] pure $ emulatorStatePool [cTx] where -- we start with an empty TxOut and we adjust it to be sure that the contained Adas fit the size diff --git a/plutus-contract/src/Wallet/Emulator/Stream.hs b/plutus-contract/src/Wallet/Emulator/Stream.hs index eb7a16f828..9740b6d348 100644 --- a/plutus-contract/src/Wallet/Emulator/Stream.hs +++ b/plutus-contract/src/Wallet/Emulator/Stream.hs @@ -46,10 +46,8 @@ import Data.Maybe (fromMaybe) import Data.Set qualified as Set import Ledger.AddressMap qualified as AM import Ledger.Blockchain (Block, OnChainTx (Valid)) -import Ledger.CardanoWallet qualified as CW import Ledger.Slot (Slot) -import Ledger.Tx (CardanoTx (CardanoApiTx), onCardanoTx) -import Ledger.Tx.CardanoAPI (fromPlutusIndex) +import Ledger.Tx (CardanoTx) import Plutus.ChainIndex (ChainIndexError) import Streaming (Stream) import Streaming qualified as S @@ -63,7 +61,6 @@ import Wallet.Emulator.MultiAgent (EmulatorState, EmulatorTimeEvent (EmulatorTim import Wallet.Emulator.Wallet (Wallet, mockWalletAddress) import Cardano.Api qualified as C -import Cardano.Node.Emulator.Validation qualified as Validation import Plutus.Contract.Trace (InitialDistribution, defaultDist, knownWallets) import Plutus.Trace.Emulator.ContractInstance (EmulatorRuntimeError) @@ -148,11 +145,7 @@ type InitialChainState = Either InitialDistribution [CardanoTx] -- | The wallets' initial funds initialDist :: EmulatorConfig -> InitialDistribution -initialDist EmulatorConfig{..} = either id (walletFunds . map (Valid . signTx)) _initialChainState where - signTx = onCardanoTx - (\t -> Validation.fromPlutusTxSigned _params cUtxoIndex t CW.knownPaymentKeys) - CardanoApiTx - cUtxoIndex = either (error . show) id $ fromPlutusIndex mempty +initialDist EmulatorConfig{..} = either id (walletFunds . map Valid) _initialChainState where walletFunds :: Block -> Map Wallet C.Value walletFunds theBlock = let values = AM.values $ AM.fromChain [theBlock] @@ -171,11 +164,7 @@ initialState EmulatorConfig{..} = let (error . ("Cannot build the initial state: " <>) . show) id . EM.emulatorStateInitialDist _params . Map.mapKeys EM.mockWalletPaymentPubKeyHash - signTx = onCardanoTx - (\t -> Validation.fromPlutusTxSigned _params cUtxoIndex t CW.knownPaymentKeys) - CardanoApiTx - cUtxoIndex = either (error . show) id $ fromPlutusIndex mempty - in either withInitialWalletValues (EM.emulatorStatePool . map signTx) _initialChainState + in either withInitialWalletValues (EM.emulatorStatePool) _initialChainState data EmulatorErr = diff --git a/plutus-contract/src/Wallet/Emulator/Types.hs b/plutus-contract/src/Wallet/Emulator/Types.hs index 56f576ae7a..1fbdbb987b 100644 --- a/plutus-contract/src/Wallet/Emulator/Types.hs +++ b/plutus-contract/src/Wallet/Emulator/Types.hs @@ -20,7 +20,6 @@ module Wallet.Emulator.Types( Wallet.Emulator.Wallet.mockWalletAddress, Wallet.Emulator.Wallet.mockWalletPaymentPubKey, Wallet.Emulator.Wallet.mockWalletPaymentPubKeyHash, - addSignature, Wallet.Emulator.Wallet.knownWallets, Wallet.Emulator.Wallet.knownWallet, Ledger.CardanoWallet.WalletNumber(..), @@ -74,7 +73,6 @@ import Control.Monad.Freer.Extras.Log (LogMsg, mapLog) import Control.Monad.Freer.State (State) import Cardano.Node.Emulator.Params (Params) -import Ledger (addSignature) import Plutus.ChainIndex (ChainIndexError) import Wallet.API (WalletAPIError) diff --git a/plutus-contract/src/Wallet/Emulator/Wallet.hs b/plutus-contract/src/Wallet/Emulator/Wallet.hs index 6498818fde..c6660f4159 100644 --- a/plutus-contract/src/Wallet/Emulator/Wallet.hs +++ b/plutus-contract/src/Wallet/Emulator/Wallet.hs @@ -23,7 +23,6 @@ module Wallet.Emulator.Wallet where -import Cardano.Api (makeSignedTransaction) import Cardano.Api qualified as C import Cardano.Node.Emulator.Chain (ChainState (_index)) import Cardano.Node.Emulator.Fee qualified as Fee @@ -48,7 +47,6 @@ import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NonEmpty import Data.Map qualified as Map import Data.Maybe (catMaybes, fromMaybe) -import Data.Set qualified as Set import Data.String (IsString (fromString)) import Data.Text qualified as T import Data.Text.Encoding qualified as T @@ -307,12 +305,10 @@ handleBalance :: => UnbalancedTx -> Eff effs CardanoTx handleBalance utx = do - params@Params { pNetworkId, emulatorPParams } <- getClientParams + params@Params { pNetworkId } <- getClientParams utxo <- get >>= ownOutputs mappedUtxo <- either (throwError . WAPI.ToCardanoError) pure $ traverse (Tx.toTxOut pNetworkId) utxo - let eitherTx = U.unBalancedTxTx utx - requiredSigners = Set.toList (U.unBalancedTxRequiredSignatories utx) - unbalancedBodyContent <- either pure (handleError eitherTx . first Right . CardanoAPI.toCardanoTxBodyContent pNetworkId emulatorPParams requiredSigners) eitherTx + let unbalancedBodyContent = U.unBalancedCardanoBuildTx utx ownAddr <- gets ownAddress -- filter out inputs from utxo that are already in unBalancedTx let inputsOutRefs = map Tx.txInRef $ Tx.getTxBodyContentInputs $ CardanoAPI.getCardanoBuildTx unbalancedBodyContent @@ -322,18 +318,17 @@ handleBalance utx = do params (UtxoIndex $ U.unBalancedTxUtxoIndex utx) ownAddr - (handleBalancingError eitherTx . Fee.utxoProviderFromWalletOutputs filteredUtxo) - (handleError eitherTx . Left) + (handleBalancingError utx . Fee.utxoProviderFromWalletOutputs filteredUtxo) + (handleError utx . Left) unbalancedBodyContent - pure $ Tx.CardanoApiTx (Tx.CardanoApiEmulatorEraTx cTx) + pure $ Tx.CardanoEmulatorEraTx cTx where - handleError tx (Left (Left (ph, ve))) = do + handleError utx' (Left (Left (ph, ve))) = do tx' <- either (throwError . WAPI.ToCardanoError) pure - $ either (fmap (Tx.CardanoApiTx . Tx.CardanoApiEmulatorEraTx . makeSignedTransaction []) - . CardanoAPI.makeTransactionBody Nothing mempty) - (pure . Tx.EmulatorTx) - $ tx + $ fmap (Tx.CardanoEmulatorEraTx . C.makeSignedTransaction []) + . CardanoAPI.makeTransactionBody Nothing mempty + $ U.unBalancedCardanoBuildTx utx' logWarn $ ValidationFailed ph (Ledger.getCardanoTxId tx') tx' ve mempty [] throwError $ WAPI.ValidationError ve handleError _ (Left (Right ce)) = throwError $ WAPI.ToCardanoError ce @@ -342,7 +337,7 @@ handleBalance utx = do $ T.unwords [ "Total:", T.pack $ show total , "expected:", T.pack $ show expected ] - handleBalancingError tx (Left (Fee.CardanoLedgerError e)) = handleError tx (Left e) + handleBalancingError utx' (Left (Fee.CardanoLedgerError e)) = handleError utx' (Left e) handleBalancingError _ (Right v) = pure v handleAddSignature :: @@ -351,17 +346,14 @@ handleAddSignature :: ) => CardanoTx -> Eff effs CardanoTx -handleAddSignature tx = do +handleAddSignature tx@(Tx.CardanoEmulatorEraTx ctx) = do msp <- gets _signingProcess case msp of Nothing -> do PaymentPrivateKey privKey <- gets ownPaymentPrivateKey pure $ Tx.addCardanoTxSignature privKey tx Just (SigningProcess sp) -> do - let ctx = case tx of - Tx.CardanoApiTx (Tx.CardanoApiEmulatorEraTx ctx') -> ctx' - _ -> error "handleAddSignature: Need a Cardano API Tx from the Alonzo era to get the required signers" - reqSigners = getRequiredSigners ctx + let reqSigners = getRequiredSigners ctx sp reqSigners tx ownOutputs :: forall effs. diff --git a/plutus-contract/src/Wallet/Rollup.hs b/plutus-contract/src/Wallet/Rollup.hs index 7837b9a121..67282d67cb 100644 --- a/plutus-contract/src/Wallet/Rollup.hs +++ b/plutus-contract/src/Wallet/Rollup.hs @@ -26,7 +26,9 @@ import Ledger (Block, Blockchain, OnChainTx (..), TxIn (TxIn), TxOut, Validation onChainTxIsValid, outputsProduced, txInRef, txOutRefId, txOutRefIdx, txOutValue, unOnChain) import Ledger.Tx qualified as Tx import Ledger.Tx.CardanoAPI (fromCardanoValue) +import Ledger.Tx.CardanoAPI.Internal (fromCardanoTxIn) import Plutus.V1.Ledger.Value (Value) +import Wallet.Emulator.MultiAgent (genesisTxIn) import Wallet.Rollup.Types ------------------------------------------------------------ @@ -49,7 +51,9 @@ annotateTransaction sequenceId tx = do in case Map.lookup key cPreviousOutputs of Just txOut -> pure $ DereferencedInput txIn txOut Nothing -> pure $ InputNotFound key) - (consumableInputs tx) + -- We are filtering out the genesisTxIn as it will be processed as `InputNotFound` + -- because there is no matching output for it. + (filter (/= TxIn (fromCardanoTxIn genesisTxIn) Nothing) $ consumableInputs tx) let txId = Tx.getCardanoTxId $ unOnChain tx txOuts = Map.elems $ outputsProduced tx newOutputs = diff --git a/plutus-contract/test/Spec/Contract.hs b/plutus-contract/test/Spec/Contract.hs index 3110d07469..e5e1e356b8 100644 --- a/plutus-contract/test/Spec/Contract.hs +++ b/plutus-contract/test/Spec/Contract.hs @@ -249,7 +249,7 @@ tests = , let submitTxConstraintsWith sl constraints = do unbalancedTx <- mkTxConstraints @Void sl constraints tx <- balanceTx unbalancedTx - submitBalancedTx $ Ledger.CardanoApiTx $ tx ^?! Ledger.cardanoApiTx + submitBalancedTx tx c :: Contract [TxOutStatus] Schema ContractError () = do -- Submit a payment tx of 10 lovelace to W2. let w2PubKeyHash = mockWalletPaymentPubKeyHash w2 @@ -392,7 +392,6 @@ type Schema = .\/ Endpoint "4" Int .\/ Endpoint "ep" () .\/ Endpoint "5" [ActiveEndpoint] - .\/ Endpoint "6" Ledger.Tx initial :: _ initial = State.initialiseContract loopCheckpointContract diff --git a/plutus-contract/test/Spec/Emulator.hs b/plutus-contract/test/Spec/Emulator.hs index 2f74374640..b37cd693cc 100644 --- a/plutus-contract/test/Spec/Emulator.hs +++ b/plutus-contract/test/Spec/Emulator.hs @@ -110,8 +110,8 @@ pubKey3 = mockWalletPaymentPubKeyHash wallet3 utxo :: Property utxo = property $ do - Mockchain txPool o params <- forAll Gen.genMockchain - Hedgehog.assert (unspentOutputs [map (Valid . Gen.signTx params o) txPool] == o) + Mockchain txPool o _params <- forAll Gen.genMockchain + Hedgehog.assert (unspentOutputs [map Valid txPool] == o) txnValid :: Property txnValid = property $ do @@ -131,15 +131,14 @@ selectCoinProp = property $ do txnUpdateUtxo :: Property txnUpdateUtxo = property $ do - (Mockchain m utxos params, txn) <- forAll genChainTxn + (Mockchain m _utxos _params, txn) <- forAll genChainTxn let options = defaultCheckOptions & emulatorConfig . Trace.initialChainState .~ Right m - signedTx = Gen.signTx params utxos txn -- submit the same txn twice, so it should be accepted the first time -- and rejected the second time. trace = do - Trace.liftWallet wallet1 (submitTxn signedTx) - Trace.liftWallet wallet1 (submitTxn signedTx) + Trace.liftWallet wallet1 (submitTxn txn) + Trace.liftWallet wallet1 (submitTxn txn) pred = \case [ Chain.TxnValidate{} , Chain.SlotAdd _ @@ -153,20 +152,18 @@ txnUpdateUtxo = property $ do validTrace :: Property validTrace = property $ do - (Mockchain m utxo params, txn) <- forAll genChainTxn + (Mockchain m _utxo _params, txn) <- forAll genChainTxn let options = defaultCheckOptions & emulatorConfig . Trace.initialChainState .~ Right m - signedTx = Gen.signTx params utxo txn - trace = Trace.liftWallet wallet1 (submitTxn signedTx) + trace = Trace.liftWallet wallet1 (submitTxn txn) void $ checkPredicateInner options assertNoFailedTransactions trace Hedgehog.annotate Hedgehog.assert (const $ pure ()) validTrace2 :: Property validTrace2 = property $ do - (Mockchain m utxo params, txn) <- forAll genChainTxn + (Mockchain m _utxo _params, txn) <- forAll genChainTxn let options = defaultCheckOptions & emulatorConfig . Trace.initialChainState .~ Right m - signedTx = Gen.signTx params utxo txn trace = do - Trace.liftWallet wallet1 (submitTxn signedTx) - Trace.liftWallet wallet1 (submitTxn signedTx) + Trace.liftWallet wallet1 (submitTxn txn) + Trace.liftWallet wallet1 (submitTxn txn) predicate = assertFailedTransaction (\_ _ -> True) void $ checkPredicateInner options predicate trace Hedgehog.annotate Hedgehog.assert (const $ pure ()) diff --git a/plutus-contract/test/Spec/golden/traceOutput - pubKeyTransactions.txt b/plutus-contract/test/Spec/golden/traceOutput - pubKeyTransactions.txt index 70d5da1385..310974e03d 100644 --- a/plutus-contract/test/Spec/golden/traceOutput - pubKeyTransactions.txt +++ b/plutus-contract/test/Spec/golden/traceOutput - pubKeyTransactions.txt @@ -9,18 +9,18 @@ [DEBUG] Slot 0: Thread 9 {W c30efb78b4e272685c1f9f0c93787fd4b6743154}: Started (Normal) [DEBUG] Slot 0: Thread 10 {W d3eddd0d37989746b029a0e050386bc425363901}: Started (Normal) [DEBUG] Slot 0: Thread 11 {block maker}: Started (Normal) -[INFO] Slot 0: TxnValidate 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84 [ ] +[INFO] Slot 0: TxnValidate d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d [ ] [DEBUG] Slot 0: SlotAdd Slot 1 -[DEBUG] Slot 1: W[7]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[8]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[6]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[4]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[2]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[1]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[10]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[9]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[3]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[5]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[7]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[8]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[6]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[4]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[2]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[1]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[10]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[9]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[3]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[5]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. [DEBUG] Slot 1: W[1]: Adjusting an unbalanced transaction: [] [INFO] Slot 1: W[1]: Balancing an unbalanced transaction: Tx: @@ -40,9 +40,9 @@ "a2c20c77887ace1cd986193e4e75babd8993cfd56995cd5cfce609c2" Utxo index: [INFO] Slot 1: W[1]: Finished balancing: - Tx 38fbe171e83c33581a737d0d1efa064afe389c8d49049e609a8ea311738a834e: + Tx 2e19f40cdf462444234d0de049163d5269ee1150feda868560315346dd12807d: {inputs: - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!50 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!50 reference inputs: collateral inputs: @@ -56,21 +56,21 @@ validity range: Interval {ivFrom = LowerBound NegInf True, ivTo = UpperBound PosInf True} data: redeemers:} -[INFO] Slot 1: W[1]: Signing tx: 38fbe171e83c33581a737d0d1efa064afe389c8d49049e609a8ea311738a834e -[INFO] Slot 1: W[1]: Submitting tx: 38fbe171e83c33581a737d0d1efa064afe389c8d49049e609a8ea311738a834e -[INFO] Slot 1: W[1]: TxSubmit: 38fbe171e83c33581a737d0d1efa064afe389c8d49049e609a8ea311738a834e -[INFO] Slot 1: TxnValidate 38fbe171e83c33581a737d0d1efa064afe389c8d49049e609a8ea311738a834e [ ] +[INFO] Slot 1: W[1]: Signing tx: 2e19f40cdf462444234d0de049163d5269ee1150feda868560315346dd12807d +[INFO] Slot 1: W[1]: Submitting tx: 2e19f40cdf462444234d0de049163d5269ee1150feda868560315346dd12807d +[INFO] Slot 1: W[1]: TxSubmit: 2e19f40cdf462444234d0de049163d5269ee1150feda868560315346dd12807d +[INFO] Slot 1: TxnValidate 2e19f40cdf462444234d0de049163d5269ee1150feda868560315346dd12807d [ ] [DEBUG] Slot 1: SlotAdd Slot 2 -[DEBUG] Slot 2: W[7]: InsertionSuccess: New tip is Tip(Slot 2, BlockId c7e6a8921696ca0bed1e8968643ed7d73508379416804ce0d2d332f711ccf8b0, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[8]: InsertionSuccess: New tip is Tip(Slot 2, BlockId c7e6a8921696ca0bed1e8968643ed7d73508379416804ce0d2d332f711ccf8b0, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[6]: InsertionSuccess: New tip is Tip(Slot 2, BlockId c7e6a8921696ca0bed1e8968643ed7d73508379416804ce0d2d332f711ccf8b0, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[4]: InsertionSuccess: New tip is Tip(Slot 2, BlockId c7e6a8921696ca0bed1e8968643ed7d73508379416804ce0d2d332f711ccf8b0, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[2]: InsertionSuccess: New tip is Tip(Slot 2, BlockId c7e6a8921696ca0bed1e8968643ed7d73508379416804ce0d2d332f711ccf8b0, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[1]: InsertionSuccess: New tip is Tip(Slot 2, BlockId c7e6a8921696ca0bed1e8968643ed7d73508379416804ce0d2d332f711ccf8b0, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[10]: InsertionSuccess: New tip is Tip(Slot 2, BlockId c7e6a8921696ca0bed1e8968643ed7d73508379416804ce0d2d332f711ccf8b0, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[9]: InsertionSuccess: New tip is Tip(Slot 2, BlockId c7e6a8921696ca0bed1e8968643ed7d73508379416804ce0d2d332f711ccf8b0, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[3]: InsertionSuccess: New tip is Tip(Slot 2, BlockId c7e6a8921696ca0bed1e8968643ed7d73508379416804ce0d2d332f711ccf8b0, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[5]: InsertionSuccess: New tip is Tip(Slot 2, BlockId c7e6a8921696ca0bed1e8968643ed7d73508379416804ce0d2d332f711ccf8b0, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[7]: InsertionSuccess: New tip is Tip(Slot 2, BlockId ff1f5db9015da8ba2e68ff2205fb77fa37beae55b4d51761e5516877817ea207, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[8]: InsertionSuccess: New tip is Tip(Slot 2, BlockId ff1f5db9015da8ba2e68ff2205fb77fa37beae55b4d51761e5516877817ea207, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[6]: InsertionSuccess: New tip is Tip(Slot 2, BlockId ff1f5db9015da8ba2e68ff2205fb77fa37beae55b4d51761e5516877817ea207, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[4]: InsertionSuccess: New tip is Tip(Slot 2, BlockId ff1f5db9015da8ba2e68ff2205fb77fa37beae55b4d51761e5516877817ea207, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[2]: InsertionSuccess: New tip is Tip(Slot 2, BlockId ff1f5db9015da8ba2e68ff2205fb77fa37beae55b4d51761e5516877817ea207, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[1]: InsertionSuccess: New tip is Tip(Slot 2, BlockId ff1f5db9015da8ba2e68ff2205fb77fa37beae55b4d51761e5516877817ea207, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[10]: InsertionSuccess: New tip is Tip(Slot 2, BlockId ff1f5db9015da8ba2e68ff2205fb77fa37beae55b4d51761e5516877817ea207, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[9]: InsertionSuccess: New tip is Tip(Slot 2, BlockId ff1f5db9015da8ba2e68ff2205fb77fa37beae55b4d51761e5516877817ea207, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[3]: InsertionSuccess: New tip is Tip(Slot 2, BlockId ff1f5db9015da8ba2e68ff2205fb77fa37beae55b4d51761e5516877817ea207, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[5]: InsertionSuccess: New tip is Tip(Slot 2, BlockId ff1f5db9015da8ba2e68ff2205fb77fa37beae55b4d51761e5516877817ea207, BlockNumber 1). UTxO state was added to the end. [DEBUG] Slot 2: W[2]: Adjusting an unbalanced transaction: [] [INFO] Slot 2: W[2]: Balancing an unbalanced transaction: Tx: @@ -90,9 +90,9 @@ "80a4f45b56b88d1139da23bc4c3c75ec6d32943c087f250b86193ca7" Utxo index: [INFO] Slot 2: W[2]: Finished balancing: - Tx 414d8f64e6635c954140ef931593457551fd9ede478ea420327afe8e72e0d7fd: + Tx 741f455cedc5326a75267c0d93d87c3ff74c7f978bf3a67250b61fb84949a7c8: {inputs: - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!20 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!20 reference inputs: collateral inputs: @@ -106,21 +106,21 @@ validity range: Interval {ivFrom = LowerBound NegInf True, ivTo = UpperBound PosInf True} data: redeemers:} -[INFO] Slot 2: W[2]: Signing tx: 414d8f64e6635c954140ef931593457551fd9ede478ea420327afe8e72e0d7fd -[INFO] Slot 2: W[2]: Submitting tx: 414d8f64e6635c954140ef931593457551fd9ede478ea420327afe8e72e0d7fd -[INFO] Slot 2: W[2]: TxSubmit: 414d8f64e6635c954140ef931593457551fd9ede478ea420327afe8e72e0d7fd -[INFO] Slot 2: TxnValidate 414d8f64e6635c954140ef931593457551fd9ede478ea420327afe8e72e0d7fd [ ] +[INFO] Slot 2: W[2]: Signing tx: 741f455cedc5326a75267c0d93d87c3ff74c7f978bf3a67250b61fb84949a7c8 +[INFO] Slot 2: W[2]: Submitting tx: 741f455cedc5326a75267c0d93d87c3ff74c7f978bf3a67250b61fb84949a7c8 +[INFO] Slot 2: W[2]: TxSubmit: 741f455cedc5326a75267c0d93d87c3ff74c7f978bf3a67250b61fb84949a7c8 +[INFO] Slot 2: TxnValidate 741f455cedc5326a75267c0d93d87c3ff74c7f978bf3a67250b61fb84949a7c8 [ ] [DEBUG] Slot 2: SlotAdd Slot 3 -[DEBUG] Slot 3: W[7]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 4b956a1972508b687649a9ff2ee558a88eb64e913b0cac3fd4c496d775ed4dd9, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[8]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 4b956a1972508b687649a9ff2ee558a88eb64e913b0cac3fd4c496d775ed4dd9, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[6]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 4b956a1972508b687649a9ff2ee558a88eb64e913b0cac3fd4c496d775ed4dd9, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[4]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 4b956a1972508b687649a9ff2ee558a88eb64e913b0cac3fd4c496d775ed4dd9, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[2]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 4b956a1972508b687649a9ff2ee558a88eb64e913b0cac3fd4c496d775ed4dd9, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[1]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 4b956a1972508b687649a9ff2ee558a88eb64e913b0cac3fd4c496d775ed4dd9, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[10]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 4b956a1972508b687649a9ff2ee558a88eb64e913b0cac3fd4c496d775ed4dd9, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[9]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 4b956a1972508b687649a9ff2ee558a88eb64e913b0cac3fd4c496d775ed4dd9, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[3]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 4b956a1972508b687649a9ff2ee558a88eb64e913b0cac3fd4c496d775ed4dd9, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[5]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 4b956a1972508b687649a9ff2ee558a88eb64e913b0cac3fd4c496d775ed4dd9, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[7]: InsertionSuccess: New tip is Tip(Slot 3, BlockId f83e25ea62cfa399e69b778e67ffc11113db8c668d460b22ef25e34231ebd0f2, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[8]: InsertionSuccess: New tip is Tip(Slot 3, BlockId f83e25ea62cfa399e69b778e67ffc11113db8c668d460b22ef25e34231ebd0f2, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[6]: InsertionSuccess: New tip is Tip(Slot 3, BlockId f83e25ea62cfa399e69b778e67ffc11113db8c668d460b22ef25e34231ebd0f2, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[4]: InsertionSuccess: New tip is Tip(Slot 3, BlockId f83e25ea62cfa399e69b778e67ffc11113db8c668d460b22ef25e34231ebd0f2, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[2]: InsertionSuccess: New tip is Tip(Slot 3, BlockId f83e25ea62cfa399e69b778e67ffc11113db8c668d460b22ef25e34231ebd0f2, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[1]: InsertionSuccess: New tip is Tip(Slot 3, BlockId f83e25ea62cfa399e69b778e67ffc11113db8c668d460b22ef25e34231ebd0f2, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[10]: InsertionSuccess: New tip is Tip(Slot 3, BlockId f83e25ea62cfa399e69b778e67ffc11113db8c668d460b22ef25e34231ebd0f2, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[9]: InsertionSuccess: New tip is Tip(Slot 3, BlockId f83e25ea62cfa399e69b778e67ffc11113db8c668d460b22ef25e34231ebd0f2, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[3]: InsertionSuccess: New tip is Tip(Slot 3, BlockId f83e25ea62cfa399e69b778e67ffc11113db8c668d460b22ef25e34231ebd0f2, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[5]: InsertionSuccess: New tip is Tip(Slot 3, BlockId f83e25ea62cfa399e69b778e67ffc11113db8c668d460b22ef25e34231ebd0f2, BlockNumber 2). UTxO state was added to the end. [DEBUG] Slot 3: W[3]: Adjusting an unbalanced transaction: [] [INFO] Slot 3: W[3]: Balancing an unbalanced transaction: Tx: @@ -140,9 +140,9 @@ "2e0ad60c3207248cecd47dbde3d752e0aad141d6b8f81ac2c6eca27c" Utxo index: [INFO] Slot 3: W[3]: Finished balancing: - Tx 58e57298a394aaa1efb22497deda184eb8ade83afe3ff1ce1032f07e42dc289f: + Tx ddd710ab33c2d46b0955e4844f706489cdac452163f4662747bf3c5611818634: {inputs: - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!0 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!0 reference inputs: collateral inputs: @@ -156,21 +156,21 @@ validity range: Interval {ivFrom = LowerBound NegInf True, ivTo = UpperBound PosInf True} data: redeemers:} -[INFO] Slot 3: W[3]: Signing tx: 58e57298a394aaa1efb22497deda184eb8ade83afe3ff1ce1032f07e42dc289f -[INFO] Slot 3: W[3]: Submitting tx: 58e57298a394aaa1efb22497deda184eb8ade83afe3ff1ce1032f07e42dc289f -[INFO] Slot 3: W[3]: TxSubmit: 58e57298a394aaa1efb22497deda184eb8ade83afe3ff1ce1032f07e42dc289f -[INFO] Slot 3: TxnValidate 58e57298a394aaa1efb22497deda184eb8ade83afe3ff1ce1032f07e42dc289f [ ] +[INFO] Slot 3: W[3]: Signing tx: ddd710ab33c2d46b0955e4844f706489cdac452163f4662747bf3c5611818634 +[INFO] Slot 3: W[3]: Submitting tx: ddd710ab33c2d46b0955e4844f706489cdac452163f4662747bf3c5611818634 +[INFO] Slot 3: W[3]: TxSubmit: ddd710ab33c2d46b0955e4844f706489cdac452163f4662747bf3c5611818634 +[INFO] Slot 3: TxnValidate ddd710ab33c2d46b0955e4844f706489cdac452163f4662747bf3c5611818634 [ ] [DEBUG] Slot 3: SlotAdd Slot 4 -[DEBUG] Slot 4: W[7]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 8dc3826de52999ed3c5a70264aa01983656e10345596bfe3d96e495ec5a89aa0, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[8]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 8dc3826de52999ed3c5a70264aa01983656e10345596bfe3d96e495ec5a89aa0, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[6]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 8dc3826de52999ed3c5a70264aa01983656e10345596bfe3d96e495ec5a89aa0, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[4]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 8dc3826de52999ed3c5a70264aa01983656e10345596bfe3d96e495ec5a89aa0, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[2]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 8dc3826de52999ed3c5a70264aa01983656e10345596bfe3d96e495ec5a89aa0, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[1]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 8dc3826de52999ed3c5a70264aa01983656e10345596bfe3d96e495ec5a89aa0, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[10]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 8dc3826de52999ed3c5a70264aa01983656e10345596bfe3d96e495ec5a89aa0, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[9]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 8dc3826de52999ed3c5a70264aa01983656e10345596bfe3d96e495ec5a89aa0, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[3]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 8dc3826de52999ed3c5a70264aa01983656e10345596bfe3d96e495ec5a89aa0, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[5]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 8dc3826de52999ed3c5a70264aa01983656e10345596bfe3d96e495ec5a89aa0, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[7]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 446303a8496ba8d45c2118218d2efaf51c6b851b86c12db3fa776505727e1b62, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[8]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 446303a8496ba8d45c2118218d2efaf51c6b851b86c12db3fa776505727e1b62, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[6]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 446303a8496ba8d45c2118218d2efaf51c6b851b86c12db3fa776505727e1b62, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[4]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 446303a8496ba8d45c2118218d2efaf51c6b851b86c12db3fa776505727e1b62, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[2]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 446303a8496ba8d45c2118218d2efaf51c6b851b86c12db3fa776505727e1b62, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[1]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 446303a8496ba8d45c2118218d2efaf51c6b851b86c12db3fa776505727e1b62, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[10]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 446303a8496ba8d45c2118218d2efaf51c6b851b86c12db3fa776505727e1b62, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[9]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 446303a8496ba8d45c2118218d2efaf51c6b851b86c12db3fa776505727e1b62, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[3]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 446303a8496ba8d45c2118218d2efaf51c6b851b86c12db3fa776505727e1b62, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[5]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 446303a8496ba8d45c2118218d2efaf51c6b851b86c12db3fa776505727e1b62, BlockNumber 3). UTxO state was added to the end. [DEBUG] Slot 4: SlotAdd Slot 5 [DEBUG] Slot 5: W[7]: InsertionSuccess: New tip is Tip(Slot 5, BlockId 76be8b528d0075f7aae98d6fa57a6d3c83ae480a8469e668d7b0af968995ac71, BlockNumber 4). UTxO state was added to the end. [DEBUG] Slot 5: W[8]: InsertionSuccess: New tip is Tip(Slot 5, BlockId 76be8b528d0075f7aae98d6fa57a6d3c83ae480a8469e668d7b0af968995ac71, BlockNumber 4). UTxO state was added to the end. diff --git a/plutus-contract/test/Spec/golden/traceOutput - pubKeyTransactions2.txt b/plutus-contract/test/Spec/golden/traceOutput - pubKeyTransactions2.txt index cf004c8eba..6bf557144c 100644 --- a/plutus-contract/test/Spec/golden/traceOutput - pubKeyTransactions2.txt +++ b/plutus-contract/test/Spec/golden/traceOutput - pubKeyTransactions2.txt @@ -9,18 +9,18 @@ [DEBUG] Slot 0: Thread 9 {W c30efb78b4e272685c1f9f0c93787fd4b6743154}: Started (Normal) [DEBUG] Slot 0: Thread 10 {W d3eddd0d37989746b029a0e050386bc425363901}: Started (Normal) [DEBUG] Slot 0: Thread 11 {block maker}: Started (Normal) -[INFO] Slot 0: TxnValidate 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84 [ ] +[INFO] Slot 0: TxnValidate d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d [ ] [DEBUG] Slot 0: SlotAdd Slot 1 -[DEBUG] Slot 1: W[7]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[8]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[6]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[4]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[2]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[1]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[10]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[9]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[3]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[5]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[7]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[8]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[6]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[4]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[2]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[1]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[10]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[9]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[3]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[5]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. [DEBUG] Slot 1: W[1]: Adjusting an unbalanced transaction: [] [INFO] Slot 1: W[1]: Balancing an unbalanced transaction: Tx: @@ -40,27 +40,27 @@ "a2c20c77887ace1cd986193e4e75babd8993cfd56995cd5cfce609c2" Utxo index: [INFO] Slot 1: W[1]: Finished balancing: - Tx f27de1e5fbd1a274645a778e85974c19390b0b638918ad797de71b7a8cb7dae5: + Tx a86d1ed2c668b7fb623b2a7ccddb4a0b43c5b4b1dd9bc1524558d44708402d95: {inputs: - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!50 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!50 - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!51 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!51 - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!52 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!52 - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!53 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!53 - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!54 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!54 - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!55 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!55 - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!56 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!56 - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!57 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!57 - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!58 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!58 - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!59 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!59 reference inputs: collateral inputs: @@ -74,21 +74,21 @@ validity range: Interval {ivFrom = LowerBound NegInf True, ivTo = UpperBound PosInf True} data: redeemers:} -[INFO] Slot 1: W[1]: Signing tx: f27de1e5fbd1a274645a778e85974c19390b0b638918ad797de71b7a8cb7dae5 -[INFO] Slot 1: W[1]: Submitting tx: f27de1e5fbd1a274645a778e85974c19390b0b638918ad797de71b7a8cb7dae5 -[INFO] Slot 1: W[1]: TxSubmit: f27de1e5fbd1a274645a778e85974c19390b0b638918ad797de71b7a8cb7dae5 -[INFO] Slot 1: TxnValidate f27de1e5fbd1a274645a778e85974c19390b0b638918ad797de71b7a8cb7dae5 [ ] +[INFO] Slot 1: W[1]: Signing tx: a86d1ed2c668b7fb623b2a7ccddb4a0b43c5b4b1dd9bc1524558d44708402d95 +[INFO] Slot 1: W[1]: Submitting tx: a86d1ed2c668b7fb623b2a7ccddb4a0b43c5b4b1dd9bc1524558d44708402d95 +[INFO] Slot 1: W[1]: TxSubmit: a86d1ed2c668b7fb623b2a7ccddb4a0b43c5b4b1dd9bc1524558d44708402d95 +[INFO] Slot 1: TxnValidate a86d1ed2c668b7fb623b2a7ccddb4a0b43c5b4b1dd9bc1524558d44708402d95 [ ] [DEBUG] Slot 1: SlotAdd Slot 2 -[DEBUG] Slot 2: W[7]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 25ca1d0c1ebf8ada7ea7ce4621769f4cf6292bf9df90b1d9486fb5b725be9901, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[8]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 25ca1d0c1ebf8ada7ea7ce4621769f4cf6292bf9df90b1d9486fb5b725be9901, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[6]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 25ca1d0c1ebf8ada7ea7ce4621769f4cf6292bf9df90b1d9486fb5b725be9901, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[4]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 25ca1d0c1ebf8ada7ea7ce4621769f4cf6292bf9df90b1d9486fb5b725be9901, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[2]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 25ca1d0c1ebf8ada7ea7ce4621769f4cf6292bf9df90b1d9486fb5b725be9901, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[1]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 25ca1d0c1ebf8ada7ea7ce4621769f4cf6292bf9df90b1d9486fb5b725be9901, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[10]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 25ca1d0c1ebf8ada7ea7ce4621769f4cf6292bf9df90b1d9486fb5b725be9901, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[9]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 25ca1d0c1ebf8ada7ea7ce4621769f4cf6292bf9df90b1d9486fb5b725be9901, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[3]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 25ca1d0c1ebf8ada7ea7ce4621769f4cf6292bf9df90b1d9486fb5b725be9901, BlockNumber 1). UTxO state was added to the end. -[DEBUG] Slot 2: W[5]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 25ca1d0c1ebf8ada7ea7ce4621769f4cf6292bf9df90b1d9486fb5b725be9901, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[7]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 4b559f87e65d419b90ac8a4ae375aa6133d133ef72372decbe040a208f78ef2a, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[8]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 4b559f87e65d419b90ac8a4ae375aa6133d133ef72372decbe040a208f78ef2a, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[6]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 4b559f87e65d419b90ac8a4ae375aa6133d133ef72372decbe040a208f78ef2a, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[4]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 4b559f87e65d419b90ac8a4ae375aa6133d133ef72372decbe040a208f78ef2a, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[2]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 4b559f87e65d419b90ac8a4ae375aa6133d133ef72372decbe040a208f78ef2a, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[1]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 4b559f87e65d419b90ac8a4ae375aa6133d133ef72372decbe040a208f78ef2a, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[10]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 4b559f87e65d419b90ac8a4ae375aa6133d133ef72372decbe040a208f78ef2a, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[9]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 4b559f87e65d419b90ac8a4ae375aa6133d133ef72372decbe040a208f78ef2a, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[3]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 4b559f87e65d419b90ac8a4ae375aa6133d133ef72372decbe040a208f78ef2a, BlockNumber 1). UTxO state was added to the end. +[DEBUG] Slot 2: W[5]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 4b559f87e65d419b90ac8a4ae375aa6133d133ef72372decbe040a208f78ef2a, BlockNumber 1). UTxO state was added to the end. [DEBUG] Slot 2: W[2]: Adjusting an unbalanced transaction: [] [INFO] Slot 2: W[2]: Balancing an unbalanced transaction: Tx: @@ -108,15 +108,15 @@ "80a4f45b56b88d1139da23bc4c3c75ec6d32943c087f250b86193ca7" Utxo index: [INFO] Slot 2: W[2]: Finished balancing: - Tx 58acb02a2c306546d145079a99ff90303e03718f0275dfdd625d28cbbbea4410: + Tx 431fc62490514f82a44ee2d5d5388d11280679c4e992f6efdd87fea6039fb34a: {inputs: - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!20 + - a86d1ed2c668b7fb623b2a7ccddb4a0b43c5b4b1dd9bc1524558d44708402d95!0 - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!21 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!20 - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!22 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!21 - - f27de1e5fbd1a274645a778e85974c19390b0b638918ad797de71b7a8cb7dae5!0 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!22 reference inputs: collateral inputs: @@ -130,21 +130,21 @@ validity range: Interval {ivFrom = LowerBound NegInf True, ivTo = UpperBound PosInf True} data: redeemers:} -[INFO] Slot 2: W[2]: Signing tx: 58acb02a2c306546d145079a99ff90303e03718f0275dfdd625d28cbbbea4410 -[INFO] Slot 2: W[2]: Submitting tx: 58acb02a2c306546d145079a99ff90303e03718f0275dfdd625d28cbbbea4410 -[INFO] Slot 2: W[2]: TxSubmit: 58acb02a2c306546d145079a99ff90303e03718f0275dfdd625d28cbbbea4410 -[INFO] Slot 2: TxnValidate 58acb02a2c306546d145079a99ff90303e03718f0275dfdd625d28cbbbea4410 [ ] +[INFO] Slot 2: W[2]: Signing tx: 431fc62490514f82a44ee2d5d5388d11280679c4e992f6efdd87fea6039fb34a +[INFO] Slot 2: W[2]: Submitting tx: 431fc62490514f82a44ee2d5d5388d11280679c4e992f6efdd87fea6039fb34a +[INFO] Slot 2: W[2]: TxSubmit: 431fc62490514f82a44ee2d5d5388d11280679c4e992f6efdd87fea6039fb34a +[INFO] Slot 2: TxnValidate 431fc62490514f82a44ee2d5d5388d11280679c4e992f6efdd87fea6039fb34a [ ] [DEBUG] Slot 2: SlotAdd Slot 3 -[DEBUG] Slot 3: W[7]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 534989ac88c07c75d16deca30d086532a6d0a2af41a03750c45fffb3ea00cd40, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[8]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 534989ac88c07c75d16deca30d086532a6d0a2af41a03750c45fffb3ea00cd40, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[6]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 534989ac88c07c75d16deca30d086532a6d0a2af41a03750c45fffb3ea00cd40, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[4]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 534989ac88c07c75d16deca30d086532a6d0a2af41a03750c45fffb3ea00cd40, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[2]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 534989ac88c07c75d16deca30d086532a6d0a2af41a03750c45fffb3ea00cd40, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[1]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 534989ac88c07c75d16deca30d086532a6d0a2af41a03750c45fffb3ea00cd40, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[10]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 534989ac88c07c75d16deca30d086532a6d0a2af41a03750c45fffb3ea00cd40, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[9]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 534989ac88c07c75d16deca30d086532a6d0a2af41a03750c45fffb3ea00cd40, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[3]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 534989ac88c07c75d16deca30d086532a6d0a2af41a03750c45fffb3ea00cd40, BlockNumber 2). UTxO state was added to the end. -[DEBUG] Slot 3: W[5]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 534989ac88c07c75d16deca30d086532a6d0a2af41a03750c45fffb3ea00cd40, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[7]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 081a929a9482d365cb13f905c0535e2ef79fab64c440235d012f1987b725224f, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[8]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 081a929a9482d365cb13f905c0535e2ef79fab64c440235d012f1987b725224f, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[6]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 081a929a9482d365cb13f905c0535e2ef79fab64c440235d012f1987b725224f, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[4]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 081a929a9482d365cb13f905c0535e2ef79fab64c440235d012f1987b725224f, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[2]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 081a929a9482d365cb13f905c0535e2ef79fab64c440235d012f1987b725224f, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[1]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 081a929a9482d365cb13f905c0535e2ef79fab64c440235d012f1987b725224f, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[10]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 081a929a9482d365cb13f905c0535e2ef79fab64c440235d012f1987b725224f, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[9]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 081a929a9482d365cb13f905c0535e2ef79fab64c440235d012f1987b725224f, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[3]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 081a929a9482d365cb13f905c0535e2ef79fab64c440235d012f1987b725224f, BlockNumber 2). UTxO state was added to the end. +[DEBUG] Slot 3: W[5]: InsertionSuccess: New tip is Tip(Slot 3, BlockId 081a929a9482d365cb13f905c0535e2ef79fab64c440235d012f1987b725224f, BlockNumber 2). UTxO state was added to the end. [DEBUG] Slot 3: W[3]: Adjusting an unbalanced transaction: [] [INFO] Slot 3: W[3]: Balancing an unbalanced transaction: Tx: @@ -164,11 +164,11 @@ "2e0ad60c3207248cecd47dbde3d752e0aad141d6b8f81ac2c6eca27c" Utxo index: [INFO] Slot 3: W[3]: Finished balancing: - Tx 13107325fe84a3d9b7b6acc810f2d2ddc83345f63be62cbf38fb8c29ec44a6a9: + Tx a67c4a462aca7a7701284dccc4ca4c6ea3b576925d0849c7c18185d151a7f183: {inputs: - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!0 + - 431fc62490514f82a44ee2d5d5388d11280679c4e992f6efdd87fea6039fb34a!0 - - 58acb02a2c306546d145079a99ff90303e03718f0275dfdd625d28cbbbea4410!0 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!0 reference inputs: collateral inputs: @@ -182,21 +182,21 @@ validity range: Interval {ivFrom = LowerBound NegInf True, ivTo = UpperBound PosInf True} data: redeemers:} -[INFO] Slot 3: W[3]: Signing tx: 13107325fe84a3d9b7b6acc810f2d2ddc83345f63be62cbf38fb8c29ec44a6a9 -[INFO] Slot 3: W[3]: Submitting tx: 13107325fe84a3d9b7b6acc810f2d2ddc83345f63be62cbf38fb8c29ec44a6a9 -[INFO] Slot 3: W[3]: TxSubmit: 13107325fe84a3d9b7b6acc810f2d2ddc83345f63be62cbf38fb8c29ec44a6a9 -[INFO] Slot 3: TxnValidate 13107325fe84a3d9b7b6acc810f2d2ddc83345f63be62cbf38fb8c29ec44a6a9 [ ] +[INFO] Slot 3: W[3]: Signing tx: a67c4a462aca7a7701284dccc4ca4c6ea3b576925d0849c7c18185d151a7f183 +[INFO] Slot 3: W[3]: Submitting tx: a67c4a462aca7a7701284dccc4ca4c6ea3b576925d0849c7c18185d151a7f183 +[INFO] Slot 3: W[3]: TxSubmit: a67c4a462aca7a7701284dccc4ca4c6ea3b576925d0849c7c18185d151a7f183 +[INFO] Slot 3: TxnValidate a67c4a462aca7a7701284dccc4ca4c6ea3b576925d0849c7c18185d151a7f183 [ ] [DEBUG] Slot 3: SlotAdd Slot 4 -[DEBUG] Slot 4: W[7]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 48bea9d9f4dfe0bd56c69bb10d60df8e609141c24e8644ebaf56f49d863aa1a1, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[8]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 48bea9d9f4dfe0bd56c69bb10d60df8e609141c24e8644ebaf56f49d863aa1a1, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[6]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 48bea9d9f4dfe0bd56c69bb10d60df8e609141c24e8644ebaf56f49d863aa1a1, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[4]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 48bea9d9f4dfe0bd56c69bb10d60df8e609141c24e8644ebaf56f49d863aa1a1, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[2]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 48bea9d9f4dfe0bd56c69bb10d60df8e609141c24e8644ebaf56f49d863aa1a1, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[1]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 48bea9d9f4dfe0bd56c69bb10d60df8e609141c24e8644ebaf56f49d863aa1a1, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[10]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 48bea9d9f4dfe0bd56c69bb10d60df8e609141c24e8644ebaf56f49d863aa1a1, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[9]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 48bea9d9f4dfe0bd56c69bb10d60df8e609141c24e8644ebaf56f49d863aa1a1, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[3]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 48bea9d9f4dfe0bd56c69bb10d60df8e609141c24e8644ebaf56f49d863aa1a1, BlockNumber 3). UTxO state was added to the end. -[DEBUG] Slot 4: W[5]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 48bea9d9f4dfe0bd56c69bb10d60df8e609141c24e8644ebaf56f49d863aa1a1, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[7]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 99201f0f00cbfa839509d8f8918f781dd413c2f97b74b2ca47159f2f8e0481a3, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[8]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 99201f0f00cbfa839509d8f8918f781dd413c2f97b74b2ca47159f2f8e0481a3, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[6]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 99201f0f00cbfa839509d8f8918f781dd413c2f97b74b2ca47159f2f8e0481a3, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[4]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 99201f0f00cbfa839509d8f8918f781dd413c2f97b74b2ca47159f2f8e0481a3, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[2]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 99201f0f00cbfa839509d8f8918f781dd413c2f97b74b2ca47159f2f8e0481a3, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[1]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 99201f0f00cbfa839509d8f8918f781dd413c2f97b74b2ca47159f2f8e0481a3, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[10]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 99201f0f00cbfa839509d8f8918f781dd413c2f97b74b2ca47159f2f8e0481a3, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[9]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 99201f0f00cbfa839509d8f8918f781dd413c2f97b74b2ca47159f2f8e0481a3, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[3]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 99201f0f00cbfa839509d8f8918f781dd413c2f97b74b2ca47159f2f8e0481a3, BlockNumber 3). UTxO state was added to the end. +[DEBUG] Slot 4: W[5]: InsertionSuccess: New tip is Tip(Slot 4, BlockId 99201f0f00cbfa839509d8f8918f781dd413c2f97b74b2ca47159f2f8e0481a3, BlockNumber 3). UTxO state was added to the end. [DEBUG] Slot 4: W[1]: Adjusting an unbalanced transaction: [] [INFO] Slot 4: W[1]: Balancing an unbalanced transaction: Tx: @@ -216,9 +216,9 @@ "a2c20c77887ace1cd986193e4e75babd8993cfd56995cd5cfce609c2" Utxo index: [INFO] Slot 4: W[1]: Finished balancing: - Tx 0c2f86bb3b8de2e696833433420e7d1ac77816bcf08114169916ba53115c2574: + Tx 0d0eb440266851eda465f3304382bc18053b57369d260d95f48217cd9ed7770e: {inputs: - - 13107325fe84a3d9b7b6acc810f2d2ddc83345f63be62cbf38fb8c29ec44a6a9!0 + - a67c4a462aca7a7701284dccc4ca4c6ea3b576925d0849c7c18185d151a7f183!0 reference inputs: collateral inputs: @@ -232,21 +232,21 @@ validity range: Interval {ivFrom = LowerBound NegInf True, ivTo = UpperBound PosInf True} data: redeemers:} -[INFO] Slot 4: W[1]: Signing tx: 0c2f86bb3b8de2e696833433420e7d1ac77816bcf08114169916ba53115c2574 -[INFO] Slot 4: W[1]: Submitting tx: 0c2f86bb3b8de2e696833433420e7d1ac77816bcf08114169916ba53115c2574 -[INFO] Slot 4: W[1]: TxSubmit: 0c2f86bb3b8de2e696833433420e7d1ac77816bcf08114169916ba53115c2574 -[INFO] Slot 4: TxnValidate 0c2f86bb3b8de2e696833433420e7d1ac77816bcf08114169916ba53115c2574 [ ] +[INFO] Slot 4: W[1]: Signing tx: 0d0eb440266851eda465f3304382bc18053b57369d260d95f48217cd9ed7770e +[INFO] Slot 4: W[1]: Submitting tx: 0d0eb440266851eda465f3304382bc18053b57369d260d95f48217cd9ed7770e +[INFO] Slot 4: W[1]: TxSubmit: 0d0eb440266851eda465f3304382bc18053b57369d260d95f48217cd9ed7770e +[INFO] Slot 4: TxnValidate 0d0eb440266851eda465f3304382bc18053b57369d260d95f48217cd9ed7770e [ ] [DEBUG] Slot 4: SlotAdd Slot 5 -[DEBUG] Slot 5: W[7]: InsertionSuccess: New tip is Tip(Slot 5, BlockId c471d7167404089f59fe6a28a9d0a51f0d03d12da59e68ff204f0e2dcbb6987d, BlockNumber 4). UTxO state was added to the end. -[DEBUG] Slot 5: W[8]: InsertionSuccess: New tip is Tip(Slot 5, BlockId c471d7167404089f59fe6a28a9d0a51f0d03d12da59e68ff204f0e2dcbb6987d, BlockNumber 4). UTxO state was added to the end. -[DEBUG] Slot 5: W[6]: InsertionSuccess: New tip is Tip(Slot 5, BlockId c471d7167404089f59fe6a28a9d0a51f0d03d12da59e68ff204f0e2dcbb6987d, BlockNumber 4). UTxO state was added to the end. -[DEBUG] Slot 5: W[4]: InsertionSuccess: New tip is Tip(Slot 5, BlockId c471d7167404089f59fe6a28a9d0a51f0d03d12da59e68ff204f0e2dcbb6987d, BlockNumber 4). UTxO state was added to the end. -[DEBUG] Slot 5: W[2]: InsertionSuccess: New tip is Tip(Slot 5, BlockId c471d7167404089f59fe6a28a9d0a51f0d03d12da59e68ff204f0e2dcbb6987d, BlockNumber 4). UTxO state was added to the end. -[DEBUG] Slot 5: W[1]: InsertionSuccess: New tip is Tip(Slot 5, BlockId c471d7167404089f59fe6a28a9d0a51f0d03d12da59e68ff204f0e2dcbb6987d, BlockNumber 4). UTxO state was added to the end. -[DEBUG] Slot 5: W[10]: InsertionSuccess: New tip is Tip(Slot 5, BlockId c471d7167404089f59fe6a28a9d0a51f0d03d12da59e68ff204f0e2dcbb6987d, BlockNumber 4). UTxO state was added to the end. -[DEBUG] Slot 5: W[9]: InsertionSuccess: New tip is Tip(Slot 5, BlockId c471d7167404089f59fe6a28a9d0a51f0d03d12da59e68ff204f0e2dcbb6987d, BlockNumber 4). UTxO state was added to the end. -[DEBUG] Slot 5: W[3]: InsertionSuccess: New tip is Tip(Slot 5, BlockId c471d7167404089f59fe6a28a9d0a51f0d03d12da59e68ff204f0e2dcbb6987d, BlockNumber 4). UTxO state was added to the end. -[DEBUG] Slot 5: W[5]: InsertionSuccess: New tip is Tip(Slot 5, BlockId c471d7167404089f59fe6a28a9d0a51f0d03d12da59e68ff204f0e2dcbb6987d, BlockNumber 4). UTxO state was added to the end. +[DEBUG] Slot 5: W[7]: InsertionSuccess: New tip is Tip(Slot 5, BlockId 45fb32a35f431d1f562fced6b7a9477d36060757a32f1c5a9f0aa90ad3e39002, BlockNumber 4). UTxO state was added to the end. +[DEBUG] Slot 5: W[8]: InsertionSuccess: New tip is Tip(Slot 5, BlockId 45fb32a35f431d1f562fced6b7a9477d36060757a32f1c5a9f0aa90ad3e39002, BlockNumber 4). UTxO state was added to the end. +[DEBUG] Slot 5: W[6]: InsertionSuccess: New tip is Tip(Slot 5, BlockId 45fb32a35f431d1f562fced6b7a9477d36060757a32f1c5a9f0aa90ad3e39002, BlockNumber 4). UTxO state was added to the end. +[DEBUG] Slot 5: W[4]: InsertionSuccess: New tip is Tip(Slot 5, BlockId 45fb32a35f431d1f562fced6b7a9477d36060757a32f1c5a9f0aa90ad3e39002, BlockNumber 4). UTxO state was added to the end. +[DEBUG] Slot 5: W[2]: InsertionSuccess: New tip is Tip(Slot 5, BlockId 45fb32a35f431d1f562fced6b7a9477d36060757a32f1c5a9f0aa90ad3e39002, BlockNumber 4). UTxO state was added to the end. +[DEBUG] Slot 5: W[1]: InsertionSuccess: New tip is Tip(Slot 5, BlockId 45fb32a35f431d1f562fced6b7a9477d36060757a32f1c5a9f0aa90ad3e39002, BlockNumber 4). UTxO state was added to the end. +[DEBUG] Slot 5: W[10]: InsertionSuccess: New tip is Tip(Slot 5, BlockId 45fb32a35f431d1f562fced6b7a9477d36060757a32f1c5a9f0aa90ad3e39002, BlockNumber 4). UTxO state was added to the end. +[DEBUG] Slot 5: W[9]: InsertionSuccess: New tip is Tip(Slot 5, BlockId 45fb32a35f431d1f562fced6b7a9477d36060757a32f1c5a9f0aa90ad3e39002, BlockNumber 4). UTxO state was added to the end. +[DEBUG] Slot 5: W[3]: InsertionSuccess: New tip is Tip(Slot 5, BlockId 45fb32a35f431d1f562fced6b7a9477d36060757a32f1c5a9f0aa90ad3e39002, BlockNumber 4). UTxO state was added to the end. +[DEBUG] Slot 5: W[5]: InsertionSuccess: New tip is Tip(Slot 5, BlockId 45fb32a35f431d1f562fced6b7a9477d36060757a32f1c5a9f0aa90ad3e39002, BlockNumber 4). UTxO state was added to the end. [DEBUG] Slot 5: SlotAdd Slot 6 [DEBUG] Slot 6: W[7]: InsertionSuccess: New tip is Tip(Slot 6, BlockId 76be8b528d0075f7aae98d6fa57a6d3c83ae480a8469e668d7b0af968995ac71, BlockNumber 5). UTxO state was added to the end. [DEBUG] Slot 6: W[8]: InsertionSuccess: New tip is Tip(Slot 6, BlockId 76be8b528d0075f7aae98d6fa57a6d3c83ae480a8469e668d7b0af968995ac71, BlockNumber 5). UTxO state was added to the end. diff --git a/plutus-contract/test/Spec/golden/traceOutput - wait1.txt b/plutus-contract/test/Spec/golden/traceOutput - wait1.txt index 7ebf1f17c8..e1f6ca1ac2 100644 --- a/plutus-contract/test/Spec/golden/traceOutput - wait1.txt +++ b/plutus-contract/test/Spec/golden/traceOutput - wait1.txt @@ -9,18 +9,18 @@ [DEBUG] Slot 0: Thread 9 {W c30efb78b4e272685c1f9f0c93787fd4b6743154}: Started (Normal) [DEBUG] Slot 0: Thread 10 {W d3eddd0d37989746b029a0e050386bc425363901}: Started (Normal) [DEBUG] Slot 0: Thread 11 {block maker}: Started (Normal) -[INFO] Slot 0: TxnValidate 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84 [ ] +[INFO] Slot 0: TxnValidate d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d [ ] [DEBUG] Slot 0: SlotAdd Slot 1 -[DEBUG] Slot 1: W[7]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[8]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[6]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[4]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[2]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[1]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[10]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[9]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[3]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. -[DEBUG] Slot 1: W[5]: InsertionSuccess: New tip is Tip(Slot 1, BlockId 9e944371f5292bcd66e4e498bbc313b92ae884154f0eca1ddf75cd0ec69ddc47, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[7]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[8]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[6]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[4]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[2]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[1]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[10]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[9]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[3]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. +[DEBUG] Slot 1: W[5]: InsertionSuccess: New tip is Tip(Slot 1, BlockId ad9b405b2fa0a28c33a5e41d23bc1d80ddbd809b42f1f6c4f252ee133ac9f843, BlockNumber 0). UTxO state was added to the end. [DEBUG] Slot 1: SlotAdd Slot 2 [DEBUG] Slot 2: W[7]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 76be8b528d0075f7aae98d6fa57a6d3c83ae480a8469e668d7b0af968995ac71, BlockNumber 1). UTxO state was added to the end. [DEBUG] Slot 2: W[8]: InsertionSuccess: New tip is Tip(Slot 2, BlockId 76be8b528d0075f7aae98d6fa57a6d3c83ae480a8469e668d7b0af968995ac71, BlockNumber 1). UTxO state was added to the end. diff --git a/plutus-ledger/changelog.d/20230302_122918_ak3n_drop_emulator_tx.md b/plutus-ledger/changelog.d/20230302_122918_ak3n_drop_emulator_tx.md new file mode 100644 index 0000000000..fbc58c3916 --- /dev/null +++ b/plutus-ledger/changelog.d/20230302_122918_ak3n_drop_emulator_tx.md @@ -0,0 +1,12 @@ +### Removed + +- Remove `unspentOutputsTx` and `spentOutputs`. +- Remove `cardanoApiTx`, `emulatorTx`, `onCardanoTx`, `cardanoTxMap`, `addSignature`, `addSignature'`, `txOutRefs`, `unspentOutputsTx`, `txId`. +- Remove `CardanoTx(EmulatorTx, CardanoApiTx)`. +- Remove `toCardanoTxBody`, `toCardanoTxBodyContent`, `toCardanoTxInWitness`, `toCardanoMintValue`. +- Remove `Tx` and `TxStripped` types and all related functions. + +### Changed + +- Renamed `SomeCardanoApiTx(SomeTx)` to `CardanoTx(CardanoTx)`. +- Renamed `CardanoApiEmulatorEraTx` to `CardanoEmulatorEraTx`. \ No newline at end of file diff --git a/plutus-ledger/plutus-ledger.cabal b/plutus-ledger/plutus-ledger.cabal index 8ca35c7d2f..7cc186bde0 100644 --- a/plutus-ledger/plutus-ledger.cabal +++ b/plutus-ledger/plutus-ledger.cabal @@ -187,8 +187,8 @@ test-suite plutus-ledger-test -- Local components -------------------- build-depends: - , plutus-ledger >=1.0.0 - , plutus-script-utils >=1.0.0 + , plutus-ledger >=1.1.0 + , plutus-script-utils >=1.1.0 -------------------------- -- Other IOG dependencies @@ -206,7 +206,6 @@ test-suite plutus-ledger-test , aeson , base >=4.9 && <5 , bytestring - , data-default , hedgehog , tasty , tasty-hedgehog diff --git a/plutus-ledger/src/Ledger/Blockchain.hs b/plutus-ledger/src/Ledger/Blockchain.hs index b5c1e57371..4d91b1af14 100644 --- a/plutus-ledger/src/Ledger/Blockchain.hs +++ b/plutus-ledger/src/Ledger/Blockchain.hs @@ -23,8 +23,6 @@ module Ledger.Blockchain ( transaction, out, value, - unspentOutputsTx, - spentOutputs, unspentOutputs, datumTxo, updateUtxo, @@ -50,8 +48,8 @@ import Prettyprinter (Pretty (..), (<+>)) import Cardano.Api qualified as C import Ledger.Tx (CardanoTx, TxId, TxIn, TxOut, TxOutRef (..), getCardanoTxCollateralInputs, getCardanoTxId, - getCardanoTxInputs, getCardanoTxProducedOutputs, getCardanoTxProducedReturnCollateral, spentOutputs, - txOutDatumHash, txOutPubKey, txOutValue, unspentOutputsTx, updateUtxo, updateUtxoCollateral) + getCardanoTxInputs, getCardanoTxProducedOutputs, getCardanoTxProducedReturnCollateral, txOutDatumHash, + txOutPubKey, txOutValue, updateUtxo, updateUtxoCollateral) import Plutus.V1.Ledger.Crypto import Plutus.V1.Ledger.Scripts diff --git a/plutus-ledger/src/Ledger/Tx.hs b/plutus-ledger/src/Ledger/Tx.hs index 40bffbc254..e8b9aeada3 100644 --- a/plutus-ledger/src/Ledger/Tx.hs +++ b/plutus-ledger/src/Ledger/Tx.hs @@ -44,11 +44,6 @@ module Ledger.Tx , DatumFromQuery(..) , datumInDatumFromQuery -- * Transactions - , CardanoTx(..) - , cardanoApiTx - , emulatorTx - , onCardanoTx - , cardanoTxMap , getCardanoTxId , getCardanoTxInputs , getCardanoTxCollateralInputs @@ -64,16 +59,12 @@ module Ledger.Tx , getCardanoTxMint , getCardanoTxValidityRange , getCardanoTxData - , SomeCardanoApiTx(.., CardanoApiEmulatorEraTx) + , CardanoTx(.., CardanoEmulatorEraTx) , ToCardanoError(..) - , addSignature - , addSignature' , addCardanoTxSignature , pubKeyTxOut , updateUtxo , updateUtxoCollateral - , txOutRefs - , unspentOutputsTx -- * TxBodyContent functions , getTxBodyContentInputs , getTxBodyContentCollateralInputs @@ -82,28 +73,21 @@ module Ledger.Tx , txBodyContentIns , txBodyContentCollateralIns , txBodyContentOuts - -- * Hashing transactions - , txId -- * Utility , decoratedTxOutPlutusValue ) where import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C.Api -import Cardano.Crypto.Hash (SHA256, digest) import Cardano.Crypto.Wallet qualified as Crypto import Cardano.Ledger.Alonzo.Tx (ValidatedTx (..)) import Cardano.Ledger.Alonzo.TxWitness (txwitsVKey) +import Codec.Serialise (Serialise) -import Codec.CBOR.Write qualified as Write -import Codec.Serialise (Serialise (encode)) -import Control.Lens (At (at), Getter, Lens', Traversal', lens, makeLenses, makePrisms, to, view, views, (&), (?~), (^.), - (^?)) +import Control.Lens (Getter, Lens', Traversal', lens, makeLenses, makePrisms, to, view, views, (^.), (^?)) import Data.Aeson (FromJSON, ToJSON) -import Data.Data (Proxy (Proxy)) import Data.Map (Map) import Data.Map qualified as Map -import Data.Maybe (isJust) import Data.Set (Set) import Data.Set qualified as Set import Data.Tuple (swap) @@ -111,10 +95,9 @@ import GHC.Generics (Generic) import Ledger.Address (Address, CardanoAddress, PaymentPubKey, cardanoAddressCredential, cardanoStakingCredential, pubKeyAddress) -import Ledger.Crypto (Passphrase, signTx, signTx', toPublicKey) import Ledger.Orphans () import Ledger.Slot (SlotRange) -import Ledger.Tx.CardanoAPI (SomeCardanoApiTx (SomeTx), ToCardanoError (..)) +import Ledger.Tx.CardanoAPI (CardanoTx (CardanoTx), ToCardanoError (..)) import Ledger.Tx.CardanoAPI qualified as CardanoAPI import Plutus.Script.Utils.Scripts (scriptHash) @@ -260,36 +243,22 @@ instance Pretty DecoratedTxOut where hang 2 $ vsep [ "-" <+> pretty (p ^. decoratedTxOutValue) <+> "addressed to" , pretty (p ^. decoratedTxOutAddress)] -{- Note [Why we have the Both constructor in CardanoTx] +getEmulatorEraTx :: CardanoTx -> C.Tx C.BabbageEra +getEmulatorEraTx (CardanoTx tx C.BabbageEraInCardanoMode) = tx +getEmulatorEraTx _ = error "getEmulatorEraTx: Expected a Babbage tx" -We want to do validation with both the emulator and with the cardano-ledger library, at least as long -as we don't have Phase2 validation errors via the cardano-ledger library. +pattern CardanoEmulatorEraTx :: C.Tx C.BabbageEra -> CardanoTx +pattern CardanoEmulatorEraTx tx <- (getEmulatorEraTx -> tx) where + CardanoEmulatorEraTx tx = CardanoTx tx C.BabbageEraInCardanoMode -To do that we need the required signers which are only available in UnbalancedTx during balancing. -So during balancing we can create the SomeCardanoApiTx, while proper validation can only happen in -Cardano.Node.Emulator.Chain.validateBlock, since that's when we know the right Slot number. This means that -we need both transaction types in the path from balancing to validateBlock. -} -data CardanoTx - = EmulatorTx { _emulatorTx :: Tx } - | CardanoApiTx { _cardanoApiTx :: SomeCardanoApiTx } - deriving (Eq, Show, Generic) - deriving anyclass (FromJSON, ToJSON, Serialise) - -makeLenses ''CardanoTx - -getEmulatorEraTx :: SomeCardanoApiTx -> C.Tx C.BabbageEra -getEmulatorEraTx (SomeTx tx C.BabbageEraInCardanoMode) = tx -getEmulatorEraTx _ = error "getEmulatorEraTx: Expected a Babbage tx" - -pattern CardanoApiEmulatorEraTx :: C.Tx C.BabbageEra -> SomeCardanoApiTx -pattern CardanoApiEmulatorEraTx tx <- (getEmulatorEraTx -> tx) where - CardanoApiEmulatorEraTx tx = SomeTx tx C.BabbageEraInCardanoMode - -{-# COMPLETE CardanoApiEmulatorEraTx #-} +{-# COMPLETE CardanoEmulatorEraTx #-} instance Pretty CardanoTx where pretty tx = - let lines' = + let + renderScriptWitnesses (CardanoEmulatorEraTx (C.Api.Tx (C.Api.ShelleyTxBody _ _ scripts _ _ _) _)) = + [ hang 2 (vsep ("attached scripts:": fmap viaShow scripts)) | not (null scripts) ] + lines' = [ hang 2 (vsep ("inputs:" : fmap pretty (getCardanoTxInputs tx))) , hang 2 (vsep ("reference inputs:" : fmap pretty (getCardanoTxReferenceInputs tx))) , hang 2 (vsep ("collateral inputs:" : fmap pretty (getCardanoTxCollateralInputs tx))) @@ -299,75 +268,52 @@ instance Pretty CardanoTx where <> maybe [] (\val -> ["total collateral:" <+> pretty val]) (getCardanoTxTotalCollateral tx) ++ [ "mint:" <+> pretty (getCardanoTxMint tx) , "fee:" <+> pretty (getCardanoTxFee tx) - ] ++ onCardanoTx (\tx' -> - [ hang 2 (vsep ("mps:": fmap pretty (Map.toList (txMintingWitnesses tx')))) - , hang 2 (vsep ("signatures:": fmap (pretty . fst) (Map.toList (txSignatures tx')))) - ]) (const []) tx ++ - [ "validity range:" <+> viaShow (getCardanoTxValidityRange tx) + , "validity range:" <+> viaShow (getCardanoTxValidityRange tx) , hang 2 (vsep ("data:": fmap pretty (Map.toList (getCardanoTxData tx)))) - , hang 2 (vsep ("redeemers:": fmap (\(k, v) -> viaShow k <+> ":" <+> viaShow v) (Map.toList $ getCardanoTxRedeemers tx))) - ] ++ onCardanoTx (const []) renderScriptWitnesses tx - renderScriptWitnesses (CardanoApiEmulatorEraTx (C.Api.Tx (C.Api.ShelleyTxBody _ _ scripts _ _ _) _)) = - [ hang 2 (vsep ("attached scripts:": fmap viaShow scripts)) | not (null scripts) ] + , hang 2 (vsep ("redeemers:": fmap (\(k, V2.Redeemer red) -> viaShow k <+> ":" <+> viaShow red) (Map.toList $ getCardanoTxRedeemers tx))) + ] ++ renderScriptWitnesses tx in nest 2 $ vsep ["Tx" <+> pretty (getCardanoTxId tx) <> colon, braces (vsep lines')] -instance Pretty SomeCardanoApiTx where - pretty = pretty . CardanoApiTx - instance Pretty CardanoAPI.CardanoBuildTx where pretty txBodyContent = case C.makeSignedTransaction [] <$> CardanoAPI.makeTransactionBody Nothing mempty txBodyContent of - Right tx -> pretty $ CardanoApiEmulatorEraTx tx + Right tx -> pretty $ CardanoEmulatorEraTx tx _ -> viaShow txBodyContent -getTxBodyContent :: SomeCardanoApiTx -> C.TxBodyContent C.ViewTx C.BabbageEra -getTxBodyContent (CardanoApiEmulatorEraTx (C.Tx (C.TxBody bodyContent) _)) = bodyContent - -onCardanoTx :: (Tx -> r) -> (SomeCardanoApiTx -> r) -> CardanoTx -> r -onCardanoTx l _ (EmulatorTx tx) = l tx -onCardanoTx _ r (CardanoApiTx ctx) = r ctx - -cardanoTxMap :: (Tx -> Tx) -> (SomeCardanoApiTx -> SomeCardanoApiTx) -> CardanoTx -> CardanoTx -cardanoTxMap l _ (EmulatorTx tx) = EmulatorTx (l tx) -cardanoTxMap _ r (CardanoApiTx ctx) = CardanoApiTx (r ctx) +getTxBodyContent :: CardanoTx -> C.TxBodyContent C.ViewTx C.BabbageEra +getTxBodyContent (CardanoEmulatorEraTx (C.Tx (C.TxBody bodyContent) _)) = bodyContent getCardanoTxId :: CardanoTx -> V1.Tx.TxId -getCardanoTxId = onCardanoTx txId getCardanoApiTxId +getCardanoTxId = getCardanoApiTxId -getCardanoApiTxId :: SomeCardanoApiTx -> V1.Tx.TxId -getCardanoApiTxId (SomeTx (C.Tx body _) _) = CardanoAPI.fromCardanoTxId $ C.getTxId body +getCardanoApiTxId :: CardanoTx -> V1.Tx.TxId +getCardanoApiTxId (CardanoTx (C.Tx body _) _) = CardanoAPI.fromCardanoTxId $ C.getTxId body getCardanoTxInputs :: CardanoTx -> [TxIn] -getCardanoTxInputs = onCardanoTx - (\tx -> map (fillTxInputWitnesses tx) $ txInputs tx) - (getTxBodyContentInputs . getTxBodyContent) +getCardanoTxInputs = getTxBodyContentInputs . getTxBodyContent getTxBodyContentInputs :: C.TxBodyContent ctx era -> [TxIn] getTxBodyContentInputs C.TxBodyContent {..} = fmap ((`TxIn` Nothing) . CardanoAPI.fromCardanoTxIn . fst) txIns getCardanoTxCollateralInputs :: CardanoTx -> [TxIn] -getCardanoTxCollateralInputs = onCardanoTx - (\tx -> map (fillTxInputWitnesses tx) $ txCollateralInputs tx) - (getTxBodyContentCollateralInputs . getTxBodyContent) +getCardanoTxCollateralInputs = getTxBodyContentCollateralInputs . getTxBodyContent getTxBodyContentCollateralInputs :: C.TxBodyContent ctx era -> [TxIn] getTxBodyContentCollateralInputs C.TxBodyContent {..} = CardanoAPI.fromCardanoTxInsCollateral txInsCollateral getCardanoTxReferenceInputs :: CardanoTx -> [TxIn] -getCardanoTxReferenceInputs = onCardanoTx - (\tx -> map (fillTxInputWitnesses tx) $ txReferenceInputs tx) - (\(SomeTx (C.Tx (C.TxBody C.TxBodyContent {..}) _) _) -> - txInsReferenceToPlutusTxIns txInsReference) - where - txInsReferenceToPlutusTxIns C.TxInsReferenceNone = [] - txInsReferenceToPlutusTxIns (C.TxInsReference _ txIns) = - fmap ((`TxIn` Nothing) . CardanoAPI.fromCardanoTxIn) txIns +getCardanoTxReferenceInputs (CardanoTx (C.Tx (C.TxBody C.TxBodyContent {..}) _) _) = + txInsReferenceToPlutusTxIns txInsReference + where + txInsReferenceToPlutusTxIns C.TxInsReferenceNone = [] + txInsReferenceToPlutusTxIns (C.TxInsReference _ txIns') = + fmap ((`TxIn` Nothing) . CardanoAPI.fromCardanoTxIn) txIns' getCardanoTxOutRefs :: CardanoTx -> [(TxOut, V1.Tx.TxOutRef)] -getCardanoTxOutRefs = onCardanoTx txOutRefs cardanoApiTxOutRefs +getCardanoTxOutRefs = cardanoApiTxOutRefs where - cardanoApiTxOutRefs :: SomeCardanoApiTx -> [(TxOut, V1.Tx.TxOutRef)] - cardanoApiTxOutRefs (CardanoApiEmulatorEraTx (C.Tx txBody@(C.TxBody C.TxBodyContent{..}) _)) = + cardanoApiTxOutRefs :: CardanoTx -> [(TxOut, V1.Tx.TxOutRef)] + cardanoApiTxOutRefs (CardanoEmulatorEraTx (C.Tx txBody@(C.TxBody C.TxBodyContent{..}) _)) = mkOut <$> zip [0..] (map TxOut txOuts) where mkOut (i, o) = (o, V1.TxOutRef (CardanoAPI.fromCardanoTxId $ C.getTxId txBody) i) @@ -382,7 +328,7 @@ getCardanoTxSpentOutputs :: CardanoTx -> Set V1.Tx.TxOutRef getCardanoTxSpentOutputs = Set.fromList . map txInRef . getCardanoTxInputs getCardanoTxReturnCollateral :: CardanoTx -> Maybe TxOut -getCardanoTxReturnCollateral = onCardanoTx txReturnCollateral (getTxBodyContentReturnCollateral . getTxBodyContent) +getCardanoTxReturnCollateral = getTxBodyContentReturnCollateral . getTxBodyContent getTxBodyContentReturnCollateral :: C.TxBodyContent ctx C.Api.BabbageEra -> Maybe TxOut getTxBodyContentReturnCollateral C.TxBodyContent {..} = @@ -395,25 +341,23 @@ getCardanoTxProducedReturnCollateral tx = maybe Map.empty (Map.singleton (V1.TxO getCardanoTxReturnCollateral tx getCardanoTxTotalCollateral :: CardanoTx -> Maybe C.Lovelace -getCardanoTxTotalCollateral = onCardanoTx txTotalCollateral - (\(CardanoApiEmulatorEraTx (C.Tx (C.TxBody C.TxBodyContent {..}) _)) -> CardanoAPI.fromCardanoTotalCollateral txTotalCollateral) +getCardanoTxTotalCollateral (CardanoEmulatorEraTx (C.Tx (C.TxBody C.TxBodyContent {..}) _)) = + CardanoAPI.fromCardanoTotalCollateral txTotalCollateral getCardanoTxFee :: CardanoTx -> C.Lovelace -getCardanoTxFee = onCardanoTx txFee (\(SomeTx (C.Tx (C.TxBody C.TxBodyContent {..}) _) _) -> CardanoAPI.fromCardanoFee txFee) +getCardanoTxFee (CardanoTx (C.Tx (C.TxBody C.TxBodyContent {..}) _) _) = CardanoAPI.fromCardanoFee txFee getCardanoTxMint :: CardanoTx -> C.Value -getCardanoTxMint = onCardanoTx txMint (getTxBodyContentMint . getTxBodyContent) +getCardanoTxMint = getTxBodyContentMint . getTxBodyContent getTxBodyContentMint :: C.TxBodyContent ctx era -> C.Value getTxBodyContentMint C.TxBodyContent {..} = CardanoAPI.fromCardanoMintValue txMintValue getCardanoTxValidityRange :: CardanoTx -> SlotRange -getCardanoTxValidityRange = onCardanoTx txValidRange - (\(SomeTx (C.Tx (C.TxBody C.TxBodyContent {..}) _) _) -> CardanoAPI.fromCardanoValidityRange txValidityRange) +getCardanoTxValidityRange (CardanoTx (C.Tx (C.TxBody C.TxBodyContent {..}) _) _) = CardanoAPI.fromCardanoValidityRange txValidityRange getCardanoTxData :: CardanoTx -> Map V1.DatumHash V1.Datum -getCardanoTxData = onCardanoTx txData - (\(SomeTx (C.Tx txBody _) _) -> fst $ CardanoAPI.scriptDataFromCardanoTxBody txBody) +getCardanoTxData (CardanoTx (C.Tx txBody _) _) = fst $ CardanoAPI.scriptDataFromCardanoTxBody txBody -- TODO: add txMetaData txBodyContentIns :: Lens' (C.TxBodyContent C.BuildTx C.BabbageEra) [(C.TxIn, C.BuildTxWith C.BuildTx (C.Witness C.WitCtxTxIn C.BabbageEra))] @@ -428,44 +372,7 @@ txBodyContentOuts :: Lens' (C.TxBodyContent ctx C.BabbageEra) [TxOut] txBodyContentOuts = lens (map TxOut . C.txOuts) (\bodyContent outs -> bodyContent { C.txOuts = map getTxOut outs }) getCardanoTxRedeemers :: CardanoTx -> V2.Tx.Redeemers -getCardanoTxRedeemers = onCardanoTx (const Map.empty) - (\(SomeTx (C.Tx txBody _) _) -> snd $ CardanoAPI.scriptDataFromCardanoTxBody txBody) - --- Defined here as uses `txId`. -instance Pretty Tx where - pretty tx@(Tx _txInputs _txReferenceInputs _txCollateralInputs _txOutputs - _txReturnCollateral _txTotalCollateral _txMint _txFee - _txValidRange _txMintingScripts _txWithdrawals _txCertificates - _txSignatures _txScripts _txData _txMetadata) = - let showNonEmpty empty x = [x | not empty] - lines' = - [ hang 2 (vsep ("inputs:" : fmap pretty _txInputs)) - , hang 2 (vsep ("reference inputs:" : fmap pretty _txReferenceInputs)) - , hang 2 (vsep ("collateral inputs:" : fmap pretty _txCollateralInputs)) - , hang 2 (vsep ("outputs:" : fmap pretty _txOutputs)) - ] - <> maybe [] (\out -> [hang 2 (vsep ["return collateral:", pretty out])]) _txReturnCollateral - <> maybe [] (\val -> ["total collateral:" <+> pretty val]) _txTotalCollateral - <> [ "mint:" <+> pretty _txMint - , "fee:" <+> pretty _txFee - , hang 2 (vsep ("mps:": fmap pretty (Map.assocs _txMintingScripts))) - , hang 2 (vsep ("signatures:": fmap (pretty . fst) (Map.toList _txSignatures))) - , "validity range:" <+> viaShow _txValidRange - ] - <> (showNonEmpty (Map.null _txData) $ hang 2 (vsep ("data:": fmap pretty (Map.toList _txData)))) - <> (showNonEmpty (Map.null _txScripts) $ hang 2 (vsep ("attached scripts:": fmap pretty (fmap version <$> Map.toList _txScripts)))) - <> (showNonEmpty (null _txWithdrawals) $ hang 2 (vsep ("withdrawals:": fmap pretty _txWithdrawals))) - <> (showNonEmpty (null _txCertificates) $ hang 2 (vsep ("certificates:": fmap pretty _txCertificates))) - <> (["metadata: present" | isJust _txMetadata]) - txid = txId tx - in nest 2 $ vsep ["Tx" <+> pretty txid <> colon, braces (vsep lines')] - --- | Compute the id of a transaction. -txId :: Tx -> V1.Tx.TxId -txId tx = TxId $ V1.toBuiltin - $ digest (Proxy @SHA256) - $ digest (Proxy @SHA256) - (Write.toStrictByteString $ encode $ strip tx) +getCardanoTxRedeemers (CardanoTx (C.Tx txBody _) _) = snd $ CardanoAPI.scriptDataFromCardanoTxBody txBody -- | Update a map of unspent transaction outputs and signatures based on the inputs -- and outputs of a transaction. @@ -479,16 +386,6 @@ updateUtxoCollateral tx unspent = (unspent `Map.withoutKeys` (Set.fromList . map txInRef $ getCardanoTxCollateralInputs tx)) `Map.union` getCardanoTxProducedReturnCollateral tx --- | A list of a transaction's outputs paired with a 'TxOutRef's referring to them. -txOutRefs :: Tx -> [(TxOut, V1.Tx.TxOutRef)] -txOutRefs t = mkOut <$> zip [0..] (txOutputs t) where - mkOut (i, o) = (o, V1.Tx.TxOutRef (txId t) i) - --- | The unspent outputs of a transaction. -unspentOutputsTx :: Tx -> Map V1.Tx.TxOutRef TxOut -unspentOutputsTx t = Map.fromList $ fmap f $ zip [0..] $ txOutputs t where - f (idx, o) = (V1.Tx.TxOutRef (txId t) idx, o) - -- | Create a transaction output locked by a public payment key and optionnaly a public stake key. pubKeyTxOut :: C.Value -> PaymentPubKey -> Maybe V1.StakingCredential -> Either ToCardanoError TxOut pubKeyTxOut v pk sk = do @@ -498,11 +395,11 @@ pubKeyTxOut v pk sk = do type PrivateKey = Crypto.XPrv addCardanoTxSignature :: PrivateKey -> CardanoTx -> CardanoTx -addCardanoTxSignature privKey = cardanoTxMap (addSignature' privKey) addSignatureCardano +addCardanoTxSignature privKey = addSignatureCardano where - addSignatureCardano :: SomeCardanoApiTx -> SomeCardanoApiTx - addSignatureCardano (CardanoApiEmulatorEraTx ctx) - = CardanoApiEmulatorEraTx (addSignatureCardano' ctx) + addSignatureCardano :: CardanoTx -> CardanoTx + addSignatureCardano (CardanoEmulatorEraTx ctx) + = CardanoEmulatorEraTx (addSignatureCardano' ctx) addSignatureCardano' (C.Api.ShelleyTx shelleyBasedEra (ValidatedTx body wits isValid aux)) = C.Api.ShelleyTx shelleyBasedEra (ValidatedTx body wits' isValid aux) @@ -519,20 +416,5 @@ addCardanoTxSignature privKey = cardanoTxMap (addSignature' privKey) addSignatur where notUsed = undefined -- hack so we can reuse code from cardano-api --- | Sign the transaction with a 'PrivateKey' and passphrase (ByteString) and add the signature to the --- transaction's list of signatures. -addSignature :: PrivateKey -> Passphrase -> Tx -> Tx -addSignature privK passPhrase tx = tx & signatures . at pubK ?~ sig where - sig = signTx (txId tx) privK passPhrase - pubK = toPublicKey privK - --- | Sign the transaction with a 'PrivateKey' that has no passphrase and add the signature to the --- transaction's list of signatures -addSignature' :: PrivateKey -> Tx -> Tx -addSignature' privK tx = tx & signatures . at pubK ?~ sig where - sig = signTx' (txId tx) privK - pubK = toPublicKey privK - - decoratedTxOutPlutusValue :: DecoratedTxOut -> Value decoratedTxOutPlutusValue = CardanoAPI.fromCardanoValue . view decoratedTxOutValue diff --git a/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs b/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs index f449106774..9007ad0723 100644 --- a/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs +++ b/plutus-ledger/src/Ledger/Tx/CardanoAPI.hs @@ -17,20 +17,16 @@ Interface to the transaction types from 'cardano-api' module Ledger.Tx.CardanoAPI( module Ledger.Tx.CardanoAPI.Internal , CardanoBuildTx(..) - , SomeCardanoApiTx(..) + , CardanoTx(..) , fromCardanoTxInsCollateral , fromCardanoTotalCollateral , fromCardanoReturnCollateral - , toCardanoTxBody - , toCardanoTxBodyContent , toCardanoTxInsCollateral , toCardanoTotalCollateral , toCardanoReturnCollateral - , toCardanoTxInWitness , toCardanoDatumWitness , toCardanoTxInReferenceWitnessHeader , toCardanoTxInScriptWitnessHeader - , toCardanoMintValue , toCardanoMintWitness , ToCardanoError(..) , FromCardanoError(..) @@ -45,13 +41,12 @@ import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C import Cardano.Ledger.Alonzo.Tx (ValidatedTx (..)) import Cardano.Ledger.Babbage qualified as Babbage -import Cardano.Ledger.Babbage.PParams qualified as Babbage import Cardano.Ledger.Babbage.TxBody (TxBody (TxBody, reqSignerHashes)) import Cardano.Ledger.BaseTypes (mkTxIxPartial) import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Shelley.API qualified as C.Ledger import Data.Bifunctor (Bifunctor (..)) -import Data.Bitraversable (bisequence, bitraverse) +import Data.Bitraversable (bitraverse) import Data.Map qualified as Map import Ledger.Address qualified as P import Ledger.Index.Internal qualified as P @@ -61,66 +56,6 @@ import Ledger.Tx.Internal qualified as P import Plutus.V1.Ledger.Api qualified as PV1 -toCardanoTxBodyContent - :: C.NetworkId - -> Babbage.PParams (Babbage.BabbageEra StandardCrypto) - -> [P.PaymentPubKeyHash] -- ^ Required signers of the transaction - -> P.Tx - -> Either ToCardanoError CardanoBuildTx -toCardanoTxBodyContent networkId protocolParams sigs tx@P.Tx{..} = do - -- TODO: translate all fields - txIns <- traverse (toCardanoTxInBuild tx) txInputs - txInsReference <- traverse (toCardanoTxIn . P.txInputRef) txReferenceInputs - txInsCollateral <- toCardanoTxInsCollateral txCollateralInputs - let txOuts = P.getTxOut <$> txOutputs - let returnCollateral = toCardanoReturnCollateral txReturnCollateral - let totalCollateral = toCardanoTotalCollateral txTotalCollateral - let txFee' = toCardanoFee txFee - txValidityRange <- toCardanoValidityRange txValidRange - txMintValue <- toCardanoMintValue tx - txExtraKeyWits <- C.TxExtraKeyWitnesses C.ExtraKeyWitnessesInBabbageEra <$> traverse toCardanoPaymentKeyHash sigs - withdrawals <- toWithdrawals txScripts networkId txWithdrawals - pure $ CardanoBuildTx $ C.TxBodyContent - { txIns = txIns - , txInsReference = C.TxInsReference C.ReferenceTxInsScriptsInlineDatumsInBabbageEra txInsReference - , txInsCollateral = txInsCollateral - , txOuts = txOuts - , txTotalCollateral = totalCollateral - , txReturnCollateral = returnCollateral - , txFee = txFee' - , txValidityRange = txValidityRange - , txMintValue = txMintValue - , txProtocolParams = C.BuildTxWith $ Just $ C.fromLedgerPParams C.ShelleyBasedEraBabbage protocolParams - , txScriptValidity = C.TxScriptValidityNone - , txExtraKeyWits - -- unused: - , txMetadata = C.TxMetadataNone - , txAuxScripts = C.TxAuxScriptsNone - , txWithdrawals = withdrawals - , txCertificates = C.TxCertificatesNone - , txUpdateProposal = C.TxUpdateProposalNone - } - -toWithdrawals :: P.ScriptsMap - -> C.NetworkId - -> [P.Withdrawal] - -> Either ToCardanoError (C.TxWithdrawals C.BuildTx C.BabbageEra) -toWithdrawals txScripts networkId = \case - [] -> pure C.TxWithdrawalsNone - xs -> C.TxWithdrawals C.WithdrawalsInBabbageEra <$> mapM toWithdraw xs - - where - toWithdraw P.Withdrawal{withdrawalCredential, withdrawalAmount, withdrawalRedeemer} = do - saddr <- toCardanoStakeAddress networkId withdrawalCredential - witness <- toStakeWitness withdrawalRedeemer withdrawalCredential - pure (saddr, C.Lovelace withdrawalAmount, witness) - - toStakeWitness withdrawalRedeemer cred = case cred of - PV1.PubKeyCredential _pkh -> pure $ C.BuildTxWith $ C.KeyWitness C.KeyWitnessForStakeAddr - PV1.ScriptCredential _vh -> case (,) <$> withdrawalRedeemer <*> P.lookupValidator txScripts _vh of - Just (redeemer, script) -> C.BuildTxWith . C.ScriptWitness C.ScriptWitnessForStakeAddr <$> toCardanoScriptWitness C.NoScriptDatumForStake redeemer (Left $ fmap P.getValidator script) - Nothing -> Left MissingStakeValidator - toCardanoMintWitness :: PV1.Redeemer -> Maybe (P.Versioned PV1.TxOutRef) -> Maybe (P.Versioned PV1.MintingPolicy) -> Either ToCardanoError (C.ScriptWitness C.WitCtxMint C.BabbageEra) toCardanoMintWitness _ Nothing Nothing = Left MissingMintingPolicy toCardanoMintWitness redeemer (Just ref) _ = @@ -152,28 +87,6 @@ toCardanoScriptWitness datum redeemer scriptOrRef = (case lang of where lang = either P.version P.version scriptOrRef -toCardanoStakeAddress :: C.NetworkId -> PV1.Credential -> Either ToCardanoError C.StakeAddress -toCardanoStakeAddress networkId credential = - C.StakeAddress (C.toShelleyNetwork networkId) . C.toShelleyStakeCredential <$> toCardanoStakingCredential credential - -toCardanoStakingCredential :: PV1.Credential -> Either ToCardanoError C.StakeCredential -toCardanoStakingCredential (PV1.PubKeyCredential pubKeyHash) = C.StakeCredentialByKey <$> toCardanoStakeKeyHash pubKeyHash -toCardanoStakingCredential (PV1.ScriptCredential validatorHash) = C.StakeCredentialByScript <$> toCardanoScriptHash validatorHash - - -toCardanoTxBody :: - C.NetworkId - -> Babbage.PParams (Babbage.BabbageEra StandardCrypto) - -> [P.PaymentPubKeyHash] -- ^ Required signers of the transaction - -> P.Tx - -> Either ToCardanoError (C.TxBody C.BabbageEra) -toCardanoTxBody networkId params sigs tx = do - txBodyContent <- toCardanoTxBodyContent networkId params sigs tx - makeTransactionBody (Just params) mempty txBodyContent - -toCardanoTxInBuild :: P.Tx -> P.TxInput -> Either ToCardanoError (C.TxIn, C.BuildTxWith C.BuildTx (C.Witness C.WitCtxTxIn C.BabbageEra)) -toCardanoTxInBuild tx (P.TxInput txInRef txInType) = (,) <$> toCardanoTxIn txInRef <*> (C.BuildTxWith <$> toCardanoTxInWitness tx txInType) - fromCardanoTxInsCollateral :: C.TxInsCollateral era -> [P.TxIn] fromCardanoTxInsCollateral C.TxInsCollateralNone = [] fromCardanoTxInsCollateral (C.TxInsCollateral _ txIns) = map (P.pubKeyTxIn . fromCardanoTxIn) txIns @@ -182,24 +95,6 @@ toCardanoTxInsCollateral :: [P.TxInput] -> Either ToCardanoError (C.TxInsCollate toCardanoTxInsCollateral [] = pure C.TxInsCollateralNone toCardanoTxInsCollateral inputs = fmap (C.TxInsCollateral C.CollateralInBabbageEra) (traverse (toCardanoTxIn . P.txInputRef) inputs) -toCardanoTxInWitness :: P.Tx -> P.TxInputType -> Either ToCardanoError (C.Witness C.WitCtxTxIn C.BabbageEra) -toCardanoTxInWitness _ P.TxConsumePublicKeyAddress = pure (C.KeyWitness C.KeyWitnessForSpending) -toCardanoTxInWitness _ P.TxConsumeSimpleScriptAddress = Left SimpleScriptsNotSupportedToCardano -- TODO: Better support for simple scripts -toCardanoTxInWitness tx - (P.TxScriptAddress - (P.Redeemer redeemer) - valhOrRef - dh) - = do - mDatum <- traverse (maybe (Left MissingDatum) pure . (`Map.lookup` P.txData tx)) dh - mkWitness <- case valhOrRef of - Left valh -> maybe (Left MissingInputValidator) (toCardanoTxInScriptWitnessHeader . fmap PV1.getValidator) $ P.lookupValidator (P.txScripts tx) valh - Right vref -> toCardanoTxInReferenceWitnessHeader vref - pure $ C.ScriptWitness C.ScriptWitnessForSpending $ mkWitness - (toCardanoDatumWitness mDatum) - (toCardanoScriptData redeemer) - zeroExecutionUnits - toCardanoDatumWitness :: Maybe PV1.Datum -> C.ScriptDatum C.WitCtxTxIn toCardanoDatumWitness = maybe C.InlineScriptDatum (C.ScriptDatumForTxIn . toCardanoScriptData . PV1.getDatum) @@ -226,14 +121,6 @@ toCardanoTxInScriptWitnessHeader (P.Versioned script lang) = C.PlutusScriptWitness C.PlutusScriptV2InBabbage C.PlutusScriptV2 . C.PScript <$> toCardanoPlutusScript (C.AsPlutusScript C.AsPlutusScriptV2) script -toCardanoMintValue :: P.Tx -> Either ToCardanoError (C.TxMintValue C.BuildTx C.BabbageEra) -toCardanoMintValue tx@P.Tx{..} = - let indexedMps = Map.assocs txMintingWitnesses - in C.TxMintValue C.MultiAssetInBabbageEra txMint . C.BuildTxWith . Map.fromList <$> - traverse (\(mph, (rd, mTxOutRef)) -> - bisequence (toCardanoPolicyId mph, toCardanoMintWitness rd mTxOutRef (P.lookupMintingPolicy (P.txScripts tx) mph))) - indexedMps - fromCardanoTotalCollateral :: C.TxTotalCollateral C.BabbageEra -> Maybe C.Lovelace fromCardanoTotalCollateral C.TxTotalCollateralNone = Nothing fromCardanoTotalCollateral (C.TxTotalCollateral _ lv) = Just lv diff --git a/plutus-ledger/src/Ledger/Tx/CardanoAPI/Internal.hs b/plutus-ledger/src/Ledger/Tx/CardanoAPI/Internal.hs index eb26f51081..2361f1f83e 100644 --- a/plutus-ledger/src/Ledger/Tx/CardanoAPI/Internal.hs +++ b/plutus-ledger/src/Ledger/Tx/CardanoAPI/Internal.hs @@ -19,7 +19,7 @@ Interface to the transaction types from 'cardano-api' -} module Ledger.Tx.CardanoAPI.Internal( CardanoBuildTx(..) - , SomeCardanoApiTx(..) + , CardanoTx(..) , txOutRefs , unspentOutputsTx , fromCardanoTxId @@ -372,22 +372,22 @@ deriving instance FromJSON (C.TxBodyContent C.BuildTx C.BabbageEra) deriving instance ToJSON (C.TxBodyContent C.BuildTx C.BabbageEra) -- | Cardano tx from any era. -data SomeCardanoApiTx where - SomeTx :: C.IsCardanoEra era => C.Tx era -> C.EraInMode era C.CardanoMode -> SomeCardanoApiTx - -instance Eq SomeCardanoApiTx where - (SomeTx tx1 C.ByronEraInCardanoMode) == (SomeTx tx2 C.ByronEraInCardanoMode) = tx1 == tx2 - (SomeTx tx1 C.ShelleyEraInCardanoMode) == (SomeTx tx2 C.ShelleyEraInCardanoMode) = tx1 == tx2 - (SomeTx tx1 C.AllegraEraInCardanoMode) == (SomeTx tx2 C.AllegraEraInCardanoMode) = tx1 == tx2 - (SomeTx tx1 C.MaryEraInCardanoMode) == (SomeTx tx2 C.MaryEraInCardanoMode) = tx1 == tx2 - (SomeTx tx1 C.AlonzoEraInCardanoMode) == (SomeTx tx2 C.AlonzoEraInCardanoMode) = tx1 == tx2 - (SomeTx tx1 C.BabbageEraInCardanoMode) == (SomeTx tx2 C.BabbageEraInCardanoMode) = tx1 == tx2 - _ == _ = False - -deriving instance Show SomeCardanoApiTx - -instance Serialise SomeCardanoApiTx where - encode (SomeTx tx eraInMode) = encodedMode eraInMode <> Encoding (TkBytes (C.serialiseToCBOR tx)) +data CardanoTx where + CardanoTx :: C.IsCardanoEra era => C.Tx era -> C.EraInMode era C.CardanoMode -> CardanoTx + +instance Eq CardanoTx where + (CardanoTx tx1 C.ByronEraInCardanoMode) == (CardanoTx tx2 C.ByronEraInCardanoMode) = tx1 == tx2 + (CardanoTx tx1 C.ShelleyEraInCardanoMode) == (CardanoTx tx2 C.ShelleyEraInCardanoMode) = tx1 == tx2 + (CardanoTx tx1 C.AllegraEraInCardanoMode) == (CardanoTx tx2 C.AllegraEraInCardanoMode) = tx1 == tx2 + (CardanoTx tx1 C.MaryEraInCardanoMode) == (CardanoTx tx2 C.MaryEraInCardanoMode) = tx1 == tx2 + (CardanoTx tx1 C.AlonzoEraInCardanoMode) == (CardanoTx tx2 C.AlonzoEraInCardanoMode) = tx1 == tx2 + (CardanoTx tx1 C.BabbageEraInCardanoMode) == (CardanoTx tx2 C.BabbageEraInCardanoMode) = tx1 == tx2 + _ == _ = False + +deriving instance Show CardanoTx + +instance Serialise CardanoTx where + encode (CardanoTx tx eraInMode) = encodedMode eraInMode <> Encoding (TkBytes (C.serialiseToCBOR tx)) where encodedMode :: C.EraInMode era C.CardanoMode -> Encoding -- 0 and 1 are for ByronEraInByronMode and ShelleyEraInShelleyMode @@ -408,23 +408,23 @@ instance Serialise SomeCardanoApiTx where 7 -> decodeTx C.AsBabbageEra C.BabbageEraInCardanoMode _ -> fail "Unexpected value while decoding Cardano.Api.EraInMode" where - decodeTx :: C.IsCardanoEra era => C.AsType era -> C.EraInMode era C.CardanoMode -> Decoder s SomeCardanoApiTx + decodeTx :: C.IsCardanoEra era => C.AsType era -> C.EraInMode era C.CardanoMode -> Decoder s CardanoTx decodeTx asType eraInMode = do bytes <- decodeBytes tx <- either (const $ fail "Failed to decode Cardano.Api.Tx") pure $ C.deserialiseFromCBOR (C.AsTx asType) bytes - pure $ SomeTx tx eraInMode + pure $ CardanoTx tx eraInMode -instance ToJSON SomeCardanoApiTx where - toJSON (SomeTx tx eraInMode) = +instance ToJSON CardanoTx where + toJSON (CardanoTx tx eraInMode) = object [ "tx" .= C.serialiseToTextEnvelope Nothing tx , "eraInMode" .= eraInMode ] --- | Converting 'SomeCardanoApiTx' to JSON. +-- | Converting 'CardanoTx' to JSON. -- -- If the "tx" field is from an unknown era, the JSON parser will print an -- error at runtime while parsing. -instance FromJSON SomeCardanoApiTx where +instance FromJSON CardanoTx where parseJSON v = parseByronInCardanoModeTx v <|> parseShelleyEraInCardanoModeTx v <|> parseAllegraEraInCardanoModeTx v @@ -442,48 +442,48 @@ withIsCardanoEra C.MaryEraInCardanoMode r = r withIsCardanoEra C.AlonzoEraInCardanoMode r = r withIsCardanoEra C.BabbageEraInCardanoMode r = r -parseByronInCardanoModeTx :: Aeson.Value -> Parser SomeCardanoApiTx +parseByronInCardanoModeTx :: Aeson.Value -> Parser CardanoTx parseByronInCardanoModeTx = - parseSomeCardanoTx "Failed to parse ByronEra 'tx' field from SomeCardanoApiTx" + parseSomeCardanoTx "Failed to parse ByronEra 'tx' field from CardanoTx" (C.AsTx C.AsByronEra) -parseShelleyEraInCardanoModeTx :: Aeson.Value -> Parser SomeCardanoApiTx +parseShelleyEraInCardanoModeTx :: Aeson.Value -> Parser CardanoTx parseShelleyEraInCardanoModeTx = - parseSomeCardanoTx "Failed to parse ShelleyEra 'tx' field from SomeCardanoApiTx" + parseSomeCardanoTx "Failed to parse ShelleyEra 'tx' field from CardanoTx" (C.AsTx C.AsShelleyEra) -parseMaryEraInCardanoModeTx :: Aeson.Value -> Parser SomeCardanoApiTx +parseMaryEraInCardanoModeTx :: Aeson.Value -> Parser CardanoTx parseMaryEraInCardanoModeTx = - parseSomeCardanoTx "Failed to parse MaryEra 'tx' field from SomeCardanoApiTx" + parseSomeCardanoTx "Failed to parse MaryEra 'tx' field from CardanoTx" (C.AsTx C.AsMaryEra) -parseAllegraEraInCardanoModeTx :: Aeson.Value -> Parser SomeCardanoApiTx +parseAllegraEraInCardanoModeTx :: Aeson.Value -> Parser CardanoTx parseAllegraEraInCardanoModeTx = - parseSomeCardanoTx "Failed to parse AllegraEra 'tx' field from SomeCardanoApiTx" + parseSomeCardanoTx "Failed to parse AllegraEra 'tx' field from CardanoTx" (C.AsTx C.AsAllegraEra) -parseAlonzoEraInCardanoModeTx :: Aeson.Value -> Parser SomeCardanoApiTx +parseAlonzoEraInCardanoModeTx :: Aeson.Value -> Parser CardanoTx parseAlonzoEraInCardanoModeTx = - parseSomeCardanoTx "Failed to parse AlonzoEra 'tx' field from SomeCardanoApiTx" + parseSomeCardanoTx "Failed to parse AlonzoEra 'tx' field from CardanoTx" (C.AsTx C.AsAlonzoEra) -- TODO Uncomment the implementation once Cardano.Api adds a FromJSON instance -- for 'EraInMode BabbageEra CardanoMode': -- https://github.com/input-output-hk/cardano-node/pull/3837 -parseBabbageEraInCardanoModeTx :: Aeson.Value -> Parser SomeCardanoApiTx +parseBabbageEraInCardanoModeTx :: Aeson.Value -> Parser CardanoTx parseBabbageEraInCardanoModeTx (Aeson.Object v) = - SomeTx - <$> (v .: "tx" >>= \envelope -> either (const $ parseFail "Failed to parse BabbageEra 'tx' field from SomeCardanoApiTx") + CardanoTx + <$> (v .: "tx" >>= \envelope -> either (const $ parseFail "Failed to parse BabbageEra 'tx' field from CardanoTx") pure $ C.deserialiseFromTextEnvelope (C.AsTx C.AsBabbageEra) envelope) <*> pure C.BabbageEraInCardanoMode -- This is a workaround that only works because we tried all other eras first parseBabbageEraInCardanoModeTx invalid = - prependFailure "parsing SomeCardanoApiTx failed, " + prependFailure "parsing CardanoTx failed, " (typeMismatch "Object" invalid) - -- parseSomeCardanoTx "Failed to parse BabbageEra 'tx' field from SomeCardanoApiTx" + -- parseSomeCardanoTx "Failed to parse BabbageEra 'tx' field from CardanoTx" -- (C.AsTx C.AsBabbageEra) -parseEraInCardanoModeFail :: Aeson.Value -> Parser SomeCardanoApiTx +parseEraInCardanoModeFail :: Aeson.Value -> Parser CardanoTx parseEraInCardanoModeFail _ = fail "Unable to parse 'eraInMode'" parseSomeCardanoTx @@ -493,25 +493,25 @@ parseSomeCardanoTx => String -> C.AsType (C.Tx era) -> Aeson.Value - -> Parser SomeCardanoApiTx + -> Parser CardanoTx parseSomeCardanoTx errorMsg txAsType (Aeson.Object v) = - SomeTx + CardanoTx <$> (v .: "tx" >>= \envelope -> either (const $ parseFail errorMsg) pure $ C.deserialiseFromTextEnvelope txAsType envelope) <*> v .: "eraInMode" parseSomeCardanoTx _ _ invalid = - prependFailure "parsing SomeCardanoApiTx failed, " + prependFailure "parsing CardanoTx failed, " (typeMismatch "Object" invalid) -txOutRefs :: SomeCardanoApiTx -> [(PV1.TxOut, PV1.TxOutRef)] -txOutRefs (SomeTx (C.Tx txBody@(C.TxBody C.TxBodyContent{..}) _) _) = +txOutRefs :: CardanoTx -> [(PV1.TxOut, PV1.TxOutRef)] +txOutRefs (CardanoTx (C.Tx txBody@(C.TxBody C.TxBodyContent{..}) _) _) = mkOut <$> zip [0..] plutusTxOuts where mkOut (i, o) = (o, PV1.TxOutRef (fromCardanoTxId $ C.getTxId txBody) i) plutusTxOuts = fromCardanoTxOutToPV1TxInfoTxOut <$> txOuts -unspentOutputsTx :: SomeCardanoApiTx -> Map PV1.TxOutRef PV1.TxOut +unspentOutputsTx :: CardanoTx -> Map PV1.TxOutRef PV1.TxOut unspentOutputsTx tx = Map.fromList $ swap <$> txOutRefs tx -- | Given a 'C.TxScriptValidity era', if the @era@ supports scripts, return a diff --git a/plutus-ledger/src/Ledger/Tx/Internal.hs b/plutus-ledger/src/Ledger/Tx/Internal.hs index 557064a418..298ffb79eb 100644 --- a/plutus-ledger/src/Ledger/Tx/Internal.hs +++ b/plutus-ledger/src/Ledger/Tx/Internal.hs @@ -22,19 +22,14 @@ import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C hiding (toShelleyTxOut) import Cardano.Binary qualified as C import Cardano.Ledger.Alonzo.Genesis () -import Codec.CBOR.Write qualified as Write import Codec.Serialise (Serialise, decode, encode) -import Control.Applicative (empty, (<|>)) import Cardano.Ledger.Core qualified as Ledger (TxOut) import Cardano.Ledger.Serialization qualified as Ledger (Sized, mkSized) import Ouroboros.Consensus.Shelley.Eras qualified as Ledger import Control.Lens qualified as L -import Control.Monad.State.Strict (execState, modify') import Data.Aeson (FromJSON, ToJSON) -import Data.ByteArray qualified as BA -import Data.Foldable (traverse_) import Data.Map (Map) import Data.Map qualified as Map import GHC.Generics (Generic) @@ -43,25 +38,35 @@ import Ledger.Address (CardanoAddress, cardanoPubKeyHash, toPlutusAddress) import Ledger.Contexts.Orphans () import Ledger.Crypto import Ledger.DCert.Orphans () -import Ledger.Slot import Ledger.Tx.CardanoAPI.Internal (fromCardanoTxOutDatum, fromCardanoTxOutValue) import Ledger.Tx.CardanoAPITemp qualified as C import Ledger.Tx.Orphans () import Ledger.Tx.Orphans.V2 () import Plutus.Script.Utils.Scripts -import Plutus.V1.Ledger.Api (Credential, DCert, ScriptPurpose (..), StakingCredential (StakingHash), dataToBuiltinData) +import Plutus.V1.Ledger.Api (Credential, DCert, dataToBuiltinData) import Plutus.V1.Ledger.Scripts import Plutus.V1.Ledger.Tx hiding (TxIn (..), TxInType (..), TxOut (..), inRef, inScripts, inType, pubKeyTxIn, pubKeyTxIns, scriptTxIn, scriptTxIns) -import Plutus.V1.Ledger.Value as V import Plutus.V2.Ledger.Api qualified as PV2 -import PlutusTx.Lattice -import PlutusTx.Prelude (BuiltinByteString) import PlutusTx.Prelude qualified as PlutusTx import Prettyprinter (Pretty (..), hang, viaShow, vsep, (<+>)) +txOutValue :: TxOut -> C.Value +txOutValue (TxOut (C.TxOut _aie tov _tod _rs)) = + C.txOutValueToValue tov + +outValue :: L.Lens TxOut TxOut C.Value (C.TxOutValue C.BabbageEra) +outValue = L.lens + txOutValue + (\(TxOut (C.TxOut aie _ tod rs)) tov -> TxOut (C.TxOut aie tov tod rs)) + +outValue' :: L.Lens' TxOut (C.TxOutValue C.BabbageEra) +outValue' = L.lens + (\(TxOut (C.TxOut _aie tov _tod _rs)) -> tov) + (\(TxOut (C.TxOut aie _ tod rs)) tov -> TxOut (C.TxOut aie tov tod rs)) + -- | The type of a transaction input. data TxInType = ScriptAddress !(Either (Versioned Validator) (Versioned TxOutRef)) !Redeemer !(Maybe Datum) @@ -194,14 +199,6 @@ referenceScriptTxInputs = (\x -> L.folding x) . filter $ \case TxInput{ txInputType = TxScriptAddress _ (Right _) _ } -> True _ -> False --- | Validator, redeemer, and data scripts of a transaction input that spends a --- "pay to script" output. --- inScripts :: Tx -> TxInput -> Maybe (LedgerPlutusVersion, Validator, Redeemer, Datum) --- inScripts tx i@TxInput{txInputType=TxConsumeScriptAddress pv _ _ _} = case txInType $ fillTxInputWitnesses tx i of --- Just (ConsumeScriptAddress v r d) -> Just (pv, v, r, d) --- _ -> Nothing --- inScripts _ _ = Nothing - newtype TxOut = TxOut {getTxOut :: C.TxOut C.CtxTx C.BabbageEra} deriving stock (Show, Eq, Generic) deriving anyclass (ToJSON, FromJSON) @@ -240,204 +237,6 @@ toSizedTxOut = Ledger.mkSized . C.toShelleyTxOut C.ShelleyBasedEraBabbage . getT type ScriptsMap = Map ScriptHash (Versioned Script) type MintingWitnessesMap = Map MintingPolicyHash (Redeemer, Maybe (Versioned TxOutRef)) --- | A Babbage-era transaction, including witnesses for its inputs. -data Tx = Tx { - txInputs :: [TxInput], - -- ^ The inputs to this transaction. - txReferenceInputs :: [TxInput], - -- ^ The reference inputs to this transaction. - txCollateralInputs :: [TxInput], - -- ^ The collateral inputs to cover the fees in case validation of the transaction fails. - txOutputs :: [TxOut], - -- ^ The outputs of this transaction, ordered so they can be referenced by index. - txReturnCollateral :: Maybe TxOut, - -- ^ The output of the remaining collateral after covering fees in case validation of the transaction fails. - txTotalCollateral :: Maybe C.Lovelace, - -- ^ The total collateral to be paid in case validation of the transaction fails. - txMint :: !C.Value, - -- ^ The 'Value' minted by this transaction. - txFee :: !C.Lovelace, - -- ^ The fee for this transaction. - txValidRange :: !SlotRange, - -- ^ The 'SlotRange' during which this transaction may be validated. - txMintingWitnesses :: MintingWitnessesMap, - -- ^ The witnesses that must be present to check minting conditions matched with their redeemers. - txWithdrawals :: [Withdrawal], - -- ^ Withdrawals, contains redeemers. - txCertificates :: [Certificate], - -- ^ Certificates, contains redeemers. - txSignatures :: Map PubKey Signature, - -- ^ Signatures of this transaction. - txScripts :: ScriptsMap, - -- ^ Scripts for all script credentials mentioned in this tx. - txData :: Map DatumHash Datum, - -- ^ Datum objects recorded on this transaction. - txMetadata :: Maybe BuiltinByteString - -- ^ Metadata - } deriving stock (Show, Eq, Generic) - deriving anyclass (ToJSON, FromJSON, Serialise) - - -instance Semigroup Tx where - tx1 <> tx2 = Tx { - txInputs = txInputs tx1 <> txInputs tx2, - txReferenceInputs = txReferenceInputs tx1 <> txReferenceInputs tx2, - txCollateralInputs = txCollateralInputs tx1 <> txCollateralInputs tx2, - txOutputs = txOutputs tx1 <> txOutputs tx2, - txReturnCollateral = txReturnCollateral tx1 <|> txReturnCollateral tx2, - txTotalCollateral = txTotalCollateral tx1 <> txTotalCollateral tx2, - txMint = txMint tx1 <> txMint tx2, - txFee = txFee tx1 <> txFee tx2, - txValidRange = txValidRange tx1 /\ txValidRange tx2, - txMintingWitnesses = txMintingWitnesses tx1 <> txMintingWitnesses tx2, - txSignatures = txSignatures tx1 <> txSignatures tx2, - txData = txData tx1 <> txData tx2, - txScripts = txScripts tx1 <> txScripts tx2, - txWithdrawals = txWithdrawals tx1 <> txWithdrawals tx2, - txCertificates = txCertificates tx1 <> txCertificates tx2, - txMetadata = txMetadata tx1 <> txMetadata tx2 - } - -instance Monoid Tx where - mempty = Tx mempty mempty mempty mempty empty mempty mempty mempty top mempty mempty mempty mempty mempty mempty mempty - -instance BA.ByteArrayAccess Tx where - length = BA.length . Write.toStrictByteString . encode - withByteArray = BA.withByteArray . Write.toStrictByteString . encode - --- | The inputs of a transaction. -inputs :: L.Lens' Tx [TxInput] -inputs = L.lens g s where - g = txInputs - s tx i = tx { txInputs = i } - --- | The reference inputs of a transaction. -referenceInputs :: L.Lens' Tx [TxInput] -referenceInputs = L.lens g s where - g = txReferenceInputs - s tx i = tx { txReferenceInputs = i } - --- | The collateral inputs of a transaction for paying fees when validating the transaction fails. -collateralInputs :: L.Lens' Tx [TxInput] -collateralInputs = L.lens g s where - g = txCollateralInputs - s tx i = tx { txCollateralInputs = i } - --- | The outputs of a transaction. -outputs :: L.Lens' Tx [TxOut] -outputs = L.lens g s where - g = txOutputs - s tx o = tx { txOutputs = o } - -returnCollateral :: L.Lens' Tx (Maybe TxOut) -returnCollateral = L.lens g s where - g = txReturnCollateral - s tx o = tx { txReturnCollateral = o } - -totalCollateral :: L.Lens' Tx (Maybe C.Lovelace) -totalCollateral = L.lens g s where - g = txTotalCollateral - s tx o = tx { txTotalCollateral = o } - --- | The validity range of a transaction. -validRange :: L.Lens' Tx SlotRange -validRange = L.lens g s where - g = txValidRange - s tx o = tx { txValidRange = o } - -signatures :: L.Lens' Tx (Map PubKey Signature) -signatures = L.lens g s where - g = txSignatures - s tx sig = tx { txSignatures = sig } - -fee :: L.Lens' Tx C.Lovelace -fee = L.lens g s where - g = txFee - s tx v = tx { txFee = v } - -mint :: L.Lens' Tx C.Value -mint = L.lens g s where - g = txMint - s tx v = tx { txMint = v } - -mintScripts :: L.Lens' Tx MintingWitnessesMap -mintScripts = L.lens g s where - g = txMintingWitnesses - s tx fs = tx { txMintingWitnesses = fs } - -scriptWitnesses :: L.Lens' Tx ScriptsMap -scriptWitnesses = L.lens g s where - g = txScripts - s tx fs = tx { txScripts = fs } - -datumWitnesses :: L.Lens' Tx (Map DatumHash Datum) -datumWitnesses = L.lens g s where - g = txData - s tx dat = tx { txData = dat } - --- | The inputs of a transaction. -metadata :: L.Lens' Tx (Maybe BuiltinByteString) -metadata = L.lens g s where - g = txMetadata - s tx i = tx { txMetadata = i } - -lookupSignature :: PubKey -> Tx -> Maybe Signature -lookupSignature s Tx{txSignatures} = Map.lookup s txSignatures - -lookupDatum :: Tx -> DatumHash -> Maybe Datum -lookupDatum Tx{txData} h = Map.lookup h txData - -txOutValue :: TxOut -> C.Value -txOutValue (TxOut (C.TxOut _aie tov _tod _rs)) = - C.txOutValueToValue tov - -outValue :: L.Lens TxOut TxOut C.Value (C.TxOutValue C.BabbageEra) -outValue = L.lens - txOutValue - (\(TxOut (C.TxOut aie _ tod rs)) tov -> TxOut (C.TxOut aie tov tod rs)) - -outValue' :: L.Lens' TxOut (C.TxOutValue C.BabbageEra) -outValue' = L.lens - (\(TxOut (C.TxOut _aie tov _tod _rs)) -> tov) - (\(TxOut (C.TxOut aie _ tod rs)) tov -> TxOut (C.TxOut aie tov tod rs)) - --- | A babbage era transaction without witnesses for its inputs. -data TxStripped = TxStripped { - txStrippedInputs :: [TxOutRef], - -- ^ The inputs to this transaction, as transaction output references only. - txStrippedReferenceInputs :: [TxOutRef], - -- ^ The reference inputs to this transaction, as transaction output references only. - txStrippedOutputs :: [TxOut], - -- ^ The outputs of this transation. - txStrippedMint :: !C.Value, - -- ^ The 'Value' minted by this transaction. - txStrippedFee :: !C.Lovelace - -- ^ The fee for this transaction. - } deriving (Show, Eq, Generic, Serialise) - -strip :: Tx -> TxStripped -strip Tx{..} = TxStripped i ri txOutputs txMint txFee where - i = map txInputRef txInputs - ri = map txInputRef txReferenceInputs - --- | A 'TxOut' along with the 'Tx' it comes from, which may have additional information e.g. --- the full data script that goes with the 'TxOut'. -data TxOutTx = TxOutTx { txOutTxTx :: Tx, txOutTxOut :: TxOut } - deriving stock (Show, Eq, Generic) - deriving anyclass (Serialise, ToJSON, FromJSON) - -txOutTxDatum :: TxOutTx -> Maybe Datum -txOutTxDatum (TxOutTx tx (TxOut (C.TxOut _aie _tov tod _rs))) = - case tod of - C.TxOutDatumNone -> - Nothing - C.TxOutDatumHash _era scriptDataHash -> - lookupDatum tx $ DatumHash $ PlutusTx.toBuiltin (C.serialiseToRawBytes scriptDataHash) - C.TxOutDatumInline _era scriptData -> - Just $ Datum $ dataToBuiltinData $ C.toPlutusData scriptData - C.TxOutDatumInTx _era scriptData -> - Just $ Datum $ dataToBuiltinData $ C.toPlutusData scriptData - -- | Get a hash from the stored TxOutDatum (either dirctly or by hashing the inlined datum) txOutDatumHash :: TxOut -> Maybe DatumHash txOutDatumHash (TxOut (C.TxOut _aie _tov tod _rs)) = @@ -485,14 +284,6 @@ lookupValidator txScripts = (fmap . fmap) Validator . lookupScript txScripts . t where toScriptHash (ValidatorHash b) = ScriptHash b --- | The transaction output references consumed by a transaction. -spentOutputs :: Tx -> [TxOutRef] -spentOutputs = map txInputRef . txInputs - --- | The transaction output references referenced by a transaction. -referencedOutputs :: Tx -> [TxOutRef] -referencedOutputs = map txInputRef . txReferenceInputs - lookupMintingPolicy :: ScriptsMap -> MintingPolicyHash -> Maybe (Versioned MintingPolicy) lookupMintingPolicy txScripts = (fmap . fmap) MintingPolicy . lookupScript txScripts . toScriptHash where @@ -503,71 +294,5 @@ lookupStakeValidator txScripts = (fmap . fmap) StakeValidator . lookupScript txS where toScriptHash (StakeValidatorHash b) = ScriptHash b --- | Translate TxInput to old Plutus.V1.Ledger.Api TxIn taking script and datum witnesses from Tx. -fillTxInputWitnesses :: Tx -> TxInput -> TxIn -fillTxInputWitnesses tx (TxInput outRef _inType) = case _inType of - TxConsumePublicKeyAddress -> TxIn outRef (Just ConsumePublicKeyAddress) - TxConsumeSimpleScriptAddress -> TxIn outRef (Just ConsumeSimpleScriptAddress) - TxScriptAddress redeemer (Left vlh) dh -> TxIn outRef $ do - datum <- traverse (`Map.lookup` txData tx) dh - validator <- lookupValidator (txScripts tx) vlh - Just $ ScriptAddress (Left validator) redeemer datum - TxScriptAddress redeemer (Right ref) dh -> TxIn outRef $ do - datum <- traverse (`Map.lookup` txData tx) dh - Just $ ScriptAddress (Right ref) redeemer datum - pubKeyTxInput :: TxOutRef -> TxInput pubKeyTxInput outRef = TxInput outRef TxConsumePublicKeyAddress - --- | Add minting policy together with the redeemer into txMintingWitnesses and txScripts accordingly. Doesn't alter txMint. -addMintingPolicy :: Versioned MintingPolicy -> (Redeemer, Maybe (Versioned TxOutRef)) -> Tx -> Tx -addMintingPolicy vvl rdWithRef tx@Tx{txMintingWitnesses, txScripts} = tx - {txMintingWitnesses = Map.insert mph rdWithRef txMintingWitnesses, - txScripts = Map.insert (ScriptHash b) (fmap getMintingPolicy vvl) txScripts} - where - mph@(MintingPolicyHash b) = mintingPolicyHash vvl - --- | Add validator together with the redeemer and datum into txInputs, txData and txScripts accordingly. --- Datum is optional if the input refers to a script output which contains an inline datum -addScriptTxInput :: TxOutRef -> Versioned Validator -> Redeemer -> Maybe Datum -> Tx -> Tx -addScriptTxInput outRef vl rd mdt tx@Tx{txInputs, txScripts, txData} = tx - {txInputs = TxInput outRef (TxScriptAddress rd (Left vlHash) mdtHash) : txInputs, - txScripts = Map.insert (ScriptHash b) (fmap getValidator vl) txScripts, - txData = maybe txData (\dt -> Map.insert (datumHash dt) dt txData) mdt} - where - mdtHash = fmap datumHash mdt - vlHash@(ValidatorHash b) = validatorHash vl - --- | Add script reference together with the redeemer and datum into txInputs and txData accordingly. --- Datum is optional if the input refers to a script output which contains an inline datum -addReferenceTxInput :: TxOutRef -> Versioned TxOutRef -> Redeemer -> Maybe Datum -> Tx -> Tx -addReferenceTxInput outRef vref rd mdt tx@Tx{txInputs, txData} = tx - {txInputs = TxInput outRef (TxScriptAddress rd (Right vref) mdtHash) : txInputs, - txData = maybe txData (\dt -> Map.insert (datumHash dt) dt txData) mdt} - where - mdtHash = fmap datumHash mdt - -txRedeemers :: Tx -> Map ScriptPurpose Redeemer -txRedeemers = (Map.mapKeys Spending . txSpendingRedeemers) - <> (Map.mapKeys (Minting . mpsSymbol) . txMintingRedeemers) - <> (Map.mapKeys (Rewarding . StakingHash) . txRewardingRedeemers) - <> (Map.mapKeys Certifying . txCertifyingRedeemers) - -txSpendingRedeemers :: Tx -> Map TxOutRef Redeemer -txSpendingRedeemers Tx{txInputs} = flip execState Map.empty $ traverse_ extract txInputs where - extract TxInput{txInputType=TxScriptAddress redeemer _ _, txInputRef} = - modify' $ Map.insert txInputRef redeemer - extract _ = return () - -txMintingRedeemers :: Tx -> Map MintingPolicyHash Redeemer -txMintingRedeemers Tx{txMintingWitnesses} = Map.map fst txMintingWitnesses - -txRewardingRedeemers :: Tx -> Map Credential Redeemer -txRewardingRedeemers Tx{txWithdrawals} = flip execState Map.empty $ traverse_ f txWithdrawals where - f (Withdrawal cred _ (Just rd)) = modify' $ Map.insert cred rd - f _ = return () - -txCertifyingRedeemers :: Tx -> Map DCert Redeemer -txCertifyingRedeemers Tx{txCertificates} = flip execState Map.empty $ traverse_ f txCertificates where - f (Certificate dcert (Just rd)) = modify' $ Map.insert dcert rd - f _ = return () diff --git a/plutus-ledger/src/Ledger/Tx/Orphans.hs b/plutus-ledger/src/Ledger/Tx/Orphans.hs index 9b321780f4..abdd32641e 100644 --- a/plutus-ledger/src/Ledger/Tx/Orphans.hs +++ b/plutus-ledger/src/Ledger/Tx/Orphans.hs @@ -33,8 +33,8 @@ instance ToJSON (C.Tx C.BabbageEra) where instance FromJSON (C.Tx C.BabbageEra) where parseJSON (Object v) = do envelope <- v .: "tx" - either (const $ parseFail "Failed to parse BabbageEra 'tx' field from SomeCardanoApiTx") + either (const $ parseFail "Failed to parse BabbageEra 'tx' field from CardanoTx") pure $ C.deserialiseFromTextEnvelope (C.AsTx C.AsBabbageEra) envelope parseJSON invalid = - prependFailure "parsing SomeCardanoApiTx failed, " (typeMismatch "Object" invalid) + prependFailure "parsing CardanoTx failed, " (typeMismatch "Object" invalid) diff --git a/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs b/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs index d6e74234a9..fa7ad0ef89 100644 --- a/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs +++ b/plutus-ledger/test/Ledger/Tx/CardanoAPISpec.hs @@ -8,28 +8,18 @@ import Cardano.Api (AsType (AsPaymentKey, AsStakeKey), Key (verificationKeyHash) NetworkMagic (NetworkMagic), PaymentCredential (PaymentCredentialByKey), StakeAddressReference (NoStakeAddress, StakeAddressByValue), StakeCredential, makeShelleyAddress, shelleyAddressInEra) -import Cardano.Api.Shelley (StakeCredential (StakeCredentialByKey), TxBody (ShelleyTxBody)) +import Cardano.Api.Shelley (StakeCredential (StakeCredentialByKey)) import Gen.Cardano.Api.Typed (genAssetName, genTxId, genValueDefault) import Gen.Cardano.Api.Typed qualified as Gen -import Ledger (toPlutusAddress) -import Ledger.Test (someValidator) -import Ledger.Tx (Language (PlutusV1), Tx (txMint), Versioned (Versioned), addMintingPolicy) -import Ledger.Tx.CardanoAPI (fromCardanoAssetName, fromCardanoTxId, fromCardanoValue, makeTransactionBody, - toCardanoAddressInEra, toCardanoAssetName, toCardanoPolicyId, toCardanoTxBodyContent, - toCardanoTxId, toCardanoValue) -import Ledger.Value.CardanoAPI (combine, valueFromList, valueGeq) -import Plutus.Script.Utils.V1.Scripts qualified as PV1 -import Plutus.Script.Utils.V1.Typed.Scripts.MonetaryPolicies qualified as MPS -import Plutus.V1.Ledger.Scripts (unitRedeemer) -import PlutusTx.Lattice ((\/)) - -import Cardano.Api qualified as C -import Data.Default (def) -import Data.Function ((&)) import Hedgehog (Gen, Property, forAll, property, tripping, (===)) import Hedgehog qualified import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range +import Ledger (toPlutusAddress) +import Ledger.Tx.CardanoAPI (fromCardanoAssetName, fromCardanoTxId, fromCardanoValue, toCardanoAddressInEra, + toCardanoAssetName, toCardanoTxId, toCardanoValue) +import Ledger.Value.CardanoAPI (combine, valueFromList, valueGeq) +import PlutusTx.Lattice ((\/)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testPropertyNamed) @@ -38,7 +28,6 @@ tests = testGroup "CardanoAPI" [ testGroup "Ledger.Tx.CardanoAPI" [ testPropertyNamed "Cardano Address -> Plutus Address roundtrip" "addressRoundTripSpec" addressRoundTripSpec - , testPropertyNamed "Tx conversion retains minting policy scripts" "txConversionRetainsMPS" convertMintingTx , testPropertyNamed "TokenName <- Cardano AssetName roundtrip" "cardanoAssetNameRoundTrip" cardanoAssetNameRoundTrip , testPropertyNamed "Plutus Value <- Cardano Value roundtrip" "cardanoValueRoundTrip" cardanoValueRoundTrip , testPropertyNamed "TxId round trip" "cardanoValueRoundTrip" cardanoTxIdRoundTrip @@ -109,25 +98,6 @@ genNetworkId = genNetworkMagic :: Gen NetworkMagic genNetworkMagic = NetworkMagic <$> Gen.word32 Range.constantBounded - -convertMintingTx :: Property -convertMintingTx = property $ do - let vHash = PV1.validatorHash someValidator - mps = MPS.mkForwardingMintingPolicy vHash - policyId <- either (\err -> do Hedgehog.annotateShow err; Hedgehog.failure) pure $ - toCardanoPolicyId (PV1.mintingPolicyHash mps) - let vL n = C.valueFromList [(C.AssetId policyId "L", n)] - tx = mempty { txMint = vL 1 } - & addMintingPolicy (Versioned mps PlutusV1) (unitRedeemer, Nothing) - ectx = toCardanoTxBodyContent (Testnet $ NetworkMagic 1) def [] tx >>= makeTransactionBody Nothing mempty - case ectx of - -- Check that the converted tx contains exactly one script - Right (ShelleyTxBody _ _ [_script] _ _ _) -> do - Hedgehog.success - msg -> do - Hedgehog.annotateShow msg - Hedgehog.failure - combineLeftId :: Property combineLeftId = property $ do valueL <- forAll genValueDefault diff --git a/plutus-ledger/test/Spec.hs b/plutus-ledger/test/Spec.hs index 62908b99dd..734b41c9b3 100644 --- a/plutus-ledger/test/Spec.hs +++ b/plutus-ledger/test/Spec.hs @@ -19,7 +19,7 @@ import Hedgehog.Range qualified as Range import Ledger (Slot (Slot)) import Ledger.Interval qualified as Interval import Ledger.Tx qualified as Tx -import Ledger.Tx.CardanoAPI (CardanoBuildTx (CardanoBuildTx), SomeCardanoApiTx (SomeTx)) +import Ledger.Tx.CardanoAPI (CardanoBuildTx (CardanoBuildTx), CardanoTx (CardanoTx)) import Ledger.Tx.CardanoAPI qualified as CardanoAPI import Ledger.Tx.CardanoAPISpec qualified import Plutus.Script.Utils.Ada qualified as Ada @@ -55,8 +55,8 @@ tests = testGroup "all tests" [ testGroup "TxIn" [ testPropertyNamed "Check that Ord instances of TxIn match" "txInOrdInstanceEquivalenceTest" txInOrdInstanceEquivalenceTest ], - testGroup "SomeCardanoApiTx" [ - testPropertyNamed "Value ToJSON/FromJSON" "genSomeCardanoApiTx" (jsonRoundTrip genSomeCardanoApiTx) + testGroup "CardanoTx" [ + testPropertyNamed "Value ToJSON/FromJSON" "genCardanoTx" (jsonRoundTrip genCardanoTx) ], testGroup "CardanoBuildTx" [ testPropertyNamed "Value ToJSON/FromJSON" "genCardanoBuildTx" (jsonRoundTrip genCardanoBuildTx) @@ -148,8 +148,8 @@ genCardanoBuildTx = do -- TODO Unfortunately, there's no way to get a warning if another era has been -- added to EraInMode. Alternative way? -genSomeCardanoApiTx :: Hedgehog.Gen SomeCardanoApiTx -genSomeCardanoApiTx = Gen.choice [ genByronEraInCardanoModeTx +genCardanoTx :: Hedgehog.Gen CardanoTx +genCardanoTx = Gen.choice [ genByronEraInCardanoModeTx , genShelleyEraInCardanoModeTx , genAllegraEraInCardanoModeTx , genMaryEraInCardanoModeTx @@ -157,32 +157,32 @@ genSomeCardanoApiTx = Gen.choice [ genByronEraInCardanoModeTx , genBabbageEraInCardanoModeTx ] -genByronEraInCardanoModeTx :: Hedgehog.Gen SomeCardanoApiTx +genByronEraInCardanoModeTx :: Hedgehog.Gen CardanoTx genByronEraInCardanoModeTx = do tx <- fromGenT $ Gen.genTx C.ByronEra - pure $ SomeTx tx C.ByronEraInCardanoMode + pure $ CardanoTx tx C.ByronEraInCardanoMode -genShelleyEraInCardanoModeTx :: Hedgehog.Gen SomeCardanoApiTx +genShelleyEraInCardanoModeTx :: Hedgehog.Gen CardanoTx genShelleyEraInCardanoModeTx = do tx <- fromGenT $ Gen.genTx C.ShelleyEra - pure $ SomeTx tx C.ShelleyEraInCardanoMode + pure $ CardanoTx tx C.ShelleyEraInCardanoMode -genAllegraEraInCardanoModeTx :: Hedgehog.Gen SomeCardanoApiTx +genAllegraEraInCardanoModeTx :: Hedgehog.Gen CardanoTx genAllegraEraInCardanoModeTx = do tx <- fromGenT $ Gen.genTx C.AllegraEra - pure $ SomeTx tx C.AllegraEraInCardanoMode + pure $ CardanoTx tx C.AllegraEraInCardanoMode -genMaryEraInCardanoModeTx :: Hedgehog.Gen SomeCardanoApiTx +genMaryEraInCardanoModeTx :: Hedgehog.Gen CardanoTx genMaryEraInCardanoModeTx = do tx <- fromGenT $ Gen.genTx C.MaryEra - pure $ SomeTx tx C.MaryEraInCardanoMode + pure $ CardanoTx tx C.MaryEraInCardanoMode -genAlonzoEraInCardanoModeTx :: Hedgehog.Gen SomeCardanoApiTx +genAlonzoEraInCardanoModeTx :: Hedgehog.Gen CardanoTx genAlonzoEraInCardanoModeTx = do tx <- fromGenT $ Gen.genTx C.AlonzoEra - pure $ SomeTx tx C.AlonzoEraInCardanoMode + pure $ CardanoTx tx C.AlonzoEraInCardanoMode -genBabbageEraInCardanoModeTx :: Hedgehog.Gen SomeCardanoApiTx +genBabbageEraInCardanoModeTx :: Hedgehog.Gen CardanoTx genBabbageEraInCardanoModeTx = do tx <- fromGenT $ Gen.genTx C.BabbageEra - pure $ SomeTx tx C.BabbageEraInCardanoMode + pure $ CardanoTx tx C.BabbageEraInCardanoMode diff --git a/plutus-pab-executables/test/full/Plutus/PAB/CoreSpec.hs b/plutus-pab-executables/test/full/Plutus/PAB/CoreSpec.hs index 03f4ed9521..3699b9f4c2 100644 --- a/plutus-pab-executables/test/full/Plutus/PAB/CoreSpec.hs +++ b/plutus-pab-executables/test/full/Plutus/PAB/CoreSpec.hs @@ -49,8 +49,7 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Extras (tshow) import Ledger (Address, PaymentPubKeyHash (unPaymentPubKeyHash), cardanoPubKeyHash, getCardanoTxFee, getCardanoTxId, - getCardanoTxOutRefs, pubKeyAddress, pubKeyHash, pubKeyHashAddress, txId, txOutAddress, txOutRefId, - txOutRefs, txOutputs) + getCardanoTxOutRefs, pubKeyAddress, pubKeyHash, pubKeyHashAddress, txOutAddress, txOutRefId) import Ledger qualified import Ledger.AddressMap qualified as AM import Ledger.CardanoWallet qualified as CW diff --git a/plutus-pab-executables/tx-inject/Main.hs b/plutus-pab-executables/tx-inject/Main.hs index 3c887a3627..7c27acd600 100644 --- a/plutus-pab-executables/tx-inject/Main.hs +++ b/plutus-pab-executables/tx-inject/Main.hs @@ -41,7 +41,7 @@ import Data.Either (fromRight) import Ledger.Blockchain (OnChainTx (..)) import Ledger.Index (UtxoIndex (..), insertBlock) import Ledger.Slot (Slot (..)) -import Ledger.Tx (CardanoTx (..), SomeCardanoApiTx (CardanoApiEmulatorEraTx)) +import Ledger.Tx (CardanoTx (..)) import Ledger.Value.CardanoAPI qualified as CardanoAPI import Plutus.PAB.Types (Config (..)) import TxInject.RandomTx (generateTx) @@ -94,7 +94,7 @@ runProducer AppEnv{txQueue, stats, utxoIndex} = do -- boundaries. We don't currently use boundaries for our generated -- transactions, so we chose the random number. tx <- generateTx rng (Slot 4) utxo - let utxo' = insertBlock [Valid $ CardanoApiTx $ CardanoApiEmulatorEraTx tx] utxo + let utxo' = insertBlock [Valid $ CardanoEmulatorEraTx tx] utxo atomically $ do writeTBQueue txQueue tx modifyTVar' stats $ \s -> s { stUtxoSize = Map.size $ getIndex utxo' } diff --git a/plutus-pab-executables/tx-inject/TxInject/RandomTx.hs b/plutus-pab-executables/tx-inject/TxInject/RandomTx.hs index 36fbd91f54..23316fc216 100644 --- a/plutus-pab-executables/tx-inject/TxInject/RandomTx.hs +++ b/plutus-pab-executables/tx-inject/TxInject/RandomTx.hs @@ -26,8 +26,7 @@ import Ledger.Address (CardanoAddress) import Ledger.CardanoWallet qualified as CW import Ledger.Index (UtxoIndex (..)) import Ledger.Slot (Slot (..)) -import Ledger.Tx (CardanoTx (CardanoApiTx, EmulatorTx), SomeCardanoApiTx (CardanoApiEmulatorEraTx), - TxInType (ConsumePublicKeyAddress), txOutAddress, txOutValue) +import Ledger.Tx (CardanoTx (CardanoEmulatorEraTx), TxInType (ConsumePublicKeyAddress), txOutAddress, txOutValue) import Ledger.Tx.CardanoAPI (fromPlutusIndex) import Ledger.Value.CardanoAPI (isAdaOnlyValue) @@ -85,18 +84,15 @@ generateTx gen slot (UtxoIndex utxo) = do inputs -- inputs of the transaction sourceTxIns = fmap ((`TxInputWitnessed` ConsumePublicKeyAddress) . fst) inputs - EmulatorTx tx <- Gen.sample $ + txn@(CardanoEmulatorEraTx cTx) <- Gen.sample $ Generators.genValidTransactionSpending sourceTxIns sourceAda slotCfg <- Gen.sample Generators.genSlotConfig let params = def { pSlotConfig = slotCfg } utxoIndex = either (error . show) id $ fromPlutusIndex $ UtxoIndex utxo - txn = Validation.fromPlutusTxSigned params utxoIndex tx CW.knownPaymentKeys validationResult = Validation.validateCardanoTx params slot utxoIndex txn case validationResult of - Left _ -> case txn of - CardanoApiTx (CardanoApiEmulatorEraTx cTx) -> pure cTx - EmulatorTx _ -> error "fromPlutusTxSigned can't generate an Emulator tx" + Left _ -> pure cTx Right _ -> generateTx gen slot (UtxoIndex utxo) keyPairs :: NonEmpty CardanoAddress diff --git a/plutus-pab/src/Cardano/BM/Data/Tracer/Extras.hs b/plutus-pab/src/Cardano/BM/Data/Tracer/Extras.hs index 25a65f0e39..d77d57ed92 100644 --- a/plutus-pab/src/Cardano/BM/Data/Tracer/Extras.hs +++ b/plutus-pab/src/Cardano/BM/Data/Tracer/Extras.hs @@ -24,7 +24,7 @@ import Data.Tagged (Tagged (Tagged)) import Data.Text (Text) import Data.UUID (UUID) import GHC.TypeLits (KnownSymbol, symbolVal) -import Ledger.Tx (Tx) +import Ledger.Tx (CardanoTx) import Plutus.Contract.Checkpoint (CheckpointLogMsg) import Plutus.Contract.Resumable (Response (..)) import Plutus.Contract.State (ContractRequest) @@ -79,7 +79,7 @@ deriving via (Tagged "contract_instance_iteration" IterationID) instance Structu deriving via (Tagged "message" CheckpointLogMsg) instance StructuredLog CheckpointLogMsg deriving via (Tagged "message" RequestHandlerLogMsg) instance StructuredLog RequestHandlerLogMsg deriving via (Tagged "message" TxBalanceMsg) instance StructuredLog TxBalanceMsg -deriving via (Tagged "tx" Tx) instance StructuredLog Tx +deriving via (Tagged "tx" CardanoTx) instance StructuredLog CardanoTx deriving via (Tagged "uuid" UUID) instance StructuredLog UUID deriving via (Tagged "request" (ContractRequest w v)) instance (ToJSON w, ToJSON v) => StructuredLog (ContractRequest w v) deriving via (Tagged "value" V.Value) instance StructuredLog V.Value diff --git a/plutus-pab/src/Cardano/Node/Client.hs b/plutus-pab/src/Cardano/Node/Client.hs index 80dcaec1a3..a797ab080c 100644 --- a/plutus-pab/src/Cardano/Node/Client.hs +++ b/plutus-pab/src/Cardano/Node/Client.hs @@ -14,7 +14,7 @@ import Control.Monad.Freer.Error (Error, throwError) import Control.Monad.Freer.Reader (Reader, ask) import Control.Monad.IO.Class import Data.Proxy (Proxy (Proxy)) -import Ledger (SomeCardanoApiTx (CardanoApiEmulatorEraTx), onCardanoTx) +import Ledger (CardanoTx (CardanoEmulatorEraTx)) import Servant (NoContent, (:<|>) (..)) import Servant.Client (ClientM, client) @@ -59,11 +59,7 @@ handleNodeClientClient params e = do -- need to be sent via the wallet, not the mocked server node -- (which is not actually running). throwError TxSenderNotAvailable - Just handle -> - liftIO $ - onCardanoTx (const $ error "Cardano.Node.Client: Expecting a cardano-api tx, not a mock when publishing it.") - (MockClient.queueTx handle . (\(CardanoApiEmulatorEraTx c) -> c)) - tx + Just handle -> liftIO $ (MockClient.queueTx handle . (\(CardanoEmulatorEraTx c) -> c)) tx GetClientSlot -> either (liftIO . MockClient.getCurrentSlot) (liftIO . Client.getCurrentSlot) diff --git a/plutus-pab/src/Cardano/Protocol/Socket/Mock/Server.hs b/plutus-pab/src/Cardano/Protocol/Socket/Mock/Server.hs index 25123ae69b..1dae8a125d 100644 --- a/plutus-pab/src/Cardano/Protocol/Socket/Mock/Server.hs +++ b/plutus-pab/src/Cardano/Protocol/Socket/Mock/Server.hs @@ -53,7 +53,7 @@ import Cardano.Chain (MockNodeServerChainState (..), addTxToPool, chainNewestFir getTip, handleControlChain, tip, txPool) import Cardano.Node.Emulator.Chain qualified as Chain import Cardano.Node.Emulator.Params (Params) -import Ledger (Block, CardanoTx (..), Slot (..), SomeCardanoApiTx (CardanoApiEmulatorEraTx)) +import Ledger (Block, CardanoTx (..), Slot (..)) data CommandChannel = CommandChannel { ccCommand :: TQueue ServerCommand @@ -153,7 +153,7 @@ handleCommand :: handleCommand trace CommandChannel {ccCommand, ccResponse} mvChainState params = liftIO (atomically $ readTQueue ccCommand) >>= \case AddTx tx -> do - liftIO $ modifyMVar_ mvChainState (pure . over txPool (CardanoApiTx (CardanoApiEmulatorEraTx tx) :)) + liftIO $ modifyMVar_ mvChainState (pure . over txPool ((CardanoEmulatorEraTx tx) :)) ModifySlot f -> liftIO $ do state <- liftIO $ takeMVar mvChainState (s, nextState') <- liftIO $ Chain.modifySlot f @@ -480,7 +480,7 @@ txSubmissionServer state = txSubmissionState TxSubmission.LocalTxSubmissionServer { TxSubmission.recvMsgSubmitTx = \tx -> do - modifyMVar_ state (pure . over txPool (addTxToPool (CardanoApiTx $ CardanoApiEmulatorEraTx tx))) + modifyMVar_ state (pure . over txPool (addTxToPool (CardanoEmulatorEraTx tx))) return (TxSubmission.SubmitSuccess, txSubmissionState) , TxSubmission.recvMsgDone = () } diff --git a/plutus-pab/src/Cardano/Wallet/LocalClient.hs b/plutus-pab/src/Cardano/Wallet/LocalClient.hs index 67e75e8a17..c622cdb2f8 100644 --- a/plutus-pab/src/Cardano/Wallet/LocalClient.hs +++ b/plutus-pab/src/Cardano/Wallet/LocalClient.hs @@ -13,7 +13,6 @@ module Cardano.Wallet.LocalClient where import Cardano.Api (shelleyAddressInEra) import Cardano.Api qualified -import Cardano.Node.Emulator.Params (Params (..)) import Cardano.Node.Types (PABServerConfig (pscPassphrase)) import Cardano.Wallet.Api qualified as C import Cardano.Wallet.Api.Client qualified as C @@ -47,8 +46,8 @@ import Data.Proxy (Proxy (Proxy)) import Data.Quantity (Quantity (Quantity)) import Data.Text (Text, pack) import Data.Text.Class (fromText) -import Ledger (CardanoAddress, CardanoTx (..)) -import Ledger.Tx.CardanoAPI (SomeCardanoApiTx (SomeTx), ToCardanoError, toCardanoTxBody) +import Ledger (CardanoAddress) +import Ledger.Tx.CardanoAPI (CardanoTx (CardanoTx), ToCardanoError) import Ledger.Tx.Constraints.OffChain (UnbalancedTx) import Plutus.PAB.Monitoring.PABLogMsg (WalletClientMsg (BalanceTxError, WalletClientError)) import Plutus.Script.Utils.Ada qualified as Ada @@ -104,7 +103,7 @@ handleWalletClient config (Wallet _ (WalletId wId)) event = do submitTxnH :: CardanoTx -> Eff effs () submitTxnH tx = do - sealedTx <- either (throwError . ToCardanoError) pure $ toSealedTx params tx + sealedTx <- either (throwError . ToCardanoError) pure $ toSealedTx tx void . runClient $ C.postExternalTransaction C.transactionClient (C.ApiBytesT (C.SerialisedTx $ C.serialisedTx sealedTx)) ownAddressesH :: Eff effs (NonEmpty CardanoAddress) @@ -137,7 +136,7 @@ handleWalletClient config (Wallet _ (WalletId wId)) event = do walletAddSignatureH :: CardanoTx -> Eff effs CardanoTx walletAddSignatureH tx = do - sealedTx <- either (throwError . ToCardanoError) pure $ toSealedTx params tx + sealedTx <- either (throwError . ToCardanoError) pure $ toSealedTx tx passphrase <- maybe (throwError $ OtherError "Wallet passphrase required") pure mpassphrase lenientPP <- either throwOtherError pure $ fromText passphrase let postData = C.ApiSignTransactionPostData (C.ApiT sealedTx) (C.ApiT lenientPP) @@ -169,22 +168,21 @@ tokenMapToValue :: C.TokenMap -> Value tokenMapToValue = Value . Map.fromList . fmap (bimap (currencySymbol . C.getHash . C.unTokenPolicyId) (Map.fromList . fmap (bimap (tokenName . C.unTokenName) (fromIntegral . C.unTokenQuantity)) . toList)) . C.toNestedList fromApiSerialisedTransaction :: C.ApiSerialisedTransaction -> CardanoTx -fromApiSerialisedTransaction (C.ApiSerialisedTransaction (C.ApiT sealedTx)) = CardanoApiTx $ case C.cardanoTxIdeallyNoLaterThan (Cardano.Api.anyCardanoEra Cardano.Api.BabbageEra) sealedTx of - Cardano.Api.InAnyCardanoEra Cardano.Api.ByronEra tx -> SomeTx tx Cardano.Api.ByronEraInCardanoMode - Cardano.Api.InAnyCardanoEra Cardano.Api.ShelleyEra tx -> SomeTx tx Cardano.Api.ShelleyEraInCardanoMode - Cardano.Api.InAnyCardanoEra Cardano.Api.AllegraEra tx -> SomeTx tx Cardano.Api.AllegraEraInCardanoMode - Cardano.Api.InAnyCardanoEra Cardano.Api.MaryEra tx -> SomeTx tx Cardano.Api.MaryEraInCardanoMode - Cardano.Api.InAnyCardanoEra Cardano.Api.AlonzoEra tx -> SomeTx tx Cardano.Api.AlonzoEraInCardanoMode - Cardano.Api.InAnyCardanoEra Cardano.Api.BabbageEra tx -> SomeTx tx Cardano.Api.BabbageEraInCardanoMode - -toSealedTx :: Params -> CardanoTx -> Either ToCardanoError C.SealedTx -toSealedTx _ (CardanoApiTx (SomeTx tx Cardano.Api.ByronEraInCardanoMode)) = Right $ C.sealedTxFromCardano $ Cardano.Api.InAnyCardanoEra Cardano.Api.ByronEra tx -toSealedTx _ (CardanoApiTx (SomeTx tx Cardano.Api.ShelleyEraInCardanoMode)) = Right $ C.sealedTxFromCardano $ Cardano.Api.InAnyCardanoEra Cardano.Api.ShelleyEra tx -toSealedTx _ (CardanoApiTx (SomeTx tx Cardano.Api.AllegraEraInCardanoMode)) = Right $ C.sealedTxFromCardano $ Cardano.Api.InAnyCardanoEra Cardano.Api.AllegraEra tx -toSealedTx _ (CardanoApiTx (SomeTx tx Cardano.Api.MaryEraInCardanoMode)) = Right $ C.sealedTxFromCardano $ Cardano.Api.InAnyCardanoEra Cardano.Api.MaryEra tx -toSealedTx _ (CardanoApiTx (SomeTx tx Cardano.Api.AlonzoEraInCardanoMode)) = Right $ C.sealedTxFromCardano $ Cardano.Api.InAnyCardanoEra Cardano.Api.AlonzoEra tx -toSealedTx _ (CardanoApiTx (SomeTx tx Cardano.Api.BabbageEraInCardanoMode)) = Right $ C.sealedTxFromCardano $ Cardano.Api.InAnyCardanoEra Cardano.Api.BabbageEra tx -toSealedTx params (EmulatorTx tx) = C.sealedTxFromCardanoBody <$> toCardanoTxBody (pNetworkId params) (emulatorPParams params) [] tx +fromApiSerialisedTransaction (C.ApiSerialisedTransaction (C.ApiT sealedTx)) = case C.cardanoTxIdeallyNoLaterThan (Cardano.Api.anyCardanoEra Cardano.Api.BabbageEra) sealedTx of + Cardano.Api.InAnyCardanoEra Cardano.Api.ByronEra tx -> CardanoTx tx Cardano.Api.ByronEraInCardanoMode + Cardano.Api.InAnyCardanoEra Cardano.Api.ShelleyEra tx -> CardanoTx tx Cardano.Api.ShelleyEraInCardanoMode + Cardano.Api.InAnyCardanoEra Cardano.Api.AllegraEra tx -> CardanoTx tx Cardano.Api.AllegraEraInCardanoMode + Cardano.Api.InAnyCardanoEra Cardano.Api.MaryEra tx -> CardanoTx tx Cardano.Api.MaryEraInCardanoMode + Cardano.Api.InAnyCardanoEra Cardano.Api.AlonzoEra tx -> CardanoTx tx Cardano.Api.AlonzoEraInCardanoMode + Cardano.Api.InAnyCardanoEra Cardano.Api.BabbageEra tx -> CardanoTx tx Cardano.Api.BabbageEraInCardanoMode + +toSealedTx :: CardanoTx -> Either ToCardanoError C.SealedTx +toSealedTx (CardanoTx tx Cardano.Api.ByronEraInCardanoMode) = Right $ C.sealedTxFromCardano $ Cardano.Api.InAnyCardanoEra Cardano.Api.ByronEra tx +toSealedTx (CardanoTx tx Cardano.Api.ShelleyEraInCardanoMode) = Right $ C.sealedTxFromCardano $ Cardano.Api.InAnyCardanoEra Cardano.Api.ShelleyEra tx +toSealedTx (CardanoTx tx Cardano.Api.AllegraEraInCardanoMode) = Right $ C.sealedTxFromCardano $ Cardano.Api.InAnyCardanoEra Cardano.Api.AllegraEra tx +toSealedTx (CardanoTx tx Cardano.Api.MaryEraInCardanoMode) = Right $ C.sealedTxFromCardano $ Cardano.Api.InAnyCardanoEra Cardano.Api.MaryEra tx +toSealedTx (CardanoTx tx Cardano.Api.AlonzoEraInCardanoMode) = Right $ C.sealedTxFromCardano $ Cardano.Api.InAnyCardanoEra Cardano.Api.AlonzoEra tx +toSealedTx (CardanoTx tx Cardano.Api.BabbageEraInCardanoMode) = Right $ C.sealedTxFromCardano $ Cardano.Api.InAnyCardanoEra Cardano.Api.BabbageEra tx throwOtherError :: (Member (Error WalletAPIError) effs, Show err) => err -> Eff effs a throwOtherError = throwError . OtherError . pack . show diff --git a/plutus-pab/src/Cardano/Wallet/LocalClient/ExportTx.hs b/plutus-pab/src/Cardano/Wallet/LocalClient/ExportTx.hs index d8392ca08c..c9e1fcd28c 100644 --- a/plutus-pab/src/Cardano/Wallet/LocalClient/ExportTx.hs +++ b/plutus-pab/src/Cardano/Wallet/LocalClient/ExportTx.hs @@ -24,7 +24,7 @@ module Cardano.Wallet.LocalClient.ExportTx( ) where import Cardano.Api qualified as C -import Cardano.Node.Emulator.Params (Params (emulatorPParams, pNetworkId)) +import Cardano.Node.Emulator.Params (Params) import Cardano.Node.Emulator.Validation (CardanoLedgerError, makeTransactionBody) import Control.Applicative ((<|>)) import Control.Monad ((>=>)) @@ -33,23 +33,20 @@ import Control.Monad.Freer.Error (Error, throwError) import Data.Aeson (FromJSON (parseJSON), Object, ToJSON (toJSON), Value (String), object, withObject, (.:), (.=)) import Data.Aeson.Extras qualified as JSON import Data.Aeson.Types (Parser, parseFail) -import Data.Bifunctor (Bifunctor (bimap), first) +import Data.Bifunctor (first) import Data.Map (Map) import Data.Map qualified as Map import Data.Maybe (mapMaybe) -import Data.Set qualified as Set import Data.Typeable (Typeable) import GHC.Generics (Generic) -import Ledger (DCert, Redeemer, StakingCredential, txRedeemers) -import Ledger qualified (ScriptPurpose (..)) +import Ledger (DCert, StakingCredential) import Ledger qualified as P import Ledger.Tx (CardanoTx, TxId (TxId), TxOutRef) import Ledger.Tx.CardanoAPI (fromPlutusIndex) -import Ledger.Tx.Constraints (UnbalancedTx (UnbalancedCardanoTx, UnbalancedEmulatorTx)) +import Ledger.Tx.Constraints (UnbalancedTx (UnbalancedCardanoTx)) import Plutus.Contract.CardanoAPI qualified as CardanoAPI import Plutus.V1.Ledger.Api qualified as Plutus import Plutus.V1.Ledger.Scripts (MintingPolicyHash) -import Plutus.V1.Ledger.Value (currencyMPSHash) import PlutusTx qualified import Wallet.API qualified as WAPI import Wallet.Effects (WalletEffect, balanceTx, yieldUnbalancedTx) @@ -230,12 +227,6 @@ export :: Params -> UnbalancedTx -> Either CardanoLedgerError ExportTx -export params (UnbalancedEmulatorTx tx sigs utxos) = - let requiredSigners = Set.toList sigs - in ExportTx - <$> bimap Right (C.makeSignedTransaction []) (CardanoAPI.toCardanoTxBody (pNetworkId params) (emulatorPParams params) requiredSigners tx) - <*> first Right (mkInputs utxos) - <*> pure (mkRedeemers tx) export params (UnbalancedCardanoTx tx utxos) = let fromCardanoTx ctx = do utxo <- fromPlutusIndex $ P.UtxoIndex utxos @@ -259,14 +250,3 @@ toExportTxInput Plutus.TxOutRef{Plutus.txOutRefId, Plutus.txOutRefIdx} txOut = d <*> pure (C.selectLovelace cardanoValue) <*> sequence (CardanoAPI.toCardanoScriptDataHash <$> P.txOutDatumHash txOut) <*> pure otherQuantities - --- TODO: Here there's hidden error of script DCert missing its redeemer - this just counts as no DCert. Don't know if bad. --- TODO: Refactor with getGardanoTxRedeemers once we are ceady to move to Cardano Txs -mkRedeemers :: P.Tx -> [ExportTxRedeemer] -mkRedeemers = map (uncurry scriptPurposeToExportRedeemer) . Map.assocs . txRedeemers - -scriptPurposeToExportRedeemer :: Ledger.ScriptPurpose -> Redeemer -> ExportTxRedeemer -scriptPurposeToExportRedeemer (Ledger.Spending ref) rd = SpendingRedeemer {redeemerOutRef = ref, redeemer=rd} -scriptPurposeToExportRedeemer (Ledger.Minting cs) rd = MintingRedeemer {redeemerPolicyId = currencyMPSHash cs, redeemer=rd} -scriptPurposeToExportRedeemer (Ledger.Rewarding cred) rd = RewardingRedeemer {redeemerStakingCredential = cred, redeemer=rd} -scriptPurposeToExportRedeemer (Ledger.Certifying dcert) rd = CertifyingRedeemer {redeemerDCert = dcert, redeemer=rd} diff --git a/plutus-pab/src/Plutus/PAB/Arbitrary.hs b/plutus-pab/src/Plutus/PAB/Arbitrary.hs index f47cb71889..0e9f04dc05 100644 --- a/plutus-pab/src/Plutus/PAB/Arbitrary.hs +++ b/plutus-pab/src/Plutus/PAB/Arbitrary.hs @@ -26,8 +26,7 @@ import Ledger.Crypto (PubKey, Signature) import Ledger.Interval (Extended, Interval, LowerBound, UpperBound) import Ledger.Scripts (Language (..), Versioned (..)) import Ledger.Slot (Slot) -import Ledger.Tx (Certificate, RedeemerPtr, ScriptTag, Tx, TxId, TxIn, TxInType, TxInput, TxInputType, TxOutRef, - Withdrawal) +import Ledger.Tx (Certificate, RedeemerPtr, ScriptTag, TxId, TxIn, TxInType, TxInput, TxInputType, TxOutRef, Withdrawal) import Ledger.Tx.CardanoAPI (ToCardanoError, toCardanoAddressInEra, toCardanoTxOut) import Ledger.Tx.Constraints (MkTxError) import Ledger.Value.CardanoAPI (policyId) @@ -108,10 +107,6 @@ instance Arbitrary ToCardanoError where arbitrary = genericArbitrary shrink = genericShrink -instance Arbitrary Tx where - arbitrary = genericArbitrary - shrink = genericShrink - instance Arbitrary TxIn where arbitrary = genericArbitrary shrink = genericShrink diff --git a/plutus-pab/src/Plutus/PAB/Core/ContractInstance/RequestHandlers.hs b/plutus-pab/src/Plutus/PAB/Core/ContractInstance/RequestHandlers.hs index 305fceeb35..831a2f9b7f 100644 --- a/plutus-pab/src/Plutus/PAB/Core/ContractInstance/RequestHandlers.hs +++ b/plutus-pab/src/Plutus/PAB/Core/ContractInstance/RequestHandlers.hs @@ -20,7 +20,7 @@ import Data.Aeson qualified as JSON import Data.Aeson.Encode.Pretty qualified as JSON import Data.ByteString.Lazy.Char8 qualified as BSL8 import GHC.Generics (Generic) -import Ledger.Tx (Tx, txId) +import Ledger.Tx (CardanoTx, getCardanoTxId) import Plutus.Contract.Effects (PABReq (..), PABResp (..)) import Plutus.Contract.Resumable (IterationID, Request (..), Response (..)) import Plutus.Contract.Trace.RequestHandler (RequestHandlerLogMsg) @@ -50,7 +50,7 @@ data ContractInstanceMsg t = | ActivatedContractInstance (Contract.ContractDef t) Wallet ContractInstanceId | RunRequestHandler ContractInstanceId Int -- number of requests | RunRequestHandlerDidNotHandleAnyEvents - | StoringSignedTx Tx + | StoringSignedTx CardanoTx | CallingEndpoint String ContractInstanceId JSON.Value | ProcessContractInbox ContractInstanceId | HandlingRequest RequestHandlerLogMsg @@ -152,7 +152,7 @@ instance Pretty (Contract.ContractDef t) => Pretty (ContractInstanceMsg t) where ActivatedContractInstance _ wallet instanceID -> "Activated instance" <+> pretty instanceID <+> "on" <+> pretty wallet RunRequestHandler instanceID numRequests -> "Running request handler for" <+> pretty instanceID <+> "with" <+> pretty numRequests <+> "requests." RunRequestHandlerDidNotHandleAnyEvents -> "runRequestHandler: did not handle any requests" - StoringSignedTx tx -> "Storing signed tx" <+> pretty (txId tx) + StoringSignedTx tx -> "Storing signed tx" <+> pretty (getCardanoTxId tx) CallingEndpoint endpoint instanceID value -> "Calling endpoint" <+> pretty endpoint <+> "on instance" <+> pretty instanceID <+> "with" <+> viaShow value ProcessContractInbox i -> "Processing contract inbox for" <+> pretty i diff --git a/plutus-pab/src/Plutus/PAB/Events.hs b/plutus-pab/src/Plutus/PAB/Events.hs index 4dd6f2875a..7ee7718cd5 100644 --- a/plutus-pab/src/Plutus/PAB/Events.hs +++ b/plutus-pab/src/Plutus/PAB/Events.hs @@ -21,7 +21,7 @@ module Plutus.PAB.Events import Control.Lens.TH (makePrisms) import Data.Aeson (FromJSON, ToJSON, Value) import GHC.Generics (Generic) -import Ledger.Tx (Tx, txId) +import Ledger.Tx (CardanoTx, getCardanoTxId) import Plutus.Contract.Effects (PABReq, PABResp) import Plutus.Contract.State (ContractResponse) import Plutus.PAB.Webserver.Types (ContractActivationArgs) @@ -31,7 +31,7 @@ import Wallet.Types (ContractInstanceId) -- | A structure which ties together all possible event types into one parent. data PABEvent t = UpdateContractInstanceState !(ContractActivationArgs t) !ContractInstanceId !(ContractResponse Value Value PABResp PABReq) -- ^ Update the state of a contract instance - | SubmitTx !Tx -- ^ Send a transaction to the node + | SubmitTx !CardanoTx -- ^ Send a transaction to the node | ActivateContract !(ContractActivationArgs t) !ContractInstanceId | StopContract !ContractInstanceId deriving stock (Eq, Show, Generic) @@ -42,6 +42,6 @@ makePrisms ''PABEvent instance Pretty t => Pretty (PABEvent t) where pretty = \case UpdateContractInstanceState t i _ -> "Update state:" <+> pretty t <+> pretty i - SubmitTx t -> "SubmitTx:" <+> pretty (txId t) + SubmitTx t -> "SubmitTx:" <+> pretty (getCardanoTxId t) ActivateContract _ i -> "Start contract instance" <+> pretty i StopContract i -> "Stop contract instance" <+> pretty i diff --git a/plutus-pab/src/Plutus/PAB/Webserver/Types.hs b/plutus-pab/src/Plutus/PAB/Webserver/Types.hs index 3c27a53b26..51f4b4d933 100644 --- a/plutus-pab/src/Plutus/PAB/Webserver/Types.hs +++ b/plutus-pab/src/Plutus/PAB/Webserver/Types.hs @@ -29,7 +29,7 @@ import Data.OpenApi (NamedSchema (NamedSchema), OpenApiType (OpenApiObject), byt required, type_) import Data.OpenApi.Schema qualified as OpenApi import GHC.Generics (Generic) -import Ledger (Certificate, Datum, POSIXTime (POSIXTime), PaymentPubKeyHash (PaymentPubKeyHash), PubKeyHash, Tx, TxId, +import Ledger (Certificate, Datum, POSIXTime (POSIXTime), PaymentPubKeyHash (PaymentPubKeyHash), PubKeyHash, TxId, TxOut, Value, Withdrawal) import Ledger.Crypto (PubKey (PubKey), Signature (Signature)) import Ledger.Index (UtxoIndex) @@ -114,9 +114,7 @@ deriving instance OpenApi.ToSchema TxInputType deriving instance OpenApi.ToSchema TxInput deriving instance OpenApi.ToSchema Withdrawal deriving instance OpenApi.ToSchema Certificate -deriving anyclass instance OpenApi.ToSchema Tx deriving anyclass instance OpenApi.ToSchema UtxoIndex -deriving anyclass instance OpenApi.ToSchema CardanoTx deriving anyclass instance OpenApi.ToSchema DereferencedInput deriving anyclass instance OpenApi.ToSchema BeneficialOwner deriving anyclass instance OpenApi.ToSchema TxKey @@ -124,7 +122,7 @@ deriving anyclass instance OpenApi.ToSchema AnnotatedTx data ChainReport = ChainReport - { transactionMap :: Map TxId Tx + { transactionMap :: Map TxId CardanoTx , utxoIndex :: UtxoIndex , annotatedBlockchain :: [[AnnotatedTx]] } diff --git a/plutus-tx-constraints/changelog.d/20230302_122624_ak3n_drop_emulator_tx.md b/plutus-tx-constraints/changelog.d/20230302_122624_ak3n_drop_emulator_tx.md new file mode 100644 index 0000000000..a7a6804d42 --- /dev/null +++ b/plutus-tx-constraints/changelog.d/20230302_122624_ak3n_drop_emulator_tx.md @@ -0,0 +1,3 @@ +### Removed + +- Remove `UnbalancedEmulatorTx` and `unBalancedTxTx` as the `Tx` was removed from `plutus-ledger`. \ No newline at end of file diff --git a/plutus-tx-constraints/src/Ledger/Tx/Constraints/OffChain.hs b/plutus-tx-constraints/src/Ledger/Tx/Constraints/OffChain.hs index 4b968a022c..9df4f950ba 100644 --- a/plutus-tx-constraints/src/Ledger/Tx/Constraints/OffChain.hs +++ b/plutus-tx-constraints/src/Ledger/Tx/Constraints/OffChain.hs @@ -36,7 +36,6 @@ module Ledger.Tx.Constraints.OffChain( -- * Constraints resolution , SomeLookupsAndConstraints(..) , UnbalancedTx(..) - , unBalancedTxTx , tx , txInsCollateral , txValidityRange @@ -334,18 +333,7 @@ paymentPubKeyHash pkh = -- can be submitted to the ledger. See note [Submitting transactions from -- Plutus contracts] in 'Plutus.Contract.Wallet'. data UnbalancedTx - = UnbalancedEmulatorTx - { unBalancedEmulatorTx :: Tx.Tx - , unBalancedTxRequiredSignatories :: Set PaymentPubKeyHash - -- ^ These are all the payment public keys that should be used to request the - -- signatories from the user's wallet. The signatories are what is required to - -- sign the transaction before submitting it to the blockchain. Transaction - -- validation will fail if the transaction is not signed by the required wallet. - , unBalancedTxUtxoIndex :: Map TxOutRef TxOut - -- ^ Utxo lookups that are used for adding inputs to the 'UnbalancedTx'. - -- Simply refers to 'slTxOutputs' of 'ScriptLookups'. - } - | UnbalancedCardanoTx + = UnbalancedCardanoTx { unBalancedCardanoBuildTx :: C.CardanoBuildTx , unBalancedTxUtxoIndex :: Map TxOutRef TxOut -- ^ Utxo lookups that are used for adding inputs to the 'UnbalancedTx'. @@ -362,17 +350,7 @@ makeLensesFor tx :: Traversal' UnbalancedTx C.CardanoBuildTx tx = cardanoTx -unBalancedTxTx :: UnbalancedTx -> Either C.CardanoBuildTx Tx.Tx -unBalancedTxTx UnbalancedEmulatorTx{unBalancedEmulatorTx} = Right unBalancedEmulatorTx -unBalancedTxTx UnbalancedCardanoTx{unBalancedCardanoBuildTx} = Left unBalancedCardanoBuildTx - instance Pretty UnbalancedTx where - pretty (UnbalancedEmulatorTx utx rs utxo) = - vsep - [ hang 2 $ vsep ["Tx:", pretty utx] - , hang 2 $ vsep $ "Requires signatures:" : (pretty <$> Set.toList rs) - , hang 2 $ vsep $ "Utxo index:" : (pretty <$> Map.toList utxo) - ] pretty (UnbalancedCardanoTx utx utxo) = vsep [ hang 2 $ vsep ["Tx:", pretty utx] diff --git a/plutus-tx-constraints/test/Spec.hs b/plutus-tx-constraints/test/Spec.hs index b065960cd9..35eb77b430 100644 --- a/plutus-tx-constraints/test/Spec.hs +++ b/plutus-tx-constraints/test/Spec.hs @@ -34,7 +34,7 @@ import Ledger.Crypto (PubKeyHash (PubKeyHash)) import Ledger.Scripts (WitCtx (WitCtxStake), examplePlutusScriptAlwaysSucceedsHash) import Ledger.Slot qualified as Slot import Ledger.Test (asRedeemer) -import Ledger.Tx (Tx (txOutputs), TxOut (TxOut), txOutAddress) +import Ledger.Tx (TxOut (TxOut), txOutAddress) import Ledger.Tx.CardanoAPI qualified as C import Ledger.Tx.Constraints as Constraints import Ledger.Tx.Constraints.OffChain qualified as OC diff --git a/plutus-use-cases/test/Spec/crowdfundingEmulatorTestOutput.txt b/plutus-use-cases/test/Spec/crowdfundingEmulatorTestOutput.txt index 86266de03f..51e6c33900 100644 --- a/plutus-use-cases/test/Spec/crowdfundingEmulatorTestOutput.txt +++ b/plutus-use-cases/test/Spec/crowdfundingEmulatorTestOutput.txt @@ -1,4 +1,4 @@ -Slot 0: TxnValidate 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84 [ ] +Slot 0: TxnValidate d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d [ ] Slot 1: 00000000-0000-4000-8000-000000000000 {Wallet W[1]}: Contract instance started Slot 1: 00000000-0000-4000-8000-000000000000 {Wallet W[1]}: @@ -43,11 +43,11 @@ Slot 1: W[2]: Balancing an unbalanced transaction: Requires signatures: Utxo index: Slot 1: W[2]: Finished balancing: - Tx 347e93f9aef35ed28126dce19cf9f4d8f88d49b6afb4b9983a03d79e8ac81be4: + Tx 454b0dec735648cb9923b835b48f4ff8e9e80bf99ad081c2d905d801c6ce3328: {inputs: - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!20 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!20 - - 43ba666cc8a22a04b63a3b605ce14146dfa5ed999986625ad90c1bc16dabdd84!21 + - d0f5b08cc20688becb8eceba9770a18ea49a49d5df159715b899736bd1d1121d!21 reference inputs: collateral inputs: @@ -64,9 +64,9 @@ Slot 1: W[2]: Finished balancing: ( 77ab184b7537cd4b1dc3730f6a8a76a3d3aad1642fae9d769aa5dae40be38b51 , "\128\164\244[V\184\141\DC19\218#\188L\222\136\166\254\253 =" ) redeemers:} -Slot 1: W[4]: Signing tx: 7a0884c15e9e68dee44e312b74b890119b98e341764d8d797d6e36d851b14df6 -Slot 1: W[4]: Submitting tx: 7a0884c15e9e68dee44e312b74b890119b98e341764d8d797d6e36d851b14df6 -Slot 1: W[4]: TxSubmit: 7a0884c15e9e68dee44e312b74b890119b98e341764d8d797d6e36d851b14df6 -Slot 1: TxnValidate 7a0884c15e9e68dee44e312b74b890119b98e341764d8d797d6e36d851b14df6 [ ] -Slot 1: TxnValidate a522f112d96e2dd90ac280b540e7c7823f8431a9b3978e6fdc6fb6d6c4df2e31 [ ] -Slot 1: TxnValidate 347e93f9aef35ed28126dce19cf9f4d8f88d49b6afb4b9983a03d79e8ac81be4 [ ] +Slot 1: W[4]: Signing tx: 4219625e5c8cbb7aac9cd02a8fe6abba627e11289cc9cae55c273aa0b713eee8 +Slot 1: W[4]: Submitting tx: 4219625e5c8cbb7aac9cd02a8fe6abba627e11289cc9cae55c273aa0b713eee8 +Slot 1: W[4]: TxSubmit: 4219625e5c8cbb7aac9cd02a8fe6abba627e11289cc9cae55c273aa0b713eee8 +Slot 1: TxnValidate 4219625e5c8cbb7aac9cd02a8fe6abba627e11289cc9cae55c273aa0b713eee8 [ ] +Slot 1: TxnValidate 2cf42b87d8872ad340b26fb4926eb29b40fffddfeb8745cdd970ea6f51762287 [ ] +Slot 1: TxnValidate 454b0dec735648cb9923b835b48f4ff8e9e80bf99ad081c2d905d801c6ce3328 [ ] Slot 20: 00000000-0000-4000-8000-000000000000 {Wallet W[1]}: Contract log: String "Collecting funds" Slot 20: W[1]: Balancing an unbalanced transaction: Tx: - Tx 1a10475d70fa7871c67872e654e30a722c904be8659271930819de11666290a6: + Tx 9088249ae32dbe7e723828c6806f84857068badb79061715ba69234e6fd0b4de: {inputs: - - 347e93f9aef35ed28126dce19cf9f4d8f88d49b6afb4b9983a03d79e8ac81be4!0 + - 2cf42b87d8872ad340b26fb4926eb29b40fffddfeb8745cdd970ea6f51762287!0 - - 7a0884c15e9e68dee44e312b74b890119b98e341764d8d797d6e36d851b14df6!0 + - 4219625e5c8cbb7aac9cd02a8fe6abba627e11289cc9cae55c273aa0b713eee8!0 - - a522f112d96e2dd90ac280b540e7c7823f8431a9b3978e6fdc6fb6d6c4df2e31!0 + - 454b0dec735648cb9923b835b48f4ff8e9e80bf99ad081c2d905d801c6ce3328!0 reference inputs: collateral inputs: @@ -182,38 +182,38 @@ Slot 20: W[1]: Balancing an unbalanced transaction: ( 77ab184b7537cd4b1dc3730f6a8a76a3d3aad1642fae9d769aa5dae40be38b51 , "\128\164\244[V\184\141\DC19\218#\188L