module Hydra.Cardano.Api.UTxO where

import Hydra.Cardano.Api.Prelude hiding (fromLedgerUTxO)
import Hydra.Cardano.Api.TxId (toLedgerTxId)
import Hydra.Cardano.Api.TxIn (txIns')

import Cardano.Api.Tx.UTxO qualified as Api.UTxO
import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Api (outputsTxBodyL)
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 ConwayEra) -> Text)
-> [(TxIn, TxOut CtxUTxO ConwayEra)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxIn, TxOut CtxUTxO ConwayEra) -> Text
forall ctx era. (TxIn, TxOut ctx era) -> Text
UTxO.render ([(TxIn, TxOut CtxUTxO ConwayEra)] -> [Text])
-> (UTxO -> [(TxIn, TxOut CtxUTxO ConwayEra)]) -> UTxO -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> [(TxIn, TxOut CtxUTxO ConwayEra)]
forall out. UTxO' out -> [(TxIn, out)]
UTxO.toList

-- | 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 ConwayEra -> UTxO
utxoFromTx (Tx body :: TxBody ConwayEra
body@(ShelleyTxBody ShelleyBasedEra ConwayEra
_ TxBody (ShelleyLedgerEra ConwayEra)
ledgerBody [Script (ShelleyLedgerEra ConwayEra)]
_ TxBodyScriptData ConwayEra
_ Maybe (TxAuxData (ShelleyLedgerEra ConwayEra))
_ TxScriptValidity ConwayEra
_) [KeyWitness ConwayEra]
_) =
  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 ConwayEra)
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 ConwayEra -> TxId
forall era. TxBody era -> TxId
getTxId TxBody ConwayEra
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 ConwayEra) -> UTxO
fromLedgerUTxO (UTxO (ShelleyLedgerEra ConwayEra) -> UTxO)
-> UTxO (ShelleyLedgerEra ConwayEra) -> UTxO
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut (ShelleyLedgerEra ConwayEra))
-> UTxO (ShelleyLedgerEra ConwayEra)
forall era. Map TxIn (TxOut era) -> UTxO era
Ledger.UTxO (Map TxIn (TxOut (ShelleyLedgerEra ConwayEra))
 -> UTxO (ShelleyLedgerEra ConwayEra))
-> Map TxIn (TxOut (ShelleyLedgerEra ConwayEra))
-> UTxO (ShelleyLedgerEra ConwayEra)
forall a b. (a -> b) -> a -> b
$ [(TxIn, TxOut (ShelleyLedgerEra ConwayEra))]
-> Map TxIn (TxOut (ShelleyLedgerEra ConwayEra))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, TxOut (ShelleyLedgerEra ConwayEra))]
 -> Map TxIn (TxOut (ShelleyLedgerEra ConwayEra)))
-> [(TxIn, TxOut (ShelleyLedgerEra ConwayEra))]
-> Map TxIn (TxOut (ShelleyLedgerEra ConwayEra))
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 ConwayEra -> UTxO
resolveInputsUTxO UTxO
utxo Tx ConwayEra
tx =
  [(TxIn, TxOut CtxUTxO ConwayEra)] -> UTxO
forall out. [(TxIn, out)] -> UTxO' out
UTxO.fromList ([(TxIn, TxOut CtxUTxO ConwayEra)] -> UTxO)
-> [(TxIn, TxOut CtxUTxO ConwayEra)] -> UTxO
forall a b. (a -> b) -> a -> b
$
    (TxIn -> Maybe (TxIn, TxOut CtxUTxO ConwayEra))
-> [TxIn] -> [(TxIn, TxOut CtxUTxO ConwayEra)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\TxIn
txIn -> (TxIn
txIn,) (TxOut CtxUTxO ConwayEra -> (TxIn, TxOut CtxUTxO ConwayEra))
-> Maybe (TxOut CtxUTxO ConwayEra)
-> Maybe (TxIn, TxOut CtxUTxO ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxIn -> UTxO -> Maybe (TxOut CtxUTxO ConwayEra)
forall out. TxIn -> UTxO' out -> Maybe out
UTxO.resolveTxIn TxIn
txIn UTxO
utxo) (Tx ConwayEra -> [TxIn]
forall era. Tx era -> [TxIn]
txIns' Tx ConwayEra
tx)

-- * Type Conversions

toLedgerUTxO :: UTxO -> Ledger.UTxO LedgerEra
toLedgerUTxO :: UTxO -> UTxO (ShelleyLedgerEra ConwayEra)
toLedgerUTxO = ShelleyBasedEra ConwayEra
-> UTxO ConwayEra -> UTxO (ShelleyLedgerEra ConwayEra)
forall era.
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
Api.UTxO.toShelleyUTxO ShelleyBasedEra ConwayEra
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra (UTxO ConwayEra -> UTxO ConwayEra)
-> (UTxO -> UTxO ConwayEra) -> UTxO -> UTxO ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> UTxO ConwayEra
UTxO.toApi

fromLedgerUTxO :: Ledger.UTxO LedgerEra -> UTxO
fromLedgerUTxO :: UTxO (ShelleyLedgerEra ConwayEra) -> UTxO
fromLedgerUTxO = UTxO ConwayEra -> UTxO
forall era. UTxO era -> UTxO
UTxO.fromApi (UTxO ConwayEra -> UTxO)
-> (UTxO ConwayEra -> UTxO ConwayEra) -> UTxO ConwayEra -> UTxO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra ConwayEra
-> UTxO (ShelleyLedgerEra ConwayEra) -> UTxO ConwayEra
forall era.
ShelleyBasedEra era -> UTxO (ShelleyLedgerEra era) -> UTxO era
Api.UTxO.fromShelleyUTxO ShelleyBasedEra ConwayEra
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra