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 LedgerEra
ledgerBody [Script LedgerEra]
_ TxBodyScriptData Era
_ Maybe (TxAuxData LedgerEra)
_ TxScriptValidity Era
_) [KeyWitness Era]
_) =
  let txOuts :: [TxOut (ConwayEra StandardCrypto)]
txOuts = StrictSeq (TxOut (ConwayEra StandardCrypto))
-> [TxOut (ConwayEra StandardCrypto)]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (TxOut (ConwayEra StandardCrypto))
 -> [TxOut (ConwayEra StandardCrypto)])
-> StrictSeq (TxOut (ConwayEra StandardCrypto))
-> [TxOut (ConwayEra StandardCrypto)]
forall a b. (a -> b) -> a -> b
$ TxBody LedgerEra
ConwayTxBody (ConwayEra StandardCrypto)
ledgerBody ConwayTxBody (ConwayEra StandardCrypto)
-> Getting
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
     (ConwayTxBody (ConwayEra StandardCrypto))
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
-> StrictSeq (TxOut (ConwayEra StandardCrypto))
forall s a. s -> Getting a s a -> a
^. (StrictSeq (TxOut (ConwayEra StandardCrypto))
 -> Const
      (StrictSeq (TxOut (ConwayEra StandardCrypto)))
      (StrictSeq (TxOut (ConwayEra StandardCrypto))))
-> TxBody (ConwayEra StandardCrypto)
-> Const
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
     (TxBody (ConwayEra StandardCrypto))
Getting
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
  (ConwayTxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
outputsTxBodyL
      txIns :: [TxIn StandardCrypto]
txIns =
        [ TxId StandardCrypto -> TxIx -> TxIn StandardCrypto
forall c. TxId c -> TxIx -> TxIn c
Ledger.TxIn (TxId -> TxId StandardCrypto
toLedgerTxId (TxId -> TxId StandardCrypto) -> TxId -> TxId StandardCrypto
forall a b. (a -> b) -> a -> b
$ TxBody Era -> TxId
forall era. TxBody era -> TxId
getTxId TxBody Era
body) TxIx
ix
        | TxIx
ix <- [Word64 -> TxIx
Ledger.TxIx Word64
0 .. Int -> TxIx
forall a. Enum a => Int -> a
toEnum ([TxOut (ConwayEra StandardCrypto)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxOut (ConwayEra StandardCrypto)]
txOuts)]
        ]
   in UTxO LedgerEra -> UTxO
fromLedgerUTxO (UTxO LedgerEra -> UTxO) -> UTxO LedgerEra -> UTxO
forall a b. (a -> b) -> a -> b
$ Map (TxIn (EraCrypto LedgerEra)) (TxOut LedgerEra)
-> UTxO LedgerEra
forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Ledger.UTxO (Map (TxIn (EraCrypto LedgerEra)) (TxOut LedgerEra)
 -> UTxO LedgerEra)
-> Map (TxIn (EraCrypto LedgerEra)) (TxOut LedgerEra)
-> UTxO LedgerEra
forall a b. (a -> b) -> a -> b
$ [(TxIn (EraCrypto LedgerEra), TxOut LedgerEra)]
-> Map (TxIn (EraCrypto LedgerEra)) (TxOut LedgerEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn (EraCrypto LedgerEra), TxOut LedgerEra)]
 -> Map (TxIn (EraCrypto LedgerEra)) (TxOut LedgerEra))
-> [(TxIn (EraCrypto LedgerEra), TxOut LedgerEra)]
-> Map (TxIn (EraCrypto LedgerEra)) (TxOut LedgerEra)
forall a b. (a -> b) -> a -> b
$ [TxIn StandardCrypto]
-> [TxOut (ConwayEra StandardCrypto)]
-> [(TxIn StandardCrypto, TxOut (ConwayEra StandardCrypto))]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxIn StandardCrypto]
txIns [TxOut (ConwayEra StandardCrypto)]
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 LedgerEra
toLedgerUTxO =
  Map
  (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  (TxOut (ConwayEra StandardCrypto))
-> UTxO (ConwayEra StandardCrypto)
Map (TxIn StandardCrypto) (BabbageTxOut (ConwayEra StandardCrypto))
-> UTxO (ConwayEra StandardCrypto)
forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
Ledger.UTxO (Map
   (TxIn StandardCrypto) (BabbageTxOut (ConwayEra StandardCrypto))
 -> UTxO (ConwayEra StandardCrypto))
-> (UTxO
    -> Map
         (TxIn StandardCrypto) (BabbageTxOut (ConwayEra StandardCrypto)))
-> UTxO
-> UTxO (ConwayEra StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn
 -> TxOut CtxUTxO Era
 -> Map
      (TxIn StandardCrypto) (BabbageTxOut (ConwayEra StandardCrypto)))
-> Map TxIn (TxOut CtxUTxO Era)
-> Map
     (TxIn StandardCrypto) (BabbageTxOut (ConwayEra StandardCrypto))
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey TxIn
-> TxOut CtxUTxO Era
-> Map (TxIn StandardCrypto) (BabbageTxOut LedgerEra)
TxIn
-> TxOut CtxUTxO Era
-> Map
     (TxIn StandardCrypto) (BabbageTxOut (ConwayEra StandardCrypto))
fn (Map TxIn (TxOut CtxUTxO Era)
 -> Map
      (TxIn StandardCrypto) (BabbageTxOut (ConwayEra StandardCrypto)))
-> (UTxO -> Map TxIn (TxOut CtxUTxO Era))
-> UTxO
-> Map
     (TxIn StandardCrypto) (BabbageTxOut (ConwayEra StandardCrypto))
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 StandardCrypto) (Ledger.BabbageTxOut LedgerEra)
  fn :: TxIn
-> TxOut CtxUTxO Era
-> Map (TxIn StandardCrypto) (BabbageTxOut LedgerEra)
fn TxIn
i TxOut CtxUTxO Era
o =
    TxIn StandardCrypto
-> BabbageTxOut (ConwayEra StandardCrypto)
-> Map
     (TxIn StandardCrypto) (BabbageTxOut (ConwayEra StandardCrypto))
forall k a. k -> a -> Map k a
Map.singleton (TxIn -> TxIn StandardCrypto
toLedgerTxIn TxIn
i) (TxOut CtxUTxO Era -> TxOut LedgerEra
forall era.
IsShelleyBasedEra era =>
TxOut CtxUTxO era -> TxOut (ShelleyLedgerEra era)
toLedgerTxOut TxOut CtxUTxO Era
o)

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