From 66f673c991f6ec4b955a3ac44f9ad5c81089d1e9 Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Thu, 26 Nov 2020 21:07:28 +0800 Subject: [PATCH] epochSucc sucks --- lib/core/src/Cardano/Wallet/Api/Server.hs | 13 ++---- .../src/Cardano/Wallet/Primitive/Slotting.hs | 16 -------- .../Cardano/Wallet/Primitive/TypesSpec.hs | 41 ------------------- .../src/Cardano/Wallet/Shelley/Pools.hs | 7 ++-- 4 files changed, 6 insertions(+), 71 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 06d4e15369d..442fa7ca408 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -283,7 +283,6 @@ import Cardano.Wallet.Primitive.Slotting , TimeInterpreter , currentEpoch , endTimeOfEpoch - , epochSucc , firstSlotInEpoch , ongoingSlotAt , startTime @@ -384,7 +383,7 @@ import Data.List.NonEmpty import Data.Map.Strict ( Map ) import Data.Maybe - ( catMaybes, fromMaybe, isJust ) + ( catMaybes, isJust ) import Data.Proxy ( Proxy (..) ) import Data.Quantity @@ -1801,8 +1800,8 @@ getNetworkInformation st nl = do let curEpoch = tip ^. #slotId . #epochNumber . #getApiT nextEpochStart <- lift $ ti $ endTimeOfEpoch curEpoch let nextEpoch = ApiEpochInfo - (ApiT $ unsafeEpochSucc curEpoch) - (nextEpochStart) + (ApiT $ succ curEpoch) + nextEpochStart return (tip, nextEpoch) where handlePastHorizonException @@ -1811,12 +1810,6 @@ getNetworkInformation st nl = do handlePastHorizonException _ = MaybeT (pure Nothing) - -- Unsafe constructor for the next epoch. Chances to reach the last epoch - -- are quite unlikely in this context :) - unsafeEpochSucc :: HasCallStack => W.EpochNo -> W.EpochNo - unsafeEpochSucc = fromMaybe bomb . epochSucc - where bomb = error "reached final epoch of the Blockchain!?" - getNetworkParameters :: (Block, NetworkParameters, SyncTolerance) -> NetworkLayer IO t Block diff --git a/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs b/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs index 67895a2cdcf..519a366c2ad 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs @@ -40,8 +40,6 @@ module Cardano.Wallet.Primitive.Slotting -- ** Helpers , unsafeEpochNo - , epochPred - , epochSucc -- * Legacy api - Inaccurate with cardano-node, okay with Jörmungandr , SlotParameters (..) @@ -379,20 +377,6 @@ slotParams t0 sp = SlotParameters epochStartTime :: SlotParameters -> EpochNo -> UTCTime epochStartTime sps e = slotStartTime sps $ SlotId e 0 --- | Return the epoch immediately before the given epoch, or 'Nothing' if there --- is no representable epoch before the given epoch. -epochPred :: EpochNo -> Maybe EpochNo -epochPred (EpochNo e) - | e == minBound = Nothing - | otherwise = Just $ EpochNo $ pred e - --- | Return the epoch immediately after the given epoch, or 'Nothing' if there --- is no representable epoch after the given epoch. -epochSucc :: EpochNo -> Maybe EpochNo -epochSucc (EpochNo e) - | e == maxBound = Nothing - | otherwise = Just $ EpochNo $ succ e - -- | Convert a 'SlotId' to the number of slots since genesis. flatSlot :: EpochLength -> SlotId -> Word64 flatSlot (EpochLength epochLength) (SlotId (EpochNo e) (SlotInEpoch s)) = diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs index dcad2af5a70..080dd595d62 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs @@ -32,11 +32,7 @@ import Cardano.Wallet.Primitive.AddressDerivation.Jormungandr ( JormungandrKey (..), generateKeyFromSeed ) import Cardano.Wallet.Primitive.Slotting ( SlotParameters (..) - , epochPred , epochStartTime - , epochStartTime - , epochSucc - , epochSucc , flatSlot , fromFlatSlot , slotAt' @@ -544,43 +540,6 @@ spec = do "time point during the lifetime of the blockchain" True - describe "Epoch arithmetic: predecessors and successors" $ do - - let succN n = applyN n (epochSucc =<<) - let predN n = applyN n (epochPred =<<) - - it "epochPred minBound == Nothing" $ - epochPred minBound === Nothing - - it "epochSucc maxBound == Nothing" $ - epochSucc maxBound === Nothing - - it "(applyN n epochSucc) . (applyN n epochPred) == id" $ - withMaxSuccess 1000 $ property $ - \(Small epochWord) (Small n) -> - let epoch = EpochNo epochWord - withinBounds = minBound + n <= unEpochNo epoch - expectedResult = - if withinBounds then Just epoch else Nothing - in - checkCoverage $ - cover 10 withinBounds "within bounds" $ - cover 10 (not withinBounds) "out of bounds" $ - expectedResult === succN n (predN n $ Just epoch) - - it "(applyN n epochPred) . (applyN n epochSucc) == id" $ - withMaxSuccess 1000 $ property $ - \(Small epochWord) (Small n) -> - let epoch = EpochNo $ maxBound - epochWord - withinBounds = maxBound - n >= unEpochNo epoch - expectedResult = - if withinBounds then Just epoch else Nothing - in - checkCoverage $ - cover 10 withinBounds "within bounds" $ - cover 10 (not withinBounds) "out of bounds" $ - expectedResult === predN n (succN n $ Just epoch) - describe "Slot arithmetic" $ do it "slotFloor (slotStartTime slotMinBound) == Just slotMinBound" $ diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Pools.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Pools.hs index 5da80d7e5b1..461ddc22858 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Pools.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Pools.hs @@ -68,7 +68,6 @@ import Cardano.Wallet.Primitive.Slotting ( PastHorizonException (..) , TimeInterpreter , epochOf - , epochPred , firstSlotInEpoch , startTime ) @@ -122,7 +121,7 @@ import Control.Exception , try ) import Control.Monad - ( forM, forM_, forever, void, when, (<=<) ) + ( forM, forM_, forever, void, when ) import Control.Monad.IO.Class ( liftIO ) import Control.Monad.Trans.Except @@ -692,9 +691,9 @@ monitorStakePools tr gp nl DBLayer{..} = -- #2196: We need the try. Arguably we shouldn't need it. liftIO (try @SomeException (timeInterpreter nl (epochOf currentSlot))) >>= \case Left _ -> return () + Right currentEpoch | currentEpoch < 2 -> return () Right currentEpoch -> do - let subtractTwoEpochs = epochPred <=< epochPred - forM_ (subtractTwoEpochs currentEpoch) $ \latestRetirementEpoch -> do + let latestRetirementEpoch = currentEpoch - 2 latestGarbageCollectionEpoch <- liftIO $ readIORef latestGarbageCollectionEpochRef -- Only perform garbage collection once per epoch: