module Hydra.Cardano.Api.UTxO where

import Hydra.Cardano.Api.Prelude hiding (fromLedgerUTxO)
import Hydra.Cardano.Api.TxId (toLedgerTxId)
import Hydra.Cardano.Api.TxIn (fromLedgerTxIn, toLedgerTxIn, txIns')
import Hydra.Cardano.Api.TxOut (fromLedgerTxOut, toLedgerTxOut)

import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Api (outputsTxBodyL)
import Cardano.Ledger.Babbage.TxBody qualified as Ledger
import Cardano.Ledger.BaseTypes qualified as Ledger
import Cardano.Ledger.Shelley.UTxO qualified as Ledger
import Cardano.Ledger.TxIn qualified as Ledger
import Control.Lens ((^.))
import Data.Foldable (toList)
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.String (IsString (..))
import Data.Text qualified as Text

-- | Get a human-readable pretty text representation of a UTxO.
renderUTxO :: IsString str => UTxO -> str
renderUTxO :: forall str. IsString str => UTxO -> str
renderUTxO =
  String -> str
forall a. IsString a => String -> a
fromString (String -> str) -> (UTxO -> String) -> UTxO -> str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String) -> (UTxO -> Text) -> UTxO -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> Text) -> (UTxO -> [Text]) -> UTxO -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxIn, TxOut CtxUTxO Era) -> Text)
-> [(TxIn, TxOut CtxUTxO Era)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxIn, TxOut CtxUTxO Era) -> Text
forall ctx era. (TxIn, TxOut ctx era) -> Text
UTxO.render ([(TxIn, TxOut CtxUTxO Era)] -> [Text])
-> (UTxO -> [(TxIn, TxOut CtxUTxO Era)]) -> UTxO -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> [(TxIn, TxOut CtxUTxO Era)]
forall out. UTxO' out -> [(TxIn, out)]
UTxO.pairs

-- | Construct a UTxO from a transaction. This constructs artificial `TxIn`
-- (a.k.a output reference) from the transaction itself, zipping them to the
-- outputs they correspond to.
utxoFromTx :: Tx Era -> UTxO
utxoFromTx :: Tx Era -> UTxO
utxoFromTx (Tx body :: TxBody Era
body@(ShelleyTxBody ShelleyBasedEra Era
_ TxBody (ShelleyLedgerEra Era)
ledgerBody [Script (ShelleyLedgerEra Era)]
_ TxBodyScriptData Era
_ Maybe (TxAuxData (ShelleyLedgerEra Era))
_ TxScriptValidity Era
_) [KeyWitness Era]
_) =
  let txOuts :: [TxOut ConwayEra]
txOuts = StrictSeq (TxOut ConwayEra) -> [TxOut ConwayEra]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (TxOut ConwayEra) -> [TxOut ConwayEra])
-> StrictSeq (TxOut ConwayEra) -> [TxOut ConwayEra]
forall a b. (a -> b) -> a -> b
$ TxBody (ShelleyLedgerEra Era)
ConwayTxBody ConwayEra
ledgerBody ConwayTxBody ConwayEra
-> Getting
     (StrictSeq (TxOut ConwayEra))
     (ConwayTxBody ConwayEra)
     (StrictSeq (TxOut ConwayEra))
-> StrictSeq (TxOut ConwayEra)
forall s a. s -> Getting a s a -> a
^. (StrictSeq (TxOut ConwayEra)
 -> Const
      (StrictSeq (TxOut ConwayEra)) (StrictSeq (TxOut ConwayEra)))
-> TxBody ConwayEra
-> Const (StrictSeq (TxOut ConwayEra)) (TxBody ConwayEra)
Getting
  (StrictSeq (TxOut ConwayEra))
  (ConwayTxBody ConwayEra)
  (StrictSeq (TxOut ConwayEra))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody ConwayEra) (StrictSeq (TxOut ConwayEra))
outputsTxBodyL
      txIns :: [TxIn]
