Merge #3034

3034: Redefine `Coin` in terms of `Natural` and remove the `Bounded` instance. r=jonathanknowles a=jonathanknowles

## Issue Number

ADP-1283

## Summary

This PR:
- Redefines `Coin` in terms of `Natural` (rather than `Word64`).
- Removes the `Bounded` instance for `Coin`.
- Adds `txOut{Min,Max}Coin` constants to `Primitive.Types.Tx`, in the same style as the existing `txOut{Min,Max}TokenQuantity` constants.
- Pushes validation checks for coins that must be within a certain range to the places where those checks are actually required.

## Implementation Notes

Where possible, this PR uses `intCast` and `intCastMaybe` (instead of `fromIntegral`) to perform statically-checked integral conversations.

## Motivation

The wallet uses the `Coin` type to represent an amount of _lovelace_.

It's currently defined in terms of `Word64`, and has a `Bounded` instance that limits the range to `[0, 45_000_000_000_000_000]`.

However, this approach is problematic, for several reasons:

- Boundary checks for `Coin` values make sense in contexts where there are boundaries.  However, for pure `Coin` values in the absence of any particular context, there isn't one particular upper bound that makes sense.
- The current choice of `Bounded` specifically defines the limits of what can be included in a _transaction output_. However, encoding values that appear in transaction outputs is not the only use of the `Coin` type.
- For example, it's quite reasonable to use `Coin` for other purposes, like finding the total volume of ada transacted over some period of time. For such usages, there is no obvious choice of upper limit that we could consider “ideal”.
- Right now, we often use awkward workarounds such as casting `Coin` values to `Natural` values before computing summations, thus losing the descriptive value of using the `Coin` type to mark that “this is a quantity of lovelace”.
- Using the existing `Semigroup` instance, we can combine valid `Coin` values into values that are **_invalid_**.  💣 

Co-authored-by: Jonathan Knowles <jonathan.knowles@iohk.io>
Co-authored-by: IOHK <devops+stack-project@iohk.io>

lib/core-integration/src/Test/Integration/Framework/DSL.hs

@@ -314,7 +314,13 @@ import Cardano.Wallet.Primitive.Types.Coin
 import Cardano.Wallet.Primitive.Types.Hash
     ( Hash (..) )
 import Cardano.Wallet.Primitive.Types.Tx
