{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Ledger.Babbage.TxInfo where

import Cardano.Crypto.Hash.Class (hashToBytes)
import Cardano.Ledger.Alonzo.Data (Datum (..), binaryDataToData, getPlutusData)
import Cardano.Ledger.Alonzo.Language (Language (..))
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
import Cardano.Ledger.Alonzo.Tx (Data, rdptrInv)
import Cardano.Ledger.Alonzo.TxInfo
  ( ExtendedUTxO (getTxOutDatum),
    TranslationError (..),
    TxOutSource (..),
    VersionedTxInfo (..),
  )
import qualified Cardano.Ledger.Alonzo.TxInfo as Alonzo
import Cardano.Ledger.Alonzo.TxWitness (RdmrPtr, TxWitness (..), unRedeemers, unTxDats)
import Cardano.Ledger.BaseTypes (ProtVer (..), StrictMaybe (..), isSJust)
import Cardano.Ledger.Core as Core (PParams, Script, Tx, TxBody, TxOut, Value)
import Cardano.Ledger.Era (Era (..), ValidateScript (..))
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (Witness))
import qualified Cardano.Ledger.Mary.Value as Mary (Value (..))
import Cardano.Ledger.SafeHash (hashAnnotated)
import Cardano.Ledger.Shelley.Scripts (ScriptHash (..))
import Cardano.Ledger.Shelley.TxBody (DCert (..), Wdrl (..))
import Cardano.Ledger.Shelley.UTxO (UTxO (..))
import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval (..))
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.Val (Val (..))
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart)
import Control.Arrow (left)
import Control.Monad (unless, when, zipWithM)
import qualified Data.Map.Strict as Map
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import GHC.Records (HasField (..))
import qualified Plutus.V1.Ledger.Api as PV1
import Plutus.V1.Ledger.Contexts ()
import qualified Plutus.V2.Ledger.Api as PV2

transScriptHash :: ScriptHash c -> PV2.ScriptHash
transScriptHash :: ScriptHash c -> ScriptHash
transScriptHash (ScriptHash Hash (ADDRHASH c) EraIndependentScript
h) = BuiltinByteString -> ScriptHash
PV2.ScriptHash (ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PV2.toBuiltin (Hash (ADDRHASH c) EraIndependentScript -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash (ADDRHASH c) EraIndependentScript
h))

transReferenceScript ::
  forall era.
  ValidateScript era =>
  StrictMaybe (Core.Script era) ->
  Maybe PV2.ScriptHash
transReferenceScript :: StrictMaybe (Script era) -> Maybe ScriptHash
transReferenceScript StrictMaybe (Script era)
SNothing = Maybe ScriptHash
forall a. Maybe a
Nothing
transReferenceScript (SJust Script era
s) = ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just (ScriptHash -> Maybe ScriptHash)
-> (Script era -> ScriptHash) -> Script era -> Maybe ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash (Crypto era) -> ScriptHash
forall c. ScriptHash c -> ScriptHash
transScriptHash (ScriptHash (Crypto era) -> ScriptHash)
-> (Script era -> ScriptHash (Crypto era))
-> Script era
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidateScript era => Script era -> ScriptHash (Crypto era)
forall era.
ValidateScript era =>
Script era -> ScriptHash (Crypto era)
hashScript @era (Script era -> Maybe ScriptHash) -> Script era -> Maybe ScriptHash
forall a b. (a -> b) -> a -> b
$ Script era
s

-- | Given a TxOut, translate it for V2 and return (Right transalation).
-- If the transaction contains any Byron addresses or Babbage features, return Left.
txInfoOutV1 ::
  forall era.
  ( Era era,
    ExtendedUTxO era,
    ValidateScript era,
    Value era ~ Mary.Value (Crypto era),
    HasField "referenceScript" (Core.TxOut era) (StrictMaybe (Core.Script era))
  ) =>
  TxOutSource (Crypto era) ->
  Core.TxOut era ->
  Either (TranslationError (Crypto era)) PV1.TxOut
txInfoOutV1 :: TxOutSource (Crypto era)
-> TxOut era -> Either (TranslationError (Crypto era)) TxOut
txInfoOutV1 TxOutSource (Crypto era)
os TxOut era
txout = do
  let val :: Value (Crypto era)
