module Hydra.Cardano.Api.Tx (
  -- * Extras
  module Hydra.Cardano.Api.Tx,

  -- * Re-export normal Tx (any era)
  Tx,
)
where

import Hydra.Cardano.Api.Prelude

import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Alonzo.TxWits qualified as Ledger
import Cardano.Ledger.Api (
  EraTx (mkBasicTx),
  bodyTxL,
  datsTxWitsL,
  getLanguageView,
  inputsTxBodyL,
  mkBasicTxBody,
  rdmrsTxWitsL,
  scriptIntegrityHashTxBodyL,
  witsTxL,
 )
import Cardano.Ledger.Api qualified as Ledger
import Cardano.Ledger.Babbage.Tx (hashScriptIntegrity)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Plutus.Language qualified as Ledger
import Control.Lens ((&), (.~), (^.))
import Data.Bifunctor (bimap)
import Data.Functor ((<&>))
import Data.Set qualified as Set
import Hydra.Cardano.Api.TxIn (mkTxIn, toLedgerTxIn)

-- * Extras

-- | Sign transaction using the provided secret key
-- It only works for tx not containing scripts.
-- You can't sign a script utxo with this.
signTx ::
  IsShelleyBasedEra era =>
  SigningKey PaymentKey ->
  Tx era ->
  Tx era
signTx :: forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
signingKey (Tx TxBody era
body [KeyWitness era]
wits) =
  [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction (KeyWitness era
witness KeyWitness era -> [KeyWitness era] -> [KeyWitness era]
forall a. a -> [a] -> [a]
: [KeyWitness era]
wits) TxBody era
body
 where
  witness :: KeyWitness era
witness = ShelleyBasedEra era
-> TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
forall era.
ShelleyBasedEra era
-> TxBody era -> ShelleyWitnessSigningKey -> KeyWitness era
makeShelleyKeyWitness ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra TxBody era
body (SigningKey PaymentKey -> ShelleyWitnessSigningKey
WitnessPaymentKey SigningKey PaymentKey
signingKey)

-- | Create a transaction spending all given `UTxO`.
txSpendingUTxO :: UTxO -> Tx Era
txSpendingUTxO :: UTxO -> Tx Era
txSpendingUTxO UTxO
utxo =
  Tx (ShelleyLedgerEra Era) -> Tx Era
forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx (Tx (ShelleyLedgerEra Era) -> Tx Era)
-> Tx (ShelleyLedgerEra Era) -> Tx Era
forall a b. (a -> b) -> a -> b
$
    TxBody (ConwayEra StandardCrypto) -> Tx (ConwayEra StandardCrypto)
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx
      ( TxBody (ConwayEra StandardCrypto)
forall era. EraTxBody era => TxBody era
mkBasicTxBody
          TxBody (ConwayEra StandardCrypto)
-> (TxBody (ConwayEra StandardCrypto)
    -> ConwayTxBody (ConwayEra StandardCrypto))
-> ConwayTxBody (ConwayEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
 -> Identity (Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))))
-> TxBody (ConwayEra StandardCrypto)
-> Identity (TxBody (ConwayEra StandardCrypto))
(Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
 -> Identity (Set (TxIn StandardCrypto)))
-> TxBody (ConwayEra StandardCrypto)
-> Identity (ConwayTxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
inputsTxBodyL ((Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  -> Identity (Set (TxIn StandardCrypto)))
 -> TxBody (ConwayEra StandardCrypto)
 -> Identity (ConwayTxBody (ConwayEra StandardCrypto)))
-> Set (TxIn StandardCrypto)
-> TxBody (ConwayEra StandardCrypto)
-> ConwayTxBody (ConwayEra StandardCrypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TxIn -> TxIn StandardCrypto
toLedgerTxIn (TxIn -> TxIn StandardCrypto)
-> Set TxIn -> Set (TxIn StandardCrypto)
forall b a. Ord b => (a -> b) -> Set a -> Set b
`Set.map` Set TxIn
inputs)
      )
 where
  inputs :: Set TxIn
inputs = UTxO -> Set TxIn
forall out. UTxO' out -> Set TxIn
UTxO.inputSet UTxO
utxo

-- | Get the UTxO that are produced by some transaction.
-- XXX: Defined here to avoid cyclic module dependency
utxoProducedByTx :: Tx Era -> UTxO
utxoProducedByTx :: Tx Era -> UTxO
utxoProducedByTx 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
$
    [Word] -> [TxOut CtxTx Era] -> [(Word, TxOut CtxTx Era)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0 ..] (TxBodyContent ViewTx Era -> [TxOut CtxTx Era]
forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txOuts TxBodyContent ViewTx Era
body)
      [(Word, TxOut CtxTx Era)]
-> ((Word, TxOut CtxTx Era) -> (TxIn, TxOut CtxUTxO Era))
-> [(TxIn, TxOut CtxUTxO Era)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Word -> TxIn)
-> (TxOut CtxTx Era -> TxOut CtxUTxO Era)
-> (Word, TxOut CtxTx Era)
-> (TxIn, TxOut CtxUTxO Era)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Tx Era -> Word -> TxIn
forall era. Tx era -> Word -> TxIn
mkTxIn Tx Era
tx) TxOut CtxTx Era -> TxOut CtxUTxO Era
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
toCtxUTxOTxOut
 where
  TxBody TxBodyContent ViewTx Era
body = Tx Era -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody Tx Era
tx

-- | Get explicit fees allocated to a transaction.
txFee' :: Tx era -> Coin
txFee' :: forall era. Tx era -> Coin
txFee' (Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody -> TxBody TxBodyContent ViewTx era
body) =
  case TxBodyContent ViewTx era -> TxFee era
forall build era. TxBodyContent build era -> TxFee era
txFee TxBodyContent ViewTx era
body of
    TxFeeExplicit ShelleyBasedEra era
_ Coin
y -> Coin
y

-- * Type Conversions

-- | Convert a cardano-api 'Tx' into a matching cardano-ledger 'Tx'.
toLedgerTx ::
  Tx era ->
  Ledger.Tx (ShelleyLedgerEra era)
toLedgerTx :: forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx (ShelleyTx ShelleyBasedEra era
_era Tx (ShelleyLedgerEra era)
tx) = Tx (ShelleyLedgerEra era)
tx

-- | Convert a cardano-ledger's 'Tx' in the Babbage era into a cardano-api 'Tx'.
fromLedgerTx ::
  IsShelleyBasedEra era =>
  Ledger.Tx (ShelleyLedgerEra era) ->
  Tx era
fromLedgerTx :: forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx =
  ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra

-- | Compute the integrity hash of a transaction using a list of plutus languages.
recomputeIntegrityHash ::
  (Ledger.AlonzoEraPParams ppera, Ledger.AlonzoEraTxWits txera, Ledger.AlonzoEraTxBody txera, EraTx txera) =>
  Ledger.PParams ppera ->
  [Ledger.Language] ->
  Ledger.Tx txera ->
  Ledger.Tx txera
recomputeIntegrityHash :: forall ppera txera.
(AlonzoEraPParams ppera, AlonzoEraTxWits txera,
 AlonzoEraTxBody txera, EraTx txera) =>
PParams ppera -> [Language] -> Tx txera -> Tx txera
recomputeIntegrityHash PParams ppera
pp [Language]
languages Tx txera
tx = do
  Tx txera
tx Tx txera -> (Tx txera -> Tx txera) -> Tx txera
forall a b. a -> (a -> b) -> b
& (TxBody txera -> Identity (TxBody txera))
-> Tx txera -> Identity (Tx txera)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx txera) (TxBody txera)
bodyTxL ((TxBody txera -> Identity (TxBody txera))
 -> Tx txera -> Identity (Tx txera))
-> ((StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
     -> Identity (StrictMaybe (ScriptIntegrityHash (EraCrypto txera))))
    -> TxBody txera -> Identity (TxBody txera))
-> (StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
    -> Identity (StrictMaybe (ScriptIntegrityHash (EraCrypto txera))))
-> Tx txera
-> Identity (Tx txera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
 -> Identity (StrictMaybe (ScriptIntegrityHash (EraCrypto txera))))
-> TxBody txera -> Identity (TxBody txera)
forall era.
AlonzoEraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
Lens'
  (TxBody txera)
  (StrictMaybe (ScriptIntegrityHash (EraCrypto txera)))
scriptIntegrityHashTxBodyL ((StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
  -> Identity (StrictMaybe (ScriptIntegrityHash (EraCrypto txera))))
 -> Tx txera -> Identity (Tx txera))
-> StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
-> Tx txera
-> Tx txera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
integrityHash
 where
  integrityHash :: StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
integrityHash =
    Set LangDepView
-> Redeemers txera
-> TxDats txera
-> StrictMaybe (ScriptIntegrityHash (EraCrypto txera))
forall era.
AlonzoEraScript era =>
Set LangDepView
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
hashScriptIntegrity
      ([LangDepView] -> Set LangDepView
forall a. Ord a => [a] -> Set a
Set.fromList ([LangDepView] -> Set LangDepView)
-> [LangDepView] -> Set LangDepView
forall a b. (a -> b) -> a -> b
$ PParams ppera -> Language -> LangDepView
forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
getLanguageView PParams ppera
pp (Language -> LangDepView) -> [Language] -> [LangDepView]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Language]
languages)
      (Tx txera
tx Tx txera
-> Getting (Redeemers txera) (Tx txera) (Redeemers txera)
-> Redeemers txera
forall s a. s -> Getting a s a -> a
^. (TxWits txera -> Const (Redeemers txera) (TxWits txera))
-> Tx txera -> Const (Redeemers txera) (Tx txera)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx txera) (TxWits txera)
witsTxL ((TxWits txera -> Const (Redeemers txera) (TxWits txera))
 -> Tx txera -> Const (Redeemers txera) (Tx txera))
-> ((Redeemers txera -> Const (Redeemers txera) (Redeemers txera))
    -> TxWits txera -> Const (Redeemers txera) (TxWits txera))
-> Getting (Redeemers txera) (Tx txera) (Redeemers txera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers txera -> Const (Redeemers txera) (Redeemers txera))
-> TxWits txera -> Const (Redeemers txera) (TxWits txera)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits txera) (Redeemers txera)
rdmrsTxWitsL)
      (Tx txera
tx Tx txera
-> Getting (TxDats txera) (Tx txera) (TxDats txera) -> TxDats txera
forall s a. s -> Getting a s a -> a
^. (TxWits txera -> Const (TxDats txera) (TxWits txera))
-> Tx txera -> Const (TxDats txera) (Tx txera)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx txera) (TxWits txera)
witsTxL ((TxWits txera -> Const (TxDats txera) (TxWits txera))
 -> Tx txera -> Const (TxDats txera) (Tx txera))
-> ((TxDats txera -> Const (TxDats txera) (TxDats txera))
    -> TxWits txera -> Const (TxDats txera) (TxWits txera))
-> Getting (TxDats txera) (Tx txera) (TxDats txera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats txera -> Const (TxDats txera) (TxDats txera))
-> TxWits txera -> Const (TxDats txera) (TxWits txera)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits txera) (TxDats txera)
datsTxWitsL)