Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

cardano-api: 8.46 -> 9.0 #1497

Merged
merged 3 commits into from
Jul 15, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 13 additions & 0 deletions cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,19 @@ index-state:
, hackage.haskell.org 2024-07-09T19:07:04Z
, cardano-haskell-packages 2024-07-09T19:04:02Z

source-repository-package
type: git
location: https://github.com/IntersectMBO/cardano-ledger
tag: 516b4555c8c7b2faa821f05fdca9c9bb11a74d66
--sha256: sha256-4cPWwRAL815smViecuKZ2LAj/PSCI4ohdddFuJCiPxc=
subdir:
libs/cardano-ledger-core
eras/alonzo/impl
eras/conway/impl
eras/shelley/test-suite

allow-newer: cardano-ledger-core

packages:
cardano-api-classy
hydra-prelude
Expand Down
2 changes: 1 addition & 1 deletion cardano-api-classy/cardano-api-classy.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,7 @@ library
-- dependencies on cardano-ledger* follow.
build-depends:
, base >=4.16
, cardano-api ^>=8.46
, cardano-api ^>=9.0
, cardano-ledger-alonzo
, cardano-ledger-conway
, cardano-ledger-core
2 changes: 1 addition & 1 deletion hydra-cardano-api/hydra-cardano-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -82,7 +82,7 @@ library
, base >=4.16
, base16-bytestring
, bytestring
, cardano-api ^>=8.46
, cardano-api ^>=9.0
, cardano-api-classy
, cardano-binary
, cardano-crypto-class
Expand Down
6 changes: 6 additions & 0 deletions hydra-cardano-api/src/Hydra/Cardano/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -403,6 +403,8 @@ pattern TxBodyContent ::
TxScriptValidity ->
Maybe (Featured ConwayEraOnwards Era (TxProposalProcedures buidl Era)) ->
Maybe (Featured ConwayEraOnwards Era (TxVotingProcedures buidl Era)) ->
Maybe (Featured ConwayEraOnwards Era Coin) ->
Maybe (Featured ConwayEraOnwards Era Coin) ->
TxBodyContent buidl
pattern TxBodyContent
{ txIns
Expand All @@ -425,6 +427,8 @@ pattern TxBodyContent
, txScriptValidity
, txProposalProcedures
, txVotingProcedures
, txCurrentTreasuryValue
, txTreasuryDonation
} <-
Cardano.Api.TxBodyContent
txIns
Expand All @@ -447,6 +451,8 @@ pattern TxBodyContent
txScriptValidity
txProposalProcedures
txVotingProcedures
txCurrentTreasuryValue
txTreasuryDonation
where
TxBodyContent = Cardano.Api.TxBodyContent

Expand Down
1 change: 1 addition & 0 deletions hydra-cluster/hydra-cluster.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -87,6 +87,7 @@ library
, async
, base >=4.7 && <5
, bytestring
, cardano-api
, cardano-slotting
, containers
, contra-tracer
Expand Down
5 changes: 3 additions & 2 deletions hydra-cluster/src/Hydra/Generator.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@ module Hydra.Generator where
import Hydra.Cardano.Api
import Hydra.Prelude hiding (size)

import Cardano.Api.Ledger (PParams)
import Cardano.Api.UTxO qualified as UTxO
import CardanoClient (mkGenesisTx)
import Control.Monad (foldM)
Expand Down Expand Up @@ -72,8 +73,8 @@ data ClientDataset = ClientDataset
deriving stock (Show, Generic)
deriving anyclass (ToJSON, FromJSON)

defaultProtocolParameters :: ProtocolParameters
defaultProtocolParameters = fromLedgerPParams ShelleyBasedEraShelley def
defaultProtocolParameters :: PParams LedgerEra
defaultProtocolParameters = def

-- | Generate 'Dataset' which does not grow the per-client UTXO set over time.
-- The sequence of transactions generated consist only of simple payments from
Expand Down
26,894 changes: 11,821 additions & 15,073 deletions hydra-node/golden/ReasonablySized (TimedServerOutput (Tx BabbageEra)).json

Large diffs are not rendered by default.

