Added NonZero

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs

@@ -63,8 +63,10 @@ import Cardano.Ledger.BaseTypes (
   ShelleyBase,
   StrictMaybe (..),
   epochInfo,
+  knownNonZero,
   networkId,
   systemStart,
+  (%.),
  )
 import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), serialize)
 import Cardano.Ledger.Binary.Coders (
@@ -104,7 +106,6 @@ import Data.Coerce (coerce)
 import Data.Either (isRight)
 import Data.Foldable as F (foldl', sequenceA_, toList)
 import qualified Data.Map.Strict as Map
-import Data.Ratio ((%))
 import Data.Set (Set)
 import qualified Data.Set as Set
 import GHC.Generics (Generic)
@@ -331,7 +332,7 @@ validateInsufficientCollateral pp txBody bal =
   failureUnless (Val.scale (100 :: Int) bal >= Val.scale collPerc (toDeltaCoin txfee)) $
     InsufficientCollateral bal $
       rationalToCoinViaCeiling $
-        (fromIntegral collPerc * unCoin txfee) % 100
+        (fromIntegral collPerc * unCoin txfee) %. knownNonZero @100
   where
     txfee = txBody ^. feeTxBodyL -- Coin supplied to pay fees
     collPerc = pp ^. ppCollateralPercentageL

eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs

@@ -181,6 +181,10 @@ import Cardano.Ledger.BaseTypes (
   EpochNo (..),
   Globals (..),
   StrictMaybe (..),
+  knownNonZero,
+  mulNonZero,
+  toIntegerNonZero,
+  (%.),
  )
 import Cardano.Ledger.Binary (
   DecCBOR (..),
@@ -251,7 +255,6 @@ import qualified Data.Foldable as F (foldl')
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
-import Data.Word (Word64)
 import GHC.Generics (Generic)
 import Lens.Micro
 import Lens.Micro.Extras (view)
@@ -491,14 +494,14 @@ setFreshDRepPulsingState epochNo stakePoolDistr epochState = do
       k = securityParameter globals -- On mainnet set to 2160
       umap = dsUnified dState
       umapSize = Map.size $ umElems umap
-      pulseSize = max 1 (umapSize `div` (fromIntegral :: Word64 -> Int) (4 * k))
+      pulseSize = max 1 (fromIntegral umapSize %. (knownNonZero @4 `mulNonZero` toIntegerNonZero k))
       govState' =
         predictFuturePParams $
           govState
             & cgsDRepPulsingStateL
               .~ DRPulsing
                 ( DRepPulser
-                    { dpPulseSize = pulseSize
+                    { dpPulseSize = floor pulseSize
                     , dpUMap = dsUnified dState
                     , dpIndex = 0 -- used as the index of the remaining UMap
                     , dpStakeDistr = stakeDistr -- used as part of the snapshot

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ratify.hs

@@ -33,6 +33,7 @@ import Cardano.Ledger.BaseTypes (
   ShelleyBase,
   StrictMaybe (..),
   addEpochInterval,
+  (%?),
  )
 import Cardano.Ledger.CertState (CommitteeAuthorization (..), CommitteeState (csCommitteeCreds))
 import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
@@ -81,7 +82,6 @@ import Control.State.Transition.Extended (
 import Data.Foldable (Foldable (..))
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import Data.Ratio ((%))
 import qualified Data.Sequence as Seq
 import qualified Data.Sequence.Strict as SSeq
 import qualified Data.Set as Set
@@ -140,9 +140,8 @@ committeeAcceptedRatio ::
   CommitteeState era ->
   EpochNo ->
   Rational
-committeeAcceptedRatio members votes committeeState currentEpoch
-  | totalExcludingAbstain == 0 = 0
-  | otherwise = yesVotes % totalExcludingAbstain
+committeeAcceptedRatio members votes committeeState currentEpoch =
+  yesVotes %? totalExcludingAbstain
   where
     accumVotes ::
       (Integer, Integer) ->
@@ -200,10 +199,8 @@ spoAcceptedRatio
     { gasStakePoolVotes
     , gasProposalProcedure = ProposalProcedure {pProcGovAction}
     }
-  pv
-    | totalActiveStake == 0 = 0 -- guard against the degenerate case when active stake is zero.
-    | totalActiveStake == abstainStake = 0 -- guard against the degenerate case when all abstain.
-    | otherwise = toInteger yesStake % toInteger (totalActiveStake - abstainStake)
+  pv =
+    toInteger yesStake %? toInteger (totalActiveStake - abstainStake)
     where
       accumStake (!yes, !abstain) poolId distr =
         let CompactCoin stake = individualTotalPoolStake distr
@@ -253,9 +250,8 @@ dRepAcceptedRatio ::
   Map (Credential 'DRepRole) Vote ->
   GovAction era ->
   Rational
-dRepAcceptedRatio RatifyEnv {reDRepDistr, reDRepState, reCurrentEpoch} gasDRepVotes govAction
-  | totalExcludingAbstainStake == 0 = 0
-  | otherwise = toInteger yesStake % toInteger totalExcludingAbstainStake
+dRepAcceptedRatio RatifyEnv {reDRepDistr, reDRepState, reCurrentEpoch} gasDRepVotes govAction =
+  toInteger yesStake %? toInteger totalExcludingAbstainStake
   where
     accumStake (!yes, !tot) drep (CompactCoin stake) =
       case drep of

eras/conway/impl/src/Cardano/Ledger/Conway/Tx.hs

@@ -42,7 +42,6 @@ import Cardano.Ledger.Conway.TxBody ()
 import Cardano.Ledger.Conway.TxWits ()
 import Cardano.Ledger.Core
 import Cardano.Ledger.Val (Val (..))
-import Data.Ratio ((%))
 import GHC.Stack
 import Lens.Micro ((^.))
 
@@ -125,10 +124,10 @@ tierRefScriptFee multiplier sizeIncrement
   where
     go !acc !curTierPrice !n
       | n < sizeIncrement =
-          Coin $ floor (acc + (toInteger n % 1) * curTierPrice)
+          Coin $ floor (acc + toRational n * curTierPrice)
       | otherwise =
           go (acc + sizeIncrementRational * curTierPrice) (multiplier * curTierPrice) (n - sizeIncrement)
-    sizeIncrementRational = toInteger sizeIncrement % 1
+    sizeIncrementRational = toRational sizeIncrement
 
 instance AlonzoEraTx ConwayEra where
   isValidTxL = isValidAlonzoTxL

eras/shelley/impl/CHANGELOG.md

@@ -2,6 +2,13 @@
 
 ## 1.16.0.0
 
+* Changed the type of `sgSecurityParam` to `NonZero Word64`
+* Following functions now expect a `NonZero Word64` security parameter:
+  * `startStep`
+  * `createRUpd`
+  * `desirability`
+  * `getTopRankedPools`
+  * `getTopRankedPoolsVMap`
 * Remove `Era era` constraint from `sizeShelleyTxF` and `wireSizeShelleyTxF`
 * Add `MemPack` instance `ShelleyTxOut`
 * Deprecate `hashShelleyTxAuxData`

eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs

@@ -44,6 +44,7 @@ import Cardano.Ledger.BaseTypes (
   NonNegativeInterval,
   UnitInterval,
   epochInfoPure,
+  (%?),
  )
 import Cardano.Ledger.Binary (
   DecCBOR (..),
@@ -110,7 +111,6 @@ import Data.Default (Default (def))
 import Data.Foldable (foldMap')
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import Data.Ratio ((%))
 import Data.Set (Set)
 import qualified Data.Set as Set
 import qualified Data.VMap as VMap
@@ -197,7 +197,7 @@ poolsByTotalStakeFraction globals ss =
   where
     snap = currentSnapshot ss
     Coin totalStake = getTotalStake globals ss
-    stakeRatio = unCoin (fromCompact totalActiveStake) % totalStake
+    stakeRatio = unCoin (fromCompact totalActiveStake) %? totalStake
     PoolDistr poolsByActiveStake totalActiveStake = calculatePoolDistr snap
     poolsByTotalStake = Map.map toTotalStakeFrac poolsByActiveStake
     toTotalStakeFrac ::
@@ -231,8 +231,8 @@ getNonMyopicMemberRewards globals ss =
   Map.fromSet (\cred -> Map.map (mkNMMRewards $ memShare cred) poolData)
   where
     maxSupply = Coin . fromIntegral $ maxLovelaceSupply globals
-    Coin totalStake = circulation es maxSupply
-    toShare (Coin x) = StakeShare (x % totalStake)
+    totalStakeCoin@(Coin totalStake) = circulation es maxSupply
+    toShare (Coin x) = StakeShare $ x %? totalStake
     memShare (Right cred) =
       toShare $ maybe mempty fromCompact $ VMap.lookup cred (EB.unStake stake)
     memShare (Left coin) = toShare coin
@@ -255,7 +255,7 @@ getNonMyopicMemberRewards globals ss =
     topPools =
       getTopRankedPoolsVMap
         rPot
-        (Coin totalStake)
+        totalStakeCoin
         pp
         poolParams
         (fmap percentile' ls)

eras/shelley/impl/src/Cardano/Ledger/Shelley/Genesis.hs

@@ -52,6 +52,7 @@ import Cardano.Ledger.BaseTypes (
   EpochSize (..),
   Globals (..),
   Network,
+  NonZero (..),
   Nonce (..),
   PositiveUnitInterval,
   mkActiveSlotCoeff,
@@ -211,7 +212,7 @@ data ShelleyGenesis = ShelleyGenesis
   , sgNetworkMagic :: !Word32
   , sgNetworkId :: !Network
   , sgActiveSlotsCoeff :: !PositiveUnitInterval
-  , sgSecurityParam :: !Word64
+  , sgSecurityParam :: !(NonZero Word64)
   , sgEpochLength :: !EpochSize
   , sgSlotsPerKESPeriod :: !Word64
   , sgMaxKESEvolutions :: !Word64
@@ -634,14 +635,14 @@ validateGenesis
         let activeSlotsCoeff = unboundRational sgActiveSlotsCoeff
             minLength =
               EpochSize . ceiling $
-                fromIntegral @_ @Double (3 * sgSecurityParam)
+                fromIntegral @_ @Double (3 * unNonZero sgSecurityParam)
                   / fromRational activeSlotsCoeff
          in if minLength > sgEpochLength
               then
                 Just $
                   EpochNotLongEnough
                     sgEpochLength
-                    sgSecurityParam
+                    (unNonZero sgSecurityParam)
                     activeSlotsCoeff
                     minLength
               else Nothing
@@ -680,6 +681,6 @@ mkShelleyGlobals genesis epochInfoAc =
     systemStart = SystemStart $ sgSystemStart genesis
     k = sgSecurityParam genesis
     stabilityWindow =
-      computeStabilityWindow k (sgActiveSlotCoeff genesis)
+      computeStabilityWindow (unNonZero k) (sgActiveSlotCoeff genesis)
     randomnessStabilisationWindow =
-      computeRandomnessStabilisationWindow k (sgActiveSlotCoeff genesis)
+      computeRandomnessStabilisationWindow (unNonZero k) (sgActiveSlotCoeff genesis)

eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/PulsingReward.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Cardano.Ledger.Shelley.LedgerState.PulsingReward (
   startStep,
@@ -24,8 +25,13 @@ import Cardano.Ledger.BaseTypes (
   ActiveSlotCoeff,
   BlocksMade (..),
   BoundedRational (..),
+  NonZero,
   ShelleyBase,
   activeSlotVal,
+  knownNonZero,
+  mulNonZero,
+  toIntegerNonZero,
+  (%.),
  )
 import Cardano.Ledger.CertState (
   CertState (..),
@@ -102,13 +108,12 @@ startStep ::
   EpochState era ->
   Coin ->
   ActiveSlotCoeff ->
-  Word64 ->
+  NonZero Word64 ->
   PulsingRewUpdate
 startStep slotsPerEpoch b@(BlocksMade b') es@(EpochState acnt ls ss nm) maxSupply asc secparam =
   let SnapShot stake delegs poolParams = ssStakeGo ss
-      numStakeCreds, k :: Rational
       numStakeCreds = fromIntegral (VMap.size $ unStake stake)
-      k = fromIntegral secparam
+      k = toIntegerNonZero secparam
       -- We expect approximately 10k-many blocks to be produced each epoch.
       -- The reward calculation begins (4k/f)-many slots into the epoch,
       -- and we guarantee that it ends (2k/f)-many slots before the end
@@ -120,7 +125,7 @@ startStep slotsPerEpoch b@(BlocksMade b') es@(EpochState acnt ls ss nm) maxSuppl
       -- stake credential rewards we should calculate each block.
       -- If it does not finish in this amount of time, the calculation is
       -- forced to completion.
-      pulseSize = max 1 (ceiling (numStakeCreds / (4 * k)))
+      pulseSize = max 1 (ceiling (numStakeCreds %. (knownNonZero @4 `mulNonZero` k)))
       -- We now compute the amount of total rewards that can potentially be given
       -- out this epoch, and the adjustments to the reserves and the treasury.
       Coin reserves = asReserves acnt
@@ -140,8 +145,11 @@ startStep slotsPerEpoch b@(BlocksMade b') es@(EpochState acnt ls ss nm) maxSuppl
       -- it would be nice to not have to compute expectedBlocks every epoch
       blocksMade = fromIntegral $ Map.foldr (+) 0 b' :: Integer
       eta
-        | unboundRational (pr ^. ppDG) >= 0.8 = 1
-        | otherwise = blocksMade % expectedBlocks
+        | d >= 0.8 = 1
+        | otherwise =
+            -- We use unsafe division here, because any sane configuration
+            -- should never have expectedBlocks anywhere close to zero
+            blocksMade % expectedBlocks
       Coin rPot = ssFee ss <> deltaR1
       deltaT1 = floor $ unboundRational (pr ^. ppTauL) * fromIntegral rPot
       _R = Coin $ rPot - deltaT1
@@ -306,7 +314,7 @@ createRUpd ::
   EpochState era ->
   Coin ->
   ActiveSlotCoeff ->
-  Word64 ->
+  NonZero Word64 ->
   ShelleyBase RewardUpdate
 createRUpd slotsPerEpoch blocksmade epstate maxSupply asc secparam = do
   let step1 = startStep slotsPerEpoch blocksmade epstate maxSupply asc secparam

eras/shelley/impl/src/Cardano/Ledger/Shelley/PoolRank.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Cardano.Ledger.Shelley.PoolRank (
@@ -31,8 +32,14 @@ import Cardano.Ledger.BaseTypes (
   ActiveSlotCoeff,
   BoundedRational (..),
   NonNegativeInterval,
+  NonZero (..),
   UnitInterval,
   activeSlotVal,
+  knownNonZero,
+  knownNonZeroBounded,
+  nonZeroOr,
+  toIntegerNonZero,
+  (%.),
  )
 import Cardano.Ledger.Binary (
   DecCBOR (decCBOR),
@@ -266,26 +273,27 @@ toNonMyopicPair nm@(NonMyopic _ _) =
 -- corresponding to f^~ in section 5.6.1 of
 -- "Design Specification for Delegation and Incentives in Cardano"
 desirability ::
-  (NonNegativeInterval, Word16) ->
+  NonNegativeInterval ->
+  NonZero Word16 ->
   Coin ->
   PoolParams ->
   PerformanceEstimate ->
   Coin ->
   Double
-desirability (a0, nOpt) r pool (PerformanceEstimate p) (Coin totalStake) =
+desirability a0 nOpt r pool (PerformanceEstimate p) totalStake =
   if fTilde <= cost
     then 0
     else (fTilde - cost) * (1 - margin)
   where
+    -- This division is safe, because 1 <= fTildeDenom <= 2
     fTilde = fTildeNumer / fTildeDenom
     fTildeNumer = p * fromRational (coinToRational r * (z0 + min s z0 * unboundRational a0))
     fTildeDenom = fromRational $ 1 + unboundRational a0
     cost = (fromRational . coinToRational . ppCost) pool
     margin = (fromRational . unboundRational . ppMargin) pool
-    tot = max 1 (fromIntegral totalStake)
     Coin pledge = ppPledge pool
-    s = fromIntegral pledge % tot
-    z0 = 1 % max 1 (fromIntegral nOpt)
+    s = toInteger pledge % max 1 (unCoin totalStake)
+    z0 = 1 %. toIntegerNonZero nOpt
 
 -- | Computes the top ranked stake pools
 -- corresponding to section 5.6.1 of
@@ -328,7 +336,13 @@ getTopRankedPoolsInternal rPot totalStake pp pdata =
   where
     rankings =
       [ ( hk
-        , desirability (pp ^. ppA0L, pp ^. ppNOptL) rPot pool ap totalStake
+        , desirability
+            (pp ^. ppA0L)
+            ((pp ^. ppNOptL) `nonZeroOr` knownNonZeroBounded @1)
+            rPot
+            pool
+            ap
+            totalStake
         )
       | (hk, (pool, ap)) <- pdata
       ]
@@ -350,7 +364,7 @@ nonMyopicStake ::
   Set (KeyHash 'StakePool) ->
   StakeShare
 nonMyopicStake pp (StakeShare s) (StakeShare sigma) (StakeShare t) kh topPools =
-  let z0 = 1 % max 1 (fromIntegral (pp ^. ppNOptL))
+  let z0 = 1 %. (toInteger (pp ^. ppNOptL) `nonZeroOr` knownNonZero @1)
    in if kh `Set.member` topPools
         then StakeShare (max (sigma + t) z0)
         else StakeShare (s + t)