Skip to content

Commit

Permalink
Change Era from BabbageEra to ConwayEra
Browse files Browse the repository at this point in the history
Do filter protocol updates in Arbitrary Tx anymore

Those are now represented differently in Conway and we'll see how the
fully random transactions (including governance actions that supersede
protocol updates) behave in situations where we use this generator.
  • Loading branch information
locallycompact committed Jul 15, 2024
1 parent b4f5dd6 commit 76a233d
Show file tree
Hide file tree
Showing 42 changed files with 36,189 additions and 38,855 deletions.
4 changes: 2 additions & 2 deletions docs/package.json
Original file line number Diff line number Diff line change
Expand Up @@ -8,8 +8,8 @@
"build": "yarn prepare && docusaurus build",
"build-dev": "yarn prepare && docusaurus build --no-minify -l en",
"start": "yarn dummy-spec && docusaurus start",
"validate:inputs": "./validate-api.js publish '/' '../hydra-node/golden/ReasonablySized (ClientInput (Tx BabbageEra)).json'",
"validate:outputs": "./validate-api.js subscribe '/' '../hydra-node/golden/ReasonablySized (TimedServerOutput (Tx BabbageEra)).json'",
"validate:inputs": "./validate-api.js publish '/' '../hydra-node/golden/ReasonablySized (ClientInput (Tx ConwayEra)).json'",
"validate:outputs": "./validate-api.js subscribe '/' '../hydra-node/golden/ReasonablySized (TimedServerOutput (Tx ConwayEra)).json'",
"validate": "yarn validate:inputs && yarn validate:outputs",
"swizzle": "docusaurus swizzle",
"deploy": "docusaurus deploy",
Expand Down
1 change: 0 additions & 1 deletion hydra-cardano-api/hydra-cardano-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -92,7 +92,6 @@ library
, cardano-ledger-babbage
, cardano-ledger-binary
, cardano-ledger-byron
, cardano-ledger-conway
, cardano-ledger-core
, cardano-ledger-mary
, cardano-ledger-shelley
Expand Down
2 changes: 1 addition & 1 deletion hydra-cardano-api/src/Cardano/Api/UTxO.hs
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ import Data.Text (Text)
import Data.Text qualified as T
import Prelude

type Era = BabbageEra
type Era = ConwayEra

type UTxO = UTxO' (TxOut CtxUTxO Era)

Expand Down
2 changes: 1 addition & 1 deletion hydra-cardano-api/src/Hydra/Cardano/Api/Prelude.hs
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,7 @@ import Data.Typeable (Typeable)
import GHC.Stack (HasCallStack)
import Test.QuickCheck (Arbitrary (..), Gen)

type Era = BabbageEra
type Era = ConwayEra

-- | Currently supported ledger era.
type LedgerEra = ShelleyLedgerEra Era
Expand Down
139 changes: 1 addition & 138 deletions hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,156 +3,19 @@ module Hydra.Cardano.Api.Tx where
import Hydra.Cardano.Api.Prelude

