diff --git a/lib/benchmarks/exe/restore-bench.hs b/lib/benchmarks/exe/restore-bench.hs index 962385c5656..a60995b0215 100644 --- a/lib/benchmarks/exe/restore-bench.hs +++ b/lib/benchmarks/exe/restore-bench.hs @@ -208,9 +208,6 @@ import Cardano.Wallet.Primitive.Types import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) -import Cardano.Wallet.Primitive.Types.Block - ( chainPointFromBlockHeader' - ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) @@ -788,9 +785,9 @@ bench_baseline_restoration $ ChainFollower { checkpointPolicy = const CP.atTip , readChainPoints = readTVarIO chainPointT - , rollForward = \blocks ntip -> do + , rollForward = \blocks nodeTip -> do atomically $ writeTVar chainPointT - [chainPointFromBlockHeader' ntip] + [Read.chainPointFromChainTip nodeTip] let (ntxs, hss) = NE.unzip $ numberOfTransactionsInBlock <$> blocks (heights, slots) = NE.unzip hss diff --git a/lib/network-layer/src/Cardano/Wallet/Network.hs b/lib/network-layer/src/Cardano/Wallet/Network.hs index bf78523216b..84557d8d22f 100644 --- a/lib/network-layer/src/Cardano/Wallet/Network.hs +++ b/lib/network-layer/src/Cardano/Wallet/Network.hs @@ -50,9 +50,6 @@ import Cardano.Wallet.Primitive.Slotting import Cardano.Wallet.Primitive.SyncProgress ( SyncProgress (..) ) -import Cardano.Wallet.Primitive.Types.Block - ( BlockHeader - ) import Cardano.Wallet.Primitive.Types.Checkpoints.Policy ( CheckpointPolicy ) @@ -113,7 +110,7 @@ import qualified Internal.Cardano.Write.Tx as Write data NetworkLayer m block = NetworkLayer { chainSync :: Tracer IO ChainFollowLog - -> ChainFollower m Read.ChainPoint BlockHeader (NonEmpty block) + -> ChainFollower m Read.ChainPoint Read.ChainTip (NonEmpty block) -> m () -- ^ Connect to the node and run the ChainSync protocol. -- The callbacks provided in the 'ChainFollower' argument diff --git a/lib/network-layer/src/Cardano/Wallet/Network/Implementation.hs b/lib/network-layer/src/Cardano/Wallet/Network/Implementation.hs index aaf74d9d5be..74811c5e647 100644 --- a/lib/network-layer/src/Cardano/Wallet/Network/Implementation.hs +++ b/lib/network-layer/src/Cardano/Wallet/Network/Implementation.hs @@ -99,8 +99,7 @@ import Cardano.Wallet.Primitive.Ledger.Read.Block.Header ( getBlockHeader ) import Cardano.Wallet.Primitive.Ledger.Shelley - ( fromTip' - , nodeToClientVersions + ( nodeToClientVersions , toCardanoEra , unsealShelleyTx ) @@ -481,7 +480,6 @@ withNodeNetworkLayerBase withStats $ \trChainSyncLog -> do let mapB = getBlockHeader getGenesisBlockHash mapP = fromOuroborosPoint - let blockHeader = fromTip' gp let client = mkWalletClient (mapChainSyncLog mapB mapP >$< trChainSyncLog) @@ -489,7 +487,7 @@ withNodeNetworkLayerBase (mapChainFollower toOuroborosPoint mapP - blockHeader + fromOuroborosTip id follower ) @@ -528,7 +526,7 @@ withNodeNetworkLayerBase , syncProgress = _syncProgress interpreterVar } where - gp@GenesisParameters + GenesisParameters { getGenesisBlockHash , getGenesisBlockDate } = genesisParameters np diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Ledger/Shelley.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Ledger/Shelley.hs index 056cc7e7a47..062a6b30157 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Ledger/Shelley.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Ledger/Shelley.hs @@ -82,9 +82,6 @@ module Cardano.Wallet.Primitive.Ledger.Shelley , toCardanoEra , fromShelleyTxOut , fromGenesisData - , fromTip - , fromTip' - , toTip , slottingParametersFromGenesis , getBabbageProducer , getConwayProducer @@ -221,8 +218,7 @@ import Data.ByteString ( ByteString ) import Data.ByteString.Short - ( fromShort - , toShort + ( toShort ) import Data.Coerce ( coerce @@ -293,9 +289,6 @@ import Ouroboros.Consensus.Shelley.Ledger.Block ) import Ouroboros.Network.Block ( BlockNo (..) - , Point (..) - , Tip (..) - , getTipPoint ) import Ouroboros.Network.NodeToClient ( ConnectionId (..) @@ -303,9 +296,6 @@ import Ouroboros.Network.NodeToClient , NodeToClientVersion (..) , NodeToClientVersionData ) -import Ouroboros.Network.Point - ( WithOrigin (..) - ) import qualified Cardano.Api as Cardano import qualified Cardano.Api.Shelley as Cardano @@ -376,7 +366,6 @@ import qualified Ouroboros.Consensus.Protocol.Praos.Header as Consensus import qualified Ouroboros.Consensus.Protocol.TPraos as Consensus import qualified Ouroboros.Consensus.Shelley.Ledger as O import qualified Ouroboros.Network.Block as O -import qualified Ouroboros.Network.Point as Point -------------------------------------------------------------------------------- -- @@ -515,49 +504,10 @@ toCardanoEra = \case BlockBabbage{} -> AnyCardanoEra BabbageEra BlockConway{} -> AnyCardanoEra ConwayEra -fromCardanoHash :: O.HeaderHash (CardanoBlock sc) -> W.Hash "BlockHeader" -fromCardanoHash = W.Hash . fromShort . getOneEraHash - -- FIXME unsafe conversion (Word64 -> Word32) fromBlockNo :: BlockNo -> Quantity "block" Word32 fromBlockNo (BlockNo h) = Quantity (fromIntegral h) -fromTip' :: W.GenesisParameters -> Tip (CardanoBlock sc) -> W.BlockHeader -fromTip' gp = fromTip (W.getGenesisBlockHash gp) - -fromTip - :: W.Hash "Genesis" - -> Tip (CardanoBlock sc) - -> W.BlockHeader -fromTip genesisHash tip = case getPoint (getTipPoint tip) of - Origin -> W.BlockHeader - { slotNo = Slotting.SlotNo 0 - , blockHeight = Quantity 0 - , headerHash = coerce genesisHash - , parentHeaderHash = Nothing - } - At blk -> W.BlockHeader - { slotNo = Point.blockPointSlot blk - , blockHeight = fromBlockNo $ getLegacyTipBlockNo tip - , headerHash = fromCardanoHash $ Point.blockPointHash blk - -- TODO: parentHeaderHash could be removed. - , parentHeaderHash = Just $ W.Hash "parentHeaderHash - unused in Shelley" - } - where - -- TODO: This function was marked deprecated in ouroboros-network. - -- It is wrong, because `Origin` doesn't have a block number. - -- We should remove it. - getLegacyTipBlockNo t = case O.getTipBlockNo t of - Origin -> BlockNo 0 - At x -> x - -toTip :: W.Hash "Genesis" -> W.BlockHeader -> Tip (CardanoBlock sc) -toTip genesisHash (W.BlockHeader sl bl h _) - | h == (coerce genesisHash) = O.TipGenesis - | otherwise = O.Tip sl - (toCardanoHash h) - (BlockNo $ fromIntegral $ getQuantity bl) - -- NOTE: Unsafe conversion from Natural -> Word16 fromMaxSize :: Word32 -> Quantity "byte" Word16 fromMaxSize = Quantity . fromIntegral diff --git a/lib/primitive/test/spec/Cardano/Wallet/Primitive/Ledger/ShelleySpec.hs b/lib/primitive/test/spec/Cardano/Wallet/Primitive/Ledger/ShelleySpec.hs index 12a0fe18020..1bccb841ad1 100644 --- a/lib/primitive/test/spec/Cardano/Wallet/Primitive/Ledger/ShelleySpec.hs +++ b/lib/primitive/test/spec/Cardano/Wallet/Primitive/Ledger/ShelleySpec.hs @@ -49,13 +49,11 @@ import Cardano.Wallet.Primitive.Ledger.Shelley , StandardCrypto , decentralizationLevelFromPParams , fromCardanoValue - , fromTip , interval0 , interval1 , invertUnitInterval , toCardanoHash , toCardanoValue - , toTip ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) @@ -168,7 +166,6 @@ import qualified Cardano.Api as Cardano import qualified Cardano.Ledger.BaseTypes as SL import qualified Cardano.Ledger.Shelley as SL import qualified Cardano.Ledger.Shelley.PParams as SL -import qualified Cardano.Wallet.Primitive.Types.Block as W import qualified Cardano.Wallet.Primitive.Types.EpochNo as W import qualified Cardano.Wallet.Primitive.Types.SlotId as W import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle @@ -178,10 +175,6 @@ import qualified Data.Text.Encoding as T spec :: Spec spec = do describe "Conversions" $ do - it "toTip' . fromTip' == id" $ property $ \gh tip -> do - let fromTip' = fromTip gh - let toTip' = toTip gh :: W.BlockHeader -> Tip (CardanoBlock StandardCrypto) - toTip' (fromTip' tip) === tip it "unsafeIntToWord" $ property prop_unsafeIntToWord diff --git a/lib/wallet/src/Cardano/Wallet.hs b/lib/wallet/src/Cardano/Wallet.hs index 61d683ed89a..cb22a257d9f 100644 --- a/lib/wallet/src/Cardano/Wallet.hs +++ b/lib/wallet/src/Cardano/Wallet.hs @@ -1357,7 +1357,7 @@ restoreBlocks => WalletLayer IO s -> Tracer IO WalletFollowLog -> BlockData IO (Either Address RewardAccount) ChainEvents s - -> BlockHeader + -> Read.ChainTip -> IO () restoreBlocks ctx tr blocks nodeTip = db & \DBLayer{..} -> atomically $ do slottingParams <- liftIO $ currentSlottingParameters nl @@ -1389,8 +1389,18 @@ restoreBlocks ctx tr blocks nodeTip = db & \DBLayer{..} -> atomically $ do epochStability = (3*) <$> getSecurityParameter slottingParams localTip = currentTip $ NE.last cps - finalitySlot = nodeTip ^. #slotNo - - stabilityWindowShelley slottingParams + nodeTipSlotNo = case nodeTip of + Read.GenesisTip -> + SlotNo 0 + Read.BlockTip{slotNo} -> + SlotNo $ fromIntegral $ Read.unSlotNo slotNo + nodeTipBlockNo = case nodeTip of + Read.GenesisTip -> + Quantity 0 + Read.BlockTip{blockNo} -> + Quantity $ fromIntegral $ Read.unBlockNo blockNo + + finalitySlot = nodeTipSlotNo - stabilityWindowShelley slottingParams -- Checkpoint deltas wcps = snd . fromWallet <$> cps @@ -1399,7 +1409,7 @@ restoreBlocks ctx tr blocks nodeTip = db & \DBLayer{..} -> atomically $ do getSlot (view $ #currentTip . #blockHeight) epochStability - (nodeTip ^. #blockHeight) + nodeTipBlockNo wcps deltaPruneCheckpoints wallet = diff --git a/lib/wallet/src/Cardano/Wallet/Pools.hs b/lib/wallet/src/Cardano/Wallet/Pools.hs index d6512f22030..248b7a48f13 100644 --- a/lib/wallet/src/Cardano/Wallet/Pools.hs +++ b/lib/wallet/src/Cardano/Wallet/Pools.hs @@ -744,7 +744,7 @@ monitorStakePools tr (NetworkParameters gp sp _pp) genesisPools nl DBLayer{..} = forward :: IORef EpochNo -> NonEmpty (CardanoBlock StandardCrypto) - -> BlockHeader + -> Read.ChainTip -> IO () forward latestGarbageCollectionEpochRef blocks _ = atomically $ forAllAndLastM blocks forAllBlocks forLastBlock