diff --git a/lib/network-layer/src/Cardano/Wallet/Network/Implementation/Types.hs b/lib/network-layer/src/Cardano/Wallet/Network/Implementation/Types.hs index 835ab72441f..18c61b6280b 100644 --- a/lib/network-layer/src/Cardano/Wallet/Network/Implementation/Types.hs +++ b/lib/network-layer/src/Cardano/Wallet/Network/Implementation/Types.hs @@ -8,13 +8,17 @@ and "Cardano.Wallet.Read". module Cardano.Wallet.Network.Implementation.Types ( fromOuroborosPoint , toOuroborosPoint + , fromOuroborosTip + , toOuroborosTip ) where import Prelude import Cardano.Wallet.Read ( BHeader + , BlockNo (..) , ChainPoint (..) + , ChainTip (..) , SlotNo (..) ) import Cardano.Wallet.Read.Hash @@ -46,20 +50,48 @@ toOuroborosPoint GenesisPoint = toOuroborosPoint (BlockPoint slot h) = O.BlockPoint (toCardanoSlotNo slot) (toCardanoHash h) -toCardanoSlotNo :: SlotNo -> O.SlotNo -toCardanoSlotNo (SlotNo slot) = O.SlotNo (toEnum $ fromEnum slot) - -toCardanoHash :: Hash Blake2b_256 BHeader -> OneEraHash (CardanoEras sc) -toCardanoHash = OneEraHash . hashToBytesShort - fromOuroborosPoint :: O.Point (CardanoBlock sc) -> ChainPoint fromOuroborosPoint O.GenesisPoint = GenesisPoint fromOuroborosPoint (O.BlockPoint slot h) = BlockPoint (fromCardanoSlotNo slot) (fromCardanoHash h) +{----------------------------------------------------------------------------- + ChainTip conversions +------------------------------------------------------------------------------} + +toOuroborosTip :: ChainTip -> O.Tip (CardanoBlock sc) +toOuroborosTip GenesisTip = + O.TipGenesis +toOuroborosTip (BlockTip slot h blockNo) = + O.Tip (toCardanoSlotNo slot) (toCardanoHash h) (toCardanoBlockNo blockNo) + +fromOuroborosTip :: O.Tip (CardanoBlock sc) -> ChainTip +fromOuroborosTip O.TipGenesis = + GenesisTip +fromOuroborosTip (O.Tip slot h blockNo) = + BlockTip + (fromCardanoSlotNo slot) + (fromCardanoHash h) + (fromCardanoBlockNo blockNo) + +{----------------------------------------------------------------------------- + Helper conversions +------------------------------------------------------------------------------} +toCardanoSlotNo :: SlotNo -> O.SlotNo +toCardanoSlotNo (SlotNo slot) = O.SlotNo (toEnum $ fromEnum slot) + fromCardanoSlotNo :: O.SlotNo -> SlotNo fromCardanoSlotNo (O.SlotNo slot) = SlotNo (fromIntegral slot) +toCardanoHash :: Hash Blake2b_256 BHeader -> OneEraHash (CardanoEras sc) +toCardanoHash = OneEraHash . hashToBytesShort + fromCardanoHash :: OneEraHash (CardanoEras sc) -> Hash Blake2b_256 BHeader fromCardanoHash = fromJust . hashFromBytesShort . getOneEraHash + +toCardanoBlockNo :: BlockNo -> O.BlockNo +toCardanoBlockNo (BlockNo blockNo) = O.BlockNo (toEnum $ fromEnum blockNo) + +fromCardanoBlockNo :: O.BlockNo -> BlockNo +fromCardanoBlockNo (O.BlockNo blockNo) = BlockNo (fromIntegral blockNo) diff --git a/lib/read/lib/Cardano/Wallet/Read/Block/BlockNo.hs b/lib/read/lib/Cardano/Wallet/Read/Block/BlockNo.hs index feac7a1e2b2..4fd4e09b74f 100644 --- a/lib/read/lib/Cardano/Wallet/Read/Block/BlockNo.hs +++ b/lib/read/lib/Cardano/Wallet/Read/Block/BlockNo.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -27,6 +28,12 @@ import Cardano.Wallet.Read.Eras.KnownEras ( Era (..) , IsEra (..) ) +import GHC.Generics + ( Generic + ) +import NoThunks.Class + ( NoThunks (..) + ) import Numeric.Natural ( Natural ) @@ -58,7 +65,9 @@ getEraBlockNo = case theEra @era of k = BlockNo . fromIntegral . O.unBlockNo newtype BlockNo = BlockNo {unBlockNo :: Natural} - deriving (Eq, Show, Enum) + deriving (Eq, Ord, Show, Generic, Enum) + +instance NoThunks BlockNo getBlockNoShelley :: (L.Era era, EncCBORGroup (TxSeq era), Crypto c) diff --git a/lib/read/lib/Cardano/Wallet/Read/Chain.hs b/lib/read/lib/Cardano/Wallet/Read/Chain.hs index 58a91d8d12c..371bfaa1b0a 100644 --- a/lib/read/lib/Cardano/Wallet/Read/Chain.hs +++ b/lib/read/lib/Cardano/Wallet/Read/Chain.hs @@ -6,17 +6,26 @@ License: Apache-2.0 Data types relating to the consensus about the blockchain. -} module Cardano.Wallet.Read.Chain - ( ChainPoint (GenesisPoint, BlockPoint) + ( -- * ChainPoint + ChainPoint (GenesisPoint, BlockPoint) , getChainPoint , prettyChainPoint + , chainPointFromChainTip + + -- * ChainTip + , ChainTip (GenesisTip, BlockTip) + , getChainTip + , prettyChainTip ) where import Prelude import Cardano.Wallet.Read.Block ( Block + , BlockNo (..) , RawHeaderHash , SlotNo (..) + , getEraBlockNo , getEraHeaderHash , getEraSlotNo , getRawHeaderHash @@ -62,3 +71,42 @@ prettyChainPoint (BlockPoint slot hash) = where hashF = T.take 8 . Hash.hashToTextAsHex slotF (SlotNo n) = T.pack (show n) + +chainPointFromChainTip :: ChainTip -> ChainPoint +chainPointFromChainTip GenesisTip = GenesisPoint +chainPointFromChainTip (BlockTip slot hash _) = BlockPoint slot hash + +{----------------------------------------------------------------------------- + Tip +------------------------------------------------------------------------------} + +-- | Used in chain-sync protocol to advertise the tip of the server's chain. +-- Records the 'ChainPoint' and the 'BlockNo' of the block. +data ChainTip + = GenesisTip + | BlockTip !SlotNo !RawHeaderHash !BlockNo + deriving (Eq, Ord, Show, Generic) + +instance NoThunks ChainTip + +{-# INLINABLE getChainTip #-} +getChainTip :: IsEra era => Block era -> ChainTip +getChainTip block = + BlockTip + (getEraSlotNo block) + (getRawHeaderHash $ getEraHeaderHash block) + (getEraBlockNo block) + +-- | Short printed representation of a 'ChainPoint'. +prettyChainTip :: ChainTip -> T.Text +prettyChainTip GenesisTip = + "[tip genesis]" +prettyChainTip (BlockTip slotNo hash blockNo) = + "[tip " <> hashF hash + <> " at slot " <> slotNoF slotNo + <> " at blockNo " <> blockNoF blockNo + <> "]" + where + hashF = T.take 8 . Hash.hashToTextAsHex + slotNoF (SlotNo n) = T.pack (show n) + blockNoF (BlockNo n) = T.pack (show n)