import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Allegra.Scripts (translateTimelock)
import Cardano.Ledger.Alonzo qualified as Ledger
import Cardano.Ledger.Alonzo.Scripts qualified as Ledger
import Cardano.Ledger.Alonzo.TxAuxData (translateAlonzoTxAuxData)
import Cardano.Ledger.Alonzo.TxWits qualified as Ledger
import Cardano.Ledger.Api (
AlonzoPlutusPurpose (..),
AsIx (..),
ConwayPlutusPurpose (..),
EraTx (mkBasicTx),
addrTxOutL,
addrTxWitsL,
auxDataHashTxBodyL,
auxDataTxL,
bodyTxL,
bootAddrTxWitsL,
collateralInputsTxBodyL,
collateralReturnTxBodyL,
dataTxOutL,
datsTxWitsL,
feeTxBodyL,
inputsTxBodyL,
isValidTxL,
mintTxBodyL,
mkBasicTxBody,
mkBasicTxOut,
mkBasicTxWits,
networkIdTxBodyL,
outputsTxBodyL,
rdmrsTxWitsL,
referenceInputsTxBodyL,
referenceScriptTxOutL,
reqSignerHashesTxBodyL,
scriptIntegrityHashTxBodyL,
scriptTxWitsL,
totalCollateralTxBodyL,
valueTxOutL,
vldtTxBodyL,
withdrawalsTxBodyL,
witsTxL,
)
import Cardano.Ledger.Api qualified as Ledger
import Cardano.Ledger.Babbage qualified as Ledger
import Cardano.Ledger.Babbage.TxWits (upgradeTxDats)
import Cardano.Ledger.BaseTypes (maybeToStrictMaybe)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Scripts (PlutusScript (..))
import Cardano.Ledger.Conway.Scripts qualified as Conway
import Cardano.Ledger.Conway.TxBody qualified as Ledger
import Cardano.Ledger.Plutus.Data (upgradeData)
import Control.Lens ((&), (.~), (^.))
import Control.Lens ((&), (.~))
import Data.Bifunctor (bimap)
import Data.Functor ((<&>))
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.Set qualified as Set
import Hydra.Cardano.Api.TxIn (mkTxIn, toLedgerTxIn)

-- * Extras

-- | Explicit downgrade from Conway to Babbage era.
--
-- NOTE: This is not a complete mapping and does silently drop things like
-- protocol updates, certificates and voting procedures.
convertConwayTx :: Tx ConwayEra -> Tx BabbageEra
convertConwayTx =
fromLedgerTx . convert . toLedgerTx
where
convert :: Ledger.Tx (Ledger.ConwayEra StandardCrypto) -> Ledger.Tx (Ledger.BabbageEra StandardCrypto)
convert tx =
mkBasicTx (translateBody $ tx ^. bodyTxL)
& witsTxL .~ translateWits (tx ^. witsTxL)
& isValidTxL .~ tx ^. isValidTxL
& auxDataTxL .~ (translateAlonzoTxAuxData <$> tx ^. auxDataTxL)

translateBody ::
Ledger.ConwayTxBody (Ledger.ConwayEra StandardCrypto) ->
Ledger.BabbageTxBody (Ledger.BabbageEra StandardCrypto)
translateBody body =
mkBasicTxBody
& inputsTxBodyL .~ body ^. inputsTxBodyL
& outputsTxBodyL .~ (translateTxOut <$> body ^. outputsTxBodyL)
& feeTxBodyL .~ body ^. feeTxBodyL
& withdrawalsTxBodyL .~ body ^. withdrawalsTxBodyL
& auxDataHashTxBodyL .~ body ^. auxDataHashTxBodyL
-- NOTE: not considering 'updateTxBodyL' as upstream also does not upgrade it
-- NOTE: not considering 'certsTxBodyL' as we are not interested in it
& vldtTxBodyL .~ body ^. vldtTxBodyL
& mintTxBodyL .~ body ^. mintTxBodyL
& collateralInputsTxBodyL .~ body ^. collateralInputsTxBodyL
& reqSignerHashesTxBodyL .~ body ^. reqSignerHashesTxBodyL
& scriptIntegrityHashTxBodyL .~ body ^. scriptIntegrityHashTxBodyL
& networkIdTxBodyL .~ body ^. networkIdTxBodyL
& referenceInputsTxBodyL .~ body ^. referenceInputsTxBodyL
& totalCollateralTxBodyL .~ body ^. totalCollateralTxBodyL
& collateralReturnTxBodyL .~ (translateTxOut <$> body ^. collateralReturnTxBodyL)

translateTxOut ::
Ledger.BabbageTxOut (Ledger.ConwayEra StandardCrypto) ->
Ledger.BabbageTxOut (Ledger.BabbageEra StandardCrypto)
translateTxOut out =
mkBasicTxOut (out ^. addrTxOutL) (out ^. valueTxOutL)
& dataTxOutL .~ (upgradeData <$> out ^. dataTxOutL)
& referenceScriptTxOutL .~ (out ^. referenceScriptTxOutL >>= maybeToStrictMaybe . translateScript)

