Merge #1399

1399: Rework use  of `Percentage` type r=Anviking a=Anviking

# Issue Number

#1331 

# Overview

- [x] Increase precision of `Percentage` from `[0,100]` natural to `Rational`.
- [x] Changed sqlite schema to store the pool margin as `(Word64, Word64)` instead of `Word8`.

# Comments

- We can make the `ToText` instance _always_ have the same number of digits after the decimal separator (e.g. `1.45%`, `2.00%`). But we can't do this for `ToJSON`, as Aeson uses `Scientific` and not `String` to represent numbers.

<img width="292" alt="Skärmavbild 2020-03-05 kl  15 06 51" src="https://user-images.githubusercontent.com/304423/75989697-fd6c0480-5ef3-11ea-82a8-d2390a4ec89c.png">

migration worked, and pool margin looks correct 🎉 


<!-- Additional comments or screenshots to attach if any -->

<!-- 
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Once created, link this PR to its corresponding ticket
 ✓ Assign the PR to a corresponding milestone
 ✓ Acknowledge any changes required to the Wiki
-->


Co-authored-by: Johannes Lund <johannes.lund@iohk.io>

lib/core/cardano-wallet-core.cabal

@@ -77,6 +77,7 @@ library
     , random
     , retry
     , safe
+    , scientific
     , servant
     , servant-client
     , servant-server

lib/core/src/Cardano/Pool/DB/Sqlite.hs

@@ -47,6 +47,8 @@ import Cardano.Wallet.Primitive.Types
     , PoolRegistrationCertificate (..)
     , SlotId (..)
     )
+import Cardano.Wallet.Unsafe
+    ( unsafeMkPercentage )
 import Control.Exception
     ( bracket, throwIO )
 import Control.Monad.IO.Class
@@ -60,7 +62,9 @@ import Data.List
 import Data.Map.Strict
     ( Map )
 import Data.Quantity
-    ( Quantity (..) )
+    ( Percentage (..), Quantity (..) )
+import Data.Ratio
+    ( denominator, numerator, (%) )
 import Data.Word
     ( Word64 )
 import Database.Persist.Sql
@@ -184,17 +188,23 @@ newDBLayer trace fp = do
             , poolMargin
             , poolCost
             } -> do
-            let poolMargin_ = fromIntegral $ fromEnum poolMargin
+            let poolMarginN = fromIntegral $ numerator $ getPercentage poolMargin
+            let poolMarginD = fromIntegral $ denominator $ getPercentage poolMargin
             let poolCost_ = getQuantity poolCost
-            insert_ $ PoolRegistration poolId point poolMargin_ poolCost_
+            insert_ $ PoolRegistration
+                    poolId
+                    point
+                    poolMarginN
+                    poolMarginD
+                    poolCost_
             insertMany_ $ uncurry (PoolOwner poolId) <$> zip poolOwners [0..]
 
         , readPoolRegistration = \poolId -> do
             selectFirst [ PoolRegistrationPoolId ==. poolId ] [] >>= \case
                 Nothing -> pure Nothing
                 Just meta -> do
-                    let (PoolRegistration _ _ poolMargin_ poolCost_) = entityVal meta
-                    let poolMargin = toEnum $ fromIntegral poolMargin_
+                    let (PoolRegistration _ _ marginNum marginDen poolCost_) = entityVal meta
+                    let poolMargin = unsafeMkPercentage $ toRational $ marginNum % marginDen
                     let poolCost = Quantity poolCost_
                     poolOwners <- fmap (poolOwnerOwner . entityVal) <$> selectList
                         [ PoolOwnerPoolId ==. poolId ]

lib/core/src/Cardano/Pool/DB/Sqlite/TH.hs

@@ -81,10 +81,11 @@ PoolOwner sql=pool_owner
 
 -- Mapping of registration certificate to pool
 PoolRegistration sql=pool_registration