val = TxOut era -> Value (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"value" TxOut era
txout
      referenceScript :: StrictMaybe (Script era)
referenceScript = TxOut era -> StrictMaybe (Script era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"referenceScript" TxOut era
txout
  Bool
-> Either (TranslationError (Crypto era)) ()
-> Either (TranslationError (Crypto era)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrictMaybe (Script era) -> Bool
forall a. StrictMaybe a -> Bool
isSJust StrictMaybe (Script era)
referenceScript) (Either (TranslationError (Crypto era)) ()
 -> Either (TranslationError (Crypto era)) ())
-> Either (TranslationError (Crypto era)) ()
-> Either (TranslationError (Crypto era)) ()
forall a b. (a -> b) -> a -> b
$ TranslationError (Crypto era)
-> Either (TranslationError (Crypto era)) ()
forall a b. a -> Either a b
Left (TranslationError (Crypto era)
 -> Either (TranslationError (Crypto era)) ())
-> TranslationError (Crypto era)
-> Either (TranslationError (Crypto era)) ()
forall a b. (a -> b) -> a -> b
$ TxOutSource (Crypto era) -> TranslationError (Crypto era)
forall crypto. TxOutSource crypto -> TranslationError crypto
ReferenceScriptsNotSupported TxOutSource (Crypto era)
os
  StrictMaybe (DataHash (Crypto era))
datahash <-
    case TxOut era -> Datum era
forall era. ExtendedUTxO era => TxOut era -> Datum era
getTxOutDatum TxOut era
txout of
      Datum era
NoDatum -> StrictMaybe (DataHash (Crypto era))
-> Either
     (TranslationError (Crypto era))
     (StrictMaybe (DataHash (Crypto era)))
forall a b. b -> Either a b
Right StrictMaybe (DataHash (Crypto era))
forall a. StrictMaybe a
SNothing
      DatumHash DataHash (Crypto era)
dh -> StrictMaybe (DataHash (Crypto era))
-> Either
     (TranslationError (Crypto era))
     (StrictMaybe (DataHash (Crypto era)))
forall a b. b -> Either a b
Right (StrictMaybe (DataHash (Crypto era))
 -> Either
      (TranslationError (Crypto era))
      (StrictMaybe (DataHash (Crypto era))))
-> StrictMaybe (DataHash (Crypto era))
-> Either
     (TranslationError (Crypto era))
     (StrictMaybe (DataHash (Crypto era)))
forall a b. (a -> b) -> a -> b
$ DataHash (Crypto era) -> StrictMaybe (DataHash (Crypto era))
forall a. a -> StrictMaybe a
SJust DataHash (Crypto era)
dh
      Datum BinaryData era
_ -> TranslationError (Crypto era)
-> Either
     (TranslationError (Crypto era))
     (StrictMaybe (DataHash (Crypto era)))
forall a b. a -> Either a b
Left (TranslationError (Crypto era)
 -> Either
      (TranslationError (Crypto era))
      (StrictMaybe (DataHash (Crypto era))))
-> TranslationError (Crypto era)
-> Either
     (TranslationError (Crypto era))
     (StrictMaybe (DataHash (Crypto era)))
forall a b. (a -> b) -> a -> b
$ TxOutSource (Crypto era) -> TranslationError (Crypto era)
forall crypto. TxOutSource crypto -> TranslationError crypto
InlineDatumsNotSupported TxOutSource (Crypto era)
os
  Address
addr <-
    case TxOut era -> Maybe Address
forall era. Era era => TxOut era -> Maybe Address
Alonzo.transTxOutAddr TxOut era
txout of
      Maybe Address
Nothing -> TranslationError (Crypto era)
-> Either (TranslationError (Crypto era)) Address
forall a b. a -> Either a b
Left (TxOutSource (Crypto era) -> TranslationError (Crypto era)
forall crypto. TxOutSource crypto -> TranslationError crypto
ByronTxOutInContext TxOutSource (Crypto era)
os)
      Just Address
addr -> Address -> Either (TranslationError (Crypto era)) Address
forall a b. b -> Either a b
Right Address
addr
  TxOut -> Either (TranslationError (Crypto era)) TxOut
forall a b. b -> Either a b
Right (Address -> Value -> Maybe DatumHash -> TxOut
PV1.TxOut Address
addr (Value (Crypto era) -> Value
forall c. Value c -> Value
Alonzo.transValue @(Crypto era) Value (Crypto era)
val) (StrictMaybe (DataHash (Crypto era)) -> Maybe DatumHash
forall c. StrictMaybe (DataHash c) -> Maybe DatumHash
Alonzo.transDataHash StrictMaybe (DataHash (Crypto era))
datahash))

-- | Given a TxOut, translate it for V2 and return (Right transalation). It is
--   possible the address part is a Bootstrap Address, in that case return Left.
txInfoOutV2 ::
  forall era.
  ( Era era,
    ExtendedUTxO era,
    ValidateScript era,
    Value era ~ Mary.Value (Crypto era),
    HasField "referenceScript" (Core.TxOut era) (StrictMaybe (Core.Script era))
  ) =>
  TxOutSource (Crypto era) ->
  Core.TxOut era ->
  Either (TranslationError (Crypto era)) PV2.TxOut
txInfoOutV2 :: TxOutSource (Crypto era)
-> TxOut era -> Either (TranslationError (Crypto era)) TxOut
txInfoOutV2 TxOutSource (Crypto era)
os TxOut era
txout = do
  let val :: Value (Crypto era)
val = TxOut era -> Value (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"value" TxOut era
txout
      referenceScript :: Maybe ScriptHash
referenceScript = ValidateScript era => StrictMaybe (Script era) -> Maybe ScriptHash
forall era.
ValidateScript era =>
StrictMaybe (Script era) -> Maybe ScriptHash
transReferenceScript @era (StrictMaybe (Script era) -> Maybe ScriptHash)
-> StrictMaybe (Script era) -> Maybe ScriptHash
forall a b. (a -> b) -> a -> b
$ TxOut era -> StrictMaybe (Script era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"referenceScript" TxOut era
txout
      datum :: OutputDatum
datum =
        case TxOut era -> Datum era
forall era. ExtendedUTxO era => TxOut era -> Datum era
getTxOutDatum TxOut era
txout of
          Datum era
NoDatum -> OutputDatum
PV2.NoOutputDatum
          DatumHash DataHash (Crypto era)
dh -> DatumHash -> OutputDatum
PV2.OutputDatumHash (DatumHash -> OutputDatum) -> DatumHash -> OutputDatum
forall a b. (a -> b) -> a -> b
$ DataHash (Crypto era) -> DatumHash
forall c. DataHash c -> DatumHash
Alonzo.transDataHash' DataHash (Crypto era)
dh
          Datum BinaryData era
binaryData ->
            Datum -> OutputDatum
PV2.OutputDatum (Datum -> OutputDatum)
-> (BinaryData era -> Datum) -> BinaryData era -> OutputDatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Datum
PV2.Datum
              (BuiltinData -> Datum)
-> (BinaryData era -> BuiltinData) -> BinaryData era -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> BuiltinData
PV2.dataToBuiltinData
              (Data -> BuiltinData)
-> (BinaryData era -> Data) -> BinaryData era -> BuiltinData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> Data
forall era. Data era -> Data
getPlutusData
              (Data era -> Data)
-> (BinaryData era -> Data era) -> BinaryData era -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryData era -> Data era
forall era. BinaryData era -> Data era
binaryDataToData
              (BinaryData era -> OutputDatum) -> BinaryData era -> OutputDatum
forall a b. (a -> b) -> a -> b
$ BinaryData era
binaryData
  case TxOut era -> Maybe Address
forall era. Era era => TxOut era -> Maybe Address
Alonzo.transTxOutAddr TxOut era
txout of
    Maybe Address
Nothing -> TranslationError (Crypto era)
-> Either (TranslationError (Crypto era)) TxOut
forall a b. a -> Either a b
Left (TxOutSource (Crypto era) -> TranslationError (Crypto era)
forall crypto. TxOutSource crypto -> TranslationError crypto
ByronTxOutInContext TxOutSource (Crypto era)
os)
    Just Address
ad ->
      TxOut -> Either (TranslationError (Crypto era)) TxOut
forall a b. b -> Either a b
Right (Address -> Value -> OutputDatum -> Maybe ScriptHash -> TxOut
PV2.TxOut Address
ad (Value (Crypto era) -> Value
forall c. Value c -> Value
Alonzo.transValue @(Crypto era) Value (Crypto era)
val) OutputDatum
datum Maybe ScriptHash
referenceScript)

-- | Given a TxIn, look it up in the UTxO. If it exists, translate it to the V1 context
--   and return (Just translation). If does not exist in the UTxO, return Nothing.
txInfoInV1 ::
  forall era.
  ( ValidateScript era,
    ExtendedUTxO era,
    Value era ~ Mary.Value (Crypto era),
    HasField "referenceScript" (Core.TxOut era) (StrictMaybe (Core.Script era))
  ) =>
  UTxO era ->
  TxIn (Crypto era) ->
  Either (TranslationError (Crypto era)) PV1.TxInInfo
txInfoInV1 :: UTxO era
-> TxIn (Crypto era)
-> Either (TranslationError (Crypto era)) TxInInfo
txInfoInV1 (UTxO Map (TxIn (Crypto era)) (TxOut era)
mp) TxIn (Crypto era)
txin =
  case TxIn (Crypto era)
-> Map (TxIn (Crypto era)) (TxOut era) -> Maybe (TxOut era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn (Crypto era)
txin Map (TxIn (Crypto era)) (TxOut era)
mp of
    Maybe (TxOut era)
Nothing -> TranslationError (Crypto era)
-> Either (TranslationError (Crypto era)) TxInInfo
forall a b. a -> Either a b
Left (TxIn (Crypto era) -> TranslationError (Crypto era)
forall crypto. TxIn crypto -> TranslationError crypto
TranslationLogicMissingInput TxIn (Crypto era)
txin)
    Just TxOut era
txout -> do
      TxOut
out <- TxOutSource (Crypto era)
-> TxOut era -> Either (TranslationError (Crypto era)) TxOut
forall era.
(Era era, ExtendedUTxO era, ValidateScript era,
 Value era ~ Value (Crypto era),
 HasField
   "referenceScript" (TxOut era) (StrictMaybe (Script era))) =>
TxOutSource (Crypto era)
-> TxOut era -> Either (TranslationError (Crypto era)) TxOut
txInfoOutV1 (TxIn (Crypto era) -> TxOutSource (Crypto era)
forall crypto. TxIn crypto -> TxOutSource crypto
TxOutFromInput TxIn (Crypto era)
txin) TxOut era
txout
      TxInInfo -> Either (TranslationError (Crypto era)) TxInInfo
forall a b. b -> Either a b
Right (TxOutRef -> TxOut -> TxInInfo
PV1.TxInInfo (TxIn (Crypto era) -> TxOutRef
forall c. TxIn c -> TxOutRef
Alonzo.txInfoIn' TxIn (Crypto era)
txin) TxOut
out)

-- | Given a TxIn, look it up in the UTxO. If it exists, translate it to the V2 context
--   and return (Just translation). If does not exist in the UTxO, return Nothing.
txInfoInV2 ::
  forall era.
  ( ValidateScript era,
    ExtendedUTxO era,
    Value era ~ Mary.Value (Crypto era),
    HasField "referenceScript" (Core.TxOut era) (StrictMaybe (Core.Script era))
  ) =>
  UTxO era ->
  TxIn (Crypto era) ->
  Either (TranslationError (Crypto era)) PV2.TxInInfo
txInfoInV2 :: UTxO era
-> TxIn (Crypto era)
-> Either (TranslationError (Crypto era)) TxInInfo
txInfoInV2 (UTxO Map (TxIn (Crypto era)) (TxOut era)
mp) TxIn (Crypto era)
txin =
  case TxIn (Crypto era)
-> Map (TxIn (Crypto era)) (TxOut era) -> Maybe (TxOut era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn (Crypto era)
txin Map (TxIn (Crypto era)) (TxOut era)
mp of
    Maybe (TxOut era)
Nothing -> TranslationError (Crypto era)
-> Either (TranslationError (Crypto era)) TxInInfo
forall a b. a -> Either a b
Left (TxIn (Crypto era) -> TranslationError (Crypto era)
forall crypto. TxIn crypto -> TranslationError crypto
TranslationLogicMissingInput TxIn (Crypto era)
txin)
    Just TxOut era
txout -> do
      TxOut
out <- TxOutSource (Crypto era)
-> TxOut era -> Either (TranslationError (Crypto era)) TxOut
forall era.
(Era era, ExtendedUTxO era, ValidateScript era,
 Value era ~ Value (Crypto era),
 HasField
   "referenceScript" (TxOut era) (StrictMaybe (Script era))) =>
TxOutSource (Crypto era)
-> TxOut era -> Either (TranslationError (Crypto era)) TxOut
txInfoOutV2 (TxIn (Crypto era) -> TxOutSource (Crypto era)
forall crypto. TxIn crypto -> TxOutSource crypto
TxOutFromInput TxIn (Crypto era)
txin) TxOut era
txout
      TxInInfo -> Either (TranslationError (Crypto era)) TxInInfo
forall a b. b -> Either a b
Right (TxOutRef -> TxOut -> TxInInfo
PV2.TxInInfo (TxIn (Crypto era) -> TxOutRef
forall c. TxIn c -> TxOutRef
Alonzo.txInfoIn' TxIn (Crypto era)
txin) TxOut
out)

transRedeemer :: Data era -> PV2.Redeemer
transRedeemer :: Data era -> Redeemer
transRedeemer = BuiltinData -> Redeemer
PV2.Redeemer (BuiltinData -> Redeemer)
-> (Data era -> BuiltinData) -> Data era -> Redeemer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> BuiltinData
PV2.dataToBuiltinData (Data -> BuiltinData)
-> (Data era -> Data) -> Data era -> BuiltinData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> Data
forall era. Data era -> Data
getPlutusData

transRedeemerPtr ::
  ( Era era,
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era)))
  ) =>
  Core.TxBody era ->
  (RdmrPtr, (Data era, ExUnits)) ->
  Either (TranslationError (Crypto era)) (PV2.ScriptPurpose, PV2.Redeemer)
transRedeemerPtr :: TxBody era
-> (RdmrPtr, (Data era, ExUnits))
-> Either (TranslationError (Crypto era)) (ScriptPurpose, Redeemer)
transRedeemerPtr TxBody era
txb (RdmrPtr
ptr, (Data era
d, ExUnits
_)) =
  case TxBody era -> RdmrPtr -> StrictMaybe (ScriptPurpose (Crypto era))
forall era.
(HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField "wdrls" (TxBody era) (Wdrl (Crypto era)),
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))),
 HasField "minted" (TxBody era) (Set (ScriptHash (Crypto era)))) =>
TxBody era -> RdmrPtr -> StrictMaybe (ScriptPurpose (Crypto era))
rdptrInv TxBody era
txb RdmrPtr
ptr of
    StrictMaybe (ScriptPurpose (Crypto era))
SNothing -> TranslationError (Crypto era)
-> Either (TranslationError (Crypto era)) (ScriptPurpose, Redeemer)
forall a b. a -> Either a b
Left (RdmrPtr -> TranslationError (Crypto era)
forall crypto. RdmrPtr -> TranslationError crypto
RdmrPtrPointsToNothing RdmrPtr
ptr)
    SJust ScriptPurpose (Crypto era)
sp -> (ScriptPurpose, Redeemer)
-> Either (TranslationError (Crypto era)) (ScriptPurpose, Redeemer)
forall a b. b -> Either a b
Right (ScriptPurpose (Crypto era) -> ScriptPurpose
forall crypto. ScriptPurpose crypto -> ScriptPurpose
Alonzo.transScriptPurpose ScriptPurpose (Crypto era)
sp, Data era -> Redeemer
forall era. Data era -> Redeemer
transRedeemer Data era
d)

babbageTxInfo ::
  forall era.
  ( Era era,
    ExtendedUTxO era,
    ValidateScript era,
    Value era ~ Mary.Value (Crypto era),
    HasField "wits" (Core.Tx era) (TxWitness era),
    HasField "referenceScript" (TxOut era) (StrictMaybe (Core.Script era)),
    HasField "_protocolVersion" (PParams era) ProtVer,
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "referenceInputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "reqSignerHashes" (Core.TxBody era) (Set (KeyHash 'Witness (Crypto era))),
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
    HasField "mint" (Core.TxBody era) (Mary.Value (Crypto era)),
    HasField "vldt" (Core.TxBody era) ValidityInterval
  ) =>
  Core.PParams era ->
  Language ->
  EpochInfo (Either Text) ->
  SystemStart ->
  UTxO era ->
  Core.Tx era ->
  Either (TranslationError (Crypto era)) VersionedTxInfo
babbageTxInfo :: PParams era
-> Language
-> EpochInfo (Either Text)
-> SystemStart
-> UTxO era
-> Tx era
-> Either (TranslationError (Crypto era)) VersionedTxInfo
babbageTxInfo PParams era
pp Language
lang EpochInfo (Either Text)
ei SystemStart
sysS UTxO era
utxo Tx era
tx = do
  POSIXTimeRange
timeRange <- (Text -> TranslationError (Crypto era))
-> Either Text POSIXTimeRange
-> Either (TranslationError (Crypto era)) POSIXTimeRange
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left Text -> TranslationError (Crypto era)
forall crypto. Text -> TranslationError crypto
TimeTranslationPastHorizon (Either Text POSIXTimeRange
 -> Either (TranslationError (Crypto era)) POSIXTimeRange)
-> Either Text POSIXTimeRange
-> Either (TranslationError (Crypto era)) POSIXTimeRange
forall a b. (a -> b) -> a -> b
$ PParams era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either Text POSIXTimeRange
forall era.
HasField "_protocolVersion" (PParams era) ProtVer =>
PParams era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either Text POSIXTimeRange
Alonzo.transVITime PParams era
pp EpochInfo (Either Text)
ei SystemStart
sysS ValidityInterval
interval
  case Language