txIns =
        [ TxId -> TxIx -> TxIn
Ledger.TxIn (TxId -> TxId
toLedgerTxId (TxId -> TxId) -> TxId -> TxId
forall a b. (a -> b) -> a -> b
$ TxBody Era -> TxId
forall era. TxBody era -> TxId
getTxId TxBody Era
body) TxIx
ix
        | TxIx
ix <- [Word16 -> TxIx
Ledger.TxIx Word16
0 .. Int -> TxIx
forall a. Enum a => Int -> a
toEnum ([TxOut ConwayEra] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxOut ConwayEra]
txOuts)]
        ]
   in UTxO (ShelleyLedgerEra Era) -> UTxO
fromLedgerUTxO (UTxO (ShelleyLedgerEra Era) -> UTxO)
-> UTxO (ShelleyLedgerEra Era) -> UTxO
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut (ShelleyLedgerEra Era))
-> UTxO (ShelleyLedgerEra Era)
forall era. Map TxIn (TxOut era) -> UTxO era
Ledger.UTxO (Map TxIn (TxOut (ShelleyLedgerEra Era))
 -> UTxO (ShelleyLedgerEra Era))
-> Map TxIn (TxOut (ShelleyLedgerEra Era))
-> UTxO (ShelleyLedgerEra Era)
forall a b. (a -> b) -> a -> b
$ [(TxIn, TxOut (ShelleyLedgerEra Era))]
-> Map TxIn (TxOut (ShelleyLedgerEra Era))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, TxOut (ShelleyLedgerEra Era))]
 -> Map TxIn (TxOut (ShelleyLedgerEra Era)))
-> [(TxIn, TxOut (ShelleyLedgerEra Era))]
-> Map TxIn (TxOut (ShelleyLedgerEra Era))
forall a b. (a -> b) -> a -> b
$ [TxIn] -> [TxOut ConwayEra] -> [(TxIn, TxOut ConwayEra)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxIn]
txIns [TxOut ConwayEra]
txOuts

-- | Resolve tx inputs in a given UTxO
resolveInputsUTxO :: UTxO -> Tx Era -> UTxO
resolveInputsUTxO :: UTxO -> Tx Era -> UTxO
resolveInputsUTxO UTxO
utxo Tx Era
tx =
  [(TxIn, TxOut CtxUTxO Era)] -> UTxO
forall out. [(TxIn, out)] -> UTxO' out
UTxO.fromPairs ([(TxIn, TxOut CtxUTxO Era)] -> UTxO)
-> [(TxIn, TxOut CtxUTxO Era)] -> UTxO
forall a b. (a -> b) -> a -> b
$
    (TxIn -> Maybe (TxIn, TxOut CtxUTxO Era))
