remove Integral and Real instance for Coin

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

@@ -6,6 +6,8 @@
 module Shelley.Spec.Ledger.Coin
   ( Coin (..),
     splitCoin,
+    coinToRational,
+    rationalToCoinViaFloor,
   )
 where
 
@@ -23,8 +25,6 @@ newtype Coin = Coin Integer
       Eq,
       Ord,
       Num,
-      Integral,
-      Real,
       Enum,
       NoUnexpectedThunks,
       Generic,
@@ -33,6 +33,12 @@ newtype Coin = Coin Integer
       NFData
     )
 
+coinToRational :: Coin -> Rational
+coinToRational (Coin c) = fromIntegral c
+
+rationalToCoinViaFloor :: Rational -> Coin
+rationalToCoinViaFloor r = Coin . floor $ r
+
 instance ToCBOR Coin where
   toCBOR (Coin c) =
     if c >= 0

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

@@ -40,7 +40,7 @@ import qualified Data.Set as Set
 import GHC.Generics (Generic)
 import Numeric.Natural (Natural)
 import Shelley.Spec.Ledger.Address (Addr (..))
-import Shelley.Spec.Ledger.Coin (Coin (..))
+import Shelley.Spec.Ledger.Coin (Coin (..), coinToRational, rationalToCoinViaFloor)
 import Shelley.Spec.Ledger.Core (dom, (▷), (◁))
 import Shelley.Spec.Ledger.Credential (Credential, Ptr, StakeReference (..))
 import Shelley.Spec.Ledger.Crypto
@@ -143,14 +143,14 @@ obligation pp (StakeCreds stakeKeys) (StakePools stakePools) =
 
 -- | Calculate maximal pool reward
 maxPool :: PParams -> Coin -> Rational -> Rational -> Coin
-maxPool pc (Coin r) sigma pR = floor $ factor1 * factor2
+maxPool pc r sigma pR = rationalToCoinViaFloor $ factor1 * factor2
   where
     a0 = _a0 pc
     nOpt = _nOpt pc
     z0 = 1 % fromIntegral nOpt
     sigma' = min sigma z0
     p' = min pR z0
-    factor1 = fromIntegral r / (1 + a0)
+    factor1 = coinToRational r / (1 + a0)
     factor2 = sigma' + p' * a0 * factor3
     factor3 = (sigma' - p' * factor4) / z0
     factor4 = (z0 - sigma') / z0

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

@@ -108,6 +108,7 @@ import qualified Data.List.NonEmpty as NonEmpty
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe)
+import Data.Ratio ((%))
 import Data.Set (Set)
 import qualified Data.Set as Set
 import GHC.Generics (Generic)
@@ -119,8 +120,9 @@ import Shelley.Spec.Ledger.BaseTypes
     StrictMaybe (..),
     activeSlotVal,
     intervalValue,
+    unitIntervalToRational,
   )
-import Shelley.Spec.Ledger.Coin (Coin (..))
+import Shelley.Spec.Ledger.Coin (Coin (..), rationalToCoinViaFloor)
 import Shelley.Spec.Ledger.Core (dom, haskey, range, (∪), (∪+), (▷), (◁))
 import Shelley.Spec.Ledger.Credential (Credential (..))
 import Shelley.Spec.Ledger.Crypto (Crypto)
@@ -985,10 +987,13 @@ createRUpd e b@(BlocksMade b') (EpochState acnt ss ls pr _ nm) total = do
       Coin reserves = _reserves acnt
       ds = _dstate $ _delegationState ls
       -- reserves and rewards change
-      deltaR_ = (floor $ min 1 eta * intervalValue (_rho pr) * fromIntegral reserves)
+      deltaR_ = (rationalToCoinViaFloor $ min 1 eta * unitIntervalToRational (_rho pr) * fromIntegral reserves)
       expectedBlocks =
-        intervalValue (activeSlotVal asc) * fromIntegral slotsPerEpoch
-      eta = fromIntegral blocksMade / expectedBlocks
+        floor $
+          unitIntervalToRational (activeSlotVal asc) * fromIntegral slotsPerEpoch
+      -- TODO asc is a global constant, and slotsPerEpoch should not change often at all,
+      -- it would be nice to not have to compute expectedBlocks every epoch
+      eta = blocksMade % expectedBlocks
       Coin rPot = _feeSS ss + deltaR_
       deltaT1 = floor $ intervalValue (_tau pr) * fromIntegral rPot
       _R = Coin $ rPot - deltaT1

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

@@ -53,7 +53,11 @@ import Shelley.Spec.Ledger.BaseTypes
     activeSlotVal,
     unitIntervalToRational,
   )
-import Shelley.Spec.Ledger.Coin (Coin (..))
+import Shelley.Spec.Ledger.Coin
+  ( Coin (..),
+    coinToRational,
+    rationalToCoinViaFloor,
+  )
 import Shelley.Spec.Ledger.Core ((◁))
 import Shelley.Spec.Ledger.Credential (Credential (..))
 import Shelley.Spec.Ledger.Crypto (Crypto)
@@ -255,9 +259,9 @@ desirability pp r pool (PerformanceEstimate p) (Coin total) =
     else (fTilde - cost) * (1 - margin)
   where
     fTilde = fTildeNumer / fTildeDenom
-    fTildeNumer = p * fromRational (fromIntegral r * (z0 + min s z0 * a0))
+    fTildeNumer = p * fromRational (coinToRational r * (z0 + min s z0 * a0))
     fTildeDenom = fromRational $ 1 + a0