4 changes: 2 additions & 2 deletions hydra-node/hydra-node.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -151,9 +151,9 @@ library
, optparse-applicative
, ouroboros-consensus
, ouroboros-consensus-cardano
, ouroboros-network-api ^>=0.7.1
, ouroboros-network-api >=0.7.1
, ouroboros-network-framework
, ouroboros-network-protocols ^>=0.8
, ouroboros-network-protocols >=0.8
, plutus-core >=1.21
, plutus-ledger-api >=1.21
, prometheus
Expand Down
5 changes: 1 addition & 4 deletions hydra-node/src/Hydra/API/HTTPServer.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,8 +14,6 @@ import Hydra.API.APIServerLog (APIServerLog (..), Method (..), PathInfo (..))
import Hydra.Cardano.Api (
LedgerEra,
Tx,
fromLedgerPParams,
shelleyBasedEra,
)
import Hydra.Chain (Chain (..), CommitBlueprintTx (..), IsChainState, PostTxError (..), draftCommitTx)
import Hydra.Chain.Direct.State ()
Expand Down Expand Up @@ -148,8 +146,7 @@ httpApp tracer directChain pparams getInitializingHeadId getConfirmedUTxO reques
>>= handleDraftCommitUtxo directChain getInitializingHeadId
>>= respond
("GET", ["protocol-parameters"]) ->
respond . responseLBS status200 [] . Aeson.encode $
fromLedgerPParams shelleyBasedEra pparams
respond . responseLBS status200 [] . Aeson.encode $ pparams
("POST", ["cardano-transaction"]) ->
consumeRequestBodyStrict request
>>= handleSubmitUserTx directChain
Expand Down
4 changes: 3 additions & 1 deletion hydra-node/src/Hydra/Chain/CardanoClient.hs
Original file line number Diff line number Diff line change
Expand Up @@ -141,6 +141,8 @@ buildTransaction networkId socket changeAddress utxoToSpend collateral outs = do
TxScriptValidityNone
Nothing
Nothing
Nothing
Nothing

