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.Api (
  EraTx (mkBasicTx),
  inputsTxBodyL,
  mkBasicTxBody,
 )
import Cardano.Ledger.Api 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

-- * 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