Explicit numeric conversions

src/Chainweb/BlockHash.hs

@@ -70,6 +70,7 @@ import qualified Data.HashMap.Strict as HM
 import qualified Data.List as L
 import qualified Data.Text as T
 import qualified Data.Vector as V
+import Data.Word
 
 import GHC.Generics hiding (to)
 
@@ -195,7 +196,7 @@ instance Each BlockHashRecord BlockHashRecord BlockHash BlockHash where
 
 encodeBlockHashRecord :: BlockHashRecord -> Put
 encodeBlockHashRecord (BlockHashRecord r) = do
-    putWord16le (int $ length r)
+    putWord16le (int @Int @Word16 $ length r)
     traverse_ (bimapM_ encodeChainId encodeBlockHash) $ L.sort $ HM.toList r
 
 decodeBlockHashWithChainId
@@ -205,7 +206,7 @@ decodeBlockHashWithChainId = (,) <$!> decodeChainId <*> decodeBlockHash
 decodeBlockHashRecord :: Get BlockHashRecord
 decodeBlockHashRecord = do
     l <- getWord16le
-    hashes <- replicateM (int l) decodeBlockHashWithChainId
+    hashes <- replicateM (int @Word16 @Int l) decodeBlockHashWithChainId
     return $ BlockHashRecord $! HM.fromList hashes
 
 decodeBlockHashWithChainIdChecked
@@ -223,8 +224,8 @@ decodeBlockHashRecordChecked
     => Expected [p]
     -> Get BlockHashRecord
 decodeBlockHashRecordChecked ps = do
-    (l :: Natural) <- int <$!> getWord16le
-    void $ check ItemCountDecodeException (int . length <$> ps) (Actual l)
+    l <- int @Word16 @Natural <$!> getWord16le
+    void $ check ItemCountDecodeException (int @Int @Natural . length <$> ps) (Actual l)
     hashes <- mapM decodeBlockHashWithChainIdChecked (Expected <$!> getExpected ps)
     return $! BlockHashRecord $! HM.fromList hashes
 

src/Chainweb/BlockHeader.hs

@@ -150,6 +150,7 @@ import Chainweb.Version
 import Chainweb.Storage.Table
 
 import Numeric.AffineSpace
+import Numeric.Natural
 
 import Text.Read (readEither)
 
@@ -219,7 +220,7 @@ effectiveWindow :: BlockHeader -> Maybe WindowWidth
 effectiveWindow h = WindowWidth <$> case window ver of
     Nothing -> Nothing
     Just (WindowWidth w)
-        | int (_blockHeight h) <= w -> Just $ max 1 $ w `div` 10
+        | int @BlockHeight @Natural (_blockHeight h) <= w -> Just $ max 1 $ w `div` 10
         | otherwise -> Just w
   where
     ver = _blockChainwebVersion h
@@ -231,7 +232,7 @@ isLastInEpoch :: BlockHeader -> Bool
 isLastInEpoch h = case effectiveWindow h of
     Nothing -> False
     Just (WindowWidth w)
