cardano-api: 10.8

Author: locallycompact

cabal.project

@@ -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

flake.lock

@@ -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

hydra-cardano-api/hydra-cardano-api.cabal

@@ -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

hydra-cardano-api/src/Hydra/Cardano/Api.hs

@@ -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)) <> ")"

hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs

@@ -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
 

hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs

@@ -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.

hydra-cardano-api/src/Hydra/Cardano/Api/TxIn.hs

@@ -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.

hydra-cardano-api/src/Hydra/Cardano/Api/TxOut.hs

@@ -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)
@@ -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 $

hydra-chain-observer/src/Hydra/Ouroborus/ChainObserver.hs

@@ -43,10 +43,11 @@ import Hydra.Cardano.Api (
   TxValidationErrorInCardanoMode,
   chainTipToChainPoint,
   connectToLocalNode,
+  getBlockHeader,
+  getBlockTxs,
   getTxBody,
   getTxId,
   toLedgerUTxO,
-  pattern Block,
  )
 import Hydra.Chain (
   ChainComponent,
@@ -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

hydra-node/src/Hydra/Chain/Direct.hs

@@ -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
 

hydra-tx/test/Hydra/Tx/Contract/FanOut.hs

@@ -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
@@ -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.
@@ -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
@@ -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