Resolve non-controversial PR comments

IntersectMBO · Mar 27, 2023 · 964b65c · 964b65c
1 parent 71cd708
commit 964b65c
Show file tree

Hide file tree

Showing 7 changed files with 108 additions and 83 deletions.
diff --git a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/CanHardFork.hs b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/CanHardFork.hs
@@ -426,7 +426,7 @@ translateLedgerStateByronToShelleyWrapper =
                   , shelleyLedgerTransition =
                       ShelleyTransitionInfo{shelleyAfterVoting = 0}
                   , shelleyLedgerTables = emptyLedgerTables
-                }
+                  }
           , translateLedgerTablesWith = \NoByronLedgerTables -> emptyLedgerTables
           }
 
@@ -609,7 +609,7 @@ translateValidatedTxShelleyToAllegraWrapper = InjectValidatedTx $
     fmap unComp . eitherToMaybe . runExcept . SL.translateEra () . Comp
 
 {-------------------------------------------------------------------------------
-  Translation from Shelley to Allegra
+  Translation from Allegra to Mary
 -------------------------------------------------------------------------------}
 
 translateLedgerStateAllegraToMaryWrapper ::
@@ -635,10 +635,6 @@ translateLedgerStateAllegraToMaryWrapper =
                                  }
         }
 
-{-------------------------------------------------------------------------------
-  Translation from Allegra to Mary
--------------------------------------------------------------------------------}
-
 translateTxAllegraToMaryWrapper ::
      (PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
   => InjectTx

diff --git a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Tables.hs b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Tables.hs
@@ -65,7 +65,7 @@ import           Ouroboros.Consensus.Shelley.ShelleyHFC
   Ledger Tables
 -------------------------------------------------------------------------------}
 
--- We reuse this for both HasLedgerTables and HasTickedLedgerTables instances,
+-- | We reuse this for both HasLedgerTables and HasTickedLedgerTables instances,
 -- so the @HasTickedLedgerTables x@ constraint here is excessive in the
 -- HasLedgerTables case. However, since x is always a Cardano era, we do know we
 -- have HasTickedLedgerTables for every x, so hardcoding the stronger constraint
@@ -125,7 +125,8 @@ withLedgerTablesHelper withLT (HardForkState st) tbs =
 -- Note that this is a HardForkBlock instance, but it's not compositional. This
 -- is because the LedgerTables relies on knowledge specific to Cardano and we
 -- have so far not found a pleasant way to express that compositionally.
-instance CardanoHardForkConstraints c => HasLedgerTables (LedgerState (CardanoBlock c)) where
+instance CardanoHardForkConstraints c
+      => HasLedgerTables (LedgerState (CardanoBlock c)) where
   newtype LedgerTables (LedgerState (CardanoBlock c)) mk = CardanoLedgerTables {
         cardanoUTxOTable :: mk (SL.TxIn c) (ShelleyTxOut (ShelleyBasedEras c))
       }
@@ -211,7 +212,8 @@ instance CardanoHardForkConstraints c
   LedgerTablesCanHardFork
 -------------------------------------------------------------------------------}
 
-instance CardanoHardForkConstraints c => LedgerTablesCanHardFork (CardanoEras c) where
+instance CardanoHardForkConstraints c
+      => LedgerTablesCanHardFork (CardanoEras c) where
   hardForkInjectLedgerTables =
          byron
       :* shelley IZ

diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Eras.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Eras.hs
@@ -404,31 +404,36 @@ deriving instance Eq       (Core.TxOut era) => Eq       (TxOutWrapper era)
 deriving instance NoThunks (Core.TxOut era) => NoThunks (TxOutWrapper era)
 deriving instance Show     (Core.TxOut era) => Show     (TxOutWrapper era)
 
-instance ShelleyBasedEra (AllegraEra c) => Core.TranslateEra (AllegraEra c) TxOutWrapper where
+instance ShelleyBasedEra (AllegraEra c)
+      => Core.TranslateEra (AllegraEra c) TxOutWrapper where
   type TranslationError (AllegraEra c) TxOutWrapper = Void
   translateEra ctxt = fmap TxOutWrapper . Core.translateEra ctxt . unTxOutWrapper
 
-instance ShelleyBasedEra (MaryEra c) => Core.TranslateEra (MaryEra c) TxOutWrapper where
+instance ShelleyBasedEra (MaryEra c)
+      => Core.TranslateEra (MaryEra c) TxOutWrapper where
   type TranslationError (MaryEra c) TxOutWrapper = Void
   translateEra ctxt = fmap TxOutWrapper . Core.translateEra ctxt . unTxOutWrapper
 
