Skip to content

Commit

Permalink
cardano-api: 10.8
Browse files Browse the repository at this point in the history
  • Loading branch information
locallycompact committed Feb 10, 2025
1 parent 1291e6a commit 85ef6b3
Show file tree
Hide file tree
Showing 12 changed files with 32 additions and 36 deletions.
4 changes: 2 additions & 2 deletions cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -12,8 +12,8 @@ repository cardano-haskell-packages

-- See CONTRIBUTING.md for information about when and how to update these.
index-state:
, hackage.haskell.org 2025-01-15T13:32:16Z
, cardano-haskell-packages 2025-01-15T09:59:24Z
, hackage.haskell.org 2025-02-01T08:30:11Z
, cardano-haskell-packages 2025-02-01T07:12:29Z

packages:
hydra-prelude
Expand Down
6 changes: 3 additions & 3 deletions flake.lock

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

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 @@ -78,7 +78,7 @@ library
, aeson >=2
, base >=4.16
, bytestring
, cardano-api ^>=10.6
, cardano-api ^>=10.8
, cardano-api:gen
, cardano-binary
, cardano-crypto-class
Expand Down
6 changes: 0 additions & 6 deletions hydra-cardano-api/src/Hydra/Cardano/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -360,12 +360,6 @@ pattern TxAuxScripts{txAuxScripts'} <-
-- ** TxBody

type TxBody = Cardano.Api.TxBody Era
{-# COMPLETE TxBody #-}

pattern TxBody :: TxBodyContent ViewTx -> TxBody
pattern TxBody{txBodyContent} <-
Cardano.Api.TxBody txBodyContent
{-# COMPLETE TxBody #-}

createAndValidateTransactionBody :: TxBodyContent BuildTx -> Either TxBodyError TxBody
createAndValidateTransactionBody = Cardano.Api.createTransactionBody shelleyBasedEra
Expand Down
2 changes: 1 addition & 1 deletion hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,7 @@ renderTxWithUTxO utxo (Tx body _wits) =
where
Api.ShelleyTxBody _lbody scripts scriptsData _auxData _validity = body
outs = txOuts content
TxBody content = body
content = getTxBodyContent body

inputLines =
"== INPUTS (" <> show (length (txIns content)) <> ")"
Expand Down
2 changes: 1 addition & 1 deletion hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs
Original file line number Diff line number Diff line change
Expand Up @@ -56,7 +56,7 @@ utxoProducedByTx tx =
zip [0 ..] (txOuts body)
<&> bimap (mkTxIn tx) toCtxUTxOTxOut
where
TxBody body = getTxBody tx
body = getTxBodyContent $ getTxBody tx

-- * Type Conversions

Expand Down
4 changes: 2 additions & 2 deletions hydra-cardano-api/src/Hydra/Cardano/Api/TxIn.hs
Original file line number Diff line number Diff line change
Expand Up @@ -27,8 +27,8 @@ withWitness txIn =

-- | Access inputs of a transaction, as an ordered list.
txIns' :: Tx era -> [TxIn]
txIns' (getTxBody -> txBody) =
let TxBody TxBodyContent{txIns} = txBody
txIns' (getTxBodyContent . getTxBody -> txBodyContent) =
let TxBodyContent{txIns} = txBodyContent
in fst <$> txIns

-- | Access inputs of a transaction, as an ordered set.
Expand Down
4 changes: 2 additions & 2 deletions hydra-cardano-api/src/Hydra/Cardano/Api/TxOut.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,8 @@ import PlutusLedgerApi.V3 qualified as Plutus
-- * Extras

txOuts' :: Tx era -> [TxOut CtxTx era]
txOuts' (getTxBody -> txBody) =
let TxBody TxBodyContent{txOuts} = txBody
txOuts' (getTxBodyContent . getTxBody -> txBody) =
let TxBodyContent{txOuts} = txBody
in txOuts

-- | Modify a 'TxOut' to set the minimum ada on the value.
Expand Down
21 changes: 10 additions & 11 deletions hydra-chain-observer/src/Hydra/Ouroborus/ChainObserver.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,10 +20,11 @@ import Hydra.Cardano.Api (
SocketPath,
UTxO,
connectToLocalNode,
getBlockHeader,
getBlockTxs,
getChainPoint,
getTxBody,
getTxId,
pattern Block,
)
import Hydra.Chain.CardanoClient (queryTip)
import Hydra.Chain.Direct.Handlers (convertObservation)
Expand Down Expand Up @@ -131,21 +132,19 @@ chainSyncClient tracer networkId startingPoint observerHandler =
clientStNext utxo =
ClientStNext
{ recvMsgRollForward = \blockInMode _tip -> ChainSyncClient $ do
let receivedTxIds = case blockInMode of
BlockInMode ConwayEra (Block _ conwayTxs) -> getTxId . getTxBody <$> conwayTxs
_ -> []
let block = case blockInMode of
BlockInMode ConwayEra block -> Just block
_ -> Nothing

(BlockInMode _ (Block bh@(BlockHeader _ _ blockNo) _)) = blockInMode
txs = getBlockTxs <$> maybeToList block
bh@(BlockHeader _ _ blockNo) = getBlockHeader block
point = getChainPoint bh
traceWith tracer RollForward{point, receivedTxIds}

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

receivedTxIds = getTxId . getTxBody <$> txs
(utxo', observations) = observeAll networkId utxo txs
onChainTxs = mapMaybe convertObservation observations

traceWith tracer RollForward{point, receivedTxIds}

forM_ onChainTxs (traceWith tracer . logOnChainTx)
let observationsAt = ChainObservation point blockNo . Just <$> onChainTxs
observerHandler $
Expand Down
7 changes: 5 additions & 2 deletions hydra-node/src/Hydra/Chain/Direct.hs
Original file line number Diff line number Diff line change
Expand Up @@ -43,10 +43,11 @@ import Hydra.Cardano.Api (
TxValidationErrorInCardanoMode,
chainTipToChainPoint,
connectToLocalNode,
getBlockHeader,
getBlockTxs,
getTxBody,
getTxId,
toLedgerUTxO,
pattern Block,
)
import Hydra.Chain (
ChainComponent,
Expand Down Expand Up @@ -320,7 +321,9 @@ chainSyncClient handler wallet startingPoint =
ClientStNext
{ recvMsgRollForward = \blockInMode _tip -> ChainSyncClient $ do
case blockInMode of
BlockInMode ConwayEra (Block header txs) -> do
BlockInMode ConwayEra block -> do
let header = getBlockHeader block
let txs = getBlockTxs block
-- Update the tiny wallet
update wallet header txs
-- Observe Hydra transactions
Expand Down
2 changes: 1 addition & 1 deletion hydra-tx/test/Hydra/Tx/Contract/FanOut.hs
Original file line number Diff line number Diff line change
Expand Up @@ -148,7 +148,7 @@ genFanoutMutation (tx, _utxo) =
]
where
burntTokens =
case toList . txMintValueToValue . txMintValue $ txBodyContent $ txBody tx of
case toList . txMintValueToValue . txMintValue $ getTxBodyContent $ txBody tx of
[] -> error "expected minted value"
v -> v

Expand Down
8 changes: 4 additions & 4 deletions hydra-tx/testlib/Test/Hydra/Tx/Mutation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -671,7 +671,7 @@ changeMintedValueQuantityFrom tx exclude = do
someQuantity <- fromInteger <$> arbitrary `suchThat` (/= exclude) `suchThat` (/= 0)
pure $ ChangeMintedValue $ fromList $ map (second $ const someQuantity) $ toList mintedValue
where
mintedValue = txMintValueToValue $ txMintValue $ txBodyContent $ txBody tx
mintedValue = txMintValueToValue $ txMintValue $ getTxBodyContent $ txBody tx

-- | A 'Mutation' that changes the minted/burned quantity of tokens like this:
-- - when no value is being minted/burned -> add a value
Expand All @@ -680,7 +680,7 @@ changeMintedTokens :: Tx -> Value -> Gen Mutation
changeMintedTokens tx mintValue =
pure $ ChangeMintedValue $ mintedValue <> mintValue
where
mintedValue = txMintValueToValue $ txMintValue $ txBodyContent $ txBody tx
mintedValue = txMintValueToValue $ txMintValue $ getTxBodyContent $ txBody tx

-- | A `Mutation` that adds an `Arbitrary` participation token with some quantity.
-- As usual the quantity can be positive for minting, or negative for burning.
Expand All @@ -697,7 +697,7 @@ addPTWithQuantity tx quantity =
pkh <- arbitrary
pure $ mintedValue <> fromList [(AssetId pid pkh, quantity)]
where
mintedValue = txMintValueToValue $ txMintValue $ txBodyContent $ txBody tx
mintedValue = txMintValueToValue $ txMintValue $ getTxBodyContent $ txBody tx

-- | Replace first given 'PolicyId' with the second argument in the whole 'TxOut' value.
replacePolicyIdWith :: PolicyId -> PolicyId -> TxOut a -> TxOut a
Expand Down Expand Up @@ -928,7 +928,7 @@ replaceContesters contesters = \case

removePTFromMintedValue :: TxOut CtxUTxO -> Tx -> Value
removePTFromMintedValue output tx =
case toList $ txMintValueToValue $ txMintValue $ txBodyContent $ txBody tx of
case toList $ txMintValueToValue $ txMintValue $ getTxBodyContent $ txBody tx of
[] -> error "expected minted value"
v -> fromList $ filter (not . isPT) v
where
Expand Down

0 comments on commit 85ef6b3

Please sign in to comment.