minimal annotatedBlock

IntersectMBO · Oct 12, 2021 · dabae53 · dabae53
1 parent 8c268e7
commit dabae53
Show file tree

Hide file tree

Showing 2 changed files with 54 additions and 6 deletions.
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Validation.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Validation.hs
@@ -19,29 +19,36 @@ module Cardano.Ledger.Shelley.API.Validation
     TickTransitionError (..),
     BlockTransitionError (..),
     chainChecks,
+    annotateBlock,
+    applyBlockOptsAnnotated,
+    AnnotatedBlock (..),
   )
 where
 
-import Cardano.Ledger.BHeaderView (BHeaderView)
-import Cardano.Ledger.BaseTypes (Globals (..), ShelleyBase)
-import Cardano.Ledger.Block (Block)
+import Cardano.Ledger.BHeaderView (BHeaderView (bhviewSlot))
+import Cardano.Ledger.BaseTypes (Globals (..), ShelleyBase, epochInfo)
+import Cardano.Ledger.Block (Block (..))
 import qualified Cardano.Ledger.Chain as STS
 import Cardano.Ledger.Core (ChainData, SerialisableData)
 import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Era (Crypto, TxSeq)
 import Cardano.Ledger.Serialization (ToCBORGroup)
 import Cardano.Ledger.Shelley (ShelleyEra)
 import Cardano.Ledger.Shelley.API.Protocol (PraosCrypto)
-import Cardano.Ledger.Shelley.LedgerState (NewEpochState)
+import Cardano.Ledger.Shelley.LedgerState (NewEpochState (..))
 import qualified Cardano.Ledger.Shelley.LedgerState as LedgerState
 import Cardano.Ledger.Shelley.PParams (PParams' (..))
 import qualified Cardano.Ledger.Shelley.Rules.Bbody as STS
 import Cardano.Ledger.Shelley.Rules.EraMapping ()
-import Cardano.Ledger.Slot (SlotNo)
+import Cardano.Ledger.Slot (SlotNo (..), epochInfoSize)
+import Cardano.Slotting.EpochInfo (epochInfoFirst, epochInfoSlotToUTCTime)
+import Cardano.Slotting.Slot (EpochNo, EpochSize)
 import Control.Arrow (left, right)
 import Control.Monad.Except
+import Control.Monad.Identity (runIdentity)
 import Control.Monad.Trans.Reader (runReader)
 import Control.State.Transition.Extended
+import Data.Time (UTCTime)
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks (..))
 
@@ -254,3 +261,44 @@ deriving stock instance
 instance
   (NoThunks (STS.PredicateFailure (Core.EraRule "BBODY" era))) =>
   NoThunks (BlockTransitionError era)
+
+data AnnotatedBlock = AnnotatedBlock
+  { -- abEra :: !Era
+    abEpochNo :: !EpochNo,
+    abSlotNo :: !SlotNo,
+    abEpochSlot :: !SlotNo, -- The slot within the epoch (starts at 0 for first slot of each epoch
+    abTimeStamp :: !UTCTime, -- The slot number converted to UTCTime
+    abEpochSize :: !EpochSize -- Number of slots in current epoch
+    -- , abTxs :: [AnnotatedTx]   -- All fields in the superset of all block types
+  }
+
+annotateBlock ::
+  (Applicative f) =>
+  Globals ->
+  NewEpochState era ->
+  Block BHeaderView era ->
+  f AnnotatedBlock
+annotateBlock globals state _blk@(Block' bheader _ _) = do
+  let slotNo = bhviewSlot bheader
+      epochNo = nesEL state
+      ann =
+        AnnotatedBlock
+          { abEpochNo = epochNo,
+            abSlotNo = slotNo,
+            abEpochSlot = runIdentity $ (epochInfoFirst $ epochInfo globals) epochNo,
+            abTimeStamp = runIdentity $ epochInfoSlotToUTCTime (epochInfo globals) (systemStart globals) slotNo,
+            abEpochSize = runReader (epochInfoSize (epochInfo globals) epochNo) globals
+          }
+  pure ann
+
+applyBlockOptsAnnotated ::
+  forall ep m era.
+  (EventReturnTypeRep ep, MonadError (BlockTransitionError era) m, ApplyBlock era) =>
+  ApplySTSOpts ep ->
+  Globals ->
+  NewEpochState era ->
+  Block BHeaderView era ->
+  m (EventReturnType ep (Core.EraRule "BBODY" era) (NewEpochState era), AnnotatedBlock)
+applyBlockOptsAnnotated opts globals state blk = do
+  (,) <$> applyBlockOpts opts globals state blk
+    <*> annotateBlock globals state blk
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Epoch.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Epoch.hs
@@ -47,7 +47,7 @@ import Cardano.Ledger.Shelley.LedgerState
   )
 import Cardano.Ledger.Shelley.Rewards ()
 import Cardano.Ledger.Shelley.Rules.PoolReap (POOLREAP, PoolreapEvent, PoolreapPredicateFailure, PoolreapState (..))
-import Cardano.Ledger.Shelley.Rules.Snap (SNAP, SnapPredicateFailure, SnapEvent)
+import Cardano.Ledger.Shelley.Rules.Snap (SNAP, SnapEvent, SnapPredicateFailure)
 import Cardano.Ledger.Shelley.Rules.Upec (UPEC, UpecPredicateFailure)
 import Cardano.Ledger.Slot (EpochNo)
 import Control.SetAlgebra (eval, (⨃))