-    poolRegistrationPoolId  W.PoolId  sql=pool_id
-    poolRegistrationSlot    W.SlotId  sql=slot
-    poolRegistrationMargin  Word8     sql=margin
-    poolRegistrationCost    Word64    sql=cost
+    poolRegistrationPoolId             W.PoolId  sql=pool_id
+    poolRegistrationSlot               W.SlotId  sql=slot
+    poolRegistrationMarginNumerator    Word64    sql=margin_numerator
+    poolRegistrationMarginDenominator  Word64    sql=margin_denominator
+    poolRegistrationCost               Word64    sql=cost
 
     Primary poolRegistrationPoolId
     deriving Show Generic

lib/core/src/Cardano/Pool/Metrics.hs

@@ -59,7 +59,7 @@ import Cardano.Pool.Metadata
 import Cardano.Pool.Performance
     ( readPoolsPerformances )
 import Cardano.Pool.Ranking
-    ( EpochConstants (..), unsafeMkNonNegative, unsafeMkRatio )
+    ( EpochConstants (..), unsafeMkNonNegative )
 import Cardano.Wallet.Network
     ( ErrCurrentNodeTip
     , ErrNetworkUnavailable
@@ -76,6 +76,8 @@ import Cardano.Wallet.Primitive.Types
     , PoolRegistrationCertificate (..)
     , SlotId
     )
+import Cardano.Wallet.Unsafe
+    ( unsafeMkPercentage )
 import Control.Arrow
     ( first )
 import Control.Monad
@@ -103,7 +105,9 @@ import Data.Map.Strict
 import Data.Ord
     ( Down (..) )
 import Data.Quantity
-    ( Percentage, Quantity (..), getPercentage )
+    ( Percentage, Quantity (..) )
+import Data.Ratio
+    ( (%) )
 import Data.Text.Class
     ( ToText (..) )
 import Data.Vector.Shuffle
@@ -363,9 +367,9 @@ newStakePoolLayer tr block0H getEpCst db@DBLayer{..} nl metadataDir = StakePoolL
                         Ranking.saturation epConstants totalStake stake
                     , desirability =
                         Ranking.desirability epConstants $ Ranking.Pool
-                            (unsafeMkRatio 0) -- pool leader pledge
+                            (unsafeMkPercentage 0) -- pool leader pledge
                             poolCost
-                            (unsafeMkRatio $ fromIntegral (getPercentage poolMargin) / 100)
+                            poolMargin
                             (unsafeMkNonNegative performance)
                     }
                 , poolOwners
@@ -382,14 +386,14 @@ newStakePoolLayer tr block0H getEpCst db@DBLayer{..} nl metadataDir = StakePoolL
         -> BlockHeader -- ^ numerator /...
         -> Quantity "percent" Percentage
     computeProgress prodTip nodeTip =
-        Quantity $ if s1 == 0
-            then minBound
-            else toEnum $ round $ 100 * (toD s0) / (toD s1)
+        if s1 == 0
+        then Quantity minBound
+        else Quantity . unsafeMkPercentage $ (toW s0) % (toW s1)
       where
         s0 = getQuantity $ prodTip ^. #blockHeight
         s1 = getQuantity $ nodeTip ^. #blockHeight
-        toD :: Integral i => i -> Double
-        toD = fromIntegral
+        toW :: Integral i => i -> Integer
+        toW = fromIntegral
 
 readNewcomers
     :: Monad m

lib/core/src/Cardano/Pool/Ranking.hs

@@ -74,9 +74,6 @@ module Cardano.Pool.Ranking
       -- * Types
     , EpochConstants (..)
     , Pool (..)
-    , Ratio
-    , unsafeMkRatio
-    , getRatio
     , NonNegative (..)
     , Positive (..)
     , unsafeMkPositive
@@ -86,8 +83,12 @@ module Cardano.Pool.Ranking
 
 import Prelude
 
+import Cardano.Wallet.Unsafe
+    ( unsafeMkPercentage )
 import Data.Quantity