-        | (int (_blockHeight h) + 1) `mod` w == 0 -> True
+        | (int @BlockHeight @Natural (_blockHeight h) + 1) `mod` w == 0 -> True
         | otherwise -> False
 {-# INLINE isLastInEpoch #-}
 
@@ -252,7 +253,7 @@ slowEpoch (ParentHeader p) (BlockCreationTime ct) = actual > (expected * 5)
     WindowWidth ww = fromJuste $ window (_blockChainwebVersion p)
 
     expected :: Seconds
-    expected = s * int ww
+    expected = s * int @Natural @Seconds ww
 
     actual :: Seconds
     actual = timeSpanToSeconds $ ct .-. es
@@ -303,9 +304,9 @@ powTarget p@(ParentHeader ph) as bct = case effectiveWindow ph of
 
     toEpochStart = EpochStartTime . _bct . _blockCreationTime
 
-    avgTarget targets = HashTarget $ floor $ s / int (length targets)
+    avgTarget targets = HashTarget $ floor $ s / int @Int @Rational (length targets)
       where
-        s = sum $ fmap (int @_ @Rational . _hashTarget) targets
+        s = sum $ fmap (int @PowHashNat @Rational . _hashTarget) targets
 
 {-# INLINE powTarget #-}
 
@@ -970,7 +971,7 @@ newBlockHeader adj pay nonce t p@(ParentHeader b) =
 instance TreeDbEntry BlockHeader where
     type Key BlockHeader = BlockHash
     key = _blockHash
-    rank = int . _blockHeight
+    rank = int @BlockHeight @Natural . _blockHeight
     parent e
         | isGenesisBlockHeader e = Nothing
         | otherwise = Just (_blockParent e)

src/Chainweb/BlockHeader/Validation.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 -- |
 -- Module: Chainweb.BlockHeader.Validation
@@ -112,6 +113,7 @@ import Chainweb.BlockCreationTime
 import Chainweb.BlockHash
 import Chainweb.BlockHeader
 import Chainweb.BlockHeader.Genesis (genesisBlockTarget, genesisParentBlockHash, genesisBlockHeader)
+import Chainweb.BlockWeight
 import Chainweb.ChainId
 import Chainweb.ChainValue
 import Chainweb.Difficulty
@@ -746,7 +748,7 @@ prop_block_weight (ChainStep (ParentHeader p) b)
     | isGenesisBlockHeader b = _blockWeight b == _blockWeight p
     | otherwise = _blockWeight b == expectedWeight
   where
-    expectedWeight = int (targetToDifficulty (_blockTarget b)) + _blockWeight p
+    expectedWeight = int  @HashDifficulty @BlockWeight (targetToDifficulty (_blockTarget b)) + _blockWeight p
 
 prop_block_chainId :: ChainStep -> Bool
 prop_block_chainId (ChainStep (ParentHeader p) b)

src/Chainweb/BlockHeaderDB/Internal.hs

@@ -55,6 +55,7 @@ import Data.Function
 import Data.Hashable
 import Data.Maybe
 import qualified Data.Text.Encoding as T
+import Data.Word
 
 import GHC.Generics
 
@@ -80,6 +81,7 @@ import Chainweb.Storage.Table
 import Chainweb.Storage.Table.RocksDB
 
 import Numeric.Additive
+import Numeric.Natural
 
 -- -------------------------------------------------------------------------- --
 -- | Configuration of the chain DB.
@@ -204,7 +206,7 @@ instance (k ~ CasKeyType BlockHeader) => ReadableTable BlockHeaderDb k BlockHead
 dbAddChecked :: BlockHeaderDb -> BlockHeader -> IO ()
 dbAddChecked db e = unlessM (tableMember (_chainDbCas db) ek) dbAddCheckedInternal
   where
-    r = int $ rank e
+    r = _blockHeight e
     ek = RankedBlockHash r (_blockHash e)
 
     -- Internal helper methods
@@ -292,19 +294,19 @@ instance TreeDb BlockHeaderDb where
 
     lookup db h = runMaybeT $ do
         -- lookup rank
-        r <- MaybeT $ tableLookup (_chainDbRankTable db) h 
-        MaybeT $ lookupRanked db (int r) h
+        r <- MaybeT $ tableLookup (_chainDbRankTable db) h
+        MaybeT $ lookupRanked db (int @BlockHeight @Natural r) h
     {-# INLINEABLE lookup #-}
 
     lookupRanked db r h = runMaybeT $ do
-        rh <- MaybeT $ tableLookup (_chainDbCas db) (RankedBlockHash (int r) h)
+        rh <- MaybeT $ tableLookup (_chainDbCas db) (RankedBlockHash (int @Natural @BlockHeight r) h)
         return $! _getRankedBlockHeader rh
     {-# INLINEABLE lookupRanked #-}
 
     entries db k l mir mar f = withSeekTreeDb db k mir $ \it -> f $ do
         iterToValueStream it
             & S.map _getRankedBlockHeader
-            & maybe id (\x -> S.takeWhile (\a -> int (_blockHeight a) <= x)) mar
+            & maybe id (\x -> S.takeWhile (\a -> int @BlockHeight @MaxRank (_blockHeight a) <= x)) mar
             & limitStream l
     {-# INLINEABLE entries #-}
 
@@ -313,7 +315,7 @@ instance TreeDb BlockHeaderDb where
 
     keys db k l mir mar f = withSeekTreeDb db k mir $ \it -> f $ do
         iterToKeyStream it
-            & maybe id (\x -> S.takeWhile (\a -> int (_rankedBlockHashHeight a) <= x)) mar
+            & maybe id (\x -> S.takeWhile (\a -> int @BlockHeight @MaxRank (_rankedBlockHashHeight a) <= x)) mar
             & S.map _rankedBlockHash
             & limitStream l
     {-# INLINEABLE keys #-}
@@ -329,7 +331,7 @@ instance TreeDb BlockHeaderDb where
     maxRank db = withTableIterator (_chainDbCas db) $ \it -> do
         iterLast it
         iterKey it >>= \case
-            Just (RankedBlockHash !r _) -> return $! int r
+            Just (RankedBlockHash !r _) -> return $! int @BlockHeight @Natural r
             Nothing -> throwM
                 $ InternalInvariantViolation "BlockHeaderDb.maxRank: empty block header db"
     {-# INLINEABLE maxRank #-}
@@ -367,7 +369,7 @@ seekTreeDb db k mir it = do
         Nothing -> case mir of
             Nothing -> return ()
             Just r -> iterSeek it
-                $ RankedBlockHash (BlockHeight $ int $ _getMinRank r) nullBlockHash
+                $ RankedBlockHash (BlockHeight $ int @Natural @Word64 $ _getMinRank r) nullBlockHash
 
         Just a -> do
 
@@ -389,7 +391,7 @@ seekTreeDb db k mir it = do
             -- Check minimum rank. Return invalid iter if cursor is below
             -- minimum rank.
             iterKey it >>= \case
-                Just (RankedBlockHash r' _) | Just m <- mir, int r' < m -> invalidIter
+                Just (RankedBlockHash r' _) | Just m <- mir, int @BlockHeight @MinRank r' < m -> invalidIter
                 _ -> return ()
   where
     invalidIter = iterLast it >> iterNext it
@@ -402,6 +404,6 @@ insertBlockHeaderDb db = dbAddChecked db . _validatedHeader
 {-# INLINE insertBlockHeaderDb #-}
 
 unsafeInsertBlockHeaderDb :: BlockHeaderDb -> BlockHeader -> IO ()
-unsafeInsertBlockHeaderDb = dbAddChecked 
+unsafeInsertBlockHeaderDb = dbAddChecked
 {-# INLINE unsafeInsertBlockHeaderDb #-}
 

src/Chainweb/BlockHeaderDB/PruneForks.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 -- |
 -- Module: Chainweb.BlockHeaderDB.PruneForks
@@ -34,6 +35,7 @@ import qualified Data.List as L
 import Data.Maybe
 import Data.Semigroup
 import qualified Data.Text as T
+import Data.Word
 
 import GHC.Generics
 import GHC.Stack
@@ -121,19 +123,19 @@ pruneForks
 pruneForks logg cdb depth callback = do
     hdr <- maxEntry cdb
     if
-        | int (_blockHeight hdr) <= depth -> do
+        | int @BlockHeight @Natural (_blockHeight hdr) <= depth -> do
             logg Info
                 $ "Skipping database pruning because the maximum block height "
                 <> sshow (_blockHeight hdr) <> " is not larger than then requested depth "
                 <> sshow depth
             return 0
-        | int (_blockHeight hdr) <= int genHeight + depth -> do
+        | int @BlockHeight @Natural (_blockHeight hdr) <= int @BlockHeight @Natural genHeight + depth -> do
             logg Info $ "Skipping database pruning because there are not yet"
                 <> " enough block headers on the chain"
             return 0
         | otherwise -> do
-            let mar = MaxRank $ Max $ int (_blockHeight hdr) - depth
-            pruneForks_ logg cdb mar (MinRank $ Min $ int genHeight) callback
+            let mar = MaxRank $ Max $ int @BlockHeight @Natural (_blockHeight hdr) - depth
+            pruneForks_ logg cdb mar (MinRank $ Min $ int @BlockHeight @Natural genHeight) callback
   where
     v = _chainwebVersion cdb
     cid = _chainId cdb
@@ -221,8 +223,8 @@ pruneForks_ logg cdb mar mir callback = do
     deleteHdr k = do
         -- TODO: make this atomic (create boilerplate to combine queries for
         -- different tables)
-        casDelete (_chainDbCas cdb) (RankedBlockHeader k) 
-        tableDelete (_chainDbRankTable cdb) (_blockHash k) 
+        casDelete (_chainDbCas cdb) (RankedBlockHeader k)
+        tableDelete (_chainDbRankTable cdb) (_blockHash k)
         logg Debug
             $ "pruned block header " <> encodeToText (_blockHash k)
             <> " at height " <> sshow (_blockHeight k)
@@ -239,11 +241,11 @@ withReverseHeaderStream
     -> (S.Stream (S.Of BlockHeader) IO () -> IO a)
     -> IO a
 withReverseHeaderStream db mar mir inner = withTableIterator headerTbl $ \it -> do
-    iterSeek it $ RankedBlockHash (BlockHeight $ int $ _getMaxRank mar + 1) nullBlockHash
+    iterSeek it $ RankedBlockHash (BlockHeight $ int @Natural @Word64 $ _getMaxRank mar + 1) nullBlockHash
     iterPrev it
     inner $ iterToReverseValueStream it
         & S.map _getRankedBlockHeader
-        & S.takeWhile (\a -> int (_blockHeight a) >= mir)
+        & S.takeWhile (\a -> int @BlockHeight @MinRank (_blockHeight a) >= mir)
   where
     headerTbl = _chainDbCas db
 

src/Chainweb/ChainId.hs

@@ -248,7 +248,7 @@ unsafeChainId :: Word32 -> ChainId
 unsafeChainId = ChainId
 {-# INLINE unsafeChainId #-}
 
-chainIdInt :: Integral i => ChainId -> i
-chainIdInt (ChainId cid) = int cid
+chainIdInt :: forall i. Integral i => ChainId -> i
+chainIdInt (ChainId cid) = int @Word32 @i cid
 {-# INLINE chainIdInt #-}
 

src/Chainweb/Chainweb.hs

@@ -769,7 +769,7 @@ runChainweb cw = do
 
     serviceApiServerSettings :: Port -> HostPreference -> Settings
     serviceApiServerSettings port interface = defaultSettings
-        & setPort (int port)
+        & setPort (int @Port @Int port)
         & setHost interface
         & setOnException
             (\r e -> when (defaultShouldDisplayException e) (logg Warn $ loggServiceApiServerError r e))

src/Chainweb/Chainweb/CheckReachability.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 -- |
 -- Module: Chainweb.Chainweb.CheckReachability
@@ -104,14 +105,14 @@ checkReachability sock mgr v logger pdb peers peer threshold = do
                         <> ": " <> sshow e
 
     let c = length $ filter id nis
-        required = ceiling (int (length peers) * threshold)
+        required = ceiling (int @Int @Double (length peers) * threshold)
     if c < required
       then do
         logg Error $ "Only "
             <> sshow c <> " out of "
             <> sshow (length peers) <> " bootstrap peers are reachable."
             <> "Required number of reachable bootstrap nodes: " <> sshow required
-        throwM $ ReachabilityException (Expected $ int required) (Actual $ int c)
+        throwM $ ReachabilityException (Expected $ int @Int @Natural required) (Actual $ int @Int @Natural c)
       else do
         logg Info $ sshow c <> " out of "
             <> sshow (length peers) <> " peers are reachable"
@@ -149,7 +150,7 @@ checkReachability sock mgr v logger pdb peers peer threshold = do
 --
 peerServerSettings :: Peer -> W.Settings
 peerServerSettings peer
-    = W.setPort (int . _hostAddressPort . _peerAddr $ _peerInfo peer)
+    = W.setPort (int @Port @Int . _hostAddressPort . _peerAddr $ _peerInfo peer)
     . W.setHost (_peerInterface peer)
     $ W.defaultSettings
 

src/Chainweb/Chainweb/Configuration.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
 
 -- |
 -- Module: Chainweb.Chainweb.Configuration
@@ -86,6 +87,7 @@ import Control.Monad.Writer
 import Data.Foldable
 import Data.Maybe
 import qualified Data.Text as T
+import Data.Word
 
 import GHC.Generics hiding (from)
 
@@ -422,7 +424,7 @@ defaultChainwebConfiguration v = ChainwebConfiguration
     , _configLogGas = False
     , _configMinGasPrice = 1e-8
     , _configPactQueueSize = 2000
-    , _configReorgLimit = int defaultReorgLimit
+    , _configReorgLimit = int @Word64 @Natural defaultReorgLimit
     , _configValidateHashesOnReplay = False
     , _configAllowReadsInLocal = False
     , _configRosetta = False

src/Chainweb/Chainweb/MempoolSyncClient.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 -- |
 -- Module: Chainweb.Chainweb.MempoolSyncClient
@@ -23,6 +24,7 @@ import Control.Lens hiding ((.=), (<.>))
 import Control.Monad
 import Control.Monad.Catch
 
+import Data.Int
 import qualified Data.Text as T
 
 import qualified Network.HTTP.Client as HTTP
@@ -102,7 +104,7 @@ mempoolSyncP2pSession chain (Seconds pollInterval) logg0 env _ = do
 
     -- FIXME Potentially dangerous down-cast.
     syncIntervalUs :: Int
-    syncIntervalUs = int pollInterval * 500000
+    syncIntervalUs = int @Int64 @Int pollInterval * 500000
 
     remote = T.pack $ Sv.showBaseUrl $ Sv.baseUrl env
     logg d m = logg0 d $ T.concat ["[mempool sync@", remote, "]:", m]

src/Chainweb/Chainweb/PeerResources.hs

@@ -156,7 +156,7 @@ withPeerResources v conf logger inner = withPeerSocket conf $ \(conf', sock) ->
 
 peerServerSettings :: Peer -> Settings
 peerServerSettings peer
-    = setPort (int . _hostAddressPort . _peerAddr $ _peerInfo peer)
+    = setPort (int @Port @Int . _hostAddressPort . _peerAddr $ _peerInfo peer)
     . setHost (_peerInterface peer)
     $ defaultSettings