diff --git a/cardano-api/internal/Cardano/Api/Block.hs b/cardano-api/internal/Cardano/Api/Block.hs index cdc0ec9824..b1c4cbdea5 100644 --- a/cardano-api/internal/Cardano/Api/Block.hs +++ b/cardano-api/internal/Cardano/Api/Block.hs @@ -19,6 +19,7 @@ module Cardano.Api.Block , pattern Block , BlockHeader (..) , getBlockHeader + , getBlockTxs -- ** Blocks in the context of a consensus mode , BlockInMode (..) @@ -99,6 +100,7 @@ data Block era where -> Block era -- | A block consists of a header and a body containing transactions. +{-# DEPRECATED Block "Use getBlockHeader instead " #-} pattern Block :: BlockHeader -> [Tx era] -> Block era pattern Block header txs <- (getBlockHeaderAndTxs -> (header, txs)) diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs index a8175a074a..6a7e8c6ebd 100644 --- a/cardano-api/internal/Cardano/Api/LedgerState.hs +++ b/cardano-api/internal/Cardano/Api/LedgerState.hs @@ -540,7 +540,7 @@ foldBlocks nodeConfigFilePath socketPath validationMode state0 accumulate = hand -> CSP.ClientStNext n BlockInMode ChainPoint ChainTip IO () clientNextN n knownLedgerStates = CSP.ClientStNext - { CSP.recvMsgRollForward = \blockInMode@(BlockInMode _ (Block (BlockHeader slotNo _ currBlockNo) _)) serverChainTip -> do + { CSP.recvMsgRollForward = \blockInMode@(BlockInMode _ block) serverChainTip -> do let newLedgerStateE = applyBlock env @@ -554,7 +554,8 @@ foldBlocks nodeConfigFilePath socketPath validationMode state0 accumulate = hand case newLedgerStateE of Left err -> clientIdle_DoneNwithMaybeError n (Just err) Right newLedgerState -> do - let (knownLedgerStates', committedStates) = pushLedgerState env knownLedgerStates slotNo newLedgerState blockInMode + let BlockHeader slotNo _ currBlockNo = getBlockHeader block + (knownLedgerStates', committedStates) = pushLedgerState env knownLedgerStates slotNo newLedgerState blockInMode newClientTip = At currBlockNo newServerTip = fromChainTip serverChainTip @@ -729,9 +730,10 @@ chainSyncClientWithLedgerState env ledgerState0 validationMode (CS.ChainSyncClie ) goClientStNext (Right history) (CS.ClientStNext recvMsgRollForward recvMsgRollBackward) = CS.ClientStNext - ( \blkInMode@(BlockInMode _ (Block (BlockHeader slotNo _ _) _)) tip -> + ( \blkInMode@(BlockInMode _ block) tip -> CS.ChainSyncClient $ let + BlockHeader slotNo _ _ = getBlockHeader block newLedgerStateE = case Seq.lookup 0 history of Nothing -> error "Impossible! History should always be non-empty" Just (_, Left err, _) -> Left err @@ -875,8 +877,9 @@ chainSyncClientPipelinedWithLedgerState env ledgerState0 validationMode (CSP.Cha ) goClientStNext (Right history) n (CSP.ClientStNext recvMsgRollForward recvMsgRollBackward) = CSP.ClientStNext - ( \blkInMode@(BlockInMode _ (Block (BlockHeader slotNo _ _) _)) tip -> + ( \blkInMode@(BlockInMode _ block) tip -> let + BlockHeader slotNo _ _ = getBlockHeader block newLedgerStateE = case Seq.lookup 0 history of Nothing -> error "Impossible! History should always be non-empty" Just (_, Left err, _) -> Left err @@ -2173,8 +2176,9 @@ foldEpochState nodeConfigFilePath socketPath validationMode terminationEpoch ini -> CSP.ClientStNext n BlockInMode ChainPoint ChainTip IO () clientNextN n knownLedgerStates = CSP.ClientStNext - { CSP.recvMsgRollForward = \blockInMode@(BlockInMode era (Block (BlockHeader slotNo _ currBlockNo) _)) serverChainTip -> do - let newLedgerStateE = + { CSP.recvMsgRollForward = \blockInMode@(BlockInMode era block) serverChainTip -> do + let BlockHeader slotNo _ currBlockNo = getBlockHeader block + newLedgerStateE = applyBlock env ( maybe diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxBody.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxBody.hs index 32408ebf22..f2a2a994d6 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxBody.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxBody.hs @@ -35,7 +35,7 @@ prop_roundtrip_txbodycontent_txouts era = H.property $ do (body, content :: TxBodyContent BuildTx era) <- shelleyBasedEraConstraints era $ H.forAll $ genValidTxBody era -- Convert ledger body back via 'getTxBodyContent' and 'fromLedgerTxBody' - let (TxBody content') = body + let content' = getTxBodyContent body matchTxOuts (txOuts content) (txOuts content') where matchTxOuts :: MonadTest m => [TxOut CtxTx era] -> [TxOut CtxTx era] -> m () @@ -84,9 +84,8 @@ prop_roundtrip_txbodycontent_conway_fields = H.property $ do let sbe = ShelleyBasedEraConway (body, content) <- H.forAll $ genValidTxBody sbe -- Convert ledger body back via 'getTxBodyContent' and 'fromLedgerTxBody' - let (TxBody content') = body - - let proposals = getProposalProcedures . unFeatured <$> txProposalProcedures content + let content' = getTxBodyContent body + proposals = getProposalProcedures . unFeatured <$> txProposalProcedures content proposals' = getProposalProcedures . unFeatured <$> txProposalProcedures content' votes = getVotingProcedures . unFeatured <$> txVotingProcedures content votes' = getVotingProcedures . unFeatured <$> txVotingProcedures content'