-- | Submit a (signed) transaction to the node.
--
Expand Down Expand Up @@ -416,7 +418,7 @@ queryInShelleyBasedEraExpr sbe query =
-- | Throws at least 'QueryException' if query fails.
runQuery :: NetworkId -> SocketPath -> QueryPoint -> QueryInMode a -> IO a
runQuery networkId socket point query =
queryNodeLocalState (localNodeConnectInfo networkId socket) queryTarget query >>= \case
runExceptT (queryNodeLocalState (localNodeConnectInfo networkId socket) queryTarget query) >>= \case
Left err -> throwIO $ QueryAcquireException err
Right result -> pure result
where
Expand Down
11 changes: 6 additions & 5 deletions hydra-node/src/Hydra/Chain/Direct/Wallet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,7 @@ import Cardano.Ledger.Alonzo.TxWits (
txscripts,
)
import Cardano.Ledger.Api (
BabbageEra,
TransactionScriptFailure,
bodyTxL,
collateralInputsTxBodyL,
Expand Down Expand Up @@ -420,12 +421,12 @@ estimateScriptsCost ::
Babbage.AlonzoTx LedgerEra ->
Either ErrCoverFee (Map (PlutusPurpose AsIx LedgerEra) ExUnits)
estimateScriptsCost pparams systemStart epochInfo utxo tx = do
case result of
Left translationError ->
Left $ ErrTranslationError translationError
Right units ->
Map.traverseWithKey (\ptr -> left $ ErrScriptExecutionFailed . (ptr,)) units
Map.traverseWithKey (\ptr -> left $ ErrScriptExecutionFailed . (ptr,)) result
where
result ::
Map
(AlonzoPlutusPurpose AsIx LedgerEra)
(Either (TransactionScriptFailure (BabbageEra StandardCrypto)) ExUnits)
result =
evalTxExUnits
pparams
Expand Down
2 changes: 2 additions & 0 deletions hydra-node/src/Hydra/Ledger/Cardano/Builder.hs
Original file line number Diff line number Diff line change
Expand Up @@ -74,6 +74,8 @@ emptyTxBody =
TxScriptValidityNone
Nothing
Nothing
Nothing
Nothing

-- | Add new inputs to an ongoing builder.
addInputs :: TxIns BuildTx -> TxBodyContent BuildTx -> TxBodyContent BuildTx
Expand Down
40 changes: 26 additions & 14 deletions hydra-node/src/Hydra/Ledger/Cardano/Evaluate.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use <$>" #-}

-- | Simplified interface to phase-2 validation of transactions, eg. evaluation
-- of Plutus scripts.
--
Expand All @@ -17,10 +21,9 @@ import Cardano.Ledger.Alonzo.Plutus.Evaluate (collectPlutusScriptsWithContext)
import Cardano.Ledger.Alonzo.Scripts (CostModel, Prices (..), mkCostModel, mkCostModels, txscriptfee)
import Cardano.Ledger.Api (CoinPerByte (..), ppCoinsPerUTxOByteL, ppCostModelsL, ppMaxBlockExUnitsL, ppMaxTxExUnitsL, ppMaxValSizeL, ppMinFeeAL, ppMinFeeBL, ppPricesL, ppProtocolVersionL)
import Cardano.Ledger.BaseTypes (BoundedRational (boundRational), ProtVer (..), natVersion)
import Cardano.Ledger.Binary (getVersion)
import Cardano.Ledger.Coin (Coin (Coin))
import Cardano.Ledger.Core (PParams, ppMaxTxSizeL)
import Cardano.Ledger.Plutus (PlutusDatums (unPlutusDatums), PlutusLanguage (decodePlutusRunnable), PlutusRunnable (..), PlutusWithContext (..))
import Cardano.Ledger.Plutus (PlutusLanguage (decodePlutusRunnable, mkTermToEvaluate), PlutusWithContext (..))
import Cardano.Ledger.Plutus.Language (Language (PlutusV2))
import Cardano.Ledger.Val (Val ((<+>)), (<×>))
import Cardano.Slotting.EpochInfo (EpochInfo, fixedEpochInfo)
Expand Down Expand Up @@ -75,8 +78,6 @@ import Ouroboros.Consensus.HardFork.History (
mkInterpreter,
)
import PlutusCore qualified as PLC
import PlutusLedgerApi.Common (mkTermToEvaluate)
import PlutusLedgerApi.Common qualified as Plutus
import Test.QuickCheck (Property, choose, counterexample, property)
import Test.QuickCheck.Gen (chooseWord64)
import UntypedPlutusCore (UnrestrictedProgram (..))
Expand Down Expand Up @@ -112,14 +113,26 @@ evaluateTx' maxUnits tx utxo = do
| all isRight report -> checkBudget maxUnits report
| otherwise -> Right report
where
result ::
LedgerProtocolParameters UTxO.Era ->
Either
(TransactionValidityError UTxO.Era)
( Map
ScriptWitnessIndex
( Either
ScriptExecutionError
ExecutionUnits
)
)
result pparams' =
evaluateTransactionExecutionUnits
cardanoEra
systemStart
(LedgerEpochInfo epochInfo)
pparams'
(UTxO.toApi utxo)
(getTxBody tx)
(fmap . fmap . fmap) snd $
evaluateTransactionExecutionUnits
cardanoEra
systemStart
(LedgerEpochInfo epochInfo)
pparams'
(UTxO.toApi utxo)
(getTxBody tx)

-- | Check the budget used by provided 'EvaluationReport' does not exceed given
-- maximum 'ExecutionUnits'.
Expand Down Expand Up @@ -220,12 +233,11 @@ prepareTxScripts tx utxo = do

-- Fully applied UPLC programs which we could run using the cekMachine
programs <- forM results $ \(PlutusWithContext protocolVersion script _ arguments _exUnits _costModel) -> do
(PlutusRunnable x) <-
x <-
case script of
Right runnable -> pure runnable
Left serialised -> left show $ decodePlutusRunnable protocolVersion serialised
let majorProtocolVersion = Plutus.MajorProtocolVersion $ getVersion protocolVersion
appliedTerm <- left show $ mkTermToEvaluate Plutus.PlutusV2 majorProtocolVersion x (unPlutusDatums arguments)
appliedTerm <- left show $ mkTermToEvaluate protocolVersion x arguments
pure $ UPLC.Program () PLC.latestVersion appliedTerm

pure $ flat . UnrestrictedProgram <$> programs
Expand Down
4 changes: 1 addition & 3 deletions hydra-node/test/Hydra/API/HTTPServerSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,9 +9,7 @@ import Data.Aeson.Lens (key, nth)
import Hydra.API.HTTPServer (DraftCommitTxRequest (..), DraftCommitTxResponse (..), SubmitTxRequest (..), TransactionSubmitted, httpApp)
import Hydra.API.ServerSpec (dummyChainHandle)
import Hydra.Cardano.Api (
fromLedgerPParams,
serialiseToTextEnvelope,
shelleyBasedEra,
)
import Hydra.Chain (Chain (draftCommitTx), PostTxError (..))
import Hydra.Chain.Direct.Fixture (defaultPParams)
Expand Down Expand Up @@ -103,7 +101,7 @@ apiServerSpec = do
it "responds given parameters" $
get "/protocol-parameters"
`shouldRespondWith` 200
{ matchBody = matchJSON $ fromLedgerPParams shelleyBasedEra defaultPParams
{ matchBody = matchJSON defaultPParams
}

describe "GET /snapshot/utxo" $ do
Expand Down
19 changes: 7 additions & 12 deletions hydra-node/test/Hydra/Ledger/CardanoSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -59,8 +59,8 @@ spec =

prop "Roundtrip to and from Api" roundtripFromAndToApi

describe "ProtocolParameters" $
prop "Roundtrip JSON encoding" roundtripProtocolParameters
describe "PParamss" $
prop "Roundtrip JSON encoding" roundtripPParams

describe "Tx" $ do
roundtripAndGoldenSpecs (Proxy @(ReasonablySized Tx))
Expand Down Expand Up @@ -114,19 +114,14 @@ roundtripFromAndToApi :: UTxO -> Property
roundtripFromAndToApi utxo =
fromApi (toApi utxo) === utxo

-- | Test that the 'ProtocolParameters' To/FromJSON instances to roundtrip. Note
-- that we use the ledger 'PParams' type to generate values, but the cardano-api
-- type 'ProtocolParameters' is used for the serialization.
roundtripProtocolParameters :: PParams LedgerEra -> Property
roundtripProtocolParameters pparams = do
case Aeson.decode (Aeson.encode expected) of
-- | Test that the 'PParams' To/FromJSON instances to roundtrip.
roundtripPParams :: PParams LedgerEra -> Property
roundtripPParams pparams = do
case Aeson.decode (Aeson.encode pparams) of
Nothing ->
property False
Just actual ->
(expected === actual)
& counterexample ("ledger: " <> show pparams)
where
expected = fromLedgerPParams shelleyBasedEra pparams
pparams === actual

roundtripTxId :: Tx -> Property
roundtripTxId tx@(Tx body _) =
Expand Down
6 changes: 3 additions & 3 deletions hydra-plutus-extras/src/Hydra/Plutus/Extras.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,12 +19,12 @@ import Cardano.Api.Shelley (PlutusScript (PlutusScriptSerialised))
import PlutusLedgerApi.Common (SerialisedScript)
import PlutusLedgerApi.V2 (ScriptHash (..))
import PlutusTx (BuiltinData, UnsafeFromData (..))
import PlutusTx.Prelude (check, toBuiltin)
import PlutusTx.Prelude (BuiltinUnit, check, toBuiltin)

-- * Vendored from plutus-ledger

-- | Signature of an untyped validator script.
type ValidatorType = BuiltinData -> BuiltinData -> BuiltinData -> ()
type ValidatorType = BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit

-- | Wrap a typed validator to get the basic `ValidatorType` signature which can
-- be passed to `PlutusTx.compile`.
Expand All @@ -42,7 +42,7 @@ wrapValidator f d r c =
{-# INLINEABLE wrapValidator #-}

-- | Signature of an untyped minting policy script.
type MintingPolicyType = BuiltinData -> BuiltinData -> ()
type MintingPolicyType = BuiltinData -> BuiltinData -> BuiltinUnit

-- | Wrap a typed minting policy to get the basic `MintingPolicyType` signature
-- which can be passed to `PlutusTx.compile`.
Expand Down
Loading