lang of
    Language
PlutusV1 -> do
      let refInputs :: Set (TxIn (Crypto era))
refInputs = TxBody era -> Set (TxIn (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"referenceInputs" TxBody era
tbody
      Bool
-> Either (TranslationError (Crypto era)) ()
-> Either (TranslationError (Crypto era)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set (TxIn (Crypto era)) -> Bool
forall a. Set a -> Bool
Set.null Set (TxIn (Crypto era))
refInputs) (Either (TranslationError (Crypto era)) ()
 -> Either (TranslationError (Crypto era)) ())
-> Either (TranslationError (Crypto era)) ()
-> Either (TranslationError (Crypto era)) ()
forall a b. (a -> b) -> a -> b
$ TranslationError (Crypto era)
-> Either (TranslationError (Crypto era)) ()
forall a b. a -> Either a b
Left (Set (TxIn (Crypto era)) -> TranslationError (Crypto era)
forall crypto. Set (TxIn crypto) -> TranslationError crypto
ReferenceInputsNotSupported Set (TxIn (Crypto era))
refInputs)
      [TxInInfo]
inputs <- (TxIn (Crypto era)
 -> Either (TranslationError (Crypto era)) TxInInfo)
-> [TxIn (Crypto era)]
-> Either (TranslationError (Crypto era)) [TxInInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (UTxO era
-> TxIn (Crypto era)
-> Either (TranslationError (Crypto era)) TxInInfo
forall era.
(ValidateScript era, ExtendedUTxO era,
 Value era ~ Value (Crypto era),
 HasField
   "referenceScript" (TxOut era) (StrictMaybe (Script era))) =>
UTxO era
-> TxIn (Crypto era)
-> Either (TranslationError (Crypto era)) TxInInfo
txInfoInV1 UTxO era
utxo) (Set (TxIn (Crypto era)) -> [TxIn (Crypto era)]
forall a. Set a -> [a]
Set.toList (TxBody era -> Set (TxIn (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"inputs" TxBody era
tbody))
      [TxOut]
outputs <-
        (TxIx -> TxOut era -> Either (TranslationError (Crypto era)) TxOut)
-> [TxIx]
-> [TxOut era]
-> Either (TranslationError (Crypto era)) [TxOut]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
          (\TxIx
txIx -> TxOutSource (Crypto era)
-> TxOut era -> Either (TranslationError (Crypto era)) TxOut
forall era.
(Era era, ExtendedUTxO era, ValidateScript era,
 Value era ~ Value (Crypto era),
 HasField
   "referenceScript" (TxOut era) (StrictMaybe (Script era))) =>
TxOutSource (Crypto era)
-> TxOut era -> Either (TranslationError (Crypto era)) TxOut
txInfoOutV1 (TxIx -> TxOutSource (Crypto era)
forall crypto. TxIx -> TxOutSource crypto
TxOutFromOutput TxIx
txIx))
          [TxIx
forall a. Bounded a => a
minBound ..]
          ((TxOut era -> [TxOut era] -> [TxOut era])
-> [TxOut era] -> StrictSeq (TxOut era) -> [TxOut era]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] StrictSeq (TxOut era)
outs)
      VersionedTxInfo
-> Either (TranslationError (Crypto era)) VersionedTxInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VersionedTxInfo
 -> Either (TranslationError (Crypto era)) VersionedTxInfo)
-> (TxInfo -> VersionedTxInfo)
-> TxInfo
-> Either (TranslationError (Crypto era)) VersionedTxInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInfo -> VersionedTxInfo
TxInfoPV1 (TxInfo -> Either (TranslationError (Crypto era)) VersionedTxInfo)
-> TxInfo -> Either (TranslationError (Crypto era)) VersionedTxInfo
forall a b. (a -> b) -> a -> b
$
        TxInfo :: [TxInInfo]
-> [TxOut]
-> Value
-> Value
-> [DCert]
-> [(StakingCredential, Integer)]
-> POSIXTimeRange
-> [PubKeyHash]
-> [(DatumHash, Datum)]
-> TxId
-> TxInfo
PV1.TxInfo
          { txInfoInputs :: [TxInInfo]
PV1.txInfoInputs = [TxInInfo]
inputs,
            txInfoOutputs :: [TxOut]
PV1.txInfoOutputs = [TxOut]
outputs,
            txInfoFee :: Value
PV1.txInfoFee = Value (Crypto era) -> Value
forall c. Value c -> Value
Alonzo.transValue (Coin -> Value (Crypto era)
forall t. Val t => Coin -> t
inject @(Mary.Value (Crypto era)) Coin
fee),
            txInfoMint :: Value
PV1.txInfoMint = Value (Crypto era) -> Value
forall c. Value c -> Value
Alonzo.transValue Value (Crypto era)
forge,
            txInfoDCert :: [DCert]
PV1.txInfoDCert = (DCert (Crypto era) -> [DCert] -> [DCert])
-> [DCert] -> StrictSeq (DCert (Crypto era)) -> [DCert]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\DCert (Crypto era)
c [DCert]
ans -> DCert (Crypto era) -> DCert
forall c. DCert c -> DCert
Alonzo.transDCert DCert (Crypto era)
c DCert -> [DCert] -> [DCert]
forall a. a -> [a] -> [a]
: [DCert]
ans) [] (TxBody era -> StrictSeq (DCert (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"certs" TxBody era
tbody),
            txInfoWdrl :: [(StakingCredential, Integer)]
PV1.txInfoWdrl = Map StakingCredential Integer -> [(StakingCredential, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList (Wdrl (Crypto era) -> Map StakingCredential Integer
forall crypto. Wdrl crypto -> Map StakingCredential Integer
Alonzo.transWdrl (TxBody era -> Wdrl (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wdrls" TxBody era
tbody)),
            txInfoValidRange :: POSIXTimeRange
PV1.txInfoValidRange = POSIXTimeRange
timeRange,
            txInfoSignatories :: [PubKeyHash]
PV1.txInfoSignatories = (KeyHash 'Witness (Crypto era) -> PubKeyHash)
-> [KeyHash 'Witness (Crypto era)] -> [PubKeyHash]
forall a b. (a -> b) -> [a] -> [b]
map KeyHash 'Witness (Crypto era) -> PubKeyHash
forall (d :: KeyRole) c. KeyHash d c -> PubKeyHash
Alonzo.transKeyHash (Set (KeyHash 'Witness (Crypto era))
-> [KeyHash 'Witness (Crypto era)]
forall a. Set a -> [a]
Set.toList (TxBody era -> Set (KeyHash 'Witness (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"reqSignerHashes" TxBody era
tbody)),
            txInfoData :: [(DatumHash, Datum)]
PV1.txInfoData = ((DataHash (Crypto era), Data era) -> (DatumHash, Datum))
-> [(DataHash (Crypto era), Data era)] -> [(DatumHash, Datum)]
forall a b. (a -> b) -> [a] -> [b]
map (DataHash (Crypto era), Data era) -> (DatumHash, Datum)
forall c era. (DataHash c, Data era) -> (DatumHash, Datum)
Alonzo.transDataPair [(DataHash (Crypto era), Data era)]
datpairs,
            txInfoId :: TxId
PV1.txInfoId = BuiltinByteString -> TxId
PV1.TxId (SafeHash (Crypto era) EraIndependentTxBody -> BuiltinByteString
forall c i. SafeHash c i -> BuiltinByteString
Alonzo.transSafeHash (TxBody era -> SafeHash (Crypto era) EraIndependentTxBody
forall c i x.
(HasAlgorithm c, HashAnnotated x i c) =>
x -> SafeHash c i
hashAnnotated @(Crypto era) TxBody era
tbody))
          }
    Language
PlutusV2 -> do
      [TxInInfo]
inputs <- (TxIn (Crypto era)
 -> Either (TranslationError (Crypto era)) TxInInfo)
-> [TxIn (Crypto era)]
-> Either (TranslationError (Crypto era)) [TxInInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (UTxO era
-> TxIn (Crypto era)
-> Either (TranslationError (Crypto era)) TxInInfo
forall era.
(ValidateScript era, ExtendedUTxO era,
 Value era ~ Value (Crypto era),
 HasField
   "referenceScript" (TxOut era) (StrictMaybe (Script era))) =>
UTxO era
-> TxIn (Crypto era)
-> Either (TranslationError (Crypto era)) TxInInfo
txInfoInV2 UTxO era
utxo) (Set (TxIn (Crypto era)) -> [TxIn (Crypto era)]
forall a. Set a -> [a]
Set.toList (TxBody era -> Set (TxIn (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"inputs" TxBody era
tbody))
      [TxInInfo]
refInputs <- (TxIn (Crypto era)
 -> Either (TranslationError (Crypto era)) TxInInfo)
-> [TxIn (Crypto era)]
-> Either (TranslationError (Crypto era)) [TxInInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (UTxO era
-> TxIn (Crypto era)
-> Either (TranslationError (Crypto era)) TxInInfo
forall era.
(ValidateScript era, ExtendedUTxO era,
 Value era ~ Value (Crypto era),
 HasField
   "referenceScript" (TxOut era) (StrictMaybe (Script era))) =>
UTxO era
-> TxIn (Crypto era)
-> Either (TranslationError (Crypto era)) TxInInfo
txInfoInV2 UTxO era
utxo) (Set (TxIn (Crypto era)) -> [TxIn (Crypto era)]
forall a. Set a -> [a]
Set.toList (TxBody era -> Set (TxIn (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"referenceInputs" TxBody era
tbody))
      [TxOut]
outputs <-
        (TxIx -> TxOut era -> Either (TranslationError (Crypto era)) TxOut)
-> [TxIx]
-> [TxOut era]
-> Either (TranslationError (Crypto era)) [TxOut]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
          (\TxIx
txIx -> TxOutSource (Crypto era)
-> TxOut era -> Either (TranslationError (Crypto era)) TxOut
forall era.
(Era era, ExtendedUTxO era, ValidateScript era,
 Value era ~ Value (Crypto era),
 HasField
   "referenceScript" (TxOut era) (StrictMaybe (Script era))) =>
TxOutSource (Crypto era)
-> TxOut era -> Either (TranslationError (Crypto era)) TxOut
txInfoOutV2 (TxIx -> TxOutSource (Crypto era)
forall crypto. TxIx -> TxOutSource crypto
TxOutFromOutput TxIx
txIx))
          [TxIx
forall a. Bounded a => a
minBound ..]
          ((TxOut era -> [TxOut era] -> [TxOut era])
-> [TxOut era] -> StrictSeq (TxOut era) -> [TxOut era]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] StrictSeq (TxOut era)
outs)
      [(ScriptPurpose, Redeemer)]
rdmrs' <- ((RdmrPtr, (Data era, ExUnits))
 -> Either
      (TranslationError (Crypto era)) (ScriptPurpose, Redeemer))
-> [(RdmrPtr, (Data era, ExUnits))]
-> Either
     (TranslationError (Crypto era)) [(ScriptPurpose, Redeemer)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TxBody era
-> (RdmrPtr, (Data era, ExUnits))
-> Either (TranslationError (Crypto era)) (ScriptPurpose, Redeemer)
forall era.
(Era era, HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField "wdrls" (TxBody era) (Wdrl (Crypto era)),
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era)))) =>
TxBody era
-> (RdmrPtr, (Data era, ExUnits))
-> Either (TranslationError (Crypto era)) (ScriptPurpose, Redeemer)
transRedeemerPtr TxBody era
tbody) [(RdmrPtr, (Data era, ExUnits))]
rdmrs
      VersionedTxInfo
-> Either (TranslationError (Crypto era)) VersionedTxInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VersionedTxInfo
 -> Either (TranslationError (Crypto era)) VersionedTxInfo)
-> (TxInfo -> VersionedTxInfo)
-> TxInfo
-> Either (TranslationError (Crypto era)) VersionedTxInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInfo -> VersionedTxInfo
TxInfoPV2 (TxInfo -> Either (TranslationError (Crypto era)) VersionedTxInfo)
-> TxInfo -> Either (TranslationError (Crypto era)) VersionedTxInfo
forall a b. (a -> b) -> a -> b
$
        TxInfo :: [TxInInfo]
-> [TxInInfo]
-> [TxOut]
-> Value
-> Value
-> [DCert]
-> Map StakingCredential Integer
-> POSIXTimeRange
-> [PubKeyHash]
-> Map ScriptPurpose Redeemer
-> Map DatumHash Datum
-> TxId
-> TxInfo
PV2.TxInfo
          { txInfoInputs :: [TxInInfo]
PV2.txInfoInputs = [TxInInfo]
inputs,
            txInfoOutputs :: [TxOut]
PV2.txInfoOutputs = [TxOut]
outputs,
            txInfoReferenceInputs :: [TxInInfo]
PV2.txInfoReferenceInputs = [TxInInfo]
refInputs,
            txInfoFee :: Value
PV2.txInfoFee = Value (Crypto era) -> Value
forall c. Value c -> Value
Alonzo.transValue (Coin -> Value (Crypto era)
forall t. Val t => Coin -> t
inject @(Mary.Value (Crypto era)) Coin
fee),
            txInfoMint :: Value
PV2.txInfoMint = Value (Crypto era) -> Value
forall c. Value c -> Value
Alonzo.transValue Value (Crypto era)
forge,
            txInfoDCert :: [DCert]
PV2.txInfoDCert = (DCert (Crypto era) -> [DCert] -> [DCert])
-> [DCert] -> StrictSeq (DCert (Crypto era)) -> [DCert]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\DCert (Crypto era)
c [DCert]
ans -> DCert (Crypto era) -> DCert
forall c. DCert c -> DCert
Alonzo.transDCert DCert (Crypto era)
c DCert -> [DCert] -> [DCert]
forall a. a -> [a] -> [a]
: [DCert]
ans) [] (TxBody era -> StrictSeq (DCert (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"certs" TxBody era
tbody),
            txInfoWdrl :: Map StakingCredential Integer
PV2.txInfoWdrl = [(StakingCredential, Integer)] -> Map StakingCredential Integer
forall k v. [(k, v)] -> Map k v
PV2.fromList ([(StakingCredential, Integer)] -> Map StakingCredential Integer)
-> [(StakingCredential, Integer)] -> Map StakingCredential Integer
forall a b. (a -> b) -> a -> b
$ Map StakingCredential Integer -> [(StakingCredential, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList (Wdrl (Crypto era) -> Map StakingCredential Integer
forall crypto. Wdrl crypto -> Map StakingCredential Integer
Alonzo.transWdrl (TxBody era -> Wdrl (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wdrls" TxBody era
tbody)),
            txInfoValidRange :: POSIXTimeRange
PV2.txInfoValidRange = POSIXTimeRange
timeRange,
            txInfoSignatories :: [PubKeyHash]
PV2.txInfoSignatories = (KeyHash 'Witness (Crypto era) -> PubKeyHash)
-> [KeyHash 'Witness (Crypto era)] -> [PubKeyHash]
forall a b. (a -> b) -> [a] -> [b]
map KeyHash 'Witness (Crypto era) -> PubKeyHash
forall (d :: KeyRole) c. KeyHash d c -> PubKeyHash
Alonzo.transKeyHash (Set (KeyHash 'Witness (Crypto era))
-> [KeyHash 'Witness (Crypto era)]
forall a. Set a -> [a]
Set.toList (TxBody era -> Set (KeyHash 'Witness (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"reqSignerHashes" TxBody era
tbody)),
            txInfoRedeemers :: Map ScriptPurpose Redeemer
PV2.txInfoRedeemers = [(ScriptPurpose, Redeemer)] -> Map ScriptPurpose Redeemer
forall k v. [(k, v)] -> Map k v
PV2.fromList [(ScriptPurpose, Redeemer)]
rdmrs',
            txInfoData :: Map DatumHash Datum
PV2.txInfoData = [(DatumHash, Datum)] -> Map DatumHash Datum
forall k v. [(k, v)] -> Map k v
PV2.fromList ([(DatumHash, Datum)] -> Map DatumHash Datum)
-> [(DatumHash, Datum)] -> Map DatumHash Datum
forall a b. (a -> b) -> a -> b
$ ((DataHash (Crypto era), Data era) -> (DatumHash, Datum))
-> [(DataHash (Crypto era), Data era)] -> [(DatumHash, Datum)]
forall a b. (a -> b) -> [a] -> [b]
map (DataHash (Crypto era), Data era) -> (DatumHash, Datum)
forall c era. (DataHash c, Data era) -> (DatumHash, Datum)
Alonzo.transDataPair [(DataHash (Crypto era), Data era)]
datpairs,
            txInfoId :: TxId
PV2.txInfoId = BuiltinByteString -> TxId
PV2.TxId (SafeHash (Crypto era) EraIndependentTxBody -> BuiltinByteString
forall c i. SafeHash c i -> BuiltinByteString
Alonzo.transSafeHash (TxBody era -> SafeHash (Crypto era) EraIndependentTxBody
forall c i x.
(HasAlgorithm c, HashAnnotated x i c) =>
x -> SafeHash c i
hashAnnotated @(Crypto era) TxBody era
tbody))
          }
  where
    tbody :: Core.TxBody era
    tbody :: TxBody era
tbody = Tx era -> TxBody era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"body" Tx era
tx
    witnesses :: TxWitness era
witnesses = Tx era -> TxWitness era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wits" Tx era
tx
    outs :: StrictSeq (TxOut era)
outs = TxBody era -> StrictSeq (TxOut era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"outputs" TxBody era
tbody
    fee :: Coin
fee = TxBody era -> Coin
forall k (x :: k) r a. HasField x r a => r -> a
getField @"txfee" TxBody era
tbody
    forge :: Value (Crypto era)
forge = TxBody era -> Value (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"mint" TxBody era
tbody
    interval :: ValidityInterval
interval = TxBody era -> ValidityInterval
forall k (x :: k) r a. HasField x r a => r -> a
getField @"vldt" TxBody era
tbody

    datpairs :: [(DataHash (Crypto era), Data era)]
datpairs = Map (DataHash (Crypto era)) (Data era)
-> [(DataHash (Crypto era), Data era)]
forall k a. Map k a -> [(k, a)]
Map.toList (TxDats era -> Map (DataHash (Crypto era)) (Data era)
forall era. TxDats era -> Map (DataHash (Crypto era)) (Data era)
unTxDats (TxDats era -> Map (DataHash (Crypto era)) (Data era))
-> TxDats era -> Map (DataHash (Crypto era)) (Data era)
forall a b. (a -> b) -> a -> b
$ TxWitness era -> TxDats era
forall era. TxWitness era -> TxDats era
txdats' TxWitness era
witnesses)
    rdmrs :: [(RdmrPtr, (Data era, ExUnits))]
rdmrs = Map RdmrPtr (Data era, ExUnits) -> [(RdmrPtr, (Data era, ExUnits))]
forall k a. Map k a -> [(k, a)]
Map.toList (Redeemers era -> Map RdmrPtr (Data era, ExUnits)
forall era. Redeemers era -> Map RdmrPtr (Data era, ExUnits)
unRedeemers (Redeemers era -> Map RdmrPtr (Data era, ExUnits))
-> Redeemers era -> Map RdmrPtr (Data era, ExUnits)
forall a b. (a -> b) -> a -> b
$ TxWitness era -> Redeemers era
forall era. TxWitness era -> Redeemers era
txrdmrs' TxWitness era
witnesses)