-    cost = (fromIntegral . _poolCost) pool
+    cost = (fromRational . coinToRational . _poolCost) pool
     margin = (fromRational . unitIntervalToRational . _poolMargin) pool
     tot = max 1 (fromIntegral total)
     Coin pledge = _poolPledge pool
@@ -314,12 +318,14 @@ leaderRew ::
   StakeShare ->
   StakeShare ->
   Coin
-leaderRew f@(Coin f') pool (StakeShare s) (StakeShare sigma)
-  | f' <= c = f
+leaderRew f pool (StakeShare s) (StakeShare sigma)
+  | f <= c = f
   | otherwise =
-    Coin $ c + floor (fromIntegral (f' - c) * (m' + (1 - m') * s / sigma))
+    c
+      + rationalToCoinViaFloor
+        (coinToRational (f - c) * (m' + (1 - m') * s / sigma))
   where
-    (Coin c, m, _) = poolSpec pool
+    (c, m, _) = poolSpec pool
     m' = unitIntervalToRational m
 
 -- | Calculate pool member reward
@@ -331,7 +337,7 @@ memberRew ::
   Coin
 memberRew (Coin f') pool (StakeShare t) (StakeShare sigma)
   | f' <= c = 0
-  | otherwise = floor $ fromIntegral (f' - c) * (1 - m') * t / sigma
+  | otherwise = rationalToCoinViaFloor $ fromIntegral (f' - c) * (1 - m') * t / sigma
   where
     (Coin c, m, _) = poolSpec pool
     m' = unitIntervalToRational m
@@ -364,7 +370,7 @@ rewardOnePool network pp r blocksN blocksTotal pool (Stake stake) sigma (Coin to
         then maxPool pp r sigma pr
         else 0
     appPerf = mkApparentPerformance (_d pp) sigma blocksN blocksTotal
-    poolR = floor (appPerf * fromIntegral maxP)
+    poolR = rationalToCoinViaFloor (appPerf * fromIntegral maxP)
     tot = fromIntegral total
     mRewards =
       Map.fromList
@@ -400,7 +406,7 @@ reward
   poolParams
   stake
   delegs
-  total
+  (Coin total)
   asc
   slotsPerEpoch = (rewards', hs)
     where
@@ -424,7 +430,7 @@ reward
                     pparams
                     actgr
                     sigma
-                    total
+                    (Coin total)
                     addrsRew
             ls =
               likelihood
@@ -466,6 +472,6 @@ nonMyopicMemberRew
   (StakeShare nm)
   (PerformanceEstimate p) =
     let nm' = max t nm -- TODO check with researchers that this is how to handle t > nm
-        (Coin f) = maxPool pp rPot nm' s
-        fHat = floor (p * fromIntegral f)
+        f = maxPool pp rPot nm' s
+        fHat = floor (p * (fromRational . coinToRational) f)
      in memberRew (Coin fHat) pool (StakeShare t) (StakeShare nm')

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

@@ -243,7 +243,7 @@ utxoInductive = do
   ppup' <- trans @(PPUP crypto) $ TRC (PPUPEnv slot pp genDelegs, ppup, txup tx)
 
   let outputCoins = [c | (TxOut _ c) <- Set.toList (range (txouts txb))]
-  let minUTxOValue = fromIntegral $ _minUTxOValue pp
+  let minUTxOValue = _minUTxOValue pp
   all (minUTxOValue <=) outputCoins
     ?! OutputTooSmallUTxO
       (filter (\(TxOut _ c) -> c < minUTxOValue) (Set.toList (range (txouts txb))))

shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Examples.hs

@@ -1661,10 +1661,10 @@ alicePerfEx2H p = likelihood blocks t slotsPerEpoch
       epochInfoSize ei 0
     blocks = 1
     t = leaderProbability f relativeStake (_d ppsEx1)
-    stake = aliceCoinEx2BBase + aliceCoinEx2BPtr + bobInitCoin
+    (Coin stake) = aliceCoinEx2BBase + aliceCoinEx2BPtr + bobInitCoin
     reserves = _reserves (acntEx2G p)
-    relativeStake =
-      fromRational (fromIntegral stake % (fromIntegral $ maxLLSupply - reserves))
+    (Coin tot) = maxLLSupply - reserves
+    relativeStake = fromRational (stake % tot)
     f = runShelleyBase (asks activeSlotCoeff)
 
 deltaT2H :: Coin
@@ -2057,9 +2057,9 @@ alicePerfEx2K p = (alicePerfEx2H p) <> epoch4Likelihood
       epochInfoSize ei 0
     blocks = 0
     t = leaderProbability f relativeStake (_d ppsEx1)
-    stake = sum . unStake . _stake . _pstakeSet $ (snapsEx2I p) -- everyone has delegated to Alice's Pool
-    relativeStake = fromRational (fromIntegral stake % (fromIntegral $ supply))
-    supply = maxLLSupply - _reserves (acntEx2I p)
+    (Coin stake) = sum . unStake . _stake . _pstakeSet $ (snapsEx2I p) -- everyone has delegated to Alice's Pool
+    relativeStake = fromRational (stake % supply)
+    (Coin supply) = maxLLSupply - _reserves (acntEx2I p)
     f = runShelleyBase (asks activeSlotCoeff)
 
 nonMyopicEx2K :: forall h. HashAlgorithm h => NonMyopic h