-instance ShelleyBasedEra (AlonzoEra c) => Core.TranslateEra (AlonzoEra c) TxOutWrapper where
+instance ShelleyBasedEra (AlonzoEra c)
+      => Core.TranslateEra (AlonzoEra c) TxOutWrapper where
   type TranslationError (AlonzoEra c) TxOutWrapper = Void
   translateEra _ctxt =
         pure
       . TxOutWrapper
       . Alonzo.translateTxOut
       . unTxOutWrapper
 
-instance ShelleyBasedEra (BabbageEra c) => Core.TranslateEra (BabbageEra c) TxOutWrapper where
+instance ShelleyBasedEra (BabbageEra c)
+      => Core.TranslateEra (BabbageEra c) TxOutWrapper where
   type TranslationError (BabbageEra c) TxOutWrapper = Void
   translateEra _ctxt =
         pure
       . TxOutWrapper
       . Babbage.translateTxOut
       . unTxOutWrapper
 
-instance ShelleyBasedEra (ConwayEra c) => Core.TranslateEra (ConwayEra c) TxOutWrapper where
+instance ShelleyBasedEra (ConwayEra c)
+      => Core.TranslateEra (ConwayEra c) TxOutWrapper where
   type TranslationError (ConwayEra c) TxOutWrapper = Void
   translateEra _ctxt =
         pure

diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs
@@ -130,7 +130,9 @@ data ShelleyLedgerConfig era = ShelleyLedgerConfig {
 deriving instance (NoThunks (Core.TranslationContext era), Era era) =>
     NoThunks (ShelleyLedgerConfig era)
 
-deriving instance (Crypto.Crypto (EraCrypto era), Show (Core.TranslationContext era)) => Show (ShelleyLedgerConfig era)
+deriving instance ( Crypto.Crypto (EraCrypto era)
+                  , Show (Core.TranslationContext era)
+                  ) => Show (ShelleyLedgerConfig era)
 
 shelleyLedgerGenesis :: ShelleyLedgerConfig era -> SL.ShelleyGenesis (EraCrypto era)
 shelleyLedgerGenesis = getCompactGenesis . shelleyLedgerCompactGenesis
@@ -211,9 +213,12 @@ data instance LedgerState (ShelleyBlock proto era) mk = ShelleyLedgerState {
     }
   deriving (Generic)
 
-deriving instance (ShelleyBasedEra era, IsMapKind mk) => Eq       (LedgerState (ShelleyBlock proto era) mk)
-deriving instance (ShelleyBasedEra era, IsMapKind mk) => NoThunks (LedgerState (ShelleyBlock proto era) mk)
-deriving instance (ShelleyBasedEra era, IsMapKind mk) => Show     (LedgerState (ShelleyBlock proto era) mk)
+deriving instance (ShelleyBasedEra era, IsMapKind mk)
+               => Eq       (LedgerState (ShelleyBlock proto era) mk)
+deriving instance (ShelleyBasedEra era, IsMapKind mk)
+               => NoThunks (LedgerState (ShelleyBlock proto era) mk)
+deriving instance (ShelleyBasedEra era, IsMapKind mk)
+               => Show     (LedgerState (ShelleyBlock proto era) mk)
 
 -- | Information required to determine the hard fork point from Shelley to the
 -- next ledger
@@ -239,15 +244,19 @@ newtype ShelleyTransition = ShelleyTransitionInfo {
   deriving stock   (Eq, Show, Generic)
   deriving newtype (NoThunks)
 
-shelleyLedgerTipPoint :: LedgerState (ShelleyBlock proto era) mk -> Point (ShelleyBlock proto era)
+shelleyLedgerTipPoint ::
+     LedgerState (ShelleyBlock proto era) mk
+  -> Point (ShelleyBlock proto era)
 shelleyLedgerTipPoint = shelleyTipToPoint . shelleyLedgerTip
 
 instance ShelleyCompatible proto era => UpdateLedger (ShelleyBlock proto era)
 
-instance ShelleyBasedEra era => HasLedgerTables (LedgerState (ShelleyBlock proto era)) where
-  newtype LedgerTables (LedgerState (ShelleyBlock proto era)) mk = ShelleyLedgerTables {
-        shelleyUTxOTable :: mk (SL.TxIn (EraCrypto era)) (Core.TxOut era)
-      }
+instance ShelleyBasedEra era
+      => HasLedgerTables (LedgerState (ShelleyBlock proto era)) where
+  newtype LedgerTables (LedgerState (ShelleyBlock proto era)) mk =
+      ShelleyLedgerTables {
+          shelleyUTxOTable :: mk (SL.TxIn (EraCrypto era)) (Core.TxOut era)
+        }
     deriving (Generic)
 
   projectLedgerTables        = shelleyLedgerTables
@@ -269,7 +278,8 @@ instance ShelleyBasedEra era => HasLedgerTables (LedgerState (ShelleyBlock proto
 
   mapLedgerTables f (ShelleyLedgerTables utxo) = ShelleyLedgerTables (f utxo)
 
-  traverseLedgerTables f (ShelleyLedgerTables utxo) = ShelleyLedgerTables <$> f utxo
+  traverseLedgerTables f (ShelleyLedgerTables utxo) =
+    ShelleyLedgerTables <$> f utxo
 
   zipLedgerTables f (ShelleyLedgerTables utxoL) (ShelleyLedgerTables utxoR) =
       ShelleyLedgerTables (f utxoL utxoR)
@@ -293,11 +303,13 @@ instance ShelleyBasedEra era => HasLedgerTables (LedgerState (ShelleyBlock proto
 
   foldLedgerTables f (ShelleyLedgerTables utxo) = f utxo
 
-  foldLedgerTables2 f (ShelleyLedgerTables utxoL) (ShelleyLedgerTables utxoR) = f utxoL utxoR
+  foldLedgerTables2 f (ShelleyLedgerTables utxoL) (ShelleyLedgerTables utxoR) =
+    f utxoL utxoR
 
   namesLedgerTables = ShelleyLedgerTables (NameMK "utxo")
 
-instance ShelleyBasedEra era => HasTickedLedgerTables (LedgerState (ShelleyBlock proto era)) where
+instance ShelleyBasedEra era
+      => HasTickedLedgerTables (LedgerState (ShelleyBlock proto era)) where
   projectLedgerTablesTicked        = tickedShelleyLedgerTables
   withLedgerTablesTicked st tables =
       TickedShelleyLedgerState {
@@ -313,20 +325,26 @@ instance ShelleyBasedEra era => HasTickedLedgerTables (LedgerState (ShelleyBlock
         , tickedShelleyLedgerState
         } = st
 
-deriving newtype  instance (ShelleyBasedEra era, Eq       (mk (SL.TxIn (EraCrypto era)) (Core.TxOut era))) => Eq       (LedgerTables (LedgerState (ShelleyBlock proto era)) mk)
-deriving anyclass instance (ShelleyBasedEra era, NoThunks (mk (SL.TxIn (EraCrypto era)) (Core.TxOut era))) => NoThunks (LedgerTables (LedgerState (ShelleyBlock proto era)) mk)
-deriving newtype  instance (ShelleyBasedEra era, Show     (mk (SL.TxIn (EraCrypto era)) (Core.TxOut era))) => Show     (LedgerTables (LedgerState (ShelleyBlock proto era)) mk)
+deriving newtype  instance ( ShelleyBasedEra era
+                           , Eq (mk (SL.TxIn (EraCrypto era)) (Core.TxOut era))
+                           ) => Eq  (LedgerTables (LedgerState (ShelleyBlock proto era)) mk)
+deriving anyclass instance ( ShelleyBasedEra era
+                           , NoThunks (mk (SL.TxIn (EraCrypto era)) (Core.TxOut era))
+                           ) => NoThunks (LedgerTables (LedgerState (ShelleyBlock proto era)) mk)
+deriving newtype  instance ( ShelleyBasedEra era
+                           , Show(mk (SL.TxIn (EraCrypto era)) (Core.TxOut era))
+                           ) => Show (LedgerTables (LedgerState (ShelleyBlock proto era)) mk)
 
-instance ShelleyBasedEra era => CanSerializeLedgerTables (LedgerState (ShelleyBlock proto era)) where
+instance ShelleyBasedEra era
+      => CanSerializeLedgerTables (LedgerState (ShelleyBlock proto era)) where
     codecLedgerTables = ShelleyLedgerTables (CodecMK
                                                (Core.toEraCBOR @era)
                                                toCBOR
                                                (Core.fromEraCBOR @era)
                                                fromCBOR)
 
-instance
-     ShelleyBasedEra era
-  => CanStowLedgerTables (LedgerState (ShelleyBlock proto era)) where
+instance ShelleyBasedEra era
+      => CanStowLedgerTables (LedgerState (ShelleyBlock proto era)) where
   stowLedgerTables st =
       ShelleyLedgerState {
           shelleyLedgerTip        = shelleyLedgerTip
@@ -451,8 +469,9 @@ data instance Ticked1 (LedgerState (ShelleyBlock proto era)) mk = TickedShelleyL
     }
   deriving (Generic)
 
-deriving instance (ShelleyBasedEra era
-                  , NoThunks (mk (SL.TxIn (EraCrypto era)) (Core.TxOut era))) => NoThunks (Ticked1 (LedgerState (ShelleyBlock proto era)) mk)
+deriving instance ( ShelleyBasedEra era
+                  , NoThunks (mk (SL.TxIn (EraCrypto era)) (Core.TxOut era))
+                  ) => NoThunks (Ticked1 (LedgerState (ShelleyBlock proto era)) mk)
 
 untickedShelleyLedgerTipPoint ::
      TickedLedgerState (ShelleyBlock proto era) mk
@@ -469,7 +488,7 @@ instance ShelleyBasedEra era => IsLedger (LedgerState (ShelleyBlock proto era))
                               , shelleyLedgerState
                               , shelleyLedgerTransition
                               } =
-    swizzle appTick <&> \l' ->
+      swizzle appTick <&> \l' ->
       TickedShelleyLedgerState {
           untickedShelleyLedgerTip      = shelleyLedgerTip
         , tickedShelleyLedgerTransition =
@@ -578,8 +597,8 @@ instance Show ShelleyReapplyException where
 
 instance Exception.Exception ShelleyReapplyException where
 
-applyHelper :: forall proto m era.
-     (ShelleyCompatible proto era, Monad m)
+applyHelper ::
+     forall proto m era. (ShelleyCompatible proto era, Monad m)
   => (   SL.Globals
       -> SL.NewEpochState era
       -> SL.Block (SL.BHeaderView (EraCrypto era)) era
@@ -619,23 +638,25 @@ applyHelper f cfg blk stBefore = do
         track = calculateDifference stBefore
 
 
-    return $ ledgerResult <&> \newNewEpochState -> forgetLedgerTablesValues $ track $ unstowLedgerTables $ ShelleyLedgerState {
-        shelleyLedgerTip = NotOrigin ShelleyTip {
-            shelleyTipBlockNo = blockNo   blk
-          , shelleyTipSlotNo  = blockSlot blk
-          , shelleyTipHash    = blockHash blk
-          }
-      , shelleyLedgerState =
-          newNewEpochState
-      , shelleyLedgerTransition = ShelleyTransitionInfo {
-            shelleyAfterVoting =
-              -- We count the number of blocks that have been applied after the
-              -- voting deadline has passed.
-              (if blockSlot blk >= votingDeadline then succ else id) $
-                shelleyAfterVoting tickedShelleyLedgerTransition
-          }
-      , shelleyLedgerTables = emptyLedgerTables
-      }
+    return $ ledgerResult <&> \newNewEpochState ->
+      forgetLedgerTablesValues $ track $ unstowLedgerTables $
+      ShelleyLedgerState {
+          shelleyLedgerTip = NotOrigin ShelleyTip {
+              shelleyTipBlockNo = blockNo   blk
+            , shelleyTipSlotNo  = blockSlot blk
+            , shelleyTipHash    = blockHash blk
+            }
+        , shelleyLedgerState =
+            newNewEpochState
+        , shelleyLedgerTransition = ShelleyTransitionInfo {
+              shelleyAfterVoting =
+                -- We count the number of blocks that have been applied after the
+                -- voting deadline has passed.
+                (if blockSlot blk >= votingDeadline then succ else id) $
+                  shelleyAfterVoting tickedShelleyLedgerTransition
+            }
+        , shelleyLedgerTables = emptyLedgerTables
+        }
   where
     globals = shelleyLedgerGlobals cfg
     swindow = SL.stabilityWindow globals

diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Query.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Query.hs
@@ -372,19 +372,19 @@ instance ( ShelleyCompatible proto era
     _other           -> emptyLedgerTables
 
   tableTraversingQuery = \case
-    GetUTxOByAddress addrs ->
-      Just (TraversingQueryHandler
-            (\st -> SL.getFilteredUTxO (shelleyLedgerState $ ledgerState st) addrs)
-            emptyUtxo
-            combUtxo
-            id)
-    GetUTxOWhole           ->
-      Just (TraversingQueryHandler
-            (SL.getUTxO . shelleyLedgerState . ledgerState)
-            emptyUtxo
-            combUtxo
-            id)
-    _other -> Nothing
+      GetUTxOByAddress addrs ->
+        Just (TraversingQueryHandler
+              (\st -> SL.getFilteredUTxO (shelleyLedgerState $ ledgerState st) addrs)
+              emptyUtxo
+              combUtxo
+              id)
+      GetUTxOWhole           ->
+        Just (TraversingQueryHandler
+              (SL.getUTxO . shelleyLedgerState . ledgerState)
+              emptyUtxo
+              combUtxo
+              id)
+      _other -> Nothing
     where
       emptyUtxo                        = SL.UTxO Map.empty
       combUtxo (SL.UTxO l) (SL.UTxO r) = SL.UTxO $ Map.union l r

diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node/TPraos.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node/TPraos.hs
@@ -310,16 +310,15 @@ protocolInfoTPraosShelleyBased ProtocolParamsShelleyBased {
         }
 
     initLedgerState :: LedgerState (ShelleyBlock (TPraos c) era) ValuesMK
-    initLedgerState =
-      let st = registerGenesisStaking (SL.sgStaking genesis) $
-                 SL.initialState genesis additionalGenesisConfig
-      in
-      ShelleyLedgerState {
-        shelleyLedgerTip        = Origin
-      , shelleyLedgerState      = st `withUtxoSL` shelleyUTxOTable emptyLedgerTables
-      , shelleyLedgerTransition = ShelleyTransitionInfo {shelleyAfterVoting = 0}
-      , shelleyLedgerTables     = ShelleyLedgerTables $ projectUtxoSL st
-      }
+    initLedgerState = ShelleyLedgerState {
+          shelleyLedgerTip        = Origin
+        , shelleyLedgerState      = st `withUtxoSL` shelleyUTxOTable emptyLedgerTables
+        , shelleyLedgerTransition = ShelleyTransitionInfo {shelleyAfterVoting = 0}
+        , shelleyLedgerTables     = ShelleyLedgerTables $ projectUtxoSL st
+        }
+      where
+        st = registerGenesisStaking (SL.sgStaking genesis) $
+               SL.initialState genesis additionalGenesisConfig
 
     initChainDepState :: TPraosState c
     initChainDepState = TPraosState Origin $

diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/ShelleyHFC.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/ShelleyHFC.hs
@@ -391,7 +391,7 @@ instance ( ShelleyBasedEra era
     <$> SL.translateValidated @era @WrapTx ctxt (SL.coerceValidated vtx)
 
 {-------------------------------------------------------------------------------
-  A wrapper helpful for Ledger HD
+  A wrapper helpful for UTxO HD
 -------------------------------------------------------------------------------}
 
 -- | We use this type for clarity, and because we don't want to declare
@@ -426,13 +426,14 @@ instance SOP.All ShelleyBasedEra eras => Show (ShelleyTxOut eras) where
         Z l -> showString "Z " . shows l
         S r -> showString "S " . go r
 
--- unline SOP.nsToIndex, this is not restricted to the interval [0, 24)
+-- unlike SOP.nsToIndex, this is not restricted to the interval [0, 24)
 idxLength :: SOP.Index xs x -> Int
 idxLength = \case
     SOP.IZ     -> 0
     SOP.IS idx -> 1 + idxLength idx
 
-instance (SOP.All ShelleyBasedEra eras, Typeable eras) => ToCBOR (ShelleyTxOut eras) where
+instance (SOP.All ShelleyBasedEra eras, Typeable eras)
+      => ToCBOR (ShelleyTxOut eras) where
   toCBOR (ShelleyTxOut x) =
         SOP.hcollapse
       $ SOP.hcimap (Proxy @ShelleyBasedEra) each x
@@ -447,7 +448,8 @@ instance (SOP.All ShelleyBasedEra eras, Typeable eras) => ToCBOR (ShelleyTxOut e
         <> CBOR.encodeWord (toEnum (idxLength idx))
         <> toCBOR txout
 
-instance (SOP.All ShelleyBasedEra eras, Typeable eras) => FromCBOR (ShelleyTxOut eras) where
+instance (SOP.All ShelleyBasedEra eras, Typeable eras)
+      => FromCBOR (ShelleyTxOut eras) where
   fromCBOR = do
       CBOR.decodeListLenOf 2
       tag <- CBOR.decodeWord
@@ -470,7 +472,7 @@ instance (SOP.All ShelleyBasedEra eras, Typeable eras) => FromCBOR (ShelleyTxOut
         if w /= toEnum (idxLength idx) then Nothing else
         Just
           $ ADecoder
-          $ (ShelleyTxOut . SOP.injectNS idx . TxOutWrapper) <$> fromCBOR
+          $ ShelleyTxOut . SOP.injectNS idx . TxOutWrapper <$> fromCBOR
 
 newtype ADecoder eras =
   ADecoder {unADecoder :: forall s. CBOR.Decoder s (ShelleyTxOut eras)}