Add 'reapplyBlockTransition'.

This can be used to implement `reapplyLedgerBlock` in ouroboros-network.

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Validation.hs

@@ -13,14 +13,15 @@ module Shelley.Spec.Ledger.API.Validation
     chainChecks,
     applyTickTransition,
     applyBlockTransition,
+    reapplyBlockTransition,
   )
 where
 
 import Cardano.Prelude (NoUnexpectedThunks (..))
 import Control.Arrow (left, right)
 import Control.Monad.Except
 import Control.Monad.Trans.Reader (runReader)
-import Control.State.Transition.Extended (TRC (..), applySTS)
+import Control.State.Transition.Extended (TRC (..), applySTS, reapplySTS)
 import Data.Either (fromRight)
 import GHC.Generics (Generic)
 import Shelley.Spec.Ledger.BaseTypes (Globals (..))
@@ -134,3 +135,34 @@ applyBlockTransition globals state blk =
       STS.BbodyState
         (LedgerState.esLState $ LedgerState.nesEs state)
         (LedgerState.nesBcur state)
+
+-- | Re-apply a ledger block to the same state it has been applied to before.
+--
+--   This function does no validation of whether the block applies successfully;
+--   the caller implicitly guarantees that they have previously called
+--   `applyBlockTransition` on the same block and that this was successful.
+reapplyBlockTransition ::
+  forall crypto.
+  ( Crypto crypto,
+    DSignable crypto (Hash crypto (Tx.TxBody crypto))
+  ) =>
+  Globals ->
+  ShelleyState crypto ->
+  Block crypto ->
+  ShelleyState crypto
+reapplyBlockTransition globals state blk =
+  updateShelleyState state res
+  where
+    res =
+      flip runReader globals . reapplySTS @(STS.BBODY crypto) $
+        TRC (mkBbodyEnv state, bbs, blk)
+    updateShelleyState ::
+      ShelleyState crypto ->
+      STS.BbodyState crypto ->
+      ShelleyState crypto
+    updateShelleyState ss (STS.BbodyState ls bcur) =
+      LedgerState.updateNES ss bcur ls
+    bbs =
+      STS.BbodyState
+        (LedgerState.esLState $ LedgerState.nesEs state)
+        (LedgerState.nesBcur state)