Skip to content

Commit

Permalink
Add Cardano.Wallet.Read.Tx.TxOut
Browse files Browse the repository at this point in the history
  • Loading branch information
HeinrichApfelmus committed Jul 30, 2024
1 parent 1fc368c commit 98cb734
Show file tree
Hide file tree
Showing 2 changed files with 104 additions and 0 deletions.
1 change: 1 addition & 0 deletions lib/read/cardano-wallet-read.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -102,6 +102,7 @@ library
Cardano.Wallet.Read.Tx.Inputs
Cardano.Wallet.Read.Tx.TxId
Cardano.Wallet.Read.Tx.TxIn
Cardano.Wallet.Read.Tx.TxOut
Cardano.Wallet.Read.Value

build-depends:
Expand Down
103 changes: 103 additions & 0 deletions lib/read/lib/Cardano/Wallet/Read/Tx/TxOut.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,103 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Copyright: © 2024 Cardano Foundation
-- License: Apache-2.0
--
-- 'TxOut' — transaction output.
--

module Cardano.Wallet.Read.Tx.TxOut
( TxOut
, getCompactAddr
, getValue
)
where

import Prelude

import Cardano.Read.Ledger.Tx.Output
( Output (..)
, getEraCompactAddr
, getEraValue
)
import Cardano.Wallet.Read.Eras
( Era (..)
, EraValue (..)
, IsEra (theEra)
)
import Cardano.Wallet.Read.Tx.TxIn
( TxIx
)
import Cardano.Wallet.Read.Address
( CompactAddr
)
import Cardano.Wallet.Read.Value
( Value
, fromMaryValue
)

import qualified Cardano.Read.Ledger.Address as Read
import qualified Cardano.Read.Ledger.Value as Read

{-----------------------------------------------------------------------------
Types
------------------------------------------------------------------------------}
-- | A 'TxOut' is a transaction output from any era — past, present
-- or next one.
newtype TxOut = TxOutC (EraValue Output)

{-# INLINEABLE getCompactAddr #-}
getCompactAddr :: TxOut -> CompactAddr
getCompactAddr (TxOutC (EraValue (txout :: Output era))) =
case theEra :: Era era of
Byron -> onAddress Read.fromByronCompactAddr txout
Shelley -> onAddress id txout
Allegra -> onAddress id txout
Mary -> onAddress id txout
Alonzo -> onAddress id txout
Babbage -> onAddress id txout
Conway -> onAddress id txout

-- Helper function for type inference.
onAddress :: IsEra era => (Read.CompactAddrType era -> t) -> Output era -> t
onAddress f x =
case getEraCompactAddr x of
Read.CompactAddr v -> f v

{-# INLINEABLE getValue #-}
getValue :: TxOut -> Value
getValue (TxOutC (EraValue (txout :: Output era))) =
fromMaryValue $ case theEra :: Era era of
Byron -> onValue Read.maryValueFromByronValue txout
Shelley -> onValue Read.maryValueFromShelleyValue txout
Allegra -> onValue Read.maryValueFromShelleyValue txout
Mary -> onValue id txout
Alonzo -> onValue id txout
Babbage -> onValue id txout
Conway -> onValue id txout

-- Helper function for type inference.
onValue :: IsEra era => (Read.ValueType era -> t) -> Output era -> t
onValue f x =
case getEraValue x of
Read.Value v -> f v

{-----------------------------------------------------------------------------
Functions
------------------------------------------------------------------------------}
{-
{-# INLINEABLE getOutputs #-}
getOutputs :: forall era. IsEra era => Tx era -> Map.Map TxIx TxOut
getOutputs = case theEra :: Era era of
Byron -> onTx $ Outputs . BY.txOutputs . BY.taTx
Shelley -> outputs
Allegra -> outputs
Mary -> outputs
Alonzo -> outputs
Babbage -> outputs
Conway -> outputs
where
outputs = onTx $ Outputs . view (bodyTxL . outputsTxBodyL)
-}

0 comments on commit 98cb734

Please sign in to comment.