-    ( Quantity (..) )
+    ( Percentage (..), Quantity (..), percentageToDouble )
+import Data.Ratio
+    ( (%) )
 import Data.Word
     ( Word64 )
 import Fmt
@@ -111,7 +112,7 @@ desirability constants pool
     | otherwise        = (f_saturated - c) * (1 - m)
   where
     f_saturated = saturatedPoolRewards constants pool
-    m = getRatio $ margin pool
+    m = percentageToDouble $ margin pool
     c = fromIntegral $ getQuantity $ cost pool
 
 -- | The saturation-level of a pool indicate how far a pool is from the
@@ -144,7 +145,7 @@ saturation
 saturation constants total own =
     σ / z0
   where
-    z0 = getRatio $ saturatedPoolSize constants
+    z0 = percentageToDouble $ saturatedPoolSize constants
     _S = fromIntegral $ getQuantity total
     s  = fromIntegral $ getQuantity own
     σ  = s / _S
@@ -157,18 +158,19 @@ saturatedPoolRewards :: EpochConstants -> Pool -> Double
 saturatedPoolRewards constants pool =
     let
         a0 = getNonNegative $ leaderStakeInfluence constants
-        z0 = getRatio $ saturatedPoolSize constants
-        s = getRatio $ leaderStake pool
+        z0 = percentageToDouble $ saturatedPoolSize constants
+        s = percentageToDouble $ leaderStake pool
         _R = fromIntegral $ getQuantity $ totalRewards constants
         p = getNonNegative $ recentAvgPerformance pool
         -- ^ technically \hat{p} in the spec
     in
         (p * _R) / (1 + a0) * (z0 + ((min s z0) * a0))
 
 -- | Determines z0, i.e 1 / k
-saturatedPoolSize :: EpochConstants -> Ratio
+saturatedPoolSize :: EpochConstants -> Percentage
 saturatedPoolSize constants =
-    Ratio $ 1 / fromIntegral (getPositive $ desiredNumberOfPools constants)
+    unsafeMkPercentage $
+        1 % fromIntegral (getPositive $ desiredNumberOfPools constants)
 
 --------------------------------------------------------------------------------
 -- Types
@@ -194,11 +196,11 @@ instance Buildable EpochConstants where
         ]
 
 data Pool = Pool
-    { leaderStake :: Ratio
+    { leaderStake :: Percentage
       -- ^ s
     , cost :: Quantity "lovelace" Word64
       -- ^ c
-    , margin :: Ratio
+    , margin :: Percentage
       -- ^ m
     , recentAvgPerformance :: NonNegative Double
       -- ^ \hat{p}, an already averaged (apparent) performance-value.
@@ -207,16 +209,6 @@ data Pool = Pool
       -- randomness.
     } deriving (Show, Eq, Generic)
 
-newtype Ratio = Ratio { getRatio :: Double }
-    deriving (Show, Eq)
-    deriving newtype Ord
-
-unsafeMkRatio :: Double -> Ratio
-unsafeMkRatio x
-    | x >= 0 && x <= 1  = Ratio x
-    | otherwise         = error $ "unsafeMkRatio: " ++ show x
-                          ++ "not in range [0, 1]"
-
 newtype Positive a = Positive { getPositive :: a }
     deriving (Generic, Eq, Show)
     deriving newtype (Ord, Num)

lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs

@@ -36,7 +36,6 @@ import Cardano.Wallet.Primitive.Types
     , PoolOwner (..)
     , SlotId (..)
     , SlotNo (..)
-    , SyncProgress (..)
     , TxStatus (..)
     , WalletId (..)
     , flatSlot
@@ -67,8 +66,6 @@ import Data.ByteString
     ( ByteString )
 import Data.Proxy
     ( Proxy (..) )
-import Data.Quantity
-    ( Quantity (..), getPercentage, mkPercentage )
 import Data.Text
     ( Text )
 import Data.Text.Class
@@ -302,30 +299,6 @@ instance PathPiece SlotId where
     toPathPiece = error "toPathPiece stub needed for persistent"
     fromPathPiece = error "fromPathPiece stub needed for persistent"
 
-
-----------------------------------------------------------------------------
--- SyncProgress
-
-walletStateNum :: SyncProgress -> Word8
-walletStateNum Ready = 100
-walletStateNum (Syncing (Quantity pc)) =
-    fromIntegral $ getPercentage pc
-
-walletStateFromNum :: Word8 -> SyncProgress
-walletStateFromNum n | n < 100 = Syncing (Quantity pc)
-                     | otherwise = Ready
-    where Right pc = mkPercentage n
-
-instance PersistField SyncProgress where
-    toPersistValue = toPersistValue . walletStateNum
-    fromPersistValue = fmap walletStateFromNum . fromPersistValue
-
-instance PersistFieldSql SyncProgress where
-    sqlType _ = sqlType (Proxy @Word8)
-
-instance Read SyncProgress where
-    readsPrec _ = error "readsPrec stub needed for persistent"
-
 ----------------------------------------------------------------------------
 -- TxStatus
 

lib/core/src/Cardano/Wallet/Primitive/Types.hs

@@ -207,7 +207,9 @@ import Data.Maybe
 import Data.Proxy
     ( Proxy (..) )
 import Data.Quantity
-    ( Percentage, Quantity (..) )
+    ( Percentage (..), Quantity (..), mkPercentage )
+import Data.Ratio
+    ( (%) )
 import Data.Set
     ( Set )
 import Data.String
@@ -1357,14 +1359,19 @@ syncProgress (SyncTolerance timeTolerance) sp tip slotNow =
         remainingSlots = fromIntegral $ n1 - n0
 
         ActiveSlotCoefficient f = sp ^. #getActiveSlotCoefficient
-        remainingBlocks = round @_ @Int $ remainingSlots * f
+        remainingBlocks = round (remainingSlots * f)
 
-        progress = fromIntegral $
-            (100 * bhTip) `div` (bhTip + remainingBlocks)
-    in if distance n1 n0 < tolerance || n0 >= n1 || progress >= 100 then
+        progress = bhTip % (bhTip + remainingBlocks)
+    in if distance n1 n0 < tolerance || n0 >= n1 || progress >= 1 then
         Ready
     else
-        Syncing (toEnum progress)
+        Syncing
+        . Quantity
+        . either (const . error $ errMsg progress) id
+        . mkPercentage
+        $ progress
+  where
+    errMsg x = "syncProgress: " ++ show x ++ " is out of bounds"
 
 -- | Helper to compare the /local tip/ with the slot corresponding to a
 -- @UTCTime@, and calculate progress based on that.

lib/core/src/Cardano/Wallet/Unsafe.hs

@@ -18,6 +18,7 @@ module Cardano.Wallet.Unsafe
     , unsafeDeserialiseCbor
     , unsafeBech32DecodeFile
     , unsafeBech32Decode
+    , unsafeMkPercentage
 
     , someDummyMnemonic
     , unsafeMkMnemonic
@@ -64,6 +65,8 @@ import Data.Char
     ( isHexDigit )
 import Data.Proxy
     ( Proxy (..) )
+import Data.Quantity
+    ( Percentage, mkPercentage )
 import Data.Text
     ( Text )
 import Data.Text.Class
@@ -211,3 +214,8 @@ unsafeBech32Decode txt = case Bech32.decodeLenient txt of
   where
     bomb msg = error $ "Could not decode bech32 string " ++ show txt
         ++ " because " ++ msg
+
+unsafeMkPercentage :: HasCallStack => Rational -> Percentage
+unsafeMkPercentage r = either (const bomb) id $ mkPercentage r
+  where
+    bomb = error $ "unsafeMkPercentage: " ++ show r ++ " is out of bounds."