[ADP-3215] Add TxOut type to Cardano.Wallet.Read.Tx

lib/read/cardano-wallet-read.cabal

@@ -67,6 +67,7 @@ library
     Cardano.Read.Ledger.Tx.Integrity
     Cardano.Read.Ledger.Tx.Metadata
     Cardano.Read.Ledger.Tx.Mint
+    Cardano.Read.Ledger.Tx.Output
     Cardano.Read.Ledger.Tx.ReferenceInputs
     Cardano.Read.Ledger.Tx.ScriptValidity
     Cardano.Read.Ledger.Tx.Validity
@@ -103,6 +104,7 @@ library
     Cardano.Wallet.Read.Tx.ScriptValidity
     Cardano.Wallet.Read.Tx.TxId
     Cardano.Wallet.Read.Tx.TxIn
+    Cardano.Wallet.Read.Tx.TxOut
     Cardano.Wallet.Read.Value
 
   build-depends:
@@ -155,9 +157,11 @@ test-suite test
   ghc-options:        -with-rtsopts=-M2G -with-rtsopts=-N4
   build-tool-depends: hspec-discover:hspec-discover
   other-modules:
+    Cardano.Read.Ledger.OutputSpec
     Cardano.Wallet.Read.EraValueSpec
     Cardano.Wallet.Read.Tx.CBORSpec
     Cardano.Wallet.Read.Tx.TxIdSpec
+    Cardano.Wallet.Read.Tx.TxOutSpec
     Test.Unit.Cardano.Read.Ledger.Tx
     Spec
     SpecHook
@@ -168,6 +172,9 @@ test-suite test
   build-depends:
     , base
     , bytestring
+    , cardano-ledger-api
+    , cardano-ledger-core
+    , cardano-ledger-mary
     , cardano-wallet-read
     , cardano-wallet-test-utils
     , hspec

lib/read/lib/Cardano/Read/Ledger/Tx/Output.hs

