DO NOT MERGE: MK synthetic re-addition

ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/ByronHFC.hs

@@ -155,7 +155,7 @@ byronTransition ::
   PartialLedgerConfig ByronBlock ->
   -- | Shelley major protocol version
   Word16 ->
-  LedgerState ByronBlock ->
+  LedgerState ByronBlock mk ->
   Maybe EpochNo
 byronTransition partialConfig shelleyMajorVersion state =
   takeAny

ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Forge.hs

@@ -52,7 +52,7 @@ forgeByronBlock ::
   -- | Current slot number
   SlotNo ->
   -- | Current ledger
-  TickedLedgerState ByronBlock ->
+  TickedLedgerState ByronBlock mk ->
   -- | Txs to include
   [Validated (GenTx ByronBlock)] ->
   -- | Leader proof ('IsLeader')
@@ -137,7 +137,7 @@ forgeRegularBlock ::
   -- | Current slot number
   SlotNo ->
   -- | Current ledger
-  TickedLedgerState ByronBlock ->
+  TickedLedgerState ByronBlock mk ->
   -- | Txs to include
   [Validated (GenTx ByronBlock)] ->
   -- | Leader proof ('IsLeader')

ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Inspect.hs

@@ -97,7 +97,7 @@ data UpdateState
 -- | All proposal updates, from new to old
 protocolUpdates ::
   LedgerConfig ByronBlock ->
-  LedgerState ByronBlock ->
+  LedgerState ByronBlock mk ->
   [ProtocolUpdate]
 protocolUpdates genesis st =
   concat

ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs

@@ -95,7 +95,7 @@ import Ouroboros.Consensus.Util (ShowProxy (..))
   LedgerState
 -------------------------------------------------------------------------------}
 
-data instance LedgerState ByronBlock = ByronLedgerState
+data instance LedgerState ByronBlock mk = ByronLedgerState
   { byronLedgerTipBlockNo :: !(WithOrigin BlockNo)
   , byronLedgerState :: !CC.ChainValidationState
   , byronLedgerTransition :: !ByronTransition
@@ -127,7 +127,7 @@ initByronLedgerState ::
   Gen.Config ->
   -- | Optionally override UTxO
   Maybe CC.UTxO ->
-  LedgerState ByronBlock
+  LedgerState ByronBlock mk
 initByronLedgerState genesis mUtxo =
   ByronLedgerState
     { byronLedgerState = override mUtxo initState
@@ -174,7 +174,7 @@ getByronTip state =
 -------------------------------------------------------------------------------}
 
 -- | The ticked Byron ledger state
-data instance Ticked LedgerState ByronBlock = TickedByronLedgerState
+data instance Ticked LedgerState ByronBlock mk = TickedByronLedgerState
   { tickedByronLedgerState :: !CC.ChainValidationState
   , untickedByronLedgerTransition :: !ByronTransition
   }
@@ -264,7 +264,7 @@ instance CommonProtocolParams ByronBlock where
   maxTxSize = fromIntegral . Update.ppMaxTxSize . getProtocolParameters
 
 -- | Return the protocol parameters adopted by the given ledger.
-getProtocolParameters :: LedgerState ByronBlock -> Update.ProtocolParameters
+getProtocolParameters :: LedgerState ByronBlock mk -> Update.ProtocolParameters
 getProtocolParameters =
   CC.adoptedProtocolParameters
     . CC.cvsUpdateState
@@ -371,8 +371,8 @@ applyByronBlock ::
   ComputeLedgerEvents ->
   LedgerConfig ByronBlock ->
   ByronBlock ->
-  TickedLedgerState ByronBlock ->
-  Except (LedgerError ByronBlock) (LedgerState ByronBlock)
+  TickedLedgerState ByronBlock mk1 ->
+  Except (LedgerError ByronBlock) (LedgerState ByronBlock mk2)
 applyByronBlock
   doValidation
   _doEvents
@@ -398,8 +398,8 @@ applyABlock ::
   CC.ABlock ByteString ->
   CC.HeaderHash ->
   BlockNo ->
-  TickedLedgerState ByronBlock ->
-  Except (LedgerError ByronBlock) (LedgerState ByronBlock)
+  TickedLedgerState ByronBlock mk1 ->
+  Except (LedgerError ByronBlock) (LedgerState ByronBlock mk2)
 applyABlock validationMode cfg blk blkHash blkNo TickedByronLedgerState{..} = do
   st' <- CC.validateBlock cfg validationMode blk blkHash tickedByronLedgerState
 
@@ -441,8 +441,8 @@ applyABoundaryBlock ::
   Gen.Config ->
   CC.ABoundaryBlock ByteString ->
   BlockNo ->
-  TickedLedgerState ByronBlock ->
-  Except (LedgerError ByronBlock) (LedgerState ByronBlock)
+  TickedLedgerState ByronBlock mk1 ->
+  Except (LedgerError ByronBlock) (LedgerState ByronBlock mk2)
 applyABoundaryBlock cfg blk blkNo TickedByronLedgerState{..} = do
   st' <- CC.validateBoundary cfg blk tickedByronLedgerState
   return
@@ -462,7 +462,7 @@ encodeByronAnnTip = encodeAnnTipIsEBB encodeByronHeaderHash
 decodeByronAnnTip :: Decoder s (AnnTip ByronBlock)
 decodeByronAnnTip = decodeAnnTipIsEBB decodeByronHeaderHash
 
-encodeByronExtLedgerState :: ExtLedgerState ByronBlock -> Encoding
+encodeByronExtLedgerState :: ExtLedgerState ByronBlock mk -> Encoding
 encodeByronExtLedgerState =
   encodeExtLedgerState
     encodeByronLedgerState
@@ -529,7 +529,7 @@ decodeByronTransition = do
     bno <- decode
     return (Update.ProtocolVersion{pvMajor, pvMinor, pvAlt}, bno)
 
-encodeByronLedgerState :: LedgerState ByronBlock -> Encoding
+encodeByronLedgerState :: LedgerState ByronBlock mk -> Encoding
 encodeByronLedgerState ByronLedgerState{..} =
   mconcat
     [ encodeListLen 3
@@ -538,7 +538,7 @@ encodeByronLedgerState ByronLedgerState{..} =
     , encodeByronTransition byronLedgerTransition
     ]
 
-decodeByronLedgerState :: Decoder s (LedgerState ByronBlock)
+decodeByronLedgerState :: Decoder s (LedgerState ByronBlock mk)
 decodeByronLedgerState = do
   enforceSize "ByronLedgerState" 3
   ByronLedgerState

ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Mempool.hs

@@ -305,8 +305,8 @@ applyByronGenTx ::
   LedgerConfig ByronBlock ->
   SlotNo ->
   GenTx ByronBlock ->
-  TickedLedgerState ByronBlock ->
-  Except (ApplyTxErr ByronBlock) (TickedLedgerState ByronBlock)
+  TickedLedgerState ByronBlock mk1 ->
+  Except (ApplyTxErr ByronBlock) (TickedLedgerState ByronBlock mk2)
 applyByronGenTx validationMode cfg slot genTx st =
   (\state -> st{tickedByronLedgerState = state})
     <$> CC.applyMempoolPayload

ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Node/Serialisation.hs

@@ -53,9 +53,9 @@ instance EncodeDisk ByronBlock ByronBlock where
 instance DecodeDisk ByronBlock (Lazy.ByteString -> Either DecoderError ByronBlock) where
   decodeDisk ccfg = (Right .) <$> decodeByronBlock (getByronEpochSlots ccfg)
 
-instance EncodeDisk ByronBlock (LedgerState ByronBlock) where
+instance EncodeDisk ByronBlock (LedgerState ByronBlock mk) where
   encodeDisk _ = encodeByronLedgerState
-instance DecodeDisk ByronBlock (LedgerState ByronBlock) where
+instance DecodeDisk ByronBlock (LedgerState ByronBlock mk) where
   decodeDisk _ = decodeByronLedgerState
 
 -- | @'ChainDepState' ('BlockProtocol' 'ByronBlock')@

ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Block.hs

@@ -209,6 +209,7 @@ module Ouroboros.Consensus.Cardano.Block
 
 import Data.Kind
 import Data.SOP.BasicFunctors
+import Data.SOP.Functors (Flip (..))
 import Data.SOP.Strict
 import Ouroboros.Consensus.Block (BlockProtocol)
 import Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
@@ -219,7 +220,7 @@ import Ouroboros.Consensus.HeaderValidation
   ( OtherHeaderEnvelopeError
   , TipInfo
   )
-import Ouroboros.Consensus.Ledger.Abstract (LedgerError)
+import Ouroboros.Consensus.Ledger.Abstract (EmptyMK, LedgerError)
 import Ouroboros.Consensus.Ledger.Query
 import Ouroboros.Consensus.Ledger.SupportsMempool
   ( ApplyTxErr
@@ -1337,78 +1338,78 @@ pattern CardanoLedgerConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo cfg
 -- 'LedgerState'. We don't give access to those internal details through the
 -- pattern synonyms. This is also the reason the pattern synonyms are not
 -- bidirectional.
-type CardanoLedgerState c = LedgerState (CardanoBlock c)
+type CardanoLedgerState c mk = LedgerState (CardanoBlock c) mk
 
 pattern LedgerStateByron ::
-  LedgerState ByronBlock ->
-  CardanoLedgerState c
+  LedgerState ByronBlock EmptyMK ->
+  CardanoLedgerState c EmptyMK
 pattern LedgerStateByron st <-
   HardForkLedgerState
     ( State.HardForkState
-        (TeleByron (State.Current{currentState = st}))
+        (TeleByron (State.Current{currentState = Flip st}))
       )
 
 pattern LedgerStateShelley ::
-  LedgerState (ShelleyBlock (TPraos c) ShelleyEra) ->
-  CardanoLedgerState c
+  LedgerState (ShelleyBlock (TPraos c) ShelleyEra) EmptyMK ->
+  CardanoLedgerState c EmptyMK
 pattern LedgerStateShelley st <-
   HardForkLedgerState
     ( State.HardForkState
-        (TeleShelley _ (State.Current{currentState = st}))
+        (TeleShelley _ (State.Current{currentState = Flip st}))
       )
 
 pattern LedgerStateAllegra ::
-  LedgerState (ShelleyBlock (TPraos c) AllegraEra) ->
-  CardanoLedgerState c
+  LedgerState (ShelleyBlock (TPraos c) AllegraEra) EmptyMK ->
+  CardanoLedgerState c EmptyMK
 pattern LedgerStateAllegra st <-
   HardForkLedgerState
     ( State.HardForkState
-        (TeleAllegra _ _ (State.Current{currentState = st}))
+        (TeleAllegra _ _ (State.Current{currentState = Flip st}))
       )
 
 pattern LedgerStateMary ::
-  LedgerState (ShelleyBlock (TPraos c) MaryEra) ->
-  CardanoLedgerState c
+  LedgerState (ShelleyBlock (TPraos c) MaryEra) EmptyMK ->
+  CardanoLedgerState c EmptyMK
 pattern LedgerStateMary st <-
   HardForkLedgerState
     ( State.HardForkState
-        (TeleMary _ _ _ (State.Current{currentState = st}))
+        (TeleMary _ _ _ (State.Current{currentState = Flip st}))
       )
 
 pattern LedgerStateAlonzo ::
-  LedgerState (ShelleyBlock (TPraos c) AlonzoEra) ->
-  CardanoLedgerState c
+  LedgerState (ShelleyBlock (TPraos c) AlonzoEra) EmptyMK ->
+  CardanoLedgerState c EmptyMK
 pattern LedgerStateAlonzo st <-
   HardForkLedgerState
     ( State.HardForkState
-        (TeleAlonzo _ _ _ _ (State.Current{currentState = st}))
+        (TeleAlonzo _ _ _ _ (State.Current{currentState = Flip st}))
       )
 
 pattern LedgerStateBabbage ::
-  LedgerState (ShelleyBlock (Praos c) BabbageEra) ->
-  CardanoLedgerState c
+  LedgerState (ShelleyBlock (Praos c) BabbageEra) EmptyMK ->
+  CardanoLedgerState c EmptyMK
 pattern LedgerStateBabbage st <-
   HardForkLedgerState
     ( State.HardForkState
-        (TeleBabbage _ _ _ _ _ (State.Current{currentState = st}))
+        (TeleBabbage _ _ _ _ _ (State.Current{currentState = Flip st}))
       )
 
 pattern LedgerStateConway ::
-  LedgerState (ShelleyBlock (Praos c) ConwayEra) ->
-  CardanoLedgerState c
+  LedgerState (ShelleyBlock (Praos c) ConwayEra) EmptyMK ->
+  CardanoLedgerState c EmptyMK
 pattern LedgerStateConway st <-
   HardForkLedgerState
     ( State.HardForkState
-        (TeleConway _ _ _ _ _ _ (State.Current{currentState = st}))
+        (TeleConway _ _ _ _ _ _ (State.Current{currentState = Flip st}))
       )
 
 pattern LedgerStateDijkstra ::
-  LedgerState (ShelleyBlock (Praos c) DijkstraEra) ->
-  CardanoLedgerState c
+  LedgerState (ShelleyBlock (Praos c) DijkstraEra) EmptyMK ->
+  CardanoLedgerState c EmptyMK
 pattern LedgerStateDijkstra st <-
   HardForkLedgerState
     ( State.HardForkState
-        (TeleDijkstra _ _ _ _ _ _ _ (State.Current{currentState = st}))
+        (TeleDijkstra _ _ _ _ _ _ _ (State.Current{currentState = Flip st}))
       )
 
 {-# COMPLETE

ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs

@@ -56,6 +56,7 @@ import qualified Data.Map.Strict as Map
 import Data.Maybe.Strict (StrictMaybe (..))
 import Data.Proxy
 import Data.SOP.BasicFunctors
+import Data.SOP.Functors (Flip (..))
 import Data.SOP.InPairs (RequiringBoth (..), ignoringBoth)
 import qualified Data.SOP.Strict as SOP
 import Data.SOP.Tails (Tails (..))
@@ -383,6 +384,7 @@ translateLedgerStateByronToShelleyWrapper =
                     , shelleyLedgerStateNoUTxO = stateNoUTxO
                     , shelleyLedgerTransition =
                         ShelleyTransitionInfo{shelleyAfterVoting = 0}
+                    , shelleyLedgerTables = emptyLedgerTables
                     , shelleyLedgerLatestPerasCertRound = SNothing
                     }
                 , Diff.fromMapInserts utxo
@@ -455,7 +457,7 @@ crossEraForecastByronToShelleyWrapper =
     ShelleyLedgerConfig ShelleyEra ->
     Bound ->
     SlotNo ->
-    LedgerState ByronBlock ->
+    LedgerState ByronBlock mk ->
     Except
       OutsideForecastRange
       (WrapLedgerView (ShelleyBlock (TPraos c) ShelleyEra))
@@ -535,9 +537,11 @@ translateLedgerStateShelleyToAllegraWrapper =
               -- The remaining (UTxO-free) ledger-state fields translate
               -- normally; we override the NES with the AVVM-consumed one above.
               lsAllegra =
-                unComp
+                unFlip
+                  . unComp
                   . SL.translateEra' SL.NoGenesis
                   . Comp
+                  . Flip
                   $ ls
            in ( lsAllegra{shelleyLedgerStateNoUTxO = stateNoUTxO}
               , avvmsAsDeletions
@@ -587,7 +591,7 @@ translateLedgerStateAllegraToMaryWrapper =
           -- A pure-upgrade boundary: the state translates with no new diffs.
           -- The per-era 'TxOut' upgrade of the on-disk values is handled by
           -- 'translateValues' when the first block's values are read.
-          (unComp . SL.translateEra' SL.NoGenesis . Comp $ ls, mempty)
+          (unFlip . unComp . SL.translateEra' SL.NoGenesis . Comp . Flip $ ls, mempty)
       }
 
 translateLedgerTablesAllegraToMaryWrapper ::
@@ -630,7 +634,7 @@ translateLedgerStateMaryToAlonzoWrapper =
   RequireBoth $ \_cfgMary cfgAlonzo ->
     TranslateLedgerState
       { translateLedgerStateWith = \_epochNo ls ->
-          ( unComp . SL.translateEra' (getAlonzoTranslationContext cfgAlonzo) . Comp $ ls
+          ( unFlip . unComp . SL.translateEra' (getAlonzoTranslationContext cfgAlonzo) . Comp . Flip $ ls
           , mempty
           )
       }
@@ -684,19 +688,20 @@ translateLedgerStateAlonzoToBabbageWrapper =
   RequireBoth $ \_cfgAlonzo _cfgBabbage ->
     TranslateLedgerState
       { translateLedgerStateWith = \_epochNo ls ->
-          ( unComp . SL.translateEra' SL.NoGenesis . Comp . transPraosLS $ ls
+          ( unFlip . unComp . SL.translateEra' SL.NoGenesis . Comp . Flip . transPraosLS $ ls
           , mempty
           )
       }
  where
   transPraosLS ::
-    LedgerState (ShelleyBlock (TPraos c) AlonzoEra) ->
-    LedgerState (ShelleyBlock (Praos c) AlonzoEra)
-  transPraosLS (ShelleyLedgerState wo nes st lcr) =
+    LedgerState (ShelleyBlock (TPraos c) AlonzoEra) EmptyMK ->
+    LedgerState (ShelleyBlock (Praos c) AlonzoEra) EmptyMK
+  transPraosLS (ShelleyLedgerState wo nes st _tb lcr) =
     ShelleyLedgerState
       { shelleyLedgerTip = fmap castShelleyTip wo
       , shelleyLedgerStateNoUTxO = nes
       , shelleyLedgerTransition = st
+      , shelleyLedgerTables = emptyLedgerTables
       , shelleyLedgerLatestPerasCertRound = lcr
       }
 
@@ -761,7 +766,7 @@ translateLedgerStateBabbageToConwayWrapper =
   RequireBoth $ \_cfgBabbage cfgConway ->
     TranslateLedgerState
       { translateLedgerStateWith = \_epochNo ls ->
-          ( unComp . SL.translateEra' (getConwayTranslationContext cfgConway) . Comp $ ls
+          ( unFlip . unComp . SL.translateEra' (getConwayTranslationContext cfgConway) . Comp . Flip $ ls
           , mempty
           )
       }
@@ -815,7 +820,7 @@ translateLedgerStateConwayToDijkstraWrapper =
   RequireBoth $ \_cfgConway cfgDijkstra ->
     TranslateLedgerState
       { translateLedgerStateWith = \_epochNo ls ->
-          ( unComp . SL.translateEra' (getDijkstraTranslationContext cfgDijkstra) . Comp $ ls
+          ( unFlip . unComp . SL.translateEra' (getDijkstraTranslationContext cfgDijkstra) . Comp . Flip $ ls
           , mempty
           )
       }