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/Governance/Poll.hs b/cardano-api/internal/Cardano/Api/Governance/Poll.hs index 7e4063e5c2..f4aee9494a 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Poll.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Poll.hs @@ -7,7 +7,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} -- | An API for driving on-chain poll for SPOs. -- @@ -341,12 +340,13 @@ verifyPollAnswer :: GovernancePoll -> InAnyShelleyBasedEra Tx -> Either GovernancePollError [Hash PaymentKey] -verifyPollAnswer poll (InAnyShelleyBasedEra _era (getTxBody -> TxBody body)) = do +verifyPollAnswer poll (InAnyShelleyBasedEra _era tx) = do answer <- extractPollAnswer (txMetadata body) answer `hasMatchingHash` hashGovernancePoll poll answer `isAmongAcceptableChoices` govPollAnswers poll extraKeyWitnesses (txExtraKeyWits body) where + body = getTxBodyContent $ getTxBody tx extractPollAnswer = \case TxMetadataNone -> Left ErrGovernancePollNoAnswer 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/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index 93dd37f9b9..ac2e932cd3 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -2147,6 +2147,7 @@ createAndValidateTransactionBody -> Either TxBodyError (TxBody era) createAndValidateTransactionBody = makeShelleyTransactionBody +{-# DEPRECATED TxBody "Use getTxBodyContent $ getTxBody instead" #-} pattern TxBody :: TxBodyContent ViewTx era -> TxBody era pattern TxBody txbodycontent <- (getTxBodyContent -> txbodycontent) diff --git a/cardano-api/internal/Cardano/Api/Tx/Sign.hs b/cardano-api/internal/Cardano/Api/Tx/Sign.hs index 00017e9fc7..83c22a77ee 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Sign.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Sign.hs @@ -52,8 +52,6 @@ module Cardano.Api.Tx.Sign -- * Data family instances , AsType ( AsTx - , AsByronTx - , AsShelleyTx , AsMaryTx , AsAllegraTx , AsAlonzoTx @@ -185,18 +183,6 @@ instance HasTypeProxy era => HasTypeProxy (Tx era) where data AsType (Tx era) = AsTx (AsType era) proxyToAsType _ = AsTx (proxyToAsType (Proxy :: Proxy era)) -{-# DEPRECATED AsByronTx "Use AsTx AsByronEra instead." #-} -pattern AsByronTx :: AsType (Tx ByronEra) -pattern AsByronTx = AsTx AsByronEra - -{-# COMPLETE AsByronTx #-} - -{-# DEPRECATED AsShelleyTx "Use AsTx AsShelleyEra instead." #-} -pattern AsShelleyTx :: AsType (Tx ShelleyEra) -pattern AsShelleyTx = AsTx AsShelleyEra - -{-# COMPLETE AsShelleyTx #-} - pattern AsMaryTx :: AsType (Tx MaryEra) pattern AsMaryTx = AsTx AsMaryEra diff --git a/cardano-api/internal/Cardano/Api/TxMetadata.hs b/cardano-api/internal/Cardano/Api/TxMetadata.hs index c86f6d22f2..9aaaa703b8 100644 --- a/cardano-api/internal/Cardano/Api/TxMetadata.hs +++ b/cardano-api/internal/Cardano/Api/TxMetadata.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} -- | Metadata embedded in transactions module Cardano.Api.TxMetadata @@ -461,12 +460,14 @@ metadataFromJson schema = return (k', v') convTopLevelKey :: Aeson.Key -> Either TxMetadataJsonError Word64 - convTopLevelKey (Aeson.toText -> k) = + convTopLevelKey key = case parseAll (pUnsigned <* Atto.endOfInput) k of Just n | n <= fromIntegral (maxBound :: Word64) -> Right (fromIntegral n) _ -> Left (TxMetadataJsonToplevelBadKey k) + where + k = Aeson.toText key validateMetadataValue :: TxMetadataValue -> Either TxMetadataRangeError () validateMetadataValue v = diff --git a/cardano-api/internal/Cardano/Api/Value.hs b/cardano-api/internal/Cardano/Api/Value.hs index 9fc9f18607..6b5204531b 100644 --- a/cardano-api/internal/Cardano/Api/Value.hs +++ b/cardano-api/internal/Cardano/Api/Value.hs @@ -5,7 +5,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} -- | Currency values module Cardano.Api.Value @@ -387,13 +386,15 @@ instance FromJSON ValueNestedRep where where parsePid :: (Aeson.Key, Aeson.Value) -> Parser ValueNestedBundle parsePid ("lovelace", q) = ValueNestedBundleAda <$> parseJSON q - parsePid (Aeson.toText -> pid, quantityBundleJson) = do + parsePid (key, quantityBundleJson) = do sHash <- failEitherWith (\e -> "Failure when deserialising PolicyId: " ++ displayError e) $ deserialiseFromRawBytesHex AsScriptHash $ Text.encodeUtf8 pid ValueNestedBundle (PolicyId sHash) <$> parseJSON quantityBundleJson + where + pid = Aeson.toText key -- ---------------------------------------------------------------------------- -- Printing and pretty-printing 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'