@@ -0,0 +1,243 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{- |
+Copyright: © 2024 Cardano Foundation
+License: Apache-2.0
+
+Era-indexed transaction output.
+-}
+module Cardano.Read.Ledger.Tx.Output
+    ( OutputType
+    , Output (..)
+    , getEraCompactAddr
+    , getEraValue
+    , upgradeToOutputBabbage
+    , upgradeToOutputConway
+    , deserializeOutput
+    , serializeOutput
+    )
+    where
+
+import Prelude
+
+import Cardano.Ledger.Alonzo.TxOut
+    ( AlonzoTxOut
+    )
+import Cardano.Ledger.Api
+    ( Addr (AddrBootstrap)
+    , BootstrapAddress (..)
+    , eraProtVerLow
+    , mkBasicTxOut
+    , upgradeTxOut
+    )
+import Cardano.Ledger.Babbage.TxOut
+    ( BabbageTxOut
+    )
+import Cardano.Ledger.Binary
+    ( DecCBOR (decCBOR)
+    , DecoderError
+    , EncCBOR
+    , byronProtVer
+    , decodeFull
+    , decodeFullDecoder
+    , shelleyProtVer
+    )
+import Cardano.Ledger.Core
+    ( compactAddrTxOutL
+    , valueTxOutL
+    )
+import Cardano.Ledger.Shelley.TxOut
+    ( ShelleyTxOut
+    )
+import Cardano.Read.Ledger.Address
+    ( CompactAddr (..)
+    , CompactAddrType
+    )
+import Cardano.Read.Ledger.Value
+    ( Value (..)
+    , ValueType
+    , maryValueFromByronValue
+    )
+import Cardano.Wallet.Read.Eras
+    ( Allegra
+    , Alonzo
+    , Babbage
+    , Byron
+    , Conway
+    , Era (..)
+    , IsEra (..)
+    , Mary
+    , Shelley
+    )
+import Control.Lens
+    ( view
+    )
+import Data.Text
+    ( Text
+    )
+
+import qualified Cardano.Chain.UTxO as BY
+import qualified Cardano.Ledger.Binary.Encoding as Ledger
+import qualified Data.ByteString.Lazy as BL
+
+{-----------------------------------------------------------------------------
+    Output
+------------------------------------------------------------------------------}
+
+type family OutputType era where
+    OutputType Byron = BY.TxOut
+    OutputType Shelley = ShelleyTxOut Shelley
+    OutputType Allegra = ShelleyTxOut Allegra
+    OutputType Mary = ShelleyTxOut Mary
+    OutputType Alonzo = AlonzoTxOut Alonzo
+    OutputType Babbage = BabbageTxOut Babbage
+    OutputType Conway = BabbageTxOut Conway
+
+newtype Output era = Output (OutputType era)
+
+deriving instance Show (OutputType era) => Show (Output era)
+deriving instance Eq (OutputType era) => Eq (Output era)
+
+{-----------------------------------------------------------------------------
+    Eliminators
+------------------------------------------------------------------------------}
+
+{-# INLINEABLE getEraCompactAddr #-}
+getEraCompactAddr :: forall era. IsEra era => Output era -> CompactAddr era
+getEraCompactAddr = case theEra :: Era era of
+    Byron -> address $ (\(BY.CompactTxOut a _) -> a) . BY.toCompactTxOut
+    Shelley -> address (view compactAddrTxOutL)
+    Allegra -> address (view compactAddrTxOutL)
+    Mary -> address (view compactAddrTxOutL)
+    Alonzo -> address (view compactAddrTxOutL)
+    Babbage -> address (view compactAddrTxOutL)
+    Conway -> address (view compactAddrTxOutL)
+
+-- Helper function for type inference
+address
+    :: (OutputType era -> CompactAddrType era)
+    -> Output era -> CompactAddr era
+address f (Output x) = CompactAddr (f x)
+
+{-# INLINEABLE getEraValue #-}
+getEraValue :: forall era. IsEra era => Output era -> Value era
+getEraValue = case theEra :: Era era of
+    Byron -> value BY.txOutValue
+    Shelley -> value (view valueTxOutL)
+    Allegra -> value (view valueTxOutL)
+    Mary -> value (view valueTxOutL)
+    Alonzo -> value (view valueTxOutL)
+    Babbage -> value (view valueTxOutL)
+    Conway -> value (view valueTxOutL)
+
+-- Helper function for type inference
+value :: (OutputType era -> ValueType era) -> Output era -> Value era
+value f (Output x) = Value (f x)
+
+{-----------------------------------------------------------------------------
+    Operations
+------------------------------------------------------------------------------}
+
+{-# INLINEABLE upgradeToOutputBabbage #-}
+-- | Upgrade an 'Output' to the 'Babbage' era if possibile.
+--
+-- Hardfork: Update this function to the new era.
+upgradeToOutputBabbage
+    :: forall era. IsEra era
+    => Output era -> Maybe (Output Babbage)
+upgradeToOutputBabbage = case theEra :: Era era of
+    Byron -> Just . onOutput
+        (\(BY.TxOut addr lovelace) ->
+            mkBasicTxOut
+                (AddrBootstrap (BootstrapAddress addr))
+                (maryValueFromByronValue lovelace)
+        )
+    Shelley -> Just . onOutput
+        (upgradeTxOut . upgradeTxOut . upgradeTxOut . upgradeTxOut)
+    Allegra -> Just . onOutput
+        (upgradeTxOut . upgradeTxOut . upgradeTxOut)
+    Mary -> Just . onOutput
+        (upgradeTxOut . upgradeTxOut)
+    Alonzo -> Just . onOutput upgradeTxOut
+    Babbage -> Just . id
+    Conway -> const Nothing
+
+{-# INLINEABLE upgradeToOutputConway #-}
+-- | Upgrade an 'Output' to the 'Conway' era.
+--
+-- Hardfork: Update this function to the next era.
+upgradeToOutputConway :: forall era. IsEra era => Output era -> Output Conway
+upgradeToOutputConway = case theEra :: Era era of
+    Byron -> onOutput
+        $ \(BY.TxOut addr lovelace) ->
+            mkBasicTxOut
+                (AddrBootstrap (BootstrapAddress addr))
+                (maryValueFromByronValue lovelace)
+    Shelley -> onOutput
+        $ upgradeTxOut . upgradeTxOut . upgradeTxOut . upgradeTxOut
+        . upgradeTxOut
+    Allegra -> onOutput
+        $ upgradeTxOut . upgradeTxOut . upgradeTxOut . upgradeTxOut
+    Mary -> onOutput
+        $ upgradeTxOut . upgradeTxOut . upgradeTxOut
+    Alonzo -> onOutput
+        $ upgradeTxOut . upgradeTxOut
+    Babbage -> onOutput upgradeTxOut
+    Conway -> id
+
+-- Helper function for type inference
+onOutput
+    :: (OutputType era1 -> OutputType era2)
+    -> Output era1 -> Output era2
+onOutput f (Output x) = Output (f x)
+
+{-----------------------------------------------------------------------------
+    Serialization
+------------------------------------------------------------------------------}
+
+{-# INLINABLE serializeOutput #-}
+-- | Serialize an 'Output' in binary format, e.g. for storing in a database.
+serializeOutput :: forall era. IsEra era => Output era -> BL.ByteString
+serializeOutput = case theEra :: Era era of
+    Byron -> encode byronProtVer
+    Shelley -> encode (eraProtVerLow @Shelley)
+    Allegra -> encode (eraProtVerLow @Allegra)
+    Mary -> encode (eraProtVerLow @Mary)
+    Alonzo -> encode (eraProtVerLow @Alonzo)
+    Babbage -> encode (eraProtVerLow @Babbage)
+    Conway -> encode (eraProtVerLow @Conway)
+  where
+    encode
+        :: EncCBOR (OutputType era)
+        => Ledger.Version -> Output era -> BL.ByteString
+    encode protVer (Output out) = Ledger.serialize protVer out
+
+{-# INLINABLE deserializeOutput #-}
+-- | Deserialize an 'Output' from the binary format.
+--
+-- prop> ∀ o.  deserializeOutput (serializeOutput o) == Just o
+deserializeOutput
+    :: forall era . IsEra era
+    => BL.ByteString -> Either DecoderError (Output era)
+deserializeOutput = case theEra :: Era era of
+    Byron -> fmap Output . decodeFull byronProtVer
+    Shelley -> decode shelleyProtVer "ShelleyTxOut"
+    Allegra -> decode (eraProtVerLow @Allegra) "AllegraTxOut"
+    Mary -> decode (eraProtVerLow @Mary) "MaryTxOut"
+    Alonzo -> decode (eraProtVerLow @Alonzo) "AlonzoTxOut"
+    Babbage -> decode (eraProtVerLow @Babbage) "BabbageTxOut"
+    Conway -> decode (eraProtVerLow @Conway) "ConwayTxOut"
+  where
+    decode
+        :: DecCBOR (OutputType era)
+        => Ledger.Version
+        -> Text
+        -> BL.ByteString
+        -> Either DecoderError (Output era)
+    decode protVer label =
+        fmap Output . decodeFullDecoder protVer label decCBOR