{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE DerivingVia         #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE NumericUnderscores  #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | An index of unspent transaction outputs, and some functions for validating
--   transactions using the index.
module Ledger.Index(
    -- * Types for transaction validation based on UTXO index
    UtxoIndex,
    insert,
    insertCollateral,
    insertBlock,
    initialise,
    lookup,
    getCollateral,
    ValidationError(..),
    _TxOutRefNotFound,
    _ScriptFailure,
    _CardanoLedgerValidationError,
    ValidationResult(..),
    _Success,
    _FailPhase1,
    _FailPhase2,
    cardanoTxFromValidationResult,
    toOnChain,
    getEvaluationLogs,
    ValidationSuccess,
    ValidationErrorInPhase,
    ValidationPhase(..),
    RedeemerReport,
    maxFee,
    adjustTxOut,
    minAdaTxOut,
    minAdaTxOutEstimated,
    minLovelaceTxOutEstimated,
    maxMinAdaTxOut,
    createGenesisTransaction,
    genesisTxIn,
    PV1.ExBudget(..),
    PV1.ExCPU(..),
    PV1.ExMemory(..),
    PV1.SatInt,
    ) where

import Prelude hiding (lookup)

import Cardano.Api qualified as C
import Cardano.Api.Shelley qualified as C.Api
import Cardano.Ledger.Babbage qualified as Babbage
import Cardano.Ledger.Babbage.PParams qualified as Babbage
import Cardano.Ledger.Crypto (StandardCrypto)
import Cardano.Ledger.Shelley.API qualified as C.Ledger
import Control.Lens (alaf, (&), (.~), (<&>))
import Data.Foldable (foldl')
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.Monoid (Ap (..))
import Data.Set qualified as Set
import Ledger.Address (CardanoAddress)
import Ledger.Blockchain
import Ledger.Index.Internal
import Ledger.Orphans ()
import Ledger.Tx (CardanoTx (..), TxOut (..), getCardanoTxCollateralInputs, getCardanoTxFee,
                  getCardanoTxProducedOutputs, getCardanoTxProducedReturnCollateral, getCardanoTxSpentOutputs,
                  getCardanoTxTotalCollateral, outValue, txOutValue)
import Ledger.Tx.CardanoAPI (fromPlutusTxOut, toCardanoTxOutValue)
import Ledger.Tx.Internal qualified as Tx
import Ledger.Value.CardanoAPI (Value, lovelaceToValue)
import Plutus.Script.Utils.Ada (Ada)
import Plutus.Script.Utils.Ada qualified as Ada
import Plutus.V1.Ledger.Api qualified as PV1
import PlutusTx.Lattice ((\/))

-- | Create an index of all UTxOs on the chain.
initialise :: Blockchain -> UtxoIndex
initialise :: Blockchain -> UtxoIndex
initialise = (Block -> UtxoIndex -> UtxoIndex
`insertBlock` UtxoIndex
forall a. Monoid a => a
mempty) (Block -> UtxoIndex)
-> (Blockchain -> Block) -> Blockchain -> UtxoIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blockchain -> Block
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat

-- | Update the index for the addition of a transaction.
insert :: CardanoTx -> UtxoIndex -> UtxoIndex
insert :: CardanoTx -> UtxoIndex -> UtxoIndex
insert CardanoTx
tx (C.UTxO Map TxIn (TxOut CtxUTxO BabbageEra)
unspent) = Map TxIn (TxOut CtxUTxO BabbageEra) -> UtxoIndex
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
C.UTxO (Map TxIn (TxOut CtxUTxO BabbageEra) -> UtxoIndex)
-> Map TxIn (TxOut CtxUTxO BabbageEra) -> UtxoIndex
forall a b. (a -> b) -> a -> b
$
  (Map TxIn (TxOut CtxUTxO BabbageEra)
unspent Map TxIn (TxOut CtxUTxO BabbageEra)
-> Set TxIn -> Map TxIn (TxOut CtxUTxO BabbageEra)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` CardanoTx -> Set TxIn
getCardanoTxSpentOutputs CardanoTx
tx)
  Map TxIn (TxOut CtxUTxO BabbageEra)
-> Map TxIn (TxOut CtxUTxO BabbageEra)
-> Map TxIn (TxOut CtxUTxO BabbageEra)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` (TxOut -> TxOut CtxUTxO BabbageEra
Tx.toCtxUTxOTxOut (TxOut -> TxOut CtxUTxO BabbageEra)
-> Map TxIn TxOut -> Map TxIn (TxOut CtxUTxO BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoTx -> Map TxIn TxOut
getCardanoTxProducedOutputs CardanoTx
tx)

-- | Update the index for the addition of only the collateral inputs of a failed transaction.
insertCollateral :: CardanoTx -> UtxoIndex -> UtxoIndex
insertCollateral :: CardanoTx -> UtxoIndex -> UtxoIndex
insertCollateral CardanoTx
tx (C.UTxO Map TxIn (TxOut CtxUTxO BabbageEra)
unspent) = Map TxIn (TxOut CtxUTxO BabbageEra) -> UtxoIndex
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
C.UTxO (Map TxIn (TxOut CtxUTxO BabbageEra) -> UtxoIndex)
-> Map TxIn (TxOut CtxUTxO BabbageEra) -> UtxoIndex
forall a b. (a -> b) -> a -> b
$
    (Map TxIn (TxOut CtxUTxO BabbageEra)
unspent Map TxIn (TxOut CtxUTxO BabbageEra)
-> Set TxIn -> Map TxIn (TxOut CtxUTxO BabbageEra)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList ([TxIn] -> Set TxIn) -> [TxIn] -> Set TxIn
forall a b. (a -> b) -> a -> b
$ CardanoTx -> [TxIn]
getCardanoTxCollateralInputs CardanoTx
tx))
    Map TxIn (TxOut CtxUTxO BabbageEra)
-> Map TxIn (TxOut CtxUTxO BabbageEra)
-> Map TxIn (TxOut CtxUTxO BabbageEra)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` (TxOut -> TxOut CtxUTxO BabbageEra
Tx.toCtxUTxOTxOut (TxOut -> TxOut CtxUTxO BabbageEra)
-> Map TxIn TxOut -> Map TxIn (TxOut CtxUTxO BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoTx -> Map TxIn TxOut
getCardanoTxProducedReturnCollateral CardanoTx
tx)

-- | Update the index for the addition of a block.
insertBlock :: Block -> UtxoIndex -> UtxoIndex
insertBlock :: Block -> UtxoIndex -> UtxoIndex
insertBlock Block
blck UtxoIndex
i = (UtxoIndex -> OnChainTx -> UtxoIndex)
-> UtxoIndex -> Block -> UtxoIndex
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((OnChainTx -> UtxoIndex -> UtxoIndex)
-> UtxoIndex -> OnChainTx -> UtxoIndex
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((CardanoTx -> UtxoIndex -> UtxoIndex)
-> (CardanoTx -> UtxoIndex -> UtxoIndex)
-> OnChainTx
-> UtxoIndex
-> UtxoIndex
forall r. (CardanoTx -> r) -> (CardanoTx -> r) -> OnChainTx -> r
eitherTx CardanoTx -> UtxoIndex -> UtxoIndex
insertCollateral CardanoTx -> UtxoIndex -> UtxoIndex
insert)) UtxoIndex
i Block
blck

-- | Find an unspent transaction output by the 'TxOutRef' that spends it.
lookup :: C.TxIn -> UtxoIndex -> Maybe TxOut
lookup :: TxIn -> UtxoIndex -> Maybe TxOut
lookup TxIn
i UtxoIndex
index = case TxIn
-> Map TxIn (TxOut CtxUTxO BabbageEra)
-> Maybe (TxOut CtxUTxO BabbageEra)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
i (Map TxIn (TxOut CtxUTxO BabbageEra)
 -> Maybe (TxOut CtxUTxO BabbageEra))
-> Map TxIn (TxOut CtxUTxO BabbageEra)
-> Maybe (TxOut CtxUTxO BabbageEra)
forall a b. (a -> b) -> a -> b
$ UtxoIndex -> Map TxIn (TxOut CtxUTxO BabbageEra)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
C.unUTxO UtxoIndex
index of
    Just (C.TxOut AddressInEra BabbageEra
aie TxOutValue BabbageEra
tov TxOutDatum CtxUTxO BabbageEra
tod ReferenceScript BabbageEra
rs) ->
        let tod' :: TxOutDatum ctx BabbageEra
tod' = case TxOutDatum CtxUTxO BabbageEra
tod of
                    TxOutDatum CtxUTxO BabbageEra
C.TxOutDatumNone                    -> TxOutDatum ctx BabbageEra
forall ctx era. TxOutDatum ctx era
C.TxOutDatumNone
                    C.TxOutDatumHash ScriptDataSupportedInEra BabbageEra
era Hash ScriptData
scriptDataHash -> ScriptDataSupportedInEra BabbageEra
-> Hash ScriptData -> TxOutDatum ctx BabbageEra
forall era ctx.
ScriptDataSupportedInEra era
-> Hash ScriptData -> TxOutDatum ctx era
C.TxOutDatumHash ScriptDataSupportedInEra BabbageEra
era Hash ScriptData
scriptDataHash
                    C.TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra
era ScriptData
scriptData   -> ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra
-> ScriptData -> TxOutDatum ctx BabbageEra
forall era ctx.
ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> ScriptData -> TxOutDatum ctx era
C.TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra
era ScriptData
scriptData
        in TxOut -> Maybe TxOut
forall a. a -> Maybe a
Just (TxOut -> Maybe TxOut) -> TxOut -> Maybe TxOut
forall a b. (a -> b) -> a -> b
$ TxOut CtxTx BabbageEra -> TxOut
TxOut (AddressInEra BabbageEra
-> TxOutValue BabbageEra
-> TxOutDatum CtxTx BabbageEra
-> ReferenceScript BabbageEra
-> TxOut CtxTx BabbageEra
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
C.TxOut AddressInEra BabbageEra
aie TxOutValue BabbageEra
tov TxOutDatum CtxTx BabbageEra
forall ctx. TxOutDatum ctx BabbageEra
tod' ReferenceScript BabbageEra
rs)
    Maybe (TxOut CtxUTxO BabbageEra)
Nothing -> Maybe TxOut
forall a. Maybe a
Nothing

getCollateral :: UtxoIndex -> CardanoTx -> C.Value
getCollateral :: UtxoIndex -> CardanoTx -> Value
getCollateral UtxoIndex
idx CardanoTx
tx = case CardanoTx -> Maybe Lovelace
getCardanoTxTotalCollateral CardanoTx
tx of
    Just Lovelace
v -> Lovelace -> Value
lovelaceToValue Lovelace
v
    Maybe Lovelace
Nothing -> Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe (Lovelace -> Value
lovelaceToValue (Lovelace -> Value) -> Lovelace -> Value
forall a b. (a -> b) -> a -> b
$ CardanoTx -> Lovelace
getCardanoTxFee CardanoTx
tx) (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$
        (Unwrapped (Ap Maybe Value) -> Ap Maybe Value)
-> ((TxIn -> Ap Maybe Value) -> [TxIn] -> Ap Maybe Value)
-> (TxIn -> Unwrapped (Ap Maybe Value))
-> [TxIn]
-> Maybe Value
forall (f :: * -> *) (g :: * -> *) s t.
(Functor f, Functor g, Rewrapping s t) =>
(Unwrapped s -> s)
-> (f t -> g s) -> f (Unwrapped t) -> g (Unwrapped s)
alaf Unwrapped (Ap Maybe Value) -> Ap Maybe Value
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (TxIn -> Ap Maybe Value) -> [TxIn] -> Ap Maybe Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((TxOut -> Value) -> Maybe TxOut -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxOut -> Value
txOutValue (Maybe TxOut -> Maybe Value)
-> (TxIn -> Maybe TxOut) -> TxIn -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn -> UtxoIndex -> Maybe TxOut
`lookup` UtxoIndex
idx)) (CardanoTx -> [TxIn]
getCardanoTxCollateralInputs CardanoTx
tx)

-- | Adjust a single transaction output so it contains at least the minimum amount of Ada
-- and return the adjustment (if any) and the updated TxOut.
adjustTxOut :: Babbage.PParams (Babbage.BabbageEra StandardCrypto) -> TxOut -> ([C.Lovelace], Tx.TxOut)
adjustTxOut :: PParams (BabbageEra StandardCrypto) -> TxOut -> ([Lovelace], TxOut)
adjustTxOut PParams (BabbageEra StandardCrypto)
params TxOut
txOut = do
    -- Increasing the ada amount can also increase the size in bytes, so start with a rough estimated amount of ada
    let withMinAdaValue :: TxOutValue BabbageEra
withMinAdaValue = Value -> TxOutValue BabbageEra
toCardanoTxOutValue (Value -> TxOutValue BabbageEra) -> Value -> TxOutValue BabbageEra
forall a b. (a -> b) -> a -> b
$ TxOut -> Value
txOutValue TxOut
txOut Value -> Value -> Value
forall a. JoinSemiLattice a => a -> a -> a
\/ Lovelace -> Value
lovelaceToValue (PParams (BabbageEra StandardCrypto) -> TxOut -> Lovelace
minAdaTxOut PParams (BabbageEra StandardCrypto)
params TxOut
txOut)
    let txOutEstimate :: TxOut
txOutEstimate = TxOut
txOut TxOut -> (TxOut -> TxOut) -> TxOut
forall a b. a -> (a -> b) -> b
& (Value -> Identity (TxOutValue BabbageEra))
-> TxOut -> Identity TxOut
Lens TxOut TxOut Value (TxOutValue BabbageEra)
outValue ((Value -> Identity (TxOutValue BabbageEra))
 -> TxOut -> Identity TxOut)
-> TxOutValue BabbageEra -> TxOut -> TxOut
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxOutValue BabbageEra
withMinAdaValue
        minAdaTxOutEstimated' :: Lovelace
minAdaTxOutEstimated' = PParams (BabbageEra StandardCrypto) -> TxOut -> Lovelace
minAdaTxOut PParams (BabbageEra StandardCrypto)
params TxOut
txOutEstimate
        missingLovelace :: Lovelace
missingLovelace = Lovelace
minAdaTxOutEstimated' Lovelace -> Lovelace -> Lovelace
forall a. Num a => a -> a -> a
- Value -> Lovelace
C.selectLovelace (TxOut -> Value
txOutValue TxOut
txOut)
    if Lovelace
missingLovelace Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
> Lovelace
0
    then
      let adjustedLovelace :: TxOutValue BabbageEra
adjustedLovelace = Value -> TxOutValue BabbageEra
toCardanoTxOutValue (Value -> TxOutValue BabbageEra) -> Value -> TxOutValue BabbageEra
forall a b. (a -> b) -> a -> b
$ TxOut -> Value
txOutValue TxOut
txOut Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Lovelace -> Value
lovelaceToValue Lovelace
missingLovelace
      in ([Lovelace
missingLovelace], TxOut
txOut TxOut -> (TxOut -> TxOut) -> TxOut
forall a b. a -> (a -> b) -> b
& (Value -> Identity (TxOutValue BabbageEra))
-> TxOut -> Identity TxOut
Lens TxOut TxOut Value (TxOutValue BabbageEra)
outValue ((Value -> Identity (TxOutValue BabbageEra))
 -> TxOut -> Identity TxOut)
-> TxOutValue BabbageEra -> TxOut -> TxOut
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxOutValue BabbageEra
adjustedLovelace)
    else ([], TxOut
txOut)

-- | Exact computation of the mimimum Ada required for a given TxOut.
-- TODO: Should be moved to cardano-api-extended once created
minAdaTxOut :: Babbage.PParams (Babbage.BabbageEra StandardCrypto) -> TxOut -> C.Lovelace
minAdaTxOut :: PParams (BabbageEra StandardCrypto) -> TxOut -> Lovelace
minAdaTxOut PParams (BabbageEra StandardCrypto)
params TxOut
txOut = let
  toLovelace :: Coin -> Lovelace
toLovelace = Integer -> Lovelace
C.Lovelace (Integer -> Lovelace) -> (Coin -> Integer) -> Coin -> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Integer
C.Ledger.unCoin
  initialValue :: Value
initialValue = TxOut -> Value
txOutValue TxOut
txOut
  firstEstimate :: Lovelace
firstEstimate = Coin -> Lovelace
toLovelace (Coin -> Lovelace)
-> (TxOut (BabbageEra StandardCrypto) -> Coin)
-> TxOut (BabbageEra StandardCrypto)
-> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams (BabbageEra StandardCrypto)
-> TxOut (BabbageEra StandardCrypto) -> Coin
forall era. CLI era => PParams era -> TxOut era -> Coin
C.Ledger.evaluateMinLovelaceOutput PParams (BabbageEra StandardCrypto)
PParams (BabbageEra StandardCrypto)
params (TxOut (BabbageEra StandardCrypto) -> Lovelace)
-> TxOut (BabbageEra StandardCrypto) -> Lovelace
forall a b. (a -> b) -> a -> b
$ TxOut -> TxOut (BabbageEra StandardCrypto)
fromPlutusTxOut TxOut
txOut
  in -- if the estimate is above the initialValue, we run minAdaAgain, just to be sure that the
     -- new amount didn't change the TxOut size and requires more ada.
     if Lovelace
firstEstimate Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
> Value -> Lovelace
C.selectLovelace Value
initialValue
     then PParams (BabbageEra StandardCrypto) -> TxOut -> Lovelace
minAdaTxOut PParams (BabbageEra StandardCrypto)
params (TxOut -> Lovelace)
-> (TxOutValue BabbageEra -> TxOut)
-> TxOutValue BabbageEra
-> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutValue BabbageEra -> TxOut -> TxOut)
-> TxOut -> TxOutValue BabbageEra -> TxOut
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Value -> Identity (TxOutValue BabbageEra))
-> TxOut -> Identity TxOut
Lens TxOut TxOut Value (TxOutValue BabbageEra)
outValue ((Value -> Identity (TxOutValue BabbageEra))
 -> TxOut -> Identity TxOut)
-> TxOutValue BabbageEra -> TxOut -> TxOut
forall s t a b. ASetter s t a b -> b -> s -> t
.~) TxOut
txOut
            (TxOutValue BabbageEra -> Lovelace)
-> TxOutValue BabbageEra -> Lovelace
forall a b. (a -> b) -> a -> b
$ Value -> TxOutValue BabbageEra
toCardanoTxOutValue (Value -> TxOutValue BabbageEra) -> Value -> TxOutValue BabbageEra
forall a b. (a -> b) -> a -> b
$ Lovelace -> Value
lovelaceToValue Lovelace
firstEstimate Value -> Value -> Value
forall a. JoinSemiLattice a => a -> a -> a
\/ Value
initialValue
     else Lovelace
firstEstimate

{-# INLINABLE minAdaTxOutEstimated #-}
{- | Provide a reasonable estimate of the mimimum of Ada required for a TxOut.

   An exact estimate of the the mimimum of Ada in a TxOut is determined by two things:
     - the `PParams`, more precisely its 'coinPerUTxOWord' parameter.
     - the size of the 'TxOut'.
 In many situations though, we need to determine a plausible value for the minimum of Ada needed for a TxOut
 without knowing much of the 'TxOut'.
 This function provides a value big enough to balance UTxOs without
 a large inlined data (larger than a hash) nor a complex val with a lot of minted values.
 It's superior to the lowest minimum needed for an UTxO, as the lowest value require no datum.
 An estimate of the minimum required Ada for each tx output.
-}
minAdaTxOutEstimated :: Ada
minAdaTxOutEstimated :: Ada
minAdaTxOutEstimated = Integer -> Ada
Ada.lovelaceOf Integer
minTxOut

minLovelaceTxOutEstimated :: C.Lovelace
minLovelaceTxOutEstimated :: Lovelace
minLovelaceTxOutEstimated = Integer -> Lovelace
C.Lovelace Integer
minTxOut

{-# INLINABLE minTxOut #-}
minTxOut :: Integer
minTxOut :: Integer
minTxOut = Integer
2_000_000

{-# INLINABLE maxMinAdaTxOut #-}
{-
maxMinAdaTxOut = maxTxOutSize * coinsPerUTxOWord
coinsPerUTxOWord = 34_482
maxTxOutSize = utxoEntrySizeWithoutVal + maxValSizeInWords + dataHashSize
utxoEntrySizeWithoutVal = 27
maxValSizeInWords = 500
dataHashSize = 10

These values are partly protocol parameters-based, but since this is used in on-chain code
we want a constant to reduce code size.
-}
maxMinAdaTxOut :: Ada
maxMinAdaTxOut :: Ada
maxMinAdaTxOut = Integer -> Ada
Ada.lovelaceOf Integer
18_516_834

-- | TODO Should be calculated based on the maximum script size permitted on
-- the Cardano blockchain.
maxFee :: Ada
maxFee :: Ada
maxFee = Integer -> Ada
Ada.lovelaceOf Integer
1_000_000

-- | cardano-ledger validation rules require the presence of inputs and
-- we have to provide a stub TxIn for the genesis transaction.
genesisTxIn :: C.TxIn
genesisTxIn :: TxIn
genesisTxIn = TxId -> TxIx -> TxIn
C.TxIn TxId
"01f4b788593d4f70de2a45c2e1e87088bfbdfa29577ae1b62aba60e095e3ab53" (Word -> TxIx
C.TxIx Word
40214)

createGenesisTransaction :: Map.Map CardanoAddress Value -> CardanoTx
createGenesisTransaction :: Map (AddressInEra BabbageEra) Value -> CardanoTx
createGenesisTransaction Map (AddressInEra BabbageEra) Value
vals =
    let
        txBodyContent :: TxBodyContent BuildTx BabbageEra
txBodyContent = TxBodyContent BuildTx BabbageEra
Tx.emptyTxBodyContent
           { txIns :: TxIns BuildTx BabbageEra
C.txIns = [ (TxIn
genesisTxIn, Witness WitCtxTxIn BabbageEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)
forall a. a -> BuildTxWith BuildTx a
C.BuildTxWith (KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn BabbageEra
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
C.KeyWitness KeyWitnessInCtx WitCtxTxIn
C.KeyWitnessForSpending)) ]
           , txOuts :: [TxOut CtxTx BabbageEra]
C.txOuts = Map (AddressInEra BabbageEra) Value
-> [(AddressInEra BabbageEra, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (AddressInEra BabbageEra) Value
vals [(AddressInEra BabbageEra, Value)]
-> ((AddressInEra BabbageEra, Value) -> TxOut CtxTx BabbageEra)
-> [TxOut CtxTx BabbageEra]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(AddressInEra BabbageEra
changeAddr, Value
v) ->
                AddressInEra BabbageEra
-> TxOutValue BabbageEra
-> TxOutDatum CtxTx BabbageEra
-> ReferenceScript BabbageEra
-> TxOut CtxTx BabbageEra
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
C.TxOut AddressInEra BabbageEra
changeAddr (Value -> TxOutValue BabbageEra
toCardanoTxOutValue Value
v) TxOutDatum CtxTx BabbageEra
forall ctx era. TxOutDatum ctx era
C.TxOutDatumNone ReferenceScript BabbageEra
forall era. ReferenceScript era
C.Api.ReferenceScriptNone
           }
        txBody :: TxBody BabbageEra
txBody = (TxBodyError -> TxBody BabbageEra)
-> (TxBody BabbageEra -> TxBody BabbageEra)
-> Either TxBodyError (TxBody BabbageEra)
-> TxBody BabbageEra
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> TxBody BabbageEra
forall a. HasCallStack => [Char] -> a
error ([Char] -> TxBody BabbageEra)
-> (TxBodyError -> [Char]) -> TxBodyError -> TxBody BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"createGenesisTransaction: Can't create TxBody: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> [Char])
-> (TxBodyError -> [Char]) -> TxBodyError -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBodyError -> [Char]
forall a. Show a => a -> [Char]
show) TxBody BabbageEra -> TxBody BabbageEra
forall a. a -> a
id (Either TxBodyError (TxBody BabbageEra) -> TxBody BabbageEra)
-> Either TxBodyError (TxBody BabbageEra) -> TxBody BabbageEra
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx BabbageEra
-> Either TxBodyError (TxBody BabbageEra)
forall era.
IsCardanoEra era =>
TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
C.makeTransactionBody TxBodyContent BuildTx BabbageEra
txBodyContent
    in Tx BabbageEra -> CardanoTx
CardanoEmulatorEraTx (Tx BabbageEra -> CardanoTx) -> Tx BabbageEra -> CardanoTx
forall a b. (a -> b) -> a -> b
$ TxBody BabbageEra -> [KeyWitness BabbageEra] -> Tx BabbageEra
forall era. TxBody era -> [KeyWitness era] -> Tx era
C.Tx TxBody BabbageEra
txBody []