Skip to content

Commit

Permalink
Use records for ChainPoint and ChainTip
Browse files Browse the repository at this point in the history
  • Loading branch information
HeinrichApfelmus committed Apr 17, 2024
1 parent bd87870 commit dd2201e
Show file tree
Hide file tree
Showing 2 changed files with 30 additions and 13 deletions.
@@ -1,3 +1,5 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-|
Copyright: © 2024 Cardano Foundation
License: Apache-2.0
Expand Down Expand Up @@ -63,8 +65,11 @@ fromOuroborosPoint (O.BlockPoint slot h) =
toOuroborosTip :: ChainTip -> O.Tip (CardanoBlock sc)
toOuroborosTip GenesisTip =
O.TipGenesis
toOuroborosTip (BlockTip slot h blockNo) =
O.Tip (toCardanoSlotNo slot) (toCardanoHash h) (toCardanoBlockNo blockNo)
toOuroborosTip BlockTip{slotNo,headerHash,blockNo} =
O.Tip
(toCardanoSlotNo slotNo)
(toCardanoHash headerHash)
(toCardanoBlockNo blockNo)

fromOuroborosTip :: O.Tip (CardanoBlock sc) -> ChainTip
fromOuroborosTip O.TipGenesis =
Expand Down
34 changes: 23 additions & 11 deletions lib/read/lib/Cardano/Wallet/Read/Chain.hs
@@ -1,4 +1,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE NamedFieldPuns #-}
{- |
Copyright: © 2024 Cardano Foundation
License: Apache-2.0
Expand All @@ -7,13 +10,13 @@ Data types relating to the consensus about the blockchain.
-}
module Cardano.Wallet.Read.Chain
( -- * ChainPoint
ChainPoint (GenesisPoint, BlockPoint)
ChainPoint (..)
, getChainPoint
, prettyChainPoint
, chainPointFromChainTip

-- * ChainTip
, ChainTip (GenesisTip, BlockTip)
, ChainTip (..)
, getChainTip
, prettyChainTip
) where
Expand Down Expand Up @@ -50,7 +53,10 @@ import qualified Data.Text as T
-- | A point (block) on the Cardano blockchain.
data ChainPoint
= GenesisPoint
| BlockPoint !SlotNo !RawHeaderHash
| BlockPoint
{ slotNo :: !SlotNo
, headerHash :: !RawHeaderHash
}
deriving (Eq, Ord, Show, Generic)

instance NoThunks ChainPoint
Expand All @@ -59,8 +65,9 @@ instance NoThunks ChainPoint
getChainPoint :: IsEra era => Block era -> ChainPoint
getChainPoint block =
BlockPoint
(getEraSlotNo block)
(getRawHeaderHash $ getEraHeaderHash block)
{ slotNo = getEraSlotNo block
, headerHash = getRawHeaderHash $ getEraHeaderHash block
}

-- | Short printed representation of a 'ChainPoint'.
prettyChainPoint :: ChainPoint -> T.Text
Expand All @@ -84,7 +91,11 @@ chainPointFromChainTip (BlockTip slot hash _) = BlockPoint slot hash
-- Records the 'ChainPoint' and the 'BlockNo' of the block.
data ChainTip
= GenesisTip
| BlockTip !SlotNo !RawHeaderHash !BlockNo
| BlockTip
{ slotNo :: !SlotNo
, headerHash :: !RawHeaderHash
, blockNo :: !BlockNo
}
deriving (Eq, Ord, Show, Generic)

instance NoThunks ChainTip
Expand All @@ -93,16 +104,17 @@ instance NoThunks ChainTip
getChainTip :: IsEra era => Block era -> ChainTip
getChainTip block =
BlockTip
(getEraSlotNo block)
(getRawHeaderHash $ getEraHeaderHash block)
(getEraBlockNo block)
{ slotNo = getEraSlotNo block
, headerHash = getRawHeaderHash $ getEraHeaderHash block
, blockNo = getEraBlockNo block
}

-- | Short printed representation of a 'ChainPoint'.
prettyChainTip :: ChainTip -> T.Text
prettyChainTip GenesisTip =
"[tip genesis]"
prettyChainTip (BlockTip slotNo hash blockNo) =
"[tip " <> hashF hash
prettyChainTip BlockTip{slotNo,headerHash,blockNo} =
"[tip " <> hashF headerHash
<> " at slot " <> slotNoF slotNo
<> " at blockNo " <> blockNoF blockNo
<> "]"
Expand Down

0 comments on commit dd2201e

Please sign in to comment.