[ADP-3215] Add Value type to Cardano.Wallet.Read (#4713)

This pull request adds a type `Value` to `Cardano.Wallet.Read`, which
mirrors the type `Value` from the ledger specification.

This type occupies the following point in the design space:

* `Value` is an abstract data type, but accompanied by a pattern
synonym.
* `Value` is era-independent.
* `Value` has zero-cost conversion to `MaryValue` from
`cardano-ledger-mary`.

The goal is to make this type convenient, but also efficient to use in
the context of reading blocks from the Cardano blockchain.

### Comments

* I have included some functions, such as `subtract` or `lessOrEqual`
that are relevant for the Deposit Wallet, but did not go into the
details of the `MultiAsset` type — this can be amended later.

### Issue Number

ADP-3215

lib/read/cardano-wallet-read.cabal

@@ -64,6 +64,7 @@ library
     Cardano.Read.Ledger.Tx.Validity
     Cardano.Read.Ledger.Tx.Withdrawals
     Cardano.Read.Ledger.Tx.Witnesses
+    Cardano.Read.Ledger.Value
     Cardano.Wallet.Read
     Cardano.Wallet.Read.Block
     Cardano.Wallet.Read.Block.BHeader
@@ -98,6 +99,7 @@ library
     Cardano.Wallet.Read.Tx.Inputs
     Cardano.Wallet.Read.Tx.TxId
     Cardano.Wallet.Read.Tx.TxIn
+    Cardano.Wallet.Read.Value
 
   build-depends:
     , base

lib/read/lib/Cardano/Read/Ledger/Value.hs

@@ -0,0 +1,63 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{- |
+Copyright: © 2024 Cardano Foundation
+License: Apache-2.0
+
+Era-indexed value.
+-}
+module Cardano.Read.Ledger.Value
+    ( ValueType
+    , Value (..)
+    , maryValueFromByronValue
+    , maryValueFromShelleyValue
+    )
+    where
+
+import Prelude
+
+import Cardano.Ledger.Crypto
+    ( StandardCrypto
+    )
+import Cardano.Wallet.Read.Eras
+    ( Allegra
+    , Alonzo
+    , Babbage
+    , Byron
+    , Conway
+    , Mary
+    , Shelley
+    )
+
+import qualified Cardano.Chain.Common as BY
+import qualified Cardano.Ledger.BaseTypes as SH
+import qualified Cardano.Ledger.Coin as SH
+import qualified Cardano.Ledger.Mary.Value as MA
+
+{-----------------------------------------------------------------------------
+    Value
+------------------------------------------------------------------------------}
+
+type family ValueType era where
+    ValueType Byron = BY.Lovelace
+    ValueType Shelley = SH.Coin
+    ValueType Allegra = SH.Coin
+    ValueType Mary = MA.MaryValue StandardCrypto
+    ValueType Alonzo = MA.MaryValue StandardCrypto
+    ValueType Babbage = MA.MaryValue StandardCrypto
+    ValueType Conway = MA.MaryValue StandardCrypto
+
+newtype Value era = Value (ValueType era)
+
+deriving instance Show (ValueType era) => Show (Value era)
+deriving instance Eq (ValueType era) => Eq (Value era)
+
+maryValueFromByronValue :: ValueType Byron -> ValueType Mary
+maryValueFromByronValue = SH.inject . SH.Coin . BY.lovelaceToInteger
+
+maryValueFromShelleyValue :: ValueType Shelley -> ValueType Mary
+maryValueFromShelleyValue = SH.inject

lib/read/lib/Cardano/Wallet/Read/Value.hs

@@ -0,0 +1,139 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+{- |
+Copyright: © 2024 Cardano Foundation
+License: Apache-2.0
+
+'Value' — ADA and native assets.
+-}
+module Cardano.Wallet.Read.Value
+    ( -- * Coin
+      Coin (unCoin)
+
+    -- * MultiAsset
+    , MultiAsset
+    , AssetName
+    , PolicyID
+    , AssetID (..)
+    , Quantity
+
+    -- * Value
+    , Value (ValueC,getCoin,getAssets)
+    , lookupAssetID
+    , injectCoin
+    , valueFromList
+    , add
+    , subtract
+    , lessOrEqual
+
+    -- * Internal
+    , fromMaryValue
+    , toMaryValue
+    ) where
+
+import Prelude hiding
+    ( subtract
+    )
+
+import Cardano.Ledger.Coin
+    ( Coin (unCoin)
+    )
+import Cardano.Ledger.Crypto
+    ( StandardCrypto
+    )
+import Cardano.Ledger.Val
+    ( pointwise
+    , (<->)
+    )
+
+import qualified Cardano.Ledger.BaseTypes as SH
+import qualified Cardano.Ledger.Mary.Value as MA
+
+{-----------------------------------------------------------------------------
+    MultiAssets
+------------------------------------------------------------------------------}
+
+type AssetName = MA.AssetName
+
+type PolicyID = MA.PolicyID StandardCrypto
+
+type Quantity = Integer
+
+-- | Identifier for an asset.
+data AssetID
+    = AdaID
+    | Asset PolicyID AssetName
+
+deriving instance Eq AssetID
+deriving instance Ord AssetID
+
+type MultiAsset = MA.MultiAsset StandardCrypto
+
+{-----------------------------------------------------------------------------
+    Value
+------------------------------------------------------------------------------}
+-- | Monetary values, representing both ADA and native assets/tokens.
+newtype Value = Value (MA.MaryValue StandardCrypto)
+
+-- | Internal: Convert from ledger 'MaryValue'.
+fromMaryValue :: MA.MaryValue StandardCrypto -> Value
+fromMaryValue = Value
+
+-- | Internal: Convert to ledger 'MaryValue'.
+toMaryValue :: Value -> MA.MaryValue StandardCrypto
+toMaryValue (Value v) = v
+
+instance Eq Value where
+    (Value x) == (Value y) = x == y
+
+instance Show Value where
+    show (Value x) = show x
+
+{-# COMPLETE ValueC #-}
+pattern ValueC :: Coin -> MultiAsset -> Value
+pattern ValueC{getCoin,getAssets} = Value (MA.MaryValue getCoin getAssets)
+
+-- | Look up the quantity corresponding to an 'AssetID'.
+lookupAssetID :: AssetID -> Value -> Quantity
+lookupAssetID AdaID value = unCoin $ getCoin value
+lookupAssetID (Asset policyId assetName) (Value value) =
+    MA.lookupMultiAsset policyId assetName value
+
+-- | Turn a 'Coin' into a 'Value', @inject@ from the specification.
+injectCoin :: Coin -> Value
+injectCoin = Value . SH.inject
+
+-- | Construct a 'Value' from a 'Coin' and a list of assets.
+valueFromList :: Coin -> [(PolicyID, AssetName, Quantity)] -> Value
+valueFromList coin = Value . MA.valueFromList coin
+
+-- | '(<>)' adds monetary values.
+instance Semigroup Value where
+    (Value x) <> (Value y) = Value (x <> y)
+
+instance Monoid Value where
+    mempty = Value mempty
+
+-- | Add all quantities in the second argument to the first argument.
+-- Synonym of '(<>)'.
+--
+-- > ∀ a. lookupAssetID a (x `add` y)
+-- >      = lookupAssetID a x + lookupAssetID a y
+add :: Value -> Value -> Value
+add = (<>)
+
+-- | Subtract the quantities in the second argument from the first argument.
+--
+-- > ∀ a. lookupAssetID a (x `subtract` y)
+-- >      = lookupAssetID a x - lookupAssetID a y
+subtract :: Value -> Value -> Value
+subtract (Value x) (Value y) = Value (x <-> y)
+
+-- | Check whether all assets in the first argument
+-- are present in less or equal quantity
+-- than the assets in the second argument.
+lessOrEqual :: Value -> Value -> Bool
+lessOrEqual (Value value1) (Value value2) =
+    pointwise (<=) value1 value2