-> [TxIn] -> [(TxIn, TxOut CtxUTxO Era)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\TxIn
txIn -> (TxIn
txIn,) (TxOut CtxUTxO Era -> (TxIn, TxOut CtxUTxO Era))
-> Maybe (TxOut CtxUTxO Era) -> Maybe (TxIn, TxOut CtxUTxO Era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxIn -> UTxO -> Maybe (TxOut CtxUTxO Era)
forall out. TxIn -> UTxO' out -> Maybe out
UTxO.resolve TxIn
txIn UTxO
utxo) (Tx Era -> [TxIn]
forall era. Tx era -> [TxIn]
txIns' Tx Era
tx)

-- * Type Conversions

toLedgerUTxO :: UTxO -> Ledger.UTxO LedgerEra
toLedgerUTxO :: UTxO -> UTxO (ShelleyLedgerEra Era)
toLedgerUTxO =
  Map TxIn (BabbageTxOut ConwayEra) -> UTxO ConwayEra
Map TxIn (TxOut ConwayEra) -> UTxO ConwayEra
forall era. Map TxIn (TxOut era) -> UTxO era
Ledger.UTxO (Map TxIn (BabbageTxOut ConwayEra) -> UTxO ConwayEra)
-> (UTxO -> Map TxIn (BabbageTxOut ConwayEra))
-> UTxO
-> UTxO ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn -> TxOut CtxUTxO Era -> Map TxIn (BabbageTxOut ConwayEra))
-> Map TxIn (TxOut CtxUTxO Era)
-> Map TxIn (BabbageTxOut ConwayEra)
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey TxIn
-> TxOut CtxUTxO Era
-> Map TxIn (BabbageTxOut (ShelleyLedgerEra Era))
TxIn -> TxOut CtxUTxO Era -> Map TxIn (BabbageTxOut ConwayEra)
fn (Map TxIn (TxOut CtxUTxO Era) -> Map TxIn (BabbageTxOut ConwayEra))
-> (UTxO -> Map TxIn (TxOut CtxUTxO Era))
-> UTxO
-> Map TxIn (BabbageTxOut ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> Map TxIn (TxOut CtxUTxO Era)
forall out. UTxO' out -> Map TxIn out
UTxO.toMap
 where
  fn ::
    TxIn ->
    TxOut CtxUTxO Era ->
    Map Ledger.TxIn (Ledger.BabbageTxOut LedgerEra)
  fn :: TxIn
-> TxOut CtxUTxO Era
-> Map TxIn (BabbageTxOut (ShelleyLedgerEra Era))
fn TxIn
i TxOut CtxUTxO Era
o =
    TxIn -> BabbageTxOut ConwayEra -> Map TxIn (BabbageTxOut ConwayEra)
forall k a. k -> a -> Map k a
Map.singleton (TxIn -> TxIn
toLedgerTxIn TxIn
i) (TxOut CtxUTxO Era -> TxOut (ShelleyLedgerEra Era)
forall era.
IsShelleyBasedEra era =>
TxOut CtxUTxO era -> TxOut (ShelleyLedgerEra era)
toLedgerTxOut TxOut CtxUTxO Era
o)

fromLedgerUTxO :: Ledger.UTxO LedgerEra -> UTxO
fromLedgerUTxO :: UTxO (ShelleyLedgerEra Era) -> UTxO
fromLedgerUTxO =
  Map TxIn (TxOut CtxUTxO Era) -> UTxO
forall out. Map TxIn out -> UTxO' out
UTxO (Map TxIn (TxOut CtxUTxO Era) -> UTxO)
-> (UTxO ConwayEra -> Map TxIn (TxOut CtxUTxO Era))
-> UTxO ConwayEra
-> UTxO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn -> BabbageTxOut ConwayEra -> Map TxIn (TxOut CtxUTxO Era))
-> Map TxIn (BabbageTxOut ConwayEra)
-> Map TxIn (TxOut CtxUTxO Era)
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey TxIn
-> BabbageTxOut (ShelleyLedgerEra Era)
-> Map TxIn (TxOut CtxUTxO Era)
TxIn -> BabbageTxOut ConwayEra -> Map TxIn (TxOut CtxUTxO Era)
fn (Map TxIn (BabbageTxOut ConwayEra) -> Map TxIn (TxOut CtxUTxO Era))
-> (UTxO ConwayEra -> Map TxIn (BabbageTxOut ConwayEra))
-> UTxO ConwayEra
-> Map TxIn (TxOut CtxUTxO Era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO ConwayEra -> Map TxIn (BabbageTxOut ConwayEra)
UTxO ConwayEra -> Map TxIn (TxOut ConwayEra)
forall era. UTxO era -> Map TxIn (TxOut era)
Ledger.unUTxO
 where
  fn ::
    Ledger.TxIn ->
    Ledger.BabbageTxOut LedgerEra ->
    Map TxIn (TxOut CtxUTxO Era)
  fn :: TxIn
-> BabbageTxOut (ShelleyLedgerEra Era)
-> Map TxIn (TxOut CtxUTxO Era)
fn TxIn
i BabbageTxOut (ShelleyLedgerEra Era)
o =
    TxIn -> TxOut CtxUTxO Era -> Map TxIn (TxOut CtxUTxO Era)
forall k a. k -> a -> Map k a
Map.singleton (TxIn -> TxIn
fromLedgerTxIn TxIn
i) (TxOut (ShelleyLedgerEra Era) -> TxOut CtxUTxO Era
forall era ctx.
IsShelleyBasedEra era =>
TxOut (ShelleyLedgerEra era) -> TxOut ctx era
fromLedgerTxOut BabbageTxOut (ShelleyLedgerEra Era)
TxOut (ShelleyLedgerEra Era)
o)