-    ( SealedTx (..), TxIn (..), TxOut (..), TxStatus (..) )
+    ( SealedTx (..)
+    , TxIn (..)
+    , TxOut (..)
+    , TxStatus (..)
+    , txOutMaxCoin
+    , txOutMinCoin
+    )
 import Cardano.Wallet.Primitive.Types.UTxO
     ( HistogramBar (..)
     , UTxO (..)
@@ -383,7 +389,7 @@ import Data.Time
 import Data.Time.Text
     ( iso8601ExtendedUtc, utcTimeToText )
 import Data.Word
-    ( Word16, Word32, Word64 )
+    ( Word16, Word32 )
 import Fmt
     ( indentF, (+|), (|+) )
 import Language.Haskell.TH.Quote
@@ -443,6 +449,7 @@ import qualified Cardano.Wallet.Primitive.AddressDerivation.Icarus as Icarus
 import qualified Cardano.Wallet.Primitive.AddressDerivation.Shared as Shared
 import qualified Cardano.Wallet.Primitive.AddressDerivation.Shelley as Shelley
 import qualified Cardano.Wallet.Primitive.Types as W
+import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
 import qualified Cardano.Wallet.Primitive.Types.TokenQuantity as TokenQuantity
@@ -563,7 +570,7 @@ expectListSizeSatisfy cond (_, res) = liftIO $ case res of
 -- pre-calculated statistics.
 expectWalletUTxO
     :: (HasCallStack, MonadIO m)
-    => [Word64]
+    => [Natural]
     -> Either RequestException ApiUtxoStatistics
     -> m ()
 expectWalletUTxO coins = \case
@@ -739,8 +746,8 @@ computeApiCoinSelectionFee selection
         - balanceOfDeposits
     feeIsValid :: Bool
     feeIsValid = (&&)
-        (fee >= fromIntegral (unCoin (minBound :: Coin)))
-        (fee <= fromIntegral (unCoin (maxBound :: Coin)))
+        (fee >= Coin.toInteger txOutMinCoin)
+        (fee <= Coin.toInteger txOutMaxCoin)
     balanceOfInputs
         = selection
         & view #inputs

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Wallets.hs

@@ -74,7 +74,9 @@ import Data.Quantity
 import Data.Text
     ( Text )
 import Data.Word
-    ( Word32, Word64 )
+    ( Word32 )
+import Numeric.Natural
+    ( Natural )
 import Test.Hspec
     ( SpecWith, describe )
 import Test.Hspec.Expectations.Lifted
@@ -964,7 +966,9 @@ spec = describe "SHELLEY_WALLETS" $ do
         --send funds
         addrs <- listAddresses @n ctx wDest
         let destination = (addrs !! 1) ^. #id
-        let coins = [13_000_000::Word64, 43_000_000, 66_000_000, 101_000_000, 1339_000_000]
+        let coins :: [Natural]
+            coins =
+                [13_000_000, 43_000_000, 66_000_000, 101_000_000, 1339_000_000]
         let payments = flip map coins $ \c -> [json|{
                 "address": #{destination},
                 "amount": {

lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Wallets.hs

@@ -53,7 +53,9 @@ import Data.Quantity
 import Data.Text
     ( Text )
 import Data.Word
-    ( Word32, Word64 )
+    ( Word32 )
+import Numeric.Natural
+    ( Natural )
 import System.Command
     ( Exit (..), Stderr (..), Stdout (..) )
 import System.Exit
@@ -735,7 +737,9 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do
         wDest <- emptyWallet ctx
 
         --send transactions to the wallet
-        let coins = [13_000_000, 43_000_000, 66_000_000, 101_000_000, 1339_000_000] :: [Word64]
+        let coins :: [Natural]
+            coins =
+                [13_000_000, 43_000_000, 66_000_000, 101_000_000, 1339_000_000]
         addrs:_ <- listAddresses @n ctx wDest
         let addr = encodeAddress @n (getApiT $ fst $ addrs ^. #id)
 

lib/core/cardano-wallet-core.cabal

@@ -332,6 +332,7 @@ test-suite unit
     , http-client-tls
     , http-media
     , http-types
+    , int-cast
     , iohk-monitoring
     , io-classes
     , io-sim

lib/core/src/Cardano/Byron/Codec/Cbor.hs

@@ -51,12 +51,10 @@ import Cardano.Wallet.Primitive.Types
     ( ProtocolMagic (..) )
 import Cardano.Wallet.Primitive.Types.Address
     ( Address (..) )
-import Cardano.Wallet.Primitive.Types.Coin
-    ( Coin (..) )
 import Cardano.Wallet.Primitive.Types.Hash
     ( Hash (..) )
 import Cardano.Wallet.Primitive.Types.Tx
-    ( TxIn (..), TxOut (..) )
+    ( TxIn (..), TxOut (..), unsafeCoinToTxOutCoinValue )
 import Control.Monad
     ( replicateM, when )
 import Crypto.Error
@@ -74,6 +72,7 @@ import Data.Either.Extra
 import Data.Word
     ( Word8 )
 
+import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Codec.CBOR.Decoding as CBOR
 import qualified Codec.CBOR.Encoding as CBOR
@@ -270,7 +269,7 @@ decodeTxOut :: CBOR.Decoder s TxOut
 decodeTxOut = do
     _ <- CBOR.decodeListLenCanonicalOf 2
     addr <- decodeAddress
-    TxOut addr . TokenBundle.fromCoin . Coin <$> CBOR.decodeWord64
+    TxOut addr . TokenBundle.fromCoin . Coin.fromWord64 <$> CBOR.decodeWord64
 
 -- * Encoding
 
@@ -399,7 +398,7 @@ encodeTxOut :: TxOut -> CBOR.Encoding
 encodeTxOut (TxOut (Address addr) tb) = mempty
     <> CBOR.encodeListLen 2
     <> encodeAddressPayload payload
-    <> CBOR.encodeWord64 (unCoin $ TokenBundle.getCoin tb)
+    <> CBOR.encodeWord64 (unsafeCoinToTxOutCoinValue $ TokenBundle.getCoin tb)
   where
     invariant =
         error $ "encodeTxOut: unable to decode address payload: " <> show addr

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

@@ -142,7 +142,7 @@ import UnliftIO.Exception
 
 import qualified Cardano.Pool.DB.Sqlite.TH as TH
 import qualified Cardano.Wallet.Primitive.Types as W
-import qualified Cardano.Wallet.Primitive.Types.Coin as W
+import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
 import qualified Data.Map.Strict as Map
 import qualified Data.Text as T
 import qualified Database.Sqlite as Sqlite
@@ -304,8 +304,8 @@ newDBLayer tr ti SqliteContext{runQuery} =
                         $ getPercentage $ poolMargin cert)
                     (fromIntegral $ denominator
                         $ getPercentage $ poolMargin cert)
-                    (W.unCoin $ poolCost cert)
-                    (W.unCoin $ poolPledge cert)
+                    (Coin.unsafeToWord64 $ poolCost cert)
+                    (Coin.unsafeToWord64 $ poolPledge cert)
                     (fst <$> poolMetadata cert)
                     (snd <$> poolMetadata cert)
             _ <- repsert poolRegistrationKey poolRegistrationRow
@@ -455,8 +455,8 @@ newDBLayer tr ti SqliteContext{runQuery} =
                     <$> fromPersistValue fieldPoolId
                     <*> fromPersistValue fieldOwners
                     <*> parseMargin
-                    <*> (W.Coin <$> fromPersistValue fieldCost)
-                    <*> (W.Coin <$> fromPersistValue fieldPledge)
+                    <*> (Coin.fromWord64 <$> fromPersistValue fieldCost)
+                    <*> (Coin.fromWord64 <$> fromPersistValue fieldPledge)
                     <*> parseMetadata
 
                 parseRetirementCertificate = do
@@ -597,8 +597,8 @@ newDBLayer tr ti SqliteContext{runQuery} =
                         poolMetadataHash = entityVal meta
                 let poolMargin = unsafeMkPercentage $
                         toRational $ marginNum % marginDen
-                let poolCost = W.Coin poolCost_
-                let poolPledge = W.Coin poolPledge_
+                let poolCost = Coin.fromWord64 poolCost_
+                let poolPledge = Coin.fromWord64 poolPledge_
                 let poolMetadata = (,) <$> poolMetadataUrl <*> poolMetadataHash
                 poolOwners <- fmap (poolOwnerOwner . entityVal) <$>
                     selectList

lib/core/src/Cardano/Wallet.hs

@@ -373,7 +373,7 @@ import Cardano.Wallet.Primitive.Types
 import Cardano.Wallet.Primitive.Types.Address
     ( Address (..), AddressState (..) )
 import Cardano.Wallet.Primitive.Types.Coin
-    ( Coin (..), addCoin, coinToInteger, sumCoins )
+    ( Coin (..) )
 import Cardano.Wallet.Primitive.Types.Hash
     ( Hash (..) )
 import Cardano.Wallet.Primitive.Types.Redeemer
@@ -1160,7 +1160,7 @@ readNextWithdrawal ctx (Coin withdrawal) = do
             calcMinimumCost tl pp (mkTxCtx $ Coin 0) emptySkeleton
 
     let costOfWithdrawal =
-            coinToInteger costWith - coinToInteger costWithout
+            Coin.toInteger costWith - Coin.toInteger costWithout
 
     if toInteger withdrawal < 2 * costOfWithdrawal
     then pure (Coin 0)
@@ -1588,7 +1588,7 @@ balanceTransaction
                     , "when balancing a transaction, but it was!"
                     ]
                 )
-                (sumCoins wdrlMap)
+                (F.fold wdrlMap)
          in (outs, wdrl, meta, toMint, toBurn)
 
     -- | Wallet coin selection is unaware of many kinds of transaction content
@@ -1625,7 +1625,7 @@ balanceTransaction
 
             txFeePadding = (<> extraMargin) $ fromMaybe (Coin 0) $ do
                 betterEstimate <- evaluateMinimumFee tl nodePParams sealedTx
-                betterEstimate `Coin.subtractCoin` worseEstimate
+                betterEstimate `Coin.subtract` worseEstimate
         in
             txCtx { txFeePadding }
 
@@ -2055,21 +2055,21 @@ mkTxMeta
     -> IO (UTCTime, TxMeta)
 mkTxMeta ti' blockHeader wState txCtx sel =
     let
-        amtOuts = sumCoins $
+        amtOuts = F.fold $
             (txOutCoin <$> view #change sel)
             ++
             mapMaybe ourCoin (view #outputs sel)
 
         amtInps
-            = sumCoins (txOutCoin . snd <$> view #inputs sel)
+            = F.fold (txOutCoin . snd <$> view #inputs sel)
             -- NOTE: In case where rewards were pulled from an external
             -- source, they aren't added to the calculation because the
             -- money is considered to come from outside of the wallet; which
             -- changes the way we look at transactions (in such case, a
             -- transaction is considered 'Incoming' since it brings extra money
             -- to the wallet from elsewhere).
             & case txWithdrawal txCtx of
-                w@WithdrawalSelf{} -> addCoin (withdrawalToCoin w)
+                w@WithdrawalSelf{} -> Coin.add (withdrawalToCoin w)
                 WithdrawalExternal{} -> Prelude.id
                 NoWithdrawal -> Prelude.id
     in do

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -420,7 +420,7 @@ import Cardano.Wallet.Primitive.Types
 import Cardano.Wallet.Primitive.Types.Address
     ( Address (..), AddressState (..) )
 import Cardano.Wallet.Primitive.Types.Coin
-    ( Coin (..), coinQuantity )
+    ( Coin (..) )
 import Cardano.Wallet.Primitive.Types.Hash
     ( Hash (..) )
 import Cardano.Wallet.Primitive.Types.Redeemer
@@ -596,6 +596,7 @@ import qualified Cardano.Wallet.Primitive.AddressDerivation.Icarus as Icarus
 import qualified Cardano.Wallet.Primitive.CoinSelection.Balance as Balance
 import qualified Cardano.Wallet.Primitive.CoinSelection.Collateral as Collateral
 import qualified Cardano.Wallet.Primitive.Types as W
+import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
 import qualified Cardano.Wallet.Primitive.Types.Tx as W
@@ -3241,8 +3242,8 @@ mkApiFee :: Maybe Coin -> [Coin] -> FeeEstimation -> ApiFee
 mkApiFee mDeposit minCoins (FeeEstimation estMin estMax) = ApiFee
     { estimatedMin = qty estMin
     , estimatedMax = qty estMax
-    , minimumCoins = coinQuantity <$> minCoins
-    , deposit = coinQuantity $ fromMaybe (Coin 0) mDeposit
+    , minimumCoins = Quantity . Coin.toNatural <$> minCoins
+    , deposit = Quantity . Coin.toNatural $ fromMaybe (Coin 0) mDeposit
     }
   where
     qty = Quantity . fromIntegral
@@ -3831,7 +3832,7 @@ instance IsServerError ErrCannotQuit where
                 , "although you're not even delegating, nor won't be in an "
                 , "immediate future."
                 ]
-        ErrNonNullRewards (Coin rewards) ->
+        ErrNonNullRewards rewards ->
             apiError err403 NonNullRewards $ mconcat
                 [ "It seems that you're trying to retire from delegation "
                 , "although you've unspoiled rewards in your rewards "

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

@@ -313,7 +313,7 @@ import Cardano.Wallet.Primitive.Types
 import Cardano.Wallet.Primitive.Types.Address
     ( Address (..), AddressState (..) )
 import Cardano.Wallet.Primitive.Types.Coin
-    ( Coin (..), isValidCoin )
+    ( Coin (..) )
 import Cardano.Wallet.Primitive.Types.Hash
     ( Hash (..) )
 import Cardano.Wallet.Primitive.Types.Tx
@@ -325,8 +325,10 @@ import Cardano.Wallet.Primitive.Types.Tx
     , TxMetadata
     , TxScriptValidity (..)
     , TxStatus (..)
+    , coinIsValidForTxOut
     , sealedTxFromBytes
     , txMetadataIsNull
+    , txOutMaxCoin
     )
 import Cardano.Wallet.Primitive.Types.UTxO
     ( BoundType, HistogramBar (..), UTxOStatistics (..) )
@@ -2939,10 +2941,10 @@ instance FromJSON a => FromJSON (AddressAmount a) where
             <*> v .:? "assets" .!= mempty
       where
         validateCoin q
-            | isValidCoin (coinFromQuantity q) = pure q
+            | coinIsValidForTxOut (coinFromQuantity q) = pure q
             | otherwise = fail $
                 "invalid coin value: value has to be lower than or equal to "
-                <> show (unCoin maxBound) <> " lovelace."
+                <> show (unCoin txOutMaxCoin) <> " lovelace."
 
 instance ToJSON (ApiT W.TokenBundle) where
     -- TODO: consider other structures
@@ -2961,10 +2963,10 @@ instance FromJSON (ApiT W.TokenBundle) where
       where
         validateCoin :: Quantity "lovelace" Word64 -> Aeson.Parser Coin
         validateCoin (coinFromQuantity -> c)
-            | isValidCoin c = pure c
+            | coinIsValidForTxOut c = pure c
             | otherwise = fail $
                 "invalid coin value: value has to be lower than or equal to "
-                <> show (unCoin maxBound) <> " lovelace."
+                <> show (unCoin txOutMaxCoin) <> " lovelace."
 
 instance ToJSON a => ToJSON (AddressAmount a) where
     toJSON = genericToJSON defaultRecordTypeOptions

lib/core/src/Cardano/Wallet/DB/Model.hs

@@ -226,7 +226,7 @@ mInitializeWallet wid cp meta txs0 gp db@Database{wallets,txs}
                 , txHistory = history
                 , xprv = Nothing
                 , genesisParameters = gp
-                , rewardAccountBalance = minBound
+                , rewardAccountBalance = Coin 0
                 , submittedTxs = mempty
                 }
             txs' = Map.fromList $ (\(tx, _) -> (view #txId tx, tx)) <$> txs0
@@ -518,7 +518,7 @@ mPutDelegationRewardBalance wid amt = alterModel wid $ \wal ->
 mReadDelegationRewardBalance
     :: Ord wid => wid -> ModelOp wid s xprv Coin
 mReadDelegationRewardBalance wid db@(Database wallets _) =
-    (Right (maybe minBound rewardAccountBalance $ Map.lookup wid wallets), db)
+    (Right (maybe (Coin 0) rewardAccountBalance $ Map.lookup wid wallets), db)
 
 mPutLocalTxSubmission :: Ord wid => wid -> Hash "Tx" -> SealedTx -> SlotNo -> ModelOp wid s xprv ()
 mPutLocalTxSubmission wid tid tx sl = alterModelErr wid $ \wal ->

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

@@ -263,6 +263,7 @@ import qualified Cardano.Wallet.Primitive.AddressDiscovery.Shared as Shared
 import qualified Cardano.Wallet.Primitive.Model as W
 import qualified Cardano.Wallet.Primitive.Types as W
 import qualified Cardano.Wallet.Primitive.Types.Address as W
+import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
 import qualified Cardano.Wallet.Primitive.Types.Coin as W
 import qualified Cardano.Wallet.Primitive.Types.Hash as W
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
@@ -1607,16 +1608,16 @@ newDBLayerWith cacheBehavior tr ti SqliteContext{runQuery} = do
         -----------------------------------------------------------------------}
 
         , putDelegationRewardBalance =
-            \wid (W.Coin amt) -> ExceptT $ do
+            \wid amt -> ExceptT $ do
             selectWallet wid >>= \case
                 Nothing -> pure $ Left $ ErrNoSuchWallet wid
                 Just _  -> Right <$> repsert
                     (DelegationRewardKey wid)
-                    (DelegationReward wid amt)
+                    (DelegationReward wid (Coin.unsafeToWord64 amt))
 
         , readDelegationRewardBalance =
             \wid ->
-                W.Coin . maybe 0 (rewardAccountBalance . entityVal) <$>
+                Coin.fromWord64 . maybe 0 (rewardAccountBalance . entityVal) <$>
                 selectFirst [RewardWalletId ==. wid] []
 
         {-----------------------------------------------------------------------