Merge pull request #1849 from input-output-hk/jc/replace-overlay-sche…

…dule-with-checks

replace overlay schedule with arithmetic checks

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

@@ -59,26 +59,21 @@ import Shelley.Spec.Ledger.Keys (GenDelegs)
 import Shelley.Spec.Ledger.LedgerState
   ( EpochState (..),
     NewEpochState (..),
-    getGKeys,
     _delegationState,
     _dstate,
     _genDelegs,
   )
 import Shelley.Spec.Ledger.OCert (OCertSignable)
-import Shelley.Spec.Ledger.OverlaySchedule
-  ( OverlaySchedule,
-  )
-import Shelley.Spec.Ledger.PParams (PParams)
+import Shelley.Spec.Ledger.PParams (PParams, PParams' (..))
 import qualified Shelley.Spec.Ledger.STS.Prtcl as STS.Prtcl
-import Shelley.Spec.Ledger.STS.Tick (TICK, TickEnv (..))
+import Shelley.Spec.Ledger.STS.Tick (TICK)
 import qualified Shelley.Spec.Ledger.STS.Tickn as STS.Tickn
 import Shelley.Spec.Ledger.Serialization (decodeRecordNamed)
 import Shelley.Spec.Ledger.Slot (SlotNo)
 
 -- | Data required by the Transitional Praos protocol from the Shelley ledger.
 data LedgerView era = LedgerView
   { lvProtParams :: PParams era,
-    lvOverlaySched :: OverlaySchedule era,
     lvPoolDistr :: PoolDistr era,
     lvGenDelegs :: GenDelegs era
   }
@@ -90,26 +85,23 @@ instance Era era => FromCBOR (LedgerView era) where
   fromCBOR =
     decodeRecordNamed
       "LedgerView"
-      (const 4)
+      (const 3)
       ( LedgerView
           <$> fromCBOR
           <*> fromCBOR
           <*> fromCBOR
-          <*> fromCBOR
       )
 
 instance Era era => ToCBOR (LedgerView era) where
   toCBOR
     LedgerView
       { lvProtParams,
-        lvOverlaySched,
         lvPoolDistr,
         lvGenDelegs
       } =
       mconcat
-        [ encodeListLen 4,
+        [ encodeListLen 3,
           toCBOR lvProtParams,
-          toCBOR lvOverlaySched,
           toCBOR lvPoolDistr,
           toCBOR lvGenDelegs
         ]
@@ -124,26 +116,23 @@ mkPrtclEnv ::
   STS.Prtcl.PrtclEnv era
 mkPrtclEnv
   LedgerView
-    { lvOverlaySched,
+    { lvProtParams,
       lvPoolDistr,
       lvGenDelegs
     } =
     STS.Prtcl.PrtclEnv
-      lvOverlaySched
+      (_d lvProtParams)
       lvPoolDistr
       lvGenDelegs
 
 view :: ShelleyState era -> LedgerView era
 view
   NewEpochState
     { nesPd,
-      nesOsched,
       nesEs
     } =
     LedgerView
       { lvProtParams = esPp nesEs,
-        lvOverlaySched =
-          nesOsched,
         lvPoolDistr = nesPd,
         lvGenDelegs =
           _genDelegs . _dstate
@@ -210,10 +199,7 @@ futureLedgerView globals ss slot =
     res =
       flip runReader globals
         . applySTS @(TICK era)
-        $ TRC (tickEnv, ss, slot)
-    tickEnv =
-      TickEnv
-        (getGKeys ss)
+        $ TRC ((), ss, slot)
 
 -- $chainstate
 --

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

@@ -64,7 +64,6 @@ import Shelley.Spec.Ledger.LedgerState as X
     EpochState (..),
     KeyPairs,
     LedgerState (..),
-    NewEpochEnv (..),
     NewEpochState (..),
     PState (..),
     RewardUpdate (..),
@@ -95,7 +94,7 @@ import Shelley.Spec.Ledger.STS.Ocert as X (OCertEnv (..))
 import Shelley.Spec.Ledger.STS.Pool as X (POOL, PoolEnv (..))
 import Shelley.Spec.Ledger.STS.PoolReap as X (POOLREAP)
 import Shelley.Spec.Ledger.STS.Ppup as X (PPUP, PPUPEnv (..))
-import Shelley.Spec.Ledger.STS.Tick as X (TICK, TickEnv (..))
+import Shelley.Spec.Ledger.STS.Tick as X (TICK)
 import Shelley.Spec.Ledger.STS.Utxo as X (UTXO, UtxoEnv (..))
 import Shelley.Spec.Ledger.STS.Utxow as X (UTXOW)
 import Shelley.Spec.Ledger.Scripts as X

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

@@ -54,22 +54,15 @@ chainChecks globals pp bh = STS.chainChecks (maxMajorPV globals) pp bh
   Applying blocks
 -------------------------------------------------------------------------------}
 
-mkTickEnv ::
-  ShelleyState era ->
-  STS.TickEnv era
-mkTickEnv = STS.TickEnv . LedgerState.getGKeys
-
 mkBbodyEnv ::
   ShelleyState era ->
   STS.BbodyEnv era
 mkBbodyEnv
   LedgerState.NewEpochState
-    { LedgerState.nesOsched,
-      LedgerState.nesEs
+    { LedgerState.nesEs
     } =
     STS.BbodyEnv
-      { STS.bbodySlots = nesOsched,
-        STS.bbodyPp = LedgerState.esPp nesEs,
+      { STS.bbodyPp = LedgerState.esPp nesEs,
         STS.bbodyAccount = LedgerState.esAccountState nesEs
       }
 
@@ -93,7 +86,7 @@ applyTickTransition ::
 applyTickTransition globals state hdr =
   (either err id) . flip runReader globals
     . applySTS @(STS.TICK era)
-    $ TRC (mkTickEnv state, state, hdr)
+    $ TRC ((), state, hdr)
   where
     err :: Show a => a -> b
     err msg = error $ "Panic! applyHeaderTransition failed: " <> (show msg)

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

@@ -44,6 +44,7 @@ import Shelley.Spec.Ledger.LedgerState
     stakeDistr,
   )
 import Shelley.Spec.Ledger.OverlaySchedule (isOverlaySlot)
+import Shelley.Spec.Ledger.PParams (PParams, PParams' (..))
 import Shelley.Spec.Ledger.Rewards
   ( NonMyopic (..),
     StakeShare (..),
@@ -153,20 +154,19 @@ getLeaderSchedule ::
   ChainDepState era ->
   KeyHash 'StakePool era ->
   SignKeyVRF era ->
+  PParams era ->
   Set SlotNo
-getLeaderSchedule globals ss cds poolHash key = Set.filter isLeader epochSlots
+getLeaderSchedule globals ss cds poolHash key pp = Set.filter isLeader epochSlots
   where
     isLeader slotNo =
       let y = VRF.evalCertified () (mkSeed seedL slotNo epochNonce) key
-       in not (isOverlaySlot slotNo overlaySched)
+       in not (isOverlaySlot a (_d pp) slotNo)
             && checkLeaderValue (VRF.certifiedOutput y) stake f
     stake = maybe 0 individualPoolStake $ Map.lookup poolHash poolDistr
-    overlaySched = nesOsched ss
     poolDistr = unPoolDistr $ nesPd ss
     TicknState epochNonce _ = csTickn cds
     currentEpoch = nesEL ss
     ei = epochInfo globals
     f = activeSlotCoeff globals
     epochSlots = Set.fromList [a .. b]
-      where
-        (a, b) = runIdentity $ epochInfoRange ei currentEpoch
+    (a, b) = runIdentity $ epochInfoRange ei currentEpoch

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

@@ -21,18 +21,15 @@ import qualified Cardano.Crypto.Hashing as Hashing
 import Cardano.Ledger.Crypto (ADDRHASH)
 import Cardano.Ledger.Era
 import qualified Cardano.Ledger.Val as Val
-import Control.Monad.Reader (runReader)
 import qualified Data.ByteString.Short as SBS
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe)
 import GHC.Stack (HasCallStack)
 import Shelley.Spec.Ledger.API
-import Shelley.Spec.Ledger.BaseTypes
 import Shelley.Spec.Ledger.Coin (word64ToCoin)
 import Shelley.Spec.Ledger.EpochBoundary
 import Shelley.Spec.Ledger.Genesis
 import Shelley.Spec.Ledger.LedgerState
-import Shelley.Spec.Ledger.OverlaySchedule
 import Shelley.Spec.Ledger.Rewards
 import Shelley.Spec.Ledger.Slot
 import Shelley.Spec.Ledger.UTxO
@@ -91,19 +88,17 @@ translateToShelleyLedgerState ::
   forall era.
   (Era era, ADDRHASH (Crypto era) ~ Crypto.Blake2b_224) =>
   ShelleyGenesis era ->
-  Globals ->
   EpochNo ->
   Byron.ChainValidationState ->
   ShelleyState era
-translateToShelleyLedgerState genesisShelley globals epochNo cvs =
+translateToShelleyLedgerState genesisShelley epochNo cvs =
   NewEpochState
     { nesEL = epochNo,
       nesBprev = BlocksMade Map.empty,
       nesBcur = BlocksMade Map.empty,
       nesEs = epochState,
       nesRu = SNothing,
-      nesPd = PoolDistr Map.empty,
-      nesOsched = oSchedule
+      nesPd = PoolDistr Map.empty
     }
   where
     pparams :: PParams era
@@ -159,34 +154,16 @@ translateToShelleyLedgerState genesisShelley globals epochNo cvs =
                 _pstate = emptyPState
               }
         }
-    oSchedule :: OverlaySchedule era
-    oSchedule =
-      flip runReader globals $
-        overlaySchedule
-          epochNo
-          (Map.keysSet (sgGenDelegs genesisShelley))
-          pparams
 
 -- | We construct a 'LedgerView' using the Shelley genesis config in the same
 -- way as 'translateToShelleyLedgerState'.
 mkInitialShelleyLedgerView ::
   forall era.
   ShelleyGenesis era ->
-  Globals ->
-  EpochNo ->
   LedgerView era
-mkInitialShelleyLedgerView genesisShelley globals epochNo =
+mkInitialShelleyLedgerView genesisShelley =
   LedgerView
     { lvProtParams = sgProtocolParams genesisShelley,
-      lvOverlaySched = oSchedule,
       lvPoolDistr = PoolDistr Map.empty,
       lvGenDelegs = GenDelegs $ sgGenDelegs genesisShelley
     }
-  where
-    oSchedule :: OverlaySchedule era
-    oSchedule =
-      flip runReader globals $
-        overlaySchedule
-          epochNo
-          (Map.keysSet (sgGenDelegs genesisShelley))
-          (sgProtocolParams genesisShelley)

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

@@ -83,7 +83,6 @@ module Shelley.Spec.Ledger.LedgerState
     createRUpd,
     --
     NewEpochState (..),
-    NewEpochEnv (..),
     getGKeys,
     updateNES,
   )
@@ -154,7 +153,6 @@ import Shelley.Spec.Ledger.Keys
     VKey,
     asWitness,
   )
-import Shelley.Spec.Ledger.OverlaySchedule
 import Shelley.Spec.Ledger.PParams
   ( PParams,
     PParams' (..),
@@ -545,9 +543,7 @@ data NewEpochState era = NewEpochState
     -- | Possible reward update
     nesRu :: !(StrictMaybe (RewardUpdate era)),
     -- | Stake distribution within the stake pool
-    nesPd :: !(PoolDistr era),
-    -- | Overlay schedule for PBFT vs Praos
-    nesOsched :: !(OverlaySchedule era)
+    nesPd :: !(PoolDistr era)
   }
   deriving (Show, Eq, Generic)
 
@@ -556,41 +552,31 @@ instance (Era era) => NFData (NewEpochState era)
 instance NoUnexpectedThunks (NewEpochState era)
 
 instance Era era => ToCBOR (NewEpochState era) where
-  toCBOR (NewEpochState e bp bc es ru pd os) =
-    encodeListLen 7 <> toCBOR e <> toCBOR bp <> toCBOR bc <> toCBOR es
+  toCBOR (NewEpochState e bp bc es ru pd) =
+    encodeListLen 6 <> toCBOR e <> toCBOR bp <> toCBOR bc <> toCBOR es
       <> toCBOR ru
       <> toCBOR pd
-      <> toCBOR os
 
 instance Era era => FromCBOR (NewEpochState era) where
   fromCBOR = do
-    decodeRecordNamed "NewEpochState" (const 7) $ do
+    decodeRecordNamed "NewEpochState" (const 6) $ do
       e <- fromCBOR
       bp <- fromCBOR
       bc <- fromCBOR
       es <- fromCBOR
       ru <- fromCBOR
       pd <- fromCBOR
-      os <- fromCBOR
-      pure $ NewEpochState e bp bc es ru pd os
+      pure $ NewEpochState e bp bc es ru pd
 
 getGKeys ::
   NewEpochState era ->
   Set (KeyHash 'Genesis era)
 getGKeys nes = Map.keysSet genDelegs
   where
-    NewEpochState _ _ _ es _ _ _ = nes
+    NewEpochState _ _ _ es _ _ = nes
     EpochState _ _ ls _ _ _ = es
     LedgerState _ (DPState (DState _ _ _ _ (GenDelegs genDelegs) _) _) = ls
 
-data NewEpochEnv era = NewEpochEnv
-  { neeS :: SlotNo,
-    neeGkeys :: Set (KeyHash 'Genesis era)
-  }
-  deriving (Show, Eq, Generic)
-
-instance NoUnexpectedThunks (NewEpochEnv era)
-
 -- | The state associated with a 'Ledger'.
 data LedgerState era = LedgerState
   { -- | The current unspent transaction outputs.
@@ -965,8 +951,7 @@ updateNES
       (EpochState acnt ss _ pr pp nm)
       ru
       pd
-      osched
     )
   bcur
   ls =
-    NewEpochState eL bprev bcur (EpochState acnt ss ls pr pp nm) ru pd osched
+    NewEpochState eL bprev bcur (EpochState acnt ss ls pr pp nm) ru pd