Pass the babbage test for current only

IntersectMBO · Jun 28, 2022 · 645287f · 645287f
1 parent cd34dd0
commit 645287f
Show file tree

Hide file tree

Showing 3 changed files with 22 additions and 7 deletions.
diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -106,7 +106,6 @@ library
                       , cardano-binary
                       , cardano-crypto
                       , cardano-crypto-class
-                      , cardano-crypto-praos
                       , cardano-crypto-wrapper
                       , cardano-data
                       , cardano-ledger-alonzo

diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs
@@ -1413,11 +1413,8 @@ nextEpochEligibleLeadershipSlots sbe sGen serCurrEpochState ptclState
     ShelleyBasedEraMary -> return $ isLeadingSlots slotRangeOfInterest nextEpochsNonce vrfSkey relativeStake f
     ShelleyBasedEraAlonzo -> return $ isLeadingSlots slotRangeOfInterest nextEpochsNonce vrfSkey relativeStake f
     ShelleyBasedEraBabbage -> do
-      let skvrf :: VRF.SignKeyVRF (VRF Shelley.StandardCrypto)
-          skvrf = vrfSkey
-
-          praosCanBeLeaderSignKeyVRF :: SL.SignKeyVRF Shelley.StandardCrypto
-          praosCanBeLeaderSignKeyVRF = skvrf
+      let praosCanBeLeaderSignKeyVRF :: SL.SignKeyVRF Shelley.StandardCrypto
+          praosCanBeLeaderSignKeyVRF = vrfSkey
 
           eta0 :: Nonce
           eta0 = praosStateEpochNonce chainDepState
@@ -1567,8 +1564,24 @@ currentEpochEligibleLeadershipSlots sbe sGen eInfo pParams ptclState
         (not . Ledger.isOverlaySlot firstSlotOfEpoch (getField @"_d" (toLedgerPParams sbe pParams)))
         $ Set.fromList [firstSlotOfEpoch .. lastSlotofEpoch] 
 
-  Right $ isLeadingSlots slotRangeOfInterest epochNonce vrkSkey relativeStake f
 
+  case sbe of
+    ShelleyBasedEraShelley -> Right $ isLeadingSlots slotRangeOfInterest epochNonce vrkSkey relativeStake f
+    ShelleyBasedEraAllegra -> Right $ isLeadingSlots slotRangeOfInterest epochNonce vrkSkey relativeStake f
+    ShelleyBasedEraMary -> Right $ isLeadingSlots slotRangeOfInterest epochNonce vrkSkey relativeStake f
+    ShelleyBasedEraAlonzo -> Right $ isLeadingSlots slotRangeOfInterest epochNonce vrkSkey relativeStake f
+    ShelleyBasedEraBabbage -> do
+      let praosCanBeLeaderSignKeyVRF :: SL.SignKeyVRF Shelley.StandardCrypto
+          praosCanBeLeaderSignKeyVRF = vrkSkey
+
+          eta0 :: Nonce
+          eta0 = praosStateEpochNonce chainDepState
+
+      let isLeader :: SlotNo -> Bool
+          isLeader slotNo = meetsLeaderThreshold f setSnapshotPoolDistr poolHash
+            $ VRF.evalCertified () (mkInputVRF slotNo eta0) praosCanBeLeaderSignKeyVRF
+
+      Right $ Set.filter isLeader slotRangeOfInterest
  where
   globals = constructGlobals sGen eInfo pParams
 

diff --git a/cardano-testnet/test/Spec/Cli/Babbage/LeadershipSchedule.hs b/cardano-testnet/test/Spec/Cli/Babbage/LeadershipSchedule.hs
@@ -153,4 +153,7 @@ hprop_leadershipSchedule = H.integration . H.runFinallies . H.workspace "alonzo"
 
   leaderSlots <- H.getRelevantLeaderSlots (TR.poolNodeStdout poolNode1) (minimum expectedLeadershipSlotNumbers)
 
+  H.noteShow_ expectedLeadershipSlotNumbers
+  H.noteShow_ leaderSlots
+
   H.assert $ L.length (expectedLeadershipSlotNumbers \\ leaderSlots) <= 1