diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 3e27692135a..b9c509562aa 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -82,7 +82,7 @@ library Cardano.Api.StakePoolMetadata Cardano.Api.Tx Cardano.Api.TxBody - Cardano.Api.TxInMode + Cardano.Api.InMode Cardano.Api.TxMetadata Cardano.Api.TxSubmit.ErrorRender Cardano.Api.TxSubmit.Types diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 1a3483ae3c7..c4fe390a0fe 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -581,6 +581,13 @@ module Cardano.Api ( UTxO(..), queryNodeLocalState, + -- *** Local tx monitoring + LocalTxMonitorClient(..), + LocalTxMonitoringQuery(..), + LocalTxMonitoringResult(..), + MempoolSizeAndCapacity(..), + queryTxMonitoringLocal, + EraHistory(..), getProgress, diff --git a/cardano-api/src/Cardano/Api/IPC.hs b/cardano-api/src/Cardano/Api/IPC.hs index 8634db5d21d..e3be2dca288 100644 --- a/cardano-api/src/Cardano/Api/IPC.hs +++ b/cardano-api/src/Cardano/Api/IPC.hs @@ -58,6 +58,13 @@ module Cardano.Api.IPC ( QueryInShelleyBasedEra(..), queryNodeLocalState, + -- *** Local tx monitoring + LocalTxMonitorClient(..), + LocalTxMonitoringQuery(..), + LocalTxMonitoringResult(..), + Consensus.MempoolSizeAndCapacity(..), + queryTxMonitoringLocal, + EraHistory(..), getProgress, @@ -79,7 +86,8 @@ import Data.Void (Void) import qualified Data.ByteString.Lazy as LBS import qualified Data.Map.Strict as Map -import Control.Concurrent.STM +import Control.Concurrent.STM (TMVar, atomically, newEmptyTMVarIO, putTMVar, takeTMVar, + tryPutTMVar) import Control.Monad (void) import Control.Tracer (nullTracer) @@ -95,6 +103,10 @@ import Ouroboros.Network.Protocol.LocalStateQuery.Client (LocalStateQu import qualified Ouroboros.Network.Protocol.LocalStateQuery.Client as Net.Query import Ouroboros.Network.Protocol.LocalStateQuery.Type (AcquireFailure (..)) import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as Net.Query +import Ouroboros.Network.Protocol.LocalTxMonitor.Client (LocalTxMonitorClient (..), + localTxMonitorClientPeer) +import qualified Ouroboros.Network.Protocol.LocalTxMonitor.Client as CTxMon +import qualified Ouroboros.Network.Protocol.LocalTxMonitor.Type as Consensus import Ouroboros.Network.Protocol.LocalTxSubmission.Client (LocalTxSubmissionClient (..), SubmitResult (..)) import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Client as Net.Tx @@ -110,11 +122,12 @@ import qualified Ouroboros.Consensus.Node.Run as Consensus import Cardano.Api.Block import Cardano.Api.HasTypeProxy +import Cardano.Api.InMode import Cardano.Api.Modes import Cardano.Api.NetworkId import Cardano.Api.Protocol.Types import Cardano.Api.Query -import Cardano.Api.TxInMode +import Cardano.Api.TxBody -- ---------------------------------------------------------------------------- -- The types for the client side of the node-to-client IPC protocols @@ -127,7 +140,7 @@ import Cardano.Api.TxInMode -- to\/from the types used by the underlying wire formats is handled by -- 'connectToLocalNode'. -- -data LocalNodeClientProtocols block point tip tx txerr query m = +data LocalNodeClientProtocols block point tip slot tx txid txerr query m = LocalNodeClientProtocols { localChainSyncClient :: LocalChainSyncClient block point tip m @@ -137,6 +150,9 @@ data LocalNodeClientProtocols block point tip tx txerr query m = , localStateQueryClient :: Maybe (LocalStateQueryClient block point query m ()) + + , localTxMonitoringClient + :: Maybe (LocalTxMonitorClient txid tx slot m ()) } data LocalChainSyncClient block point tip m @@ -150,7 +166,9 @@ type LocalNodeClientProtocolsInMode mode = (BlockInMode mode) ChainPoint ChainTip + SlotNo (TxInMode mode) + (TxIdInMode mode) (TxValidationErrorInMode mode) (QueryInMode mode) IO @@ -256,7 +274,8 @@ mkVersionedProtocols networkid ptcl unversionedClients = LocalNodeClientProtocolsForBlock { localChainSyncClientForBlock, localTxSubmissionClientForBlock, - localStateQueryClientForBlock + localStateQueryClientForBlock, + localTxMonitoringClientForBlock } ptclBlockVersion ptclVersion = @@ -298,7 +317,9 @@ mkVersionedProtocols networkid ptcl unversionedClients = Net.MuxPeer nullTracer cTxMonitorCodec - Net.localTxMonitorPeerNull + (maybe Net.localTxMonitorPeerNull + localTxMonitorClientPeer + localTxMonitoringClientForBlock) } where Consensus.Codecs { @@ -355,6 +376,10 @@ data LocalNodeClientProtocolsForBlock block = :: Maybe (LocalTxSubmissionClient (Consensus.GenTx block) (Consensus.ApplyTxErr block) IO ()) + , localTxMonitoringClientForBlock + :: Maybe (LocalTxMonitorClient (Consensus.TxId (Consensus.GenTx block)) + (Consensus.GenTx block) + SlotNo IO ()) } @@ -404,7 +429,8 @@ convLocalNodeClientProtocols LocalNodeClientProtocols { localChainSyncClient, localTxSubmissionClient, - localStateQueryClient + localStateQueryClient, + localTxMonitoringClient } = LocalNodeClientProtocolsForBlock { localChainSyncClientForBlock = case localChainSyncClient of @@ -416,9 +442,23 @@ convLocalNodeClientProtocols localTxSubmissionClient, localStateQueryClientForBlock = convLocalStateQueryClient mode <$> - localStateQueryClient + localStateQueryClient, + + localTxMonitoringClientForBlock = convLocalTxMonitoringClient mode <$> + localTxMonitoringClient + } +convLocalTxMonitoringClient + :: forall mode block m a. ConsensusBlockForMode mode ~ block + => Functor m + => ConsensusMode mode + -> LocalTxMonitorClient (TxIdInMode mode) (TxInMode mode) SlotNo m a + -> LocalTxMonitorClient (Consensus.TxId (Consensus.GenTx block)) (Consensus.GenTx block) SlotNo m a +convLocalTxMonitoringClient mode = + mapLocalTxMonitoringClient + toConsensusTxId + (fromConsensusGenTx mode) convLocalChainSyncClient :: forall mode block m a. @@ -473,6 +513,38 @@ convLocalStateQueryClient mode = fromConsensusQueryResult +--TODO: Move to consensus +mapLocalTxMonitoringClient + :: forall txid txid' tx tx' m a. Functor m + => (txid -> txid') + -> (tx'-> tx) + -> LocalTxMonitorClient txid tx SlotNo m a + -> LocalTxMonitorClient txid' tx' SlotNo m a +mapLocalTxMonitoringClient convTxid convTx ltxmc = + let LocalTxMonitorClient idleEff = ltxmc + in LocalTxMonitorClient (fmap convClientStateIdle idleEff) + where + convClientStateIdle + :: CTxMon.ClientStIdle txid tx SlotNo m a + -> CTxMon.ClientStIdle txid' tx' SlotNo m a + convClientStateIdle (CTxMon.SendMsgAcquire f) = + CTxMon.SendMsgAcquire $ (fmap . fmap) convClientStateAcquired f + convClientStateIdle (CTxMon.SendMsgDone a) = CTxMon.SendMsgDone a + + convClientStateAcquired + :: CTxMon.ClientStAcquired txid tx SlotNo m a + -> CTxMon.ClientStAcquired txid' tx' SlotNo m a + convClientStateAcquired (CTxMon.SendMsgNextTx f) = + CTxMon.SendMsgNextTx (\mTx -> convClientStateAcquired <$> f (convTx <$> mTx)) + convClientStateAcquired (CTxMon.SendMsgHasTx txid f)= + CTxMon.SendMsgHasTx (convTxid txid) ((fmap . fmap) convClientStateAcquired f) + convClientStateAcquired (CTxMon.SendMsgGetSizes f) = + CTxMon.SendMsgGetSizes $ (fmap . fmap) convClientStateAcquired f + convClientStateAcquired (CTxMon.SendMsgAwaitAcquire f) = + CTxMon.SendMsgAwaitAcquire $ (fmap . fmap ) convClientStateAcquired f + convClientStateAcquired (CTxMon.SendMsgRelease eff) = + CTxMon.SendMsgRelease (convClientStateIdle <$> eff) + -- ---------------------------------------------------------------------------- -- Wrappers for specific protocol use-cases -- @@ -496,7 +568,8 @@ queryNodeLocalState connctInfo mpoint query = do LocalNodeClientProtocols { localChainSyncClient = NoLocalChainSyncClient, localStateQueryClient = Just (singleQuery mpoint resultVar), - localTxSubmissionClient = Nothing + localTxSubmissionClient = Nothing, + localTxMonitoringClient = Nothing } atomically (takeTMVar resultVar) where @@ -535,7 +608,8 @@ submitTxToNodeLocal connctInfo tx = do LocalNodeClientProtocols { localChainSyncClient = NoLocalChainSyncClient, localTxSubmissionClient = Just (localTxSubmissionClientSingle resultVar), - localStateQueryClient = Nothing + localStateQueryClient = Nothing, + localTxMonitoringClient = Nothing } atomically (takeTMVar resultVar) where @@ -550,11 +624,98 @@ submitTxToNodeLocal connctInfo tx = do atomically $ putTMVar resultVar result pure (Net.Tx.SendMsgDone ()) + +data LocalTxMonitoringResult mode + = LocalTxMonitoringTxExists + TxId + SlotNo -- ^ Slot number at which the mempool snapshot was taken + | LocalTxMonitoringTxDoesNotExist + TxId + SlotNo -- ^ Slot number at which the mempool snapshot was taken + | LocalTxMonitoringNextTx + (Maybe (TxInMode mode)) + SlotNo -- ^ Slot number at which the mempool snapshot was taken + | LocalTxMonitoringMempoolSizeAndCapacity + Consensus.MempoolSizeAndCapacity + SlotNo -- ^ Slot number at which the mempool snapshot was taken + +data LocalTxMonitoringQuery mode + -- | Query if a particular tx exists in the mempool. Note that, the absence + -- of a transaction does not imply anything about how the transaction was + -- processed: it may have been dropped, or inserted in a block. + = LocalTxMonitoringQueryTx (TxIdInMode mode) + -- | The mempool is modeled as an ordered list of transactions and thus, can + -- be traversed linearly. 'LocalTxMonitoringSendNextTx' requests the next transaction from the + -- current list. This must be a transaction that was not previously sent to + -- the client for this particular snapshot. + | LocalTxMonitoringSendNextTx + -- | Ask the server about the current mempool's capacity and sizes. This is + -- fixed in a given snapshot. + | LocalTxMonitoringMempoolInformation + + +queryTxMonitoringLocal + :: forall mode. LocalNodeConnectInfo mode + -> LocalTxMonitoringQuery mode + -> IO (LocalTxMonitoringResult mode) +queryTxMonitoringLocal connectInfo localTxMonitoringQuery = do + resultVar <- newEmptyTMVarIO + + let client = case localTxMonitoringQuery of + LocalTxMonitoringQueryTx txidInMode -> + localTxMonitorClientTxExists txidInMode resultVar + LocalTxMonitoringSendNextTx -> + localTxMonitorNextTx resultVar + LocalTxMonitoringMempoolInformation -> + localTxMonitorMempoolInfo resultVar + + connectToLocalNode + connectInfo + LocalNodeClientProtocols { + localChainSyncClient = NoLocalChainSyncClient, + localTxSubmissionClient = Nothing, + localStateQueryClient = Nothing, + localTxMonitoringClient = Just client + } + atomically (takeTMVar resultVar) + where + localTxMonitorClientTxExists + :: TxIdInMode mode + -> TMVar (LocalTxMonitoringResult mode) + -> LocalTxMonitorClient (TxIdInMode mode) (TxInMode mode) SlotNo IO () + localTxMonitorClientTxExists tIdInMode@(TxIdInMode txid _) resultVar = do + LocalTxMonitorClient $ return $ + CTxMon.SendMsgAcquire $ \slt -> do + return $ CTxMon.SendMsgHasTx tIdInMode $ \txPresentBool -> do + if txPresentBool + then atomically . putTMVar resultVar $ LocalTxMonitoringTxExists txid slt + else atomically . putTMVar resultVar $ LocalTxMonitoringTxDoesNotExist txid slt + return $ CTxMon.SendMsgRelease $ return $ CTxMon.SendMsgDone () + + localTxMonitorNextTx + :: TMVar (LocalTxMonitoringResult mode) + -> LocalTxMonitorClient (TxIdInMode mode) (TxInMode mode) SlotNo IO () + localTxMonitorNextTx resultVar = + LocalTxMonitorClient $ return $ do + CTxMon.SendMsgAcquire $ \slt -> do + return $ CTxMon.SendMsgNextTx $ \mTx -> do + atomically $ putTMVar resultVar $ LocalTxMonitoringNextTx mTx slt + return $ CTxMon.SendMsgRelease $ return $ CTxMon.SendMsgDone () + + localTxMonitorMempoolInfo + :: TMVar (LocalTxMonitoringResult mode) + -> LocalTxMonitorClient (TxIdInMode mode) (TxInMode mode) SlotNo IO () + localTxMonitorMempoolInfo resultVar = + LocalTxMonitorClient $ return $ do + CTxMon.SendMsgAcquire $ \slt -> do + return$ CTxMon.SendMsgGetSizes $ \mempoolCapacity -> do + atomically $ putTMVar resultVar $ LocalTxMonitoringMempoolSizeAndCapacity mempoolCapacity slt + return $ CTxMon.SendMsgRelease $ return $ CTxMon.SendMsgDone () + -- ---------------------------------------------------------------------------- -- Get tip as 'ChainPoint' -- - getLocalChainTip :: LocalNodeConnectInfo mode -> IO ChainTip getLocalChainTip localNodeConInfo = do resultVar <- newEmptyTMVarIO @@ -564,6 +725,7 @@ getLocalChainTip localNodeConInfo = do { localChainSyncClient = LocalChainSyncClient $ chainSyncGetCurrentTip resultVar , localTxSubmissionClient = Nothing , localStateQueryClient = Nothing + , localTxMonitoringClient = Nothing } atomically $ takeTMVar resultVar diff --git a/cardano-api/src/Cardano/Api/IPC/Monad.hs b/cardano-api/src/Cardano/Api/IPC/Monad.hs index eba3017ba5c..fe77e76710c 100644 --- a/cardano-api/src/Cardano/Api/IPC/Monad.hs +++ b/cardano-api/src/Cardano/Api/IPC/Monad.hs @@ -9,20 +9,20 @@ module Cardano.Api.IPC.Monad , determineEraExpr ) where -import Cardano.Api.Block -import Cardano.Api.Eras -import Cardano.Api.IPC -import Cardano.Api.Modes -import Control.Applicative -import Control.Concurrent.STM -import Control.Monad -import Control.Monad.IO.Class -import Control.Monad.Trans.Cont -import Data.Either -import Data.Function -import Data.Maybe -import Cardano.Ledger.Shelley.Scripts () -import System.IO +import Cardano.Api.Block +import Cardano.Api.Eras +import Cardano.Api.IPC +import Cardano.Api.Modes +import Cardano.Ledger.Shelley.Scripts () +import Control.Applicative +import Control.Concurrent.STM +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Trans.Cont +import Data.Either +import Data.Function +import Data.Maybe +import System.IO import qualified Ouroboros.Network.Protocol.LocalStateQuery.Client as Net.Query import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as Net.Query @@ -62,6 +62,7 @@ executeLocalStateQueryExpr connectInfo mpoint f = do { localChainSyncClient = NoLocalChainSyncClient , localStateQueryClient = Just $ setupLocalStateQueryExpr waitResult mpoint tmvResultLocalState (f ntcVersion) , localTxSubmissionClient = Nothing + , localTxMonitoringClient = Nothing } ) diff --git a/cardano-api/src/Cardano/Api/TxInMode.hs b/cardano-api/src/Cardano/Api/InMode.hs similarity index 62% rename from cardano-api/src/Cardano/Api/TxInMode.hs rename to cardano-api/src/Cardano/Api/InMode.hs index fad91ce0a95..b2a16900fef 100644 --- a/cardano-api/src/Cardano/Api/TxInMode.hs +++ b/cardano-api/src/Cardano/Api/InMode.hs @@ -6,12 +6,17 @@ -- | Transactions in the context of a consensus mode, and other types used in -- the transaction submission protocol. -- -module Cardano.Api.TxInMode ( +module Cardano.Api.InMode ( -- * Transaction in a consensus mode TxInMode(..), + fromConsensusGenTx, toConsensusGenTx, + -- * Transaction id in a consensus mode + TxIdInMode(..), + toConsensusTxId, + -- * Transaction validation errors TxValidationError(..), TxValidationErrorInMode(..), @@ -29,10 +34,12 @@ import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch import qualified Ouroboros.Consensus.HardFork.Combinator.Degenerate as Consensus import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Consensus import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus +import qualified Ouroboros.Consensus.TypeFamilyWrappers as Consensus import Cardano.Api.Eras import Cardano.Api.Modes import Cardano.Api.Tx +import Cardano.Api.TxBody -- ---------------------------------------------------------------------------- @@ -60,6 +67,34 @@ data TxInMode mode where deriving instance Show (TxInMode mode) +fromConsensusGenTx + :: ConsensusBlockForMode mode ~ block + => ConsensusMode mode -> Consensus.GenTx block -> TxInMode mode +fromConsensusGenTx ByronMode (Consensus.HardForkGenTx (Consensus.OneEraGenTx (Z tx'))) = + TxInByronSpecial tx' ByronEraInByronMode + +fromConsensusGenTx ShelleyMode (Consensus.HardForkGenTx (Consensus.OneEraGenTx (Z tx'))) = + let Consensus.ShelleyTx _txid shelleyEraTx = tx' + in TxInMode (ShelleyTx ShelleyBasedEraShelley shelleyEraTx) ShelleyEraInShelleyMode + +fromConsensusGenTx CardanoMode (Consensus.HardForkGenTx (Consensus.OneEraGenTx (Z tx'))) = + TxInByronSpecial tx' ByronEraInCardanoMode + +fromConsensusGenTx CardanoMode (Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (Z tx')))) = + let Consensus.ShelleyTx _txid shelleyEraTx = tx' + in TxInMode (ShelleyTx ShelleyBasedEraShelley shelleyEraTx) ShelleyEraInCardanoMode + +fromConsensusGenTx CardanoMode (Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (Z tx'))))) = + let Consensus.ShelleyTx _txid shelleyEraTx = tx' + in TxInMode (ShelleyTx ShelleyBasedEraAllegra shelleyEraTx) AllegraEraInCardanoMode + +fromConsensusGenTx CardanoMode (Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (Z tx')))))) = + let Consensus.ShelleyTx _txid shelleyEraTx = tx' + in TxInMode (ShelleyTx ShelleyBasedEraMary shelleyEraTx) MaryEraInCardanoMode + +fromConsensusGenTx CardanoMode (Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (S (Z tx'))))))) = + let Consensus.ShelleyTx _txid shelleyEraTx = tx' + in TxInMode (ShelleyTx ShelleyBasedEraAlonzo shelleyEraTx) AlonzoEraInCardanoMode toConsensusGenTx :: ConsensusBlockForMode mode ~ block => TxInMode mode @@ -107,7 +142,64 @@ toConsensusGenTx (TxInMode (ShelleyTx _ tx) AlonzoEraInCardanoMode) = where tx' = Consensus.mkShelleyTx tx +-- ---------------------------------------------------------------------------- +-- Transaction ids in the context of a consensus mode +-- + +-- | A 'TxId' in one of the eras supported by a given protocol mode. +-- +-- For multi-era modes such as the 'CardanoMode' this type is a sum of the +-- different transaction types for all the eras. It is used in the +-- LocalTxMonitoring protocol. +-- +data TxIdInMode mode where + TxIdInMode :: TxId -> EraInMode era mode -> TxIdInMode mode + +toConsensusTxId + :: ConsensusBlockForMode mode ~ block + => TxIdInMode mode -> Consensus.TxId (Consensus.GenTx block) +toConsensusTxId (TxIdInMode txid ByronEraInByronMode) = + Consensus.HardForkGenTxId . Consensus.OneEraGenTxId . Z $ Consensus.WrapGenTxId txid' + where + txid' :: Consensus.TxId (Consensus.GenTx Consensus.ByronBlock) + txid' = Consensus.ByronTxId $ toByronTxId txid + +toConsensusTxId (TxIdInMode t ShelleyEraInShelleyMode) = + Consensus.HardForkGenTxId $ Consensus.OneEraGenTxId $ Z (Consensus.WrapGenTxId txid') + where + txid' :: Consensus.TxId (Consensus.GenTx (Consensus.ShelleyBlock Consensus.StandardShelley)) + txid' = Consensus.ShelleyTxId $ toShelleyTxId t + +toConsensusTxId (TxIdInMode txid ByronEraInCardanoMode) = + Consensus.HardForkGenTxId . Consensus.OneEraGenTxId . Z $ Consensus.WrapGenTxId txid' + where + txid' :: Consensus.TxId (Consensus.GenTx Consensus.ByronBlock) + txid' = Consensus.ByronTxId $ toByronTxId txid + +toConsensusTxId (TxIdInMode txid ShelleyEraInCardanoMode) = + Consensus.HardForkGenTxId (Consensus.OneEraGenTxId (S (Z (Consensus.WrapGenTxId txid')))) + where + txid' :: Consensus.TxId (Consensus.GenTx (Consensus.ShelleyBlock Consensus.StandardShelley)) + txid' = Consensus.ShelleyTxId $ toShelleyTxId txid + +toConsensusTxId (TxIdInMode txid AllegraEraInCardanoMode) = + Consensus.HardForkGenTxId (Consensus.OneEraGenTxId (S (S (Z (Consensus.WrapGenTxId txid'))))) + where + txid' :: Consensus.TxId (Consensus.GenTx (Consensus.ShelleyBlock Consensus.StandardAllegra)) + txid' = Consensus.ShelleyTxId $ toShelleyTxId txid + +toConsensusTxId (TxIdInMode txid MaryEraInCardanoMode) = + Consensus.HardForkGenTxId (Consensus.OneEraGenTxId (S (S (S (Z (Consensus.WrapGenTxId txid')))))) + where + txid' :: Consensus.TxId (Consensus.GenTx (Consensus.ShelleyBlock Consensus.StandardMary)) + txid' = Consensus.ShelleyTxId $ toShelleyTxId txid + +toConsensusTxId (TxIdInMode txid AlonzoEraInCardanoMode) = + Consensus.HardForkGenTxId (Consensus.OneEraGenTxId (S (S (S (S (Z (Consensus.WrapGenTxId txid'))))))) + where + txid' :: Consensus.TxId (Consensus.GenTx (Consensus.ShelleyBlock Consensus.StandardAlonzo)) + txid' = Consensus.ShelleyTxId $ toShelleyTxId txid -- ---------------------------------------------------------------------------- -- Transaction validation errors in the context of eras and consensus modes diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index e8a74b34919..9801d7fcbd8 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -116,9 +116,10 @@ import qualified Cardano.Ledger.Crypto as Crypto import qualified Cardano.Ledger.Era as Ledger import qualified Cardano.Ledger.Keys as Shelley.Spec import qualified Cardano.Ledger.Shelley.API as ShelleyAPI -import qualified Cardano.Protocol.TPraos.API as TPraos import qualified Cardano.Ledger.Shelley.Genesis as Shelley.Spec +import qualified Cardano.Protocol.TPraos.API as TPraos import qualified Cardano.Protocol.TPraos.BHeader as TPraos +import qualified Cardano.Protocol.TPraos.Rules.Prtcl as TPraos import qualified Cardano.Protocol.TPraos.Rules.Tickn as Tick import Cardano.Slotting.EpochInfo (EpochInfo) import qualified Cardano.Slotting.EpochInfo.API as Slot @@ -151,7 +152,6 @@ import qualified Ouroboros.Network.Block import qualified Ouroboros.Network.Protocol.ChainSync.Client as CS import qualified Ouroboros.Network.Protocol.ChainSync.ClientPipelined as CSP import Ouroboros.Network.Protocol.ChainSync.PipelineDecision -import qualified Cardano.Protocol.TPraos.Rules.Prtcl as TPraos data InitialLedgerStateError = ILSEConfigFile Text @@ -360,7 +360,8 @@ foldBlocks nodeConfigFilePath socketPath validationMode state0 accumulate = do LocalNodeClientProtocols { localChainSyncClient = LocalChainSyncClientPipelined (chainSyncClient 50 stateIORef errorIORef env ledgerState), localTxSubmissionClient = Nothing, - localStateQueryClient = Nothing + localStateQueryClient = Nothing, + localTxMonitoringClient = Nothing } -- | Defines the client side of the chain sync protocol. diff --git a/cardano-api/src/Cardano/Api/Modes.hs b/cardano-api/src/Cardano/Api/Modes.hs index dcb46d9f080..dfd4ffc0ff1 100644 --- a/cardano-api/src/Cardano/Api/Modes.hs +++ b/cardano-api/src/Cardano/Api/Modes.hs @@ -43,7 +43,7 @@ import Prelude import Cardano.Api.Eras import Cardano.Ledger.Crypto (StandardCrypto) -import Data.Aeson (Value, FromJSON (parseJSON), ToJSON (toJSON)) +import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value) import Data.Aeson.Types (Parser, prependFailure, typeMismatch) import Data.SOP.Strict (K (K), NS (S, Z)) import Data.Text (Text) @@ -53,11 +53,8 @@ import qualified Ouroboros.Consensus.Cardano.Block as Consensus import qualified Ouroboros.Consensus.Cardano.ByronHFC as Consensus (ByronBlockHFC) import Ouroboros.Consensus.HardFork.Combinator as Consensus (EraIndex (..), eraIndexSucc, eraIndexZero) -import Ouroboros.Consensus.Shelley.Eras - (StandardShelley, - StandardAllegra, - StandardMary, - StandardAlonzo) +import Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardAlonzo, StandardMary, + StandardShelley) import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus import qualified Ouroboros.Consensus.Shelley.ShelleyHFC as Consensus (ShelleyBlockHFC) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 4a47b080d17..1e5a1ad3dea 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -121,6 +121,7 @@ module Cardano.Api.TxBody ( mapTxScriptWitnesses, -- * Internal conversion functions & types + toByronTxId, toShelleyTxId, toShelleyTxIn, toShelleyTxOut, @@ -188,9 +189,11 @@ import qualified Cardano.Crypto.Hashing as Byron import qualified Cardano.Ledger.Address as Shelley import qualified Cardano.Ledger.AuxiliaryData as Ledger (hashAuxiliaryData) import Cardano.Ledger.BaseTypes (StrictMaybe (..), maybeToStrictMaybe) +import qualified Cardano.Ledger.BaseTypes as Ledger import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Credential as Shelley +import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Era as Ledger import qualified Cardano.Ledger.Keys as Shelley import qualified Cardano.Ledger.SafeHash as SafeHash @@ -242,8 +245,7 @@ import Cardano.Api.TxMetadata import Cardano.Api.Utils import Cardano.Api.Value import Cardano.Api.ValueParser -import qualified Cardano.Ledger.BaseTypes as Ledger -import Cardano.Ledger.Crypto (StandardCrypto) + {- HLINT ignore "Redundant flip" -} {- HLINT ignore "Use section" -} diff --git a/cardano-client-demo/ChainSyncClientWithLedgerState.hs b/cardano-client-demo/ChainSyncClientWithLedgerState.hs index 69df23732cf..f1098ae5c38 100644 --- a/cardano-client-demo/ChainSyncClientWithLedgerState.hs +++ b/cardano-client-demo/ChainSyncClientWithLedgerState.hs @@ -66,7 +66,8 @@ main = do LocalNodeClientProtocols { localChainSyncClient = LocalChainSyncClient client, localTxSubmissionClient = Nothing, - localStateQueryClient = Nothing + localStateQueryClient = Nothing, + localTxMonitoringClient = Nothing } -- Connect to the node. diff --git a/cardano-client-demo/ScanBlocks.hs b/cardano-client-demo/ScanBlocks.hs index f78847c0a4c..a15a1c0dfa6 100644 --- a/cardano-client-demo/ScanBlocks.hs +++ b/cardano-client-demo/ScanBlocks.hs @@ -48,7 +48,8 @@ main = do LocalNodeClientProtocols { localChainSyncClient = LocalChainSyncClient chainSyncClient, localTxSubmissionClient = Nothing, - localStateQueryClient = Nothing + localStateQueryClient = Nothing, + localTxMonitoringClient = Nothing } -- | Defines the client side of the chain sync protocol. diff --git a/cardano-client-demo/ScanBlocksPipelined.hs b/cardano-client-demo/ScanBlocksPipelined.hs index af2b981a7e1..080202aa90a 100644 --- a/cardano-client-demo/ScanBlocksPipelined.hs +++ b/cardano-client-demo/ScanBlocksPipelined.hs @@ -57,7 +57,8 @@ main = do LocalNodeClientProtocols { localChainSyncClient = LocalChainSyncClientPipelined (chainSyncClient 50), localTxSubmissionClient = Nothing, - localStateQueryClient = Nothing + localStateQueryClient = Nothing, + localTxMonitoringClient = Nothing } diff --git a/cardano-node-chairman/app/Cardano/Chairman.hs b/cardano-node-chairman/app/Cardano/Chairman.hs index d0c5bf6edfc..75f2508fdff 100644 --- a/cardano-node-chairman/app/Cardano/Chairman.hs +++ b/cardano-node-chairman/app/Cardano/Chairman.hs @@ -281,6 +281,7 @@ runChairman tracer networkId runningTime socketPaths cModeParams secParam = do { localChainSyncClient = chairmanChainSyncClient , localTxSubmissionClient = Nothing , localStateQueryClient = Nothing + , localTxMonitoringClient = Nothing } in connectToLocalNode localConnInfo protocolsInMode