Add ChainTip type

cardano-foundation · Apr 16, 2024 · aa9f40e · aa9f40e
1 parent 352ed60
commit aa9f40e
Show file tree

Hide file tree

Showing 2 changed files with 59 additions and 2 deletions.
diff --git 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
@@ -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)