translateWits ::
Ledger.AlonzoTxWits (Ledger.ConwayEra StandardCrypto) ->
Ledger.AlonzoTxWits (Ledger.BabbageEra StandardCrypto)
translateWits wits =
mkBasicTxWits
& addrTxWitsL .~ wits ^. addrTxWitsL
& bootAddrTxWitsL .~ wits ^. bootAddrTxWitsL
& scriptTxWitsL .~ Map.mapMaybe translateScript (wits ^. scriptTxWitsL)
& datsTxWitsL .~ upgradeTxDats (wits ^. datsTxWitsL)
& rdmrsTxWitsL .~ translateRdmrs (wits ^. rdmrsTxWitsL)

translateScript ::
Ledger.AlonzoScript (Ledger.ConwayEra StandardCrypto) ->
Maybe (Ledger.AlonzoScript (Ledger.BabbageEra StandardCrypto))
translateScript = \case
Ledger.TimelockScript ts -> Just . Ledger.TimelockScript $ translateTimelock ts
Ledger.PlutusScript ps -> case ps of
ConwayPlutusV1 p1 -> Just . Ledger.PlutusScript $ BabbagePlutusV1 p1
ConwayPlutusV2 p2 -> Just . Ledger.PlutusScript $ BabbagePlutusV2 p2
ConwayPlutusV3{} -> Nothing

translateRdmrs ::
Ledger.Redeemers (Ledger.ConwayEra StandardCrypto) ->
Ledger.Redeemers (Ledger.BabbageEra StandardCrypto)
translateRdmrs (Ledger.Redeemers redeemerMap) =
Ledger.Redeemers
. Map.fromList
$ mapMaybe
( \(purpose, (dat, units)) -> do
p' <- translatePlutusPurpose purpose
pure (p', (upgradeData dat, units))
)
$ Map.toList redeemerMap

translatePlutusPurpose ::
Conway.ConwayPlutusPurpose Ledger.AsIx (Ledger.ConwayEra StandardCrypto) ->
Maybe (Ledger.AlonzoPlutusPurpose Ledger.AsIx (Ledger.BabbageEra StandardCrypto))
translatePlutusPurpose = \case
ConwaySpending (AsIx ix) -> Just $ AlonzoSpending (AsIx ix)
ConwayMinting (AsIx ix) -> Just $ AlonzoMinting (AsIx ix)
ConwayCertifying (AsIx ix) -> Just $ AlonzoCertifying (AsIx ix)
ConwayRewarding (AsIx ix) -> Just $ AlonzoRewarding (AsIx ix)
ConwayVoting{} -> Nothing
ConwayProposing{} -> Nothing

-- | Sign transaction using the provided secret key
-- It only works for tx not containing scripts.
-- You can't sign a script utxo with this.
Expand Down
11 changes: 8 additions & 3 deletions hydra-cardano-api/src/Hydra/Cardano/Api/TxBody.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,12 @@ module Hydra.Cardano.Api.TxBody where
import Hydra.Cardano.Api.Prelude

import Cardano.Ledger.Alonzo.TxWits qualified as Ledger
import Cardano.Ledger.Api (AlonzoPlutusPurpose (..), AsItem (..), AsIx, PlutusPurpose)
import Cardano.Ledger.Api (
AsItem (..),
AsIx,
ConwayPlutusPurpose (..),
PlutusPurpose,
)
import Cardano.Ledger.Babbage.Core (redeemerPointer)
import Cardano.Ledger.BaseTypes (strictMaybeToMaybe)
import Cardano.Ledger.Core qualified as Ledger
Expand All @@ -23,7 +28,7 @@ findRedeemerSpending ::
TxIn ->
Maybe a
findRedeemerSpending (getTxBody -> ShelleyTxBody _ body _ scriptData _ _) txIn = do
ptr <- strictMaybeToMaybe $ redeemerPointer body (AlonzoSpending . AsItem $ toLedgerTxIn txIn)
ptr <- strictMaybeToMaybe $ redeemerPointer body (ConwaySpending . AsItem $ toLedgerTxIn txIn)
lookupRedeemer ptr scriptData

findRedeemerMinting ::
Expand All @@ -32,7 +37,7 @@ findRedeemerMinting ::
PolicyId ->
Maybe a
findRedeemerMinting (getTxBody -> ShelleyTxBody _ body _ scriptData _ _) pid = do
ptr <- strictMaybeToMaybe $ redeemerPointer body (AlonzoMinting . AsItem $ toLedgerPolicyID pid)
ptr <- strictMaybeToMaybe $ redeemerPointer body (ConwayMinting . AsItem $ toLedgerPolicyID pid)
lookupRedeemer ptr scriptData

findScriptMinting ::
Expand Down
5 changes: 1 addition & 4 deletions hydra-chain-observer/src/Hydra/ChainObserver.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,6 @@ import Hydra.Cardano.Api (
Tx,
UTxO,
connectToLocalNode,
convertConwayTx,
getChainPoint,
getTxBody,
getTxId,
Expand Down Expand Up @@ -172,16 +171,14 @@ chainSyncClient tracer networkId startingPoint observerHandler =
{ recvMsgRollForward = \blockInMode _tip -> ChainSyncClient $ do
let receivedTxIds = case blockInMode of
BlockInMode ConwayEra (Block _ conwayTxs) -> getTxId . getTxBody <$> conwayTxs
BlockInMode BabbageEra (Block _ babbageTxs) -> getTxId . getTxBody <$> babbageTxs
_ -> []

(BlockInMode _ (Block bh@(BlockHeader _ _ blockNo) _)) = blockInMode
point = getChainPoint bh
traceWith tracer RollForward{point, receivedTxIds}

let txs = case blockInMode of
BlockInMode ConwayEra (Block _ conwayTxs) -> map convertConwayTx conwayTxs
BlockInMode BabbageEra (Block _ babbageTxs) -> babbageTxs
BlockInMode ConwayEra (Block _ conwayTxs) -> conwayTxs
_ -> []

(utxo', observations) = observeAll networkId utxo txs
Expand Down
1 change: 1 addition & 0 deletions hydra-cluster/config/devnet/cardano-node.json
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@
"TestMaryHardForkAtEpoch": 0,
"TestAlonzoHardForkAtEpoch": 0,
"TestBabbageHardForkAtEpoch": 0,
"TestConwayHardForkAtEpoch": 0,

"RequiresNetworkMagic": "RequiresNoMagic",

Expand Down
3 changes: 2 additions & 1 deletion hydra-cluster/config/devnet/genesis-conway.json
Original file line number Diff line number Diff line change
Expand Up @@ -37,5 +37,6 @@
"threshold": 0
},
"minFeeRefScriptCostPerByte": 0,
"plutusV3CostModel":[]
"plutusV3CostModel":[],
"extraPraosEntropy": null
}
2 changes: 1 addition & 1 deletion hydra-cluster/datasets/1-node.json

Large diffs are not rendered by default.

2 changes: 1 addition & 1 deletion hydra-cluster/datasets/3-nodes.json

Large diffs are not rendered by default.

11 changes: 0 additions & 11 deletions hydra-cluster/src/CardanoNode.hs
Original file line number Diff line number Diff line change
Expand Up @@ -276,17 +276,6 @@ setupCardanoDevnet stateDirectory = do
Aeson.encodeFile (stateDirectory </> nodeTopologyFile args) $
mkTopology peers

-- | Modify the cardano-node configuration to fork into conway at given era
-- number.
forkIntoConwayInEpoch :: FilePath -> CardanoNodeArgs -> Natural -> IO ()
forkIntoConwayInEpoch stateDirectory args n = do
config <-
unsafeDecodeJsonFile @Aeson.Value (stateDirectory </> nodeConfigFile args)
<&> atKey "TestConwayHardForkAtEpoch" ?~ toJSON n
Aeson.encodeFile
(stateDirectory </> nodeConfigFile args)
config

withCardanoNode ::
Tracer IO NodeLog ->
FilePath ->
Expand Down
Loading

0 comments on commit 76a233d

Please sign in to comment.