{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}


module PlutusExample.ScriptContextChecker where

import Prelude hiding (($))

import Cardano.Api
import Cardano.Api.Byron
import Cardano.Api.Shelley
import Cardano.Api.Shelley qualified as Api

import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Except.Extra
import Data.Aeson qualified as Aeson
import Data.Bifunctor (first)
import Data.ByteString.Lazy qualified as LB
import Data.Map.Strict qualified as Map
import Data.Sequence.Strict qualified as Seq
import Data.Set qualified as Set
import Data.Text qualified as T
import GHC.Records (HasField (..))

import Cardano.CLI.Shelley.Run.Query
import Cardano.Ledger.Alonzo qualified as Alonzo
import Cardano.Ledger.Alonzo.PParams qualified as Alonzo
import Cardano.Ledger.Alonzo.PlutusScriptApi qualified as Alonzo
import Cardano.Ledger.Alonzo.Tx qualified as Alonzo
import Cardano.Ledger.Alonzo.TxInfo qualified as Alonzo
import Cardano.Ledger.Alonzo.TxWitness qualified as Alonzo
import Cardano.Ledger.Babbage.PParams
import Cardano.Ledger.Coin qualified as Ledger
import Cardano.Ledger.Shelley.API qualified as Shelley
import Cardano.Ledger.Shelley.Tx ()
import Cardano.Ledger.TxIn qualified as Ledger

import Cardano.Ledger.Babbage.TxInfo qualified as Babbage
import Cardano.Ledger.Crypto (StandardCrypto)
import Cardano.Slotting.EpochInfo (EpochInfo, hoistEpochInfo)
import Control.Monad.Trans.Except
import Ouroboros.Consensus.HardFork.Combinator.AcrossEras qualified as Consensus
import Ouroboros.Consensus.HardFork.History qualified as Consensus

import Plutus.V1.Ledger.Api qualified as V1
import Plutus.V2.Ledger.Api qualified as V2
import PlutusTx.AssocMap qualified as PMap
import PlutusTx.Prelude as PPrelude hiding (Eq, Semigroup (..), unless, (.))

import Data.Maybe (catMaybes)
import Data.Text (Text)
import PlutusExample.PlutusVersion1.RedeemerContextScripts
import PlutusExample.PlutusVersion2.RedeemerContextEquivalence

data AnyCustomRedeemer
  = AnyPV1CustomRedeemer PV1CustomRedeemer
  | AnyPV2CustomRedeemer PV2CustomRedeemer
  deriving (Int -> AnyCustomRedeemer -> ShowS
[AnyCustomRedeemer] -> ShowS
AnyCustomRedeemer -> String
(Int -> AnyCustomRedeemer -> ShowS)
-> (AnyCustomRedeemer -> String)
-> ([AnyCustomRedeemer] -> ShowS)
-> Show AnyCustomRedeemer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnyCustomRedeemer] -> ShowS
$cshowList :: [AnyCustomRedeemer] -> ShowS
show :: AnyCustomRedeemer -> String
$cshow :: AnyCustomRedeemer -> String
showsPrec :: Int -> AnyCustomRedeemer -> ShowS
$cshowsPrec :: Int -> AnyCustomRedeemer -> ShowS
Show, AnyCustomRedeemer -> AnyCustomRedeemer -> Bool
(AnyCustomRedeemer -> AnyCustomRedeemer -> Bool)
-> (AnyCustomRedeemer -> AnyCustomRedeemer -> Bool)
-> Eq AnyCustomRedeemer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnyCustomRedeemer -> AnyCustomRedeemer -> Bool
$c/= :: AnyCustomRedeemer -> AnyCustomRedeemer -> Bool
== :: AnyCustomRedeemer -> AnyCustomRedeemer -> Bool
$c== :: AnyCustomRedeemer -> AnyCustomRedeemer -> Bool
Eq)

-- We convert our custom redeemer to ScriptData so we can include it
-- in our transaction.
customRedeemerToScriptData :: AnyCustomRedeemer -> ScriptData
customRedeemerToScriptData :: AnyCustomRedeemer -> ScriptData
customRedeemerToScriptData (AnyPV1CustomRedeemer PV1CustomRedeemer
cRedeem) =
  Data -> ScriptData
fromPlutusData (Data -> ScriptData) -> Data -> ScriptData
forall a b. (a -> b) -> a -> b
$ PV1CustomRedeemer -> Data
forall a. ToData a => a -> Data
V1.toData PV1CustomRedeemer
cRedeem
customRedeemerToScriptData (AnyPV2CustomRedeemer PV2CustomRedeemer
cRedeem) =
  Data -> ScriptData
fromPlutusData (Data -> ScriptData) -> Data -> ScriptData
forall a b. (a -> b) -> a -> b
$ PV2CustomRedeemer -> Data
forall a. ToData a => a -> Data
V2.toData PV2CustomRedeemer
cRedeem


data ScriptContextError = NoScriptsInByronEra
                        | NoScriptsInEra
                        | ReadTxBodyError (FileError TextEnvelopeCddlError)
                        | IntervalConvError Text
                        | AcquireFail AcquiringFailure
                        | NoTipLocalStateError
                        | NoSystemStartTimeError
                        | EnvVarSocketErr EnvSocketError
                        | ScriptContextErrorByronEra
                        | QueryError ShelleyQueryCmdError
                        | ConsensusModeMismatch AnyConsensusMode AnyCardanoEra
                        | EraMismatch !Consensus.EraMismatch
                        | PlutusV2TranslationError (Alonzo.TranslationError StandardCrypto)
                        | MoreThanOneTxInput
                        deriving Int -> ScriptContextError -> ShowS
[ScriptContextError] -> ShowS
ScriptContextError -> String
(Int -> ScriptContextError -> ShowS)
-> (ScriptContextError -> String)
-> ([ScriptContextError] -> ShowS)
-> Show ScriptContextError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptContextError] -> ShowS
$cshowList :: [ScriptContextError] -> ShowS
show :: ScriptContextError -> String
$cshow :: ScriptContextError -> String
showsPrec :: Int -> ScriptContextError -> ShowS
$cshowsPrec :: Int -> ScriptContextError -> ShowS
Show

createAnyCustomRedeemer
  :: forall era lang. PlutusScriptVersion lang
  -> ShelleyBasedEra era
  -> ProtocolParameters
  -> UTxO era
  -> EpochInfo (Either Text)
  -> SystemStart
  -> Api.Tx era
  -> Either ScriptContextError AnyCustomRedeemer
createAnyCustomRedeemer :: PlutusScriptVersion lang
-> ShelleyBasedEra era
-> ProtocolParameters
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> Tx era
-> Either ScriptContextError AnyCustomRedeemer
createAnyCustomRedeemer PlutusScriptVersion lang
_ ShelleyBasedEra era
_ ProtocolParameters
_ UTxO era
_ EpochInfo (Either Text)
_ SystemStart
_ (ByronTx ATxAux ByteString
_) = ScriptContextError -> Either ScriptContextError AnyCustomRedeemer
forall a b. a -> Either a b
Left ScriptContextError
NoScriptsInByronEra
createAnyCustomRedeemer PlutusScriptVersion lang
_ ShelleyBasedEra era
sbe ProtocolParameters
pparams UTxO era
utxo EpochInfo (Either Text)
eInfo SystemStart
sStart (ShelleyTx ShelleyBasedEra era
ShelleyBasedEraAlonzo Tx (ShelleyLedgerEra era)
ledgerTx) = do
  let txBody :: TxBody (AlonzoEra StandardCrypto)
txBody = ValidatedTx (AlonzoEra StandardCrypto)
-> TxBody (AlonzoEra StandardCrypto)
forall era. ValidatedTx era -> TxBody era
Alonzo.body Tx (ShelleyLedgerEra era)
ValidatedTx (AlonzoEra StandardCrypto)
ledgerTx
      witness :: TxWitness (AlonzoEra StandardCrypto)
witness = ValidatedTx (AlonzoEra StandardCrypto)
-> TxWitness (AlonzoEra StandardCrypto)
forall era. ValidatedTx era -> TxWitness era
Alonzo.wits Tx (ShelleyLedgerEra era)
ValidatedTx (AlonzoEra StandardCrypto)
ledgerTx
      Alonzo.TxWitness Set (WitVKey 'Witness (Crypto (AlonzoEra StandardCrypto)))
_ Set (BootstrapWitness (Crypto (AlonzoEra StandardCrypto)))
_ Map
  (ScriptHash (Crypto (AlonzoEra StandardCrypto)))
  (Script (AlonzoEra StandardCrypto))
_ TxDats (AlonzoEra StandardCrypto)
_ Redeemers (AlonzoEra StandardCrypto)
_rdmrs = TxWitness (AlonzoEra StandardCrypto)
witness
      _redeemerPtrs :: [(RdmrPtr, (Data (AlonzoEra StandardCrypto), ExUnits))]
_redeemerPtrs = Map RdmrPtr (Data (AlonzoEra StandardCrypto), ExUnits)
-> [(RdmrPtr, (Data (AlonzoEra StandardCrypto), ExUnits))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map RdmrPtr (Data (AlonzoEra StandardCrypto), ExUnits)
 -> [(RdmrPtr, (Data (AlonzoEra StandardCrypto), ExUnits))])
-> Map RdmrPtr (Data (AlonzoEra StandardCrypto), ExUnits)
-> [(RdmrPtr, (Data (AlonzoEra StandardCrypto), ExUnits))]
forall a b. (a -> b) -> a -> b
$ Redeemers (AlonzoEra StandardCrypto)
-> Map RdmrPtr (Data (AlonzoEra StandardCrypto), ExUnits)
forall era. Redeemers era -> Map RdmrPtr (Data era, ExUnits)
Alonzo.unRedeemers Redeemers (AlonzoEra StandardCrypto)
_rdmrs
      ledgerUTxO :: UTxO (AlonzoEra StandardCrypto)
ledgerUTxO = ShelleyBasedEra AlonzoEra
-> UTxO AlonzoEra -> UTxO (AlonzoEra StandardCrypto)
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera,
 Crypto ledgerera ~ StandardCrypto) =>
ShelleyBasedEra era -> UTxO era -> UTxO ledgerera
toLedgerUTxO ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo UTxO era
UTxO AlonzoEra
utxo
      scriptsNeeded :: [(ScriptPurpose (Crypto (AlonzoEra StandardCrypto)),
  ScriptHash (Crypto (AlonzoEra StandardCrypto)))]
scriptsNeeded = UTxO (AlonzoEra StandardCrypto)
-> ValidatedTx (AlonzoEra StandardCrypto)
-> [(ScriptPurpose (Crypto (AlonzoEra StandardCrypto)),
     ScriptHash (Crypto (AlonzoEra StandardCrypto)))]
forall era tx.
(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))),
 HasField "body" tx (TxBody era)) =>
UTxO era
-> tx -> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
Alonzo.scriptsNeeded UTxO (AlonzoEra StandardCrypto)
ledgerUTxO Tx (ShelleyLedgerEra era)
ValidatedTx (AlonzoEra StandardCrypto)
ledgerTx
      sPurpose :: ScriptPurpose
sPurpose = case [(ScriptPurpose (Crypto (AlonzoEra StandardCrypto)),
  ScriptHash (Crypto (AlonzoEra StandardCrypto)))]
scriptsNeeded of
                   [(ScriptPurpose (Crypto (AlonzoEra StandardCrypto))
p ,ScriptHash (Crypto (AlonzoEra StandardCrypto))
_)] -> ScriptPurpose StandardCrypto -> ScriptPurpose
forall crypto. ScriptPurpose crypto -> ScriptPurpose
Alonzo.transScriptPurpose ScriptPurpose StandardCrypto
ScriptPurpose (Crypto (AlonzoEra StandardCrypto))
p
                   [(ScriptPurpose (Crypto (AlonzoEra StandardCrypto)),
  ScriptHash (Crypto (AlonzoEra StandardCrypto)))]
needed   -> String -> ScriptPurpose
forall a. HasCallStack => String -> a
Prelude.error (String -> ScriptPurpose) -> String -> ScriptPurpose
forall a b. (a -> b) -> a -> b
$ String
"More than one redeemer ptr: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(ScriptPurpose StandardCrypto, ScriptHash StandardCrypto)]
-> String
forall a. Show a => a -> String
show [(ScriptPurpose StandardCrypto, ScriptHash StandardCrypto)]
[(ScriptPurpose (Crypto (AlonzoEra StandardCrypto)),
  ScriptHash (Crypto (AlonzoEra StandardCrypto)))]
needed
      eTxIns :: [Maybe TxInInfo]
eTxIns = (TxIn StandardCrypto -> Maybe TxInInfo)
-> [TxIn StandardCrypto] -> [Maybe TxInInfo]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (UTxO (AlonzoEra StandardCrypto)
-> TxIn StandardCrypto -> Maybe TxInInfo
getTxInInfoFromTxIn UTxO (AlonzoEra StandardCrypto)
ledgerUTxO) ([TxIn StandardCrypto] -> [Maybe TxInInfo])
-> (Set (TxIn StandardCrypto) -> [TxIn StandardCrypto])
-> Set (TxIn StandardCrypto)
-> [Maybe TxInInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (TxIn StandardCrypto) -> [TxIn StandardCrypto]
forall a. Set a -> [a]
Set.toList (Set (TxIn StandardCrypto) -> [Maybe TxInInfo])
-> Set (TxIn StandardCrypto) -> [Maybe TxInInfo]
forall a b. (a -> b) -> a -> b
$ TxBody (AlonzoEra StandardCrypto)
-> AlonzoBody (AlonzoEra StandardCrypto) =>
   Set (TxIn (Crypto (AlonzoEra StandardCrypto)))
forall era. TxBody era -> AlonzoBody era => Set (TxIn (Crypto era))
Alonzo.inputs TxBody (AlonzoEra StandardCrypto)
TxBody (AlonzoEra StandardCrypto)
txBody
      eTouts :: [Maybe TxOut]
eTouts = (TxOut (AlonzoEra StandardCrypto) -> Maybe TxOut)
-> [TxOut (AlonzoEra StandardCrypto)] -> [Maybe TxOut]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map TxOut (AlonzoEra StandardCrypto) -> Maybe TxOut
forall era c.
(Era era, Value era ~ Value (Crypto era),
 HasField "datahash" (TxOut era) (StrictMaybe (DataHash c))) =>
TxOut era -> Maybe TxOut
Alonzo.txInfoOut ([TxOut (AlonzoEra StandardCrypto)] -> [Maybe TxOut])
-> [TxOut (AlonzoEra StandardCrypto)] -> [Maybe TxOut]
forall a b. (a -> b) -> a -> b
$ StrictSeq (TxOut (AlonzoEra StandardCrypto))
-> [TxOut (AlonzoEra StandardCrypto)]
forall a. StrictSeq a -> [a]
seqToList (StrictSeq (TxOut (AlonzoEra StandardCrypto))
 -> [TxOut (AlonzoEra StandardCrypto)])
-> StrictSeq (TxOut (AlonzoEra StandardCrypto))
-> [TxOut (AlonzoEra StandardCrypto)]
forall a b. (a -> b) -> a -> b
$ TxBody (AlonzoEra StandardCrypto)
-> AlonzoBody (AlonzoEra StandardCrypto) =>
   StrictSeq (TxOut (AlonzoEra StandardCrypto))
forall era. TxBody era -> AlonzoBody era => StrictSeq (TxOut era)
Alonzo.outputs TxBody (AlonzoEra StandardCrypto)
TxBody (AlonzoEra StandardCrypto)
txBody
      minted :: Value
minted = Value StandardCrypto -> Value
forall c. Value c -> Value
Alonzo.transValue (Value StandardCrypto -> Value) -> Value StandardCrypto -> Value
forall a b. (a -> b) -> a -> b
$ TxBody (AlonzoEra StandardCrypto)
-> AlonzoBody (AlonzoEra StandardCrypto) =>
   Value (Crypto (AlonzoEra StandardCrypto))
forall era. TxBody era -> AlonzoBody era => Value (Crypto era)
Alonzo.mint TxBody (AlonzoEra StandardCrypto)
TxBody (AlonzoEra StandardCrypto)
txBody
      txfee :: Value
txfee = Value StandardCrypto -> Value
forall c. Value c -> Value
Alonzo.transValue (Value StandardCrypto -> Value)
-> (Coin -> Value StandardCrypto) -> Coin -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value StandardCrypto
toMaryValue (Value -> Value StandardCrypto)
-> (Coin -> Value) -> Coin -> Value StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Value
lovelaceToValue (Lovelace -> Value) -> (Coin -> Lovelace) -> Coin -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Lovelace
fromShelleyLovelace (Coin -> Value) -> Coin -> Value
forall a b. (a -> b) -> a -> b
$ TxBody (AlonzoEra StandardCrypto)
-> AlonzoBody (AlonzoEra StandardCrypto) => Coin
forall era. TxBody era -> AlonzoBody era => Coin
Alonzo.txfee TxBody (AlonzoEra StandardCrypto)
TxBody (AlonzoEra StandardCrypto)
txBody
      Alonzo.TxDats Map
  (DataHash (Crypto (AlonzoEra StandardCrypto)))
  (Data (AlonzoEra StandardCrypto))
datumHashMap = TxWitness (AlonzoEra StandardCrypto)
-> (Era (AlonzoEra StandardCrypto),
    Script (AlonzoEra StandardCrypto)
    ~ Script (AlonzoEra StandardCrypto)) =>
   TxDats (AlonzoEra StandardCrypto)
forall era.
TxWitness era -> (Era era, Script era ~ Script era) => TxDats era
Alonzo.txdats TxWitness (AlonzoEra StandardCrypto)
witness
      datumHashes :: [(DatumHash, Datum)]
datumHashes = ((DataHash StandardCrypto, Data (AlonzoEra StandardCrypto))
 -> (DatumHash, Datum))
-> [(DataHash StandardCrypto, Data (AlonzoEra StandardCrypto))]
-> [(DatumHash, Datum)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (DataHash StandardCrypto, Data (AlonzoEra StandardCrypto))
-> (DatumHash, Datum)
forall c era. (DataHash c, Data era) -> (DatumHash, Datum)
Alonzo.transDataPair ([(DataHash StandardCrypto, Data (AlonzoEra StandardCrypto))]
 -> [(DatumHash, Datum)])
-> [(DataHash StandardCrypto, Data (AlonzoEra StandardCrypto))]
-> [(DatumHash, Datum)]
forall a b. (a -> b) -> a -> b
$ Map (DataHash StandardCrypto) (Data (AlonzoEra StandardCrypto))
-> [(DataHash StandardCrypto, Data (AlonzoEra StandardCrypto))]
forall k a. Map k a -> [(k, a)]
Map.toList Map (DataHash StandardCrypto) (Data (AlonzoEra StandardCrypto))
Map
  (DataHash (Crypto (AlonzoEra StandardCrypto)))
  (Data (AlonzoEra StandardCrypto))
datumHashMap
      txcerts :: [DCert]
txcerts = (DCert StandardCrypto -> DCert)
-> [DCert StandardCrypto] -> [DCert]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map DCert StandardCrypto -> DCert
forall c. DCert c -> DCert
Alonzo.transDCert ([DCert StandardCrypto] -> [DCert])
-> (StrictSeq (DCert StandardCrypto) -> [DCert StandardCrypto])
-> StrictSeq (DCert StandardCrypto)
-> [DCert]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq (DCert StandardCrypto) -> [DCert StandardCrypto]
forall a. StrictSeq a -> [a]
seqToList (StrictSeq (DCert StandardCrypto) -> [DCert])
-> StrictSeq (DCert StandardCrypto) -> [DCert]
forall a b. (a -> b) -> a -> b
$ TxBody (AlonzoEra StandardCrypto)
-> AlonzoBody (AlonzoEra StandardCrypto) =>
   StrictSeq (DCert (Crypto (AlonzoEra StandardCrypto)))
forall era.
TxBody era -> AlonzoBody era => StrictSeq (DCert (Crypto era))
Alonzo.txcerts TxBody (AlonzoEra StandardCrypto)
TxBody (AlonzoEra StandardCrypto)
txBody
      txsignatories :: [PubKeyHash]
txsignatories = (KeyHash 'Witness StandardCrypto -> PubKeyHash)
-> [KeyHash 'Witness StandardCrypto] -> [PubKeyHash]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map KeyHash 'Witness StandardCrypto -> PubKeyHash
forall (d :: KeyRole) c. KeyHash d c -> PubKeyHash
Alonzo.transKeyHash ([KeyHash 'Witness StandardCrypto] -> [PubKeyHash])
-> (Set (KeyHash 'Witness StandardCrypto)
    -> [KeyHash 'Witness StandardCrypto])
-> Set (KeyHash 'Witness StandardCrypto)
-> [PubKeyHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (KeyHash 'Witness StandardCrypto)
-> [KeyHash 'Witness StandardCrypto]
forall a. Set a -> [a]
Set.toList (Set (KeyHash 'Witness StandardCrypto) -> [PubKeyHash])
-> Set (KeyHash 'Witness StandardCrypto) -> [PubKeyHash]
forall a b. (a -> b) -> a -> b
$ TxBody (AlonzoEra StandardCrypto)
-> AlonzoBody (AlonzoEra StandardCrypto) =>
   Set (KeyHash 'Witness (Crypto (AlonzoEra StandardCrypto)))
forall era.
TxBody era -> AlonzoBody era => Set (KeyHash 'Witness (Crypto era))
Alonzo.reqSignerHashes TxBody (AlonzoEra StandardCrypto)
TxBody (AlonzoEra StandardCrypto)
txBody
  POSIXTimeRange
valRange <-
    (Text -> ScriptContextError)
-> Either Text POSIXTimeRange
-> Either ScriptContextError POSIXTimeRange
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> ScriptContextError
IntervalConvError
      (Either Text POSIXTimeRange
 -> Either ScriptContextError POSIXTimeRange)
-> Either Text POSIXTimeRange
-> Either ScriptContextError POSIXTimeRange
forall a b. (a -> b) -> a -> b
$ PParams (AlonzoEra StandardCrypto)
-> 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 (ShelleyBasedEra era
-> ProtocolParameters -> PParams (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era
-> ProtocolParameters -> PParams (ShelleyLedgerEra era)
toLedgerPParams ShelleyBasedEra era
sbe ProtocolParameters
pparams) EpochInfo (Either Text)
eInfo SystemStart
sStart (ValidityInterval -> Either Text POSIXTimeRange)
-> ValidityInterval -> Either Text POSIXTimeRange
forall a b. (a -> b) -> a -> b
$ TxBody (AlonzoEra StandardCrypto)
-> AlonzoBody (AlonzoEra StandardCrypto) => ValidityInterval
forall era. TxBody era -> AlonzoBody era => ValidityInterval
Alonzo.txvldt TxBody (AlonzoEra StandardCrypto)
TxBody (AlonzoEra StandardCrypto)
txBody

  [TxOut]
tOuts <- if (Maybe TxOut -> Bool) -> [Maybe TxOut] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Prelude.all Maybe TxOut -> Bool
forall a. Maybe a -> Bool
isJust [Maybe TxOut]
eTouts
           then [TxOut] -> Either ScriptContextError [TxOut]
forall (m :: * -> *) a. Monad m => a -> m a
return ([TxOut] -> Either ScriptContextError [TxOut])
-> [TxOut] -> Either ScriptContextError [TxOut]
forall a b. (a -> b) -> a -> b
$ [Maybe TxOut] -> [TxOut]
forall a. [Maybe a] -> [a]
catMaybes [Maybe TxOut]
eTouts
           else String -> Either ScriptContextError [TxOut]
forall a. HasCallStack => String -> a
Prelude.error String
"Tx Outs not all Just"
  [TxInInfo]
txins <- if (Maybe TxInInfo -> Bool) -> [Maybe TxInInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Prelude.all Maybe TxInInfo -> Bool
forall a. Maybe a -> Bool
isJust [Maybe TxInInfo]
eTxIns
           then [TxInInfo] -> Either ScriptContextError [TxInInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return ([TxInInfo] -> Either ScriptContextError [TxInInfo])
-> [TxInInfo] -> Either ScriptContextError [TxInInfo]
forall a b. (a -> b) -> a -> b
$ [Maybe TxInInfo] -> [TxInInfo]
forall a. [Maybe a] -> [a]
catMaybes [Maybe TxInInfo]
eTxIns
           else String -> Either ScriptContextError [TxInInfo]
forall a. HasCallStack => String -> a
Prelude.error String
"Tx Ins not all Just"
  AnyCustomRedeemer -> Either ScriptContextError AnyCustomRedeemer
forall a b. b -> Either a b
Right (AnyCustomRedeemer -> Either ScriptContextError AnyCustomRedeemer)
-> (PV1CustomRedeemer -> AnyCustomRedeemer)
-> PV1CustomRedeemer
-> Either ScriptContextError AnyCustomRedeemer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PV1CustomRedeemer -> AnyCustomRedeemer
AnyPV1CustomRedeemer (PV1CustomRedeemer -> Either ScriptContextError AnyCustomRedeemer)
-> PV1CustomRedeemer -> Either ScriptContextError AnyCustomRedeemer
forall a b. (a -> b) -> a -> b
$ [TxOut]
-> [TxInInfo]
-> Value
-> POSIXTimeRange
-> Value
-> [(DatumHash, Datum)]
-> [DCert]
-> [PubKeyHash]
-> Maybe ScriptPurpose
-> PV1CustomRedeemer
PV1CustomRedeemer [TxOut]
tOuts [TxInInfo]
txins Value
minted POSIXTimeRange
valRange Value
txfee [(DatumHash, Datum)]
datumHashes [DCert]
txcerts [PubKeyHash]
txsignatories (ScriptPurpose -> Maybe ScriptPurpose
forall a. a -> Maybe a
Just ScriptPurpose
sPurpose)

createAnyCustomRedeemer PlutusScriptVersion lang
pScriptVer ShelleyBasedEra era
sbe ProtocolParameters
pparams UTxO era
utxo EpochInfo (Either Text)
eInfo SystemStart
sStart (ShelleyTx ShelleyBasedEra era
ShelleyBasedEraBabbage Tx (ShelleyLedgerEra era)
ledgerTx) = do
  let txBody :: TxBody (BabbageEra StandardCrypto)
txBody = ValidatedTx (BabbageEra StandardCrypto)
-> TxBody (BabbageEra StandardCrypto)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"body" Tx (ShelleyLedgerEra era)
ValidatedTx (BabbageEra StandardCrypto)
ledgerTx
      mint :: Value StandardCrypto
mint = TxBody (BabbageEra StandardCrypto) -> Value StandardCrypto
forall k (x :: k) r a. HasField x r a => r -> a
getField @"mint" TxBody (BabbageEra StandardCrypto)
txBody
      txins :: [TxIn StandardCrypto]
txins = Set (TxIn StandardCrypto) -> [TxIn StandardCrypto]
forall a. Set a -> [a]
Set.toList (Set (TxIn StandardCrypto) -> [TxIn StandardCrypto])
-> Set (TxIn StandardCrypto) -> [TxIn StandardCrypto]
forall a b. (a -> b) -> a -> b
$ TxBody (BabbageEra StandardCrypto) -> Set (TxIn StandardCrypto)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"inputs" TxBody (BabbageEra StandardCrypto)
txBody
      refTxins :: [TxIn StandardCrypto]
refTxins = Set (TxIn StandardCrypto) -> [TxIn StandardCrypto]
forall a. Set a -> [a]
Set.toList (Set (TxIn StandardCrypto) -> [TxIn StandardCrypto])
-> Set (TxIn StandardCrypto) -> [TxIn StandardCrypto]
forall a b. (a -> b) -> a -> b
$ TxBody (BabbageEra StandardCrypto) -> Set (TxIn StandardCrypto)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"referenceInputs" TxBody (BabbageEra StandardCrypto)
txBody
      outputs :: [TxOut (BabbageEra StandardCrypto)]
outputs = StrictSeq (TxOut (BabbageEra StandardCrypto))
-> [TxOut (BabbageEra StandardCrypto)]
forall a. StrictSeq a -> [a]
seqToList (StrictSeq (TxOut (BabbageEra StandardCrypto))
 -> [TxOut (BabbageEra StandardCrypto)])
-> StrictSeq (TxOut (BabbageEra StandardCrypto))
-> [TxOut (BabbageEra StandardCrypto)]
forall a b. (a -> b) -> a -> b
$ TxBody (BabbageEra StandardCrypto)
-> StrictSeq (TxOut (BabbageEra StandardCrypto))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"outputs" TxBody (BabbageEra StandardCrypto)
txBody
      fee :: Integer
fee = Coin -> Integer
Ledger.unCoin (Coin -> Integer) -> Coin -> Integer
forall a b. (a -> b) -> a -> b
$ TxBody (BabbageEra StandardCrypto) -> Coin
forall k (x :: k) r a. HasField x r a => r -> a
getField @"txfee" TxBody (BabbageEra StandardCrypto)
txBody
      certs :: [DCert StandardCrypto]
certs = StrictSeq (DCert StandardCrypto) -> [DCert StandardCrypto]
forall a. StrictSeq a -> [a]
seqToList (StrictSeq (DCert StandardCrypto) -> [DCert StandardCrypto])
-> StrictSeq (DCert StandardCrypto) -> [DCert StandardCrypto]
forall a b. (a -> b) -> a -> b
$ TxBody (BabbageEra StandardCrypto)
-> StrictSeq (DCert StandardCrypto)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"certs" TxBody (BabbageEra StandardCrypto)
txBody
      vldt :: ValidityInterval
vldt = TxBody (BabbageEra StandardCrypto) -> ValidityInterval
forall k (x :: k) r a. HasField x r a => r -> a
getField @"vldt" TxBody (BabbageEra StandardCrypto)
txBody
      reqSigners :: [KeyHash 'Witness StandardCrypto]
reqSigners = Set (KeyHash 'Witness StandardCrypto)
-> [KeyHash 'Witness StandardCrypto]
forall a. Set a -> [a]
Set.toList (Set (KeyHash 'Witness StandardCrypto)
 -> [KeyHash 'Witness StandardCrypto])
-> Set (KeyHash 'Witness StandardCrypto)
-> [KeyHash 'Witness StandardCrypto]
forall a b. (a -> b) -> a -> b
$ TxBody (BabbageEra StandardCrypto)
-> Set (KeyHash 'Witness StandardCrypto)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"reqSignerHashes" TxBody (BabbageEra StandardCrypto)
txBody
      Alonzo.TxDats Map
  (DataHash (Crypto (BabbageEra StandardCrypto)))
  (Data (BabbageEra StandardCrypto))
datumHashMap = forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "txdats" r a => r -> a
getField @"txdats" (TxWitness (BabbageEra StandardCrypto)
 -> TxDats (BabbageEra StandardCrypto))
-> TxWitness (BabbageEra StandardCrypto)
-> TxDats (BabbageEra StandardCrypto)
forall a b. (a -> b) -> a -> b
$ ValidatedTx (BabbageEra StandardCrypto)
-> TxWitness (BabbageEra StandardCrypto)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wits" Tx (ShelleyLedgerEra era)
ValidatedTx (BabbageEra StandardCrypto)
ledgerTx
      wdrwls :: Wdrl StandardCrypto
wdrwls = TxBody (BabbageEra StandardCrypto) -> Wdrl StandardCrypto
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wdrls" TxBody (BabbageEra StandardCrypto)
txBody
      txwit :: TxWitness (BabbageEra StandardCrypto)
txwit = ValidatedTx (BabbageEra StandardCrypto)
-> TxWitness (BabbageEra StandardCrypto)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wits" Tx (ShelleyLedgerEra era)
ValidatedTx (BabbageEra StandardCrypto)
ledgerTx
      Alonzo.Redeemers Map RdmrPtr (Data (BabbageEra StandardCrypto), ExUnits)
rdmrs = TxWitness (BabbageEra StandardCrypto)
-> Redeemers (BabbageEra StandardCrypto)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"txrdmrs" TxWitness (BabbageEra StandardCrypto)
txwit
      rdmrList :: [(RdmrPtr, (Data (BabbageEra StandardCrypto), ExUnits))]
rdmrList = Map RdmrPtr (Data (BabbageEra StandardCrypto), ExUnits)
-> [(RdmrPtr, (Data (BabbageEra StandardCrypto), ExUnits))]
forall k a. Map k a -> [(k, a)]
Map.toList Map RdmrPtr (Data (BabbageEra StandardCrypto), ExUnits)
rdmrs
      bUtxo :: UTxO (BabbageEra StandardCrypto)
bUtxo = ShelleyBasedEra BabbageEra
-> UTxO BabbageEra -> UTxO (BabbageEra StandardCrypto)
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera,
 Crypto ledgerera ~ StandardCrypto) =>
ShelleyBasedEra era -> UTxO era -> UTxO ledgerera
toLedgerUTxO ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage UTxO era
UTxO BabbageEra
utxo
      scriptsNeeded :: [(ScriptPurpose (Crypto (BabbageEra StandardCrypto)),
  ScriptHash (Crypto (BabbageEra StandardCrypto)))]
scriptsNeeded = UTxO (BabbageEra StandardCrypto)
-> ValidatedTx (BabbageEra StandardCrypto)
-> [(ScriptPurpose (Crypto (BabbageEra StandardCrypto)),
     ScriptHash (Crypto (BabbageEra StandardCrypto)))]
forall era tx.
(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))),
 HasField "body" tx (TxBody era)) =>
UTxO era
-> tx -> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
Alonzo.scriptsNeeded UTxO (BabbageEra StandardCrypto)
bUtxo Tx (ShelleyLedgerEra era)
ValidatedTx (BabbageEra StandardCrypto)
ledgerTx
      sPurpose :: ScriptPurpose
sPurpose = case [(ScriptPurpose (Crypto (BabbageEra StandardCrypto)),
  ScriptHash (Crypto (BabbageEra StandardCrypto)))]
scriptsNeeded of
                   [(ScriptPurpose (Crypto (BabbageEra StandardCrypto))
p ,ScriptHash (Crypto (BabbageEra StandardCrypto))
_)] -> ScriptPurpose StandardCrypto -> ScriptPurpose
forall crypto. ScriptPurpose crypto -> ScriptPurpose
Alonzo.transScriptPurpose ScriptPurpose StandardCrypto
ScriptPurpose (Crypto (BabbageEra StandardCrypto))
p
                   [(ScriptPurpose (Crypto (BabbageEra StandardCrypto)),
  ScriptHash (Crypto (BabbageEra StandardCrypto)))]
needed   -> String -> ScriptPurpose
forall a. HasCallStack => String -> a
Prelude.error (String -> ScriptPurpose) -> String -> ScriptPurpose
forall a b. (a -> b) -> a -> b
$ String
"More than one redeemer ptr: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(ScriptPurpose StandardCrypto, ScriptHash StandardCrypto)]
-> String
forall a. Show a => a -> String
show [(ScriptPurpose StandardCrypto, ScriptHash StandardCrypto)]
[(ScriptPurpose (Crypto (BabbageEra StandardCrypto)),
  ScriptHash (Crypto (BabbageEra StandardCrypto)))]
needed


      -- Plutus script context types
  case PlutusScriptVersion lang
pScriptVer of
    PlutusScriptVersion lang
PlutusScriptV1 -> String -> Either ScriptContextError AnyCustomRedeemer
forall a. HasCallStack => String -> a
Prelude.error String
"createAnyCustomRedeemer: PlutusScriptV1 custom redeemer not wired up yet"
    PlutusScriptVersion lang
PlutusScriptV2 -> do
      [TxInInfo]
bV2Ins <- (TranslationError StandardCrypto -> ScriptContextError)
-> Either (TranslationError StandardCrypto) [TxInInfo]
-> Either ScriptContextError [TxInInfo]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TranslationError StandardCrypto -> ScriptContextError
PlutusV2TranslationError (Either (TranslationError StandardCrypto) [TxInInfo]
 -> Either ScriptContextError [TxInInfo])
-> Either (TranslationError StandardCrypto) [TxInInfo]
-> Either ScriptContextError [TxInInfo]
forall a b. (a -> b) -> a -> b
$ (TxIn StandardCrypto
 -> Either (TranslationError StandardCrypto) TxInInfo)
-> [TxIn StandardCrypto]
-> Either (TranslationError StandardCrypto) [TxInInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Prelude.mapM (UTxO (BabbageEra StandardCrypto)
-> TxIn (Crypto (BabbageEra StandardCrypto))
-> Either
     (TranslationError (Crypto (BabbageEra StandardCrypto))) 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
Babbage.txInfoInV2 UTxO (BabbageEra StandardCrypto)
bUtxo) [TxIn StandardCrypto]
txins
      [TxInInfo]
bV2RefIns <- (TranslationError StandardCrypto -> ScriptContextError)
-> Either (TranslationError StandardCrypto) [TxInInfo]
-> Either ScriptContextError [TxInInfo]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TranslationError StandardCrypto -> ScriptContextError
PlutusV2TranslationError (Either (TranslationError StandardCrypto) [TxInInfo]
 -> Either ScriptContextError [TxInInfo])
-> Either (TranslationError StandardCrypto) [TxInInfo]
-> Either ScriptContextError [TxInInfo]
forall a b. (a -> b) -> a -> b
$ (TxIn StandardCrypto
 -> Either (TranslationError StandardCrypto) TxInInfo)
-> [TxIn StandardCrypto]
-> Either (TranslationError StandardCrypto) [TxInInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Prelude.mapM (UTxO (BabbageEra StandardCrypto)
-> TxIn (Crypto (BabbageEra StandardCrypto))
-> Either
     (TranslationError (Crypto (BabbageEra StandardCrypto))) 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
Babbage.txInfoInV2 UTxO (BabbageEra StandardCrypto)
bUtxo) [TxIn StandardCrypto]
refTxins
      [TxOut]
bV2Outputs <- (TranslationError StandardCrypto -> ScriptContextError)
-> Either (TranslationError StandardCrypto) [TxOut]
-> Either ScriptContextError [TxOut]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TranslationError StandardCrypto -> ScriptContextError
PlutusV2TranslationError (Either (TranslationError StandardCrypto) [TxOut]
 -> Either ScriptContextError [TxOut])
-> Either (TranslationError StandardCrypto) [TxOut]
-> Either ScriptContextError [TxOut]
forall a b. (a -> b) -> a -> b
$ (TxOutSource StandardCrypto
 -> TxOut (BabbageEra StandardCrypto)
 -> Either (TranslationError StandardCrypto) TxOut)
-> [TxOutSource StandardCrypto]
-> [TxOut (BabbageEra StandardCrypto)]
-> Either (TranslationError StandardCrypto) [TxOut]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM TxOutSource StandardCrypto
-> TxOut (BabbageEra StandardCrypto)
-> Either (TranslationError StandardCrypto) 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
Babbage.txInfoOutV2 ((TxIn StandardCrypto -> TxOutSource StandardCrypto)
-> [TxIn StandardCrypto] -> [TxOutSource StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map TxIn StandardCrypto -> TxOutSource StandardCrypto
forall crypto. TxIn crypto -> TxOutSource crypto
Alonzo.TxOutFromInput [TxIn StandardCrypto]
txins) [TxOut (BabbageEra StandardCrypto)]
outputs

      let _bV2fee :: Value
_bV2fee = CurrencySymbol -> TokenName -> Integer -> Value
V2.singleton CurrencySymbol
V2.adaSymbol TokenName
V2.adaToken Integer
fee -- Impossible to test
          _withdrawals :: Map StakingCredential Integer
_withdrawals = [(StakingCredential, Integer)] -> Map StakingCredential Integer
forall k v. [(k, v)] -> Map k v
PMap.fromList ([(StakingCredential, Integer)] -> Map StakingCredential Integer)
-> (Map StakingCredential Integer
    -> [(StakingCredential, Integer)])
-> Map StakingCredential Integer
-> Map StakingCredential Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map StakingCredential Integer -> [(StakingCredential, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map StakingCredential Integer -> Map StakingCredential Integer)
-> Map StakingCredential Integer -> Map StakingCredential Integer
forall a b. (a -> b) -> a -> b
$ Wdrl StandardCrypto -> Map StakingCredential Integer
forall crypto. Wdrl crypto -> Map StakingCredential Integer
Alonzo.transWdrl Wdrl StandardCrypto
wdrwls -- untested
          bvtMint :: Value
bvtMint =  Value StandardCrypto -> Value
forall c. Value c -> Value
Alonzo.transValue Value StandardCrypto
mint
      POSIXTimeRange
valRange <-
        (Text -> ScriptContextError)
-> Either Text POSIXTimeRange
-> Either ScriptContextError POSIXTimeRange
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> ScriptContextError
IntervalConvError
          (Either Text POSIXTimeRange
 -> Either ScriptContextError POSIXTimeRange)
-> Either Text POSIXTimeRange
-> Either ScriptContextError POSIXTimeRange
forall a b. (a -> b) -> a -> b
$ PParams (BabbageEra StandardCrypto)
-> 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 (ShelleyBasedEra era
-> ProtocolParameters -> PParams (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era
-> ProtocolParameters -> PParams (ShelleyLedgerEra era)
toLedgerPParams ShelleyBasedEra era
sbe ProtocolParameters
pparams) EpochInfo (Either Text)
eInfo SystemStart
sStart ValidityInterval
vldt
      [(ScriptPurpose, Redeemer)]
redeemrs <- (TranslationError StandardCrypto -> ScriptContextError)
-> Either
     (TranslationError StandardCrypto) [(ScriptPurpose, Redeemer)]
-> Either ScriptContextError [(ScriptPurpose, Redeemer)]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TranslationError StandardCrypto -> ScriptContextError
PlutusV2TranslationError (Either
   (TranslationError StandardCrypto) [(ScriptPurpose, Redeemer)]
 -> Either ScriptContextError [(ScriptPurpose, Redeemer)])
-> Either
     (TranslationError StandardCrypto) [(ScriptPurpose, Redeemer)]
-> Either ScriptContextError [(ScriptPurpose, Redeemer)]
forall a b. (a -> b) -> a -> b
$ ((RdmrPtr, (Data (BabbageEra StandardCrypto), ExUnits))
 -> Either
      (TranslationError StandardCrypto) (ScriptPurpose, Redeemer))
-> [(RdmrPtr, (Data (BabbageEra StandardCrypto), ExUnits))]
-> Either
     (TranslationError StandardCrypto) [(ScriptPurpose, Redeemer)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Prelude.mapM (TxBody (BabbageEra StandardCrypto)
-> (RdmrPtr, (Data (BabbageEra StandardCrypto), ExUnits))
-> Either
     (TranslationError (Crypto (BabbageEra StandardCrypto)))
     (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)
Babbage.transRedeemerPtr TxBody (BabbageEra StandardCrypto)
TxBody (BabbageEra StandardCrypto)
txBody) [(RdmrPtr, (Data (BabbageEra StandardCrypto), ExUnits))]
rdmrList
      AnyCustomRedeemer -> Either ScriptContextError AnyCustomRedeemer
forall a b. b -> Either a b
Right (AnyCustomRedeemer -> Either ScriptContextError AnyCustomRedeemer)
-> (PV2CustomRedeemer -> AnyCustomRedeemer)
-> PV2CustomRedeemer
-> Either ScriptContextError AnyCustomRedeemer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PV2CustomRedeemer -> AnyCustomRedeemer
AnyPV2CustomRedeemer
        (PV2CustomRedeemer -> Either ScriptContextError AnyCustomRedeemer)
-> PV2CustomRedeemer -> Either ScriptContextError AnyCustomRedeemer
forall a b. (a -> b) -> a -> b
$ PV2CustomRedeemer :: [TxInInfo]
-> [TxInInfo]
-> [TxOut]
-> Value
-> Value
-> [DCert]
-> Map StakingCredential Integer
-> POSIXTimeRange
-> [PubKeyHash]
-> Map ScriptPurpose Redeemer
-> Map DatumHash Datum
-> Maybe ScriptPurpose
-> PV2CustomRedeemer
PV2CustomRedeemer
            { pv2Inputs :: [TxInInfo]
pv2Inputs = [TxInInfo]
bV2Ins
            , pv2RefInputs :: [TxInInfo]
pv2RefInputs = [TxInInfo]
bV2RefIns
            , pv2Outputs :: [TxOut]
pv2Outputs = [TxOut]
bV2Outputs
            , pv2Fee :: Value
pv2Fee = Value
forall a. Monoid a => a
PPrelude.mempty -- Impossible to test
            , pv2Mint :: Value
pv2Mint = Value
bvtMint
            , pv2DCert :: [DCert]
pv2DCert = (DCert StandardCrypto -> DCert)
-> [DCert StandardCrypto] -> [DCert]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map DCert StandardCrypto -> DCert
forall c. DCert c -> DCert
Alonzo.transDCert [DCert StandardCrypto]
certs
            , pv2Wdrl :: Map StakingCredential Integer
pv2Wdrl = Map StakingCredential Integer
forall k v. Map k v
PMap.empty -- TODO: Not tested
            , pv2ValidRange :: POSIXTimeRange
pv2ValidRange = POSIXTimeRange
valRange -- TODO: Fails when using (/=)
            , pv2Signatories :: [PubKeyHash]
pv2Signatories = (KeyHash 'Witness StandardCrypto -> PubKeyHash)
-> [KeyHash 'Witness StandardCrypto] -> [PubKeyHash]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map KeyHash 'Witness StandardCrypto -> PubKeyHash
forall (d :: KeyRole) c. KeyHash d c -> PubKeyHash
Alonzo.transKeyHash [KeyHash 'Witness StandardCrypto]
reqSigners
            , pv2Redeemers :: Map ScriptPurpose Redeemer
pv2Redeemers = [(ScriptPurpose, Redeemer)] -> Map ScriptPurpose Redeemer
forall k v. [(k, v)] -> Map k v
PMap.fromList [(ScriptPurpose, Redeemer)]
redeemrs
            , pv2Data :: Map DatumHash Datum
pv2Data = [(DatumHash, Datum)] -> Map DatumHash Datum
forall k v. [(k, v)] -> Map k v
PMap.fromList ([(DatumHash, Datum)] -> Map DatumHash Datum)
-> ([(DataHash StandardCrypto, Data (BabbageEra StandardCrypto))]
    -> [(DatumHash, Datum)])
-> [(DataHash StandardCrypto, Data (BabbageEra StandardCrypto))]
-> Map DatumHash Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DataHash StandardCrypto, Data (BabbageEra StandardCrypto))
 -> (DatumHash, Datum))
-> [(DataHash StandardCrypto, Data (BabbageEra StandardCrypto))]
-> [(DatumHash, Datum)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (DataHash StandardCrypto, Data (BabbageEra StandardCrypto))
-> (DatumHash, Datum)
forall c era. (DataHash c, Data era) -> (DatumHash, Datum)
Alonzo.transDataPair ([(DataHash StandardCrypto, Data (BabbageEra StandardCrypto))]
 -> Map DatumHash Datum)
-> [(DataHash StandardCrypto, Data (BabbageEra StandardCrypto))]
-> Map DatumHash Datum
forall a b. (a -> b) -> a -> b
$ Map (DataHash StandardCrypto) (Data (BabbageEra StandardCrypto))
-> [(DataHash StandardCrypto, Data (BabbageEra StandardCrypto))]
forall k a. Map k a -> [(k, a)]
Map.toList Map (DataHash StandardCrypto) (Data (BabbageEra StandardCrypto))
Map
  (DataHash (Crypto (BabbageEra StandardCrypto)))
  (Data (BabbageEra StandardCrypto))
datumHashMap
            , pv2ScriptPurpose :: Maybe ScriptPurpose
pv2ScriptPurpose = ScriptPurpose -> Maybe ScriptPurpose
forall a. a -> Maybe a
Just ScriptPurpose
sPurpose
            }

createAnyCustomRedeemer PlutusScriptVersion lang
_ ShelleyBasedEra era
_ ProtocolParameters
_ UTxO era
_ EpochInfo (Either Text)
_ SystemStart
_ Tx era
_ = ScriptContextError -> Either ScriptContextError AnyCustomRedeemer
forall a b. a -> Either a b
Left ScriptContextError
NoScriptsInByronEra

seqToList :: Seq.StrictSeq a -> [a]
seqToList :: StrictSeq a -> [a]
seqToList (a
x Seq.:<| StrictSeq a
rest) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: StrictSeq a -> [a]
forall a. StrictSeq a -> [a]
seqToList StrictSeq a
rest
seqToList StrictSeq a
Seq.Empty        = []

newtype CddlTx = CddlTx { CddlTx -> InAnyCardanoEra Tx
unCddlTx :: InAnyCardanoEra Tx }
    deriving (Int -> CddlTx -> ShowS
[CddlTx] -> ShowS
CddlTx -> String
(Int -> CddlTx -> ShowS)
-> (CddlTx -> String) -> ([CddlTx] -> ShowS) -> Show CddlTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CddlTx] -> ShowS
$cshowList :: [CddlTx] -> ShowS
show :: CddlTx -> String
$cshow :: CddlTx -> String
showsPrec :: Int -> CddlTx -> ShowS
$cshowsPrec :: Int -> CddlTx -> ShowS
Show, CddlTx -> CddlTx -> Bool
(CddlTx -> CddlTx -> Bool)
-> (CddlTx -> CddlTx -> Bool) -> Eq CddlTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CddlTx -> CddlTx -> Bool
$c/= :: CddlTx -> CddlTx -> Bool
== :: CddlTx -> CddlTx -> Bool
$c== :: CddlTx -> CddlTx -> Bool
Eq)

createAnyCustomRedeemerFromTxFp
  :: PlutusScriptVersion lang
  -> FilePath
  -> AnyConsensusModeParams
  -> NetworkId
  -> ExceptT ScriptContextError IO AnyCustomRedeemer
createAnyCustomRedeemerFromTxFp :: PlutusScriptVersion lang
-> String
-> AnyConsensusModeParams
-> NetworkId
-> ExceptT ScriptContextError IO AnyCustomRedeemer
createAnyCustomRedeemerFromTxFp PlutusScriptVersion lang
pScriptVer String
fp (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network = do
  -- TODO: Expose readFileTx from cardano-cli
  CddlTx (InAnyCardanoEra CardanoEra era
cEra Tx era
alonzoTx)
    <- (FileError TextEnvelopeCddlError -> ScriptContextError)
-> ExceptT (FileError TextEnvelopeCddlError) IO CddlTx
-> ExceptT ScriptContextError IO CddlTx
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeCddlError -> ScriptContextError
ReadTxBodyError
         (ExceptT (FileError TextEnvelopeCddlError) IO CddlTx
 -> ExceptT ScriptContextError IO CddlTx)
-> (IO (Either (FileError TextEnvelopeCddlError) CddlTx)
    -> ExceptT (FileError TextEnvelopeCddlError) IO CddlTx)
-> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
-> ExceptT ScriptContextError IO CddlTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError TextEnvelopeCddlError) CddlTx)
-> ExceptT (FileError TextEnvelopeCddlError) IO CddlTx
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
         (IO (Either (FileError TextEnvelopeCddlError) CddlTx)
 -> ExceptT ScriptContextError IO CddlTx)
-> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
-> ExceptT ScriptContextError IO CddlTx
forall a b. (a -> b) -> a -> b
$ [FromSomeTypeCDDL TextEnvelopeCddl CddlTx]
-> String -> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
forall b.
[FromSomeTypeCDDL TextEnvelopeCddl b]
-> String -> IO (Either (FileError TextEnvelopeCddlError) b)
readFileTextEnvelopeCddlAnyOf
             [ Text
-> (InAnyCardanoEra Tx -> CddlTx)
-> FromSomeTypeCDDL TextEnvelopeCddl CddlTx
forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Witnessed Tx AlonzoEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
             , Text
-> (InAnyCardanoEra Tx -> CddlTx)
-> FromSomeTypeCDDL TextEnvelopeCddl CddlTx
forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Unwitnessed Tx AlonzoEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
             , Text
-> (InAnyCardanoEra Tx -> CddlTx)
-> FromSomeTypeCDDL TextEnvelopeCddl CddlTx
forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Witnessed Tx BabbageEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
             , Text
-> (InAnyCardanoEra Tx -> CddlTx)
-> FromSomeTypeCDDL TextEnvelopeCddl CddlTx
forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Unwitnessed Tx BabbageEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
             ]
             String
fp

  ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ScriptContextError IO (ShelleyBasedEra era)
forall era.
CardanoEraStyle era
-> ExceptT ScriptContextError IO (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
 -> ExceptT ScriptContextError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ScriptContextError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
cEra
  SocketPath String
sockPath <- (EnvSocketError -> ScriptContextError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ScriptContextError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ScriptContextError
EnvVarSocketErr (ExceptT EnvSocketError IO SocketPath
 -> ExceptT ScriptContextError IO SocketPath)
-> (IO (Either EnvSocketError SocketPath)
    -> ExceptT EnvSocketError IO SocketPath)
-> IO (Either EnvSocketError SocketPath)
-> ExceptT ScriptContextError IO SocketPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either EnvSocketError SocketPath)
-> ExceptT EnvSocketError IO SocketPath
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either EnvSocketError SocketPath)
 -> ExceptT ScriptContextError IO SocketPath)
-> IO (Either EnvSocketError SocketPath)
-> ExceptT ScriptContextError IO SocketPath
forall a b. (a -> b) -> a -> b
$ IO (Either EnvSocketError SocketPath)
readEnvSocketPath
  case ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams of
    ConsensusMode mode
CardanoMode -> do
      let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
      EraInMode era CardanoMode
eInMode <- ScriptContextError
-> Maybe (EraInMode era CardanoMode)
-> ExceptT ScriptContextError IO (EraInMode era CardanoMode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe
                   (AnyConsensusMode -> AnyCardanoEra -> ScriptContextError
ConsensusModeMismatch (ConsensusMode CardanoMode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode CardanoMode
CardanoMode) (CardanoEra era -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
cEra))
                   (Maybe (EraInMode era CardanoMode)
 -> ExceptT ScriptContextError IO (EraInMode era CardanoMode))
-> Maybe (EraInMode era CardanoMode)
-> ExceptT ScriptContextError IO (EraInMode era CardanoMode)
forall a b. (a -> b) -> a -> b
$ CardanoEra era
-> ConsensusMode CardanoMode -> Maybe (EraInMode era CardanoMode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
cEra ConsensusMode CardanoMode
CardanoMode

      Either
  AcquiringFailure
  (EpochInfo (Either Text), Maybe SystemStart,
   Either EraMismatch ProtocolParameters)
eResult <-
        IO
  (Either
     AcquiringFailure
     (EpochInfo (Either Text), Maybe SystemStart,
      Either EraMismatch ProtocolParameters))
-> ExceptT
     ScriptContextError
     IO
     (Either
        AcquiringFailure
        (EpochInfo (Either Text), Maybe SystemStart,
         Either EraMismatch ProtocolParameters))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Either
      AcquiringFailure
      (EpochInfo (Either Text), Maybe SystemStart,
       Either EraMismatch ProtocolParameters))
 -> ExceptT
      ScriptContextError
      IO
      (Either
         AcquiringFailure
         (EpochInfo (Either Text), Maybe SystemStart,
          Either EraMismatch ProtocolParameters)))
-> IO
     (Either
        AcquiringFailure
        (EpochInfo (Either Text), Maybe SystemStart,
         Either EraMismatch ProtocolParameters))
-> ExceptT
     ScriptContextError
     IO
     (Either
        AcquiringFailure
        (EpochInfo (Either Text), Maybe SystemStart,
         Either EraMismatch ProtocolParameters))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
    -> LocalStateQueryExpr
         (BlockInMode mode)
         ChainPoint
         (QueryInMode mode)
         ()
         IO
         (EpochInfo (Either Text), Maybe SystemStart,
          Either EraMismatch ProtocolParameters))
-> IO
     (Either
        AcquiringFailure
        (EpochInfo (Either Text), Maybe SystemStart,
         Either EraMismatch ProtocolParameters))
forall mode a.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
    -> LocalStateQueryExpr
         (BlockInMode mode) ChainPoint (QueryInMode mode) () IO a)
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo mode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing
          ((NodeToClientVersion
  -> LocalStateQueryExpr
       (BlockInMode mode)
       ChainPoint
       (QueryInMode mode)
       ()
       IO
       (EpochInfo (Either Text), Maybe SystemStart,
        Either EraMismatch ProtocolParameters))
 -> IO
      (Either
         AcquiringFailure
         (EpochInfo (Either Text), Maybe SystemStart,
          Either EraMismatch ProtocolParameters)))
-> (NodeToClientVersion
    -> LocalStateQueryExpr
         (BlockInMode mode)
         ChainPoint
         (QueryInMode mode)
         ()
         IO
         (EpochInfo (Either Text), Maybe SystemStart,
          Either EraMismatch ProtocolParameters))
-> IO
     (Either
        AcquiringFailure
        (EpochInfo (Either Text), Maybe SystemStart,
         Either EraMismatch ProtocolParameters))
forall a b. (a -> b) -> a -> b
$ \NodeToClientVersion
ntcVersion -> do
              (EraHistory ConsensusMode CardanoMode
_ Interpreter xs
interpreter) <- QueryInMode CardanoMode (EraHistory CardanoMode)
-> LocalStateQueryExpr
     (BlockInMode mode)
     ChainPoint
     (QueryInMode CardanoMode)
     ()
     IO
     (EraHistory CardanoMode)
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (QueryInMode CardanoMode (EraHistory CardanoMode)
 -> LocalStateQueryExpr
      (BlockInMode mode)
      ChainPoint
      (QueryInMode CardanoMode)
      ()
      IO
      (EraHistory CardanoMode))
-> QueryInMode CardanoMode (EraHistory CardanoMode)
-> LocalStateQueryExpr
     (BlockInMode mode)
     ChainPoint
     (QueryInMode CardanoMode)
     ()
     IO
     (EraHistory CardanoMode)
forall a b. (a -> b) -> a -> b
$ ConsensusModeIsMultiEra CardanoMode
-> QueryInMode CardanoMode (EraHistory CardanoMode)
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode (EraHistory mode)
QueryEraHistory ConsensusModeIsMultiEra CardanoMode
CardanoModeIsMultiEra
              Maybe SystemStart
mSystemStart <-
                if NodeToClientVersion
ntcVersion NodeToClientVersion -> NodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.>= NodeToClientVersion
NodeToClientV_9
                then SystemStart -> Maybe SystemStart
forall a. a -> Maybe a
Just (SystemStart -> Maybe SystemStart)
-> LocalStateQueryExpr
     (BlockInMode mode) ChainPoint (QueryInMode mode) () IO SystemStart
-> LocalStateQueryExpr
     (BlockInMode mode)
     ChainPoint
     (QueryInMode mode)
     ()
     IO
     (Maybe SystemStart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> QueryInMode mode SystemStart
-> LocalStateQueryExpr
     (BlockInMode mode) ChainPoint (QueryInMode mode) () IO SystemStart
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr QueryInMode mode SystemStart
forall mode. QueryInMode mode SystemStart
QuerySystemStart
                else Maybe SystemStart
-> LocalStateQueryExpr
     (BlockInMode mode)
     ChainPoint
     (QueryInMode mode)
     ()
     IO
     (Maybe SystemStart)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SystemStart
forall a. Maybe a
Nothing
              let eInfo :: EpochInfo (Either Text)
eInfo = (forall a. Except PastHorizonException a -> Either Text a)
-> EpochInfo (Except PastHorizonException)
-> EpochInfo (Either Text)
forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> EpochInfo m -> EpochInfo n
hoistEpochInfo ((PastHorizonException -> Text)
-> Either PastHorizonException a -> Either Text a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
T.pack (String -> Text)
-> (PastHorizonException -> String) -> PastHorizonException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionValidityError -> String
forall e. Error e => e -> String
displayError (TransactionValidityError -> String)
-> (PastHorizonException -> TransactionValidityError)
-> PastHorizonException
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PastHorizonException -> TransactionValidityError
TransactionValidityIntervalError) (Either PastHorizonException a -> Either Text a)
-> (Except PastHorizonException a -> Either PastHorizonException a)
-> Except PastHorizonException a
-> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except PastHorizonException a -> Either PastHorizonException a
forall e a. Except e a -> Either e a
runExcept)
                            (EpochInfo (Except PastHorizonException)
 -> EpochInfo (Either Text))
-> EpochInfo (Except PastHorizonException)
-> EpochInfo (Either Text)
forall a b. (a -> b) -> a -> b
$ Interpreter xs -> EpochInfo (Except PastHorizonException)
forall (xs :: [*]).
Interpreter xs -> EpochInfo (Except PastHorizonException)
Consensus.interpreterToEpochInfo Interpreter xs
interpreter
              Either EraMismatch ProtocolParameters
ppResult <- QueryInMode CardanoMode (Either EraMismatch ProtocolParameters)
-> LocalStateQueryExpr
     (BlockInMode mode)
     ChainPoint
     (QueryInMode CardanoMode)
     ()
     IO
     (Either EraMismatch ProtocolParameters)
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (QueryInMode CardanoMode (Either EraMismatch ProtocolParameters)
 -> LocalStateQueryExpr
      (BlockInMode mode)
      ChainPoint
      (QueryInMode CardanoMode)
      ()
      IO
      (Either EraMismatch ProtocolParameters))
-> QueryInMode CardanoMode (Either EraMismatch ProtocolParameters)
-> LocalStateQueryExpr
     (BlockInMode mode)
     ChainPoint
     (QueryInMode CardanoMode)
     ()
     IO
     (Either EraMismatch ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ EraInMode era CardanoMode
-> QueryInEra era ProtocolParameters
-> QueryInMode CardanoMode (Either EraMismatch ProtocolParameters)
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era CardanoMode
eInMode (QueryInEra era ProtocolParameters
 -> QueryInMode CardanoMode (Either EraMismatch ProtocolParameters))
-> QueryInEra era ProtocolParameters
-> QueryInMode CardanoMode (Either EraMismatch ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era ProtocolParameters
-> QueryInEra era ProtocolParameters
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe QueryInShelleyBasedEra era ProtocolParameters
forall era. QueryInShelleyBasedEra era ProtocolParameters
QueryProtocolParameters
              (EpochInfo (Either Text), Maybe SystemStart,
 Either EraMismatch ProtocolParameters)
-> LocalStateQueryExpr
     (BlockInMode mode)
     ChainPoint
     (QueryInMode mode)
     ()
     IO
     (EpochInfo (Either Text), Maybe SystemStart,
      Either EraMismatch ProtocolParameters)
forall (m :: * -> *) a. Monad m => a -> m a
return (EpochInfo (Either Text)
eInfo, Maybe SystemStart
mSystemStart, Either EraMismatch ProtocolParameters
ppResult)

      (EpochInfo (Either Text)
eInfo, Maybe SystemStart
mSystemStart, Either EraMismatch ProtocolParameters
ePParams) <- (AcquiringFailure -> ScriptContextError)
-> ExceptT
     AcquiringFailure
     IO
     (EpochInfo (Either Text), Maybe SystemStart,
      Either EraMismatch ProtocolParameters)
-> ExceptT
     ScriptContextError
     IO
     (EpochInfo (Either Text), Maybe SystemStart,
      Either EraMismatch ProtocolParameters)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquiringFailure -> ScriptContextError
AcquireFail (ExceptT
   AcquiringFailure
   IO
   (EpochInfo (Either Text), Maybe SystemStart,
    Either EraMismatch ProtocolParameters)
 -> ExceptT
      ScriptContextError
      IO
      (EpochInfo (Either Text), Maybe SystemStart,
       Either EraMismatch ProtocolParameters))
-> ExceptT
     AcquiringFailure
     IO
     (EpochInfo (Either Text), Maybe SystemStart,
      Either EraMismatch ProtocolParameters)
-> ExceptT
     ScriptContextError
     IO
     (EpochInfo (Either Text), Maybe SystemStart,
      Either EraMismatch ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ Either
  AcquiringFailure
  (EpochInfo (Either Text), Maybe SystemStart,
   Either EraMismatch ProtocolParameters)
-> ExceptT
     AcquiringFailure
     IO
     (EpochInfo (Either Text), Maybe SystemStart,
      Either EraMismatch ProtocolParameters)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither Either
  AcquiringFailure
  (EpochInfo (Either Text), Maybe SystemStart,
   Either EraMismatch ProtocolParameters)
eResult
      ProtocolParameters
pparams <- (EraMismatch -> ScriptContextError)
-> ExceptT EraMismatch IO ProtocolParameters
-> ExceptT ScriptContextError IO ProtocolParameters
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EraMismatch -> ScriptContextError
EraMismatch (ExceptT EraMismatch IO ProtocolParameters
 -> ExceptT ScriptContextError IO ProtocolParameters)
-> ExceptT EraMismatch IO ProtocolParameters
-> ExceptT ScriptContextError IO ProtocolParameters
forall a b. (a -> b) -> a -> b
$ Either EraMismatch ProtocolParameters
-> ExceptT EraMismatch IO ProtocolParameters
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither Either EraMismatch ProtocolParameters
ePParams
      SystemStart
sStart <- ScriptContextError
-> Maybe SystemStart -> ExceptT ScriptContextError IO SystemStart
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe ScriptContextError
NoSystemStartTimeError Maybe SystemStart
mSystemStart

      -- Query UTxO
      let utxoQ :: QueryInEra era (UTxO era)
utxoQ = ShelleyBasedEra era
-> QueryInShelleyBasedEra era (UTxO era)
-> QueryInEra era (UTxO era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe (QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
forall era.
QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
QueryUTxO QueryUTxOFilter
QueryUTxOWhole)
          utxoQinMode :: QueryInMode CardanoMode (Either EraMismatch (UTxO era))
utxoQinMode = case CardanoEra era
-> ConsensusMode CardanoMode -> Maybe (EraInMode era CardanoMode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
cEra ConsensusMode CardanoMode
CardanoMode of
                          Just EraInMode era CardanoMode
eInMode' -> EraInMode era CardanoMode
-> QueryInEra era (UTxO era)
-> QueryInMode CardanoMode (Either EraMismatch (UTxO era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era CardanoMode
eInMode' QueryInEra era (UTxO era)
utxoQ
                          Maybe (EraInMode era CardanoMode)
Nothing       -> String -> QueryInMode CardanoMode (Either EraMismatch (UTxO era))
forall a. HasCallStack => String -> a
Prelude.error String
"Cannot determine era in mode"
      UTxO era
utxo <- (ShelleyQueryCmdError -> ScriptContextError)
-> ExceptT ShelleyQueryCmdError IO (UTxO era)
-> ExceptT ScriptContextError IO (UTxO era)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyQueryCmdError -> ScriptContextError
QueryError
                (ExceptT ShelleyQueryCmdError IO (UTxO era)
 -> ExceptT ScriptContextError IO (UTxO era))
-> ExceptT ShelleyQueryCmdError IO (UTxO era)
-> ExceptT ScriptContextError IO (UTxO era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch (UTxO era))
-> ExceptT ShelleyQueryCmdError IO (UTxO era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery
                    CardanoEra era
cEra
                    ConsensusModeParams mode
cModeParams
                    LocalNodeConnectInfo mode
localNodeConnInfo
                    QueryInMode mode (Either EraMismatch (UTxO era))
QueryInMode CardanoMode (Either EraMismatch (UTxO era))
utxoQinMode
      Either ScriptContextError AnyCustomRedeemer
-> ExceptT ScriptContextError IO AnyCustomRedeemer
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either ScriptContextError AnyCustomRedeemer
 -> ExceptT ScriptContextError IO AnyCustomRedeemer)
-> Either ScriptContextError AnyCustomRedeemer
-> ExceptT ScriptContextError IO AnyCustomRedeemer
forall a b. (a -> b) -> a -> b
$ PlutusScriptVersion lang
-> ShelleyBasedEra era
-> ProtocolParameters
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> Tx era
-> Either ScriptContextError AnyCustomRedeemer
forall era lang.
PlutusScriptVersion lang
-> ShelleyBasedEra era
-> ProtocolParameters
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> Tx era
-> Either ScriptContextError AnyCustomRedeemer
createAnyCustomRedeemer PlutusScriptVersion lang
pScriptVer ShelleyBasedEra era
sbe ProtocolParameters
pparams
                                       UTxO era
utxo EpochInfo (Either Text)
eInfo SystemStart
sStart Tx era
alonzoTx
    ConsensusMode mode
_ -> String -> ExceptT ScriptContextError IO AnyCustomRedeemer
forall a. HasCallStack => String -> a
Prelude.error String
"Please specify --cardano-mode on cli."


createAnyCustomRedeemerBsFromTxFp
  :: PlutusScriptVersion lang
  -> FilePath
  -> AnyConsensusModeParams
  -> NetworkId
  -> ExceptT ScriptContextError IO LB.ByteString
createAnyCustomRedeemerBsFromTxFp :: PlutusScriptVersion lang
-> String
-> AnyConsensusModeParams
-> NetworkId
-> ExceptT ScriptContextError IO ByteString
createAnyCustomRedeemerBsFromTxFp PlutusScriptVersion lang
pScriptVer String
txFp AnyConsensusModeParams
anyCmodeParams NetworkId
nid = do
  AnyCustomRedeemer
anyCustomRedeemer <- PlutusScriptVersion lang
-> String
-> AnyConsensusModeParams
-> NetworkId
-> ExceptT ScriptContextError IO AnyCustomRedeemer
forall lang.
PlutusScriptVersion lang
-> String
-> AnyConsensusModeParams
-> NetworkId
-> ExceptT ScriptContextError IO AnyCustomRedeemer
createAnyCustomRedeemerFromTxFp PlutusScriptVersion lang
pScriptVer String
txFp AnyConsensusModeParams
anyCmodeParams NetworkId
nid
  ByteString -> ExceptT ScriptContextError IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ExceptT ScriptContextError IO ByteString)
-> (ScriptData -> ByteString)
-> ScriptData
-> ExceptT ScriptContextError IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Value -> ByteString)
-> (ScriptData -> Value) -> ScriptData -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptDataJsonSchema -> ScriptData -> Value
scriptDataToJson ScriptDataJsonSchema
ScriptDataJsonDetailedSchema
         (ScriptData -> ExceptT ScriptContextError IO ByteString)
-> ScriptData -> ExceptT ScriptContextError IO ByteString
forall a b. (a -> b) -> a -> b
$ AnyCustomRedeemer -> ScriptData
customRedeemerToScriptData AnyCustomRedeemer
anyCustomRedeemer


getSbe :: CardanoEraStyle era -> ExceptT ScriptContextError IO (ShelleyBasedEra era)
getSbe :: CardanoEraStyle era
-> ExceptT ScriptContextError IO (ShelleyBasedEra era)
getSbe CardanoEraStyle era
LegacyByronEra        = ScriptContextError
-> ExceptT ScriptContextError IO (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ScriptContextError
ScriptContextErrorByronEra
getSbe (ShelleyBasedEra ShelleyBasedEra era
sbe) = ShelleyBasedEra era
-> ExceptT ScriptContextError IO (ShelleyBasedEra era)
forall (m :: * -> *) a. Monad m => a -> m a
return ShelleyBasedEra era
sbe


-- Used in roundtrip testing

fromPlutusTxId :: V1.TxId -> Ledger.TxId StandardCrypto
fromPlutusTxId :: TxId -> TxId StandardCrypto
fromPlutusTxId (V1.TxId BuiltinByteString
builtInBs) =
  case AsType TxId -> ByteString -> Maybe TxId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytes AsType TxId
AsTxId (ByteString -> Maybe TxId) -> ByteString -> Maybe TxId
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
fromBuiltin BuiltinByteString
builtInBs of
    Just TxId
txidHash -> TxId -> TxId StandardCrypto
toShelleyTxId TxId
txidHash
    Maybe TxId
Nothing       -> String -> TxId StandardCrypto
forall a. HasCallStack => String -> a
Prelude.error String
"Could not derserialize txid"


sampleTestV1ScriptContextDataJSON :: LB.ByteString
sampleTestV1ScriptContextDataJSON :: ByteString
sampleTestV1ScriptContextDataJSON =
  Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode
    (Value -> ByteString)
-> (PV1CustomRedeemer -> Value) -> PV1CustomRedeemer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptDataJsonSchema -> ScriptData -> Value
scriptDataToJson ScriptDataJsonSchema
ScriptDataJsonDetailedSchema
    (ScriptData -> Value)
-> (PV1CustomRedeemer -> ScriptData) -> PV1CustomRedeemer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCustomRedeemer -> ScriptData
customRedeemerToScriptData
    (AnyCustomRedeemer -> ScriptData)
-> (PV1CustomRedeemer -> AnyCustomRedeemer)
-> PV1CustomRedeemer
-> ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PV1CustomRedeemer -> AnyCustomRedeemer
AnyPV1CustomRedeemer
    (PV1CustomRedeemer -> ByteString)
-> PV1CustomRedeemer -> ByteString
forall a b. (a -> b) -> a -> b
$ [TxOut]
-> [TxInInfo]
-> Value
-> POSIXTimeRange
-> Value
-> [(DatumHash, Datum)]
-> [DCert]
-> [PubKeyHash]
-> Maybe ScriptPurpose
-> PV1CustomRedeemer
PV1CustomRedeemer
        [TxOut]
dummyTxOuts
        [TxInInfo]
dummyTxIns
        Value
dummyLedgerVal
        POSIXTimeRange
dummyPOSIXTimeRange
        Value
dummyLedgerVal
        [(DatumHash, Datum)]
dummyDatumHashes
        [DCert]
dummyCerts
        [PubKeyHash]
dummySignatories
        Maybe ScriptPurpose
dummyScriptPurpose


dummyCerts :: [V1.DCert]
dummyCerts :: [DCert]
dummyCerts = []

dummyTxIns :: [V1.TxInInfo]
dummyTxIns :: [TxInInfo]
dummyTxIns = []

dummySignatories :: [V1.PubKeyHash]
dummySignatories :: [PubKeyHash]
dummySignatories = []

dummyDatumHashes :: [(V1.DatumHash, V1.Datum)]
dummyDatumHashes :: [(DatumHash, Datum)]
dummyDatumHashes = []

dummyLedgerVal :: V1.Value
dummyLedgerVal :: Value
dummyLedgerVal = Value StandardCrypto -> Value
forall c. Value c -> Value
Alonzo.transValue (Value StandardCrypto -> Value) -> Value StandardCrypto -> Value
forall a b. (a -> b) -> a -> b
$ Value -> Value StandardCrypto
toMaryValue Value
forall a. Monoid a => a
Prelude.mempty

dummyTxOuts :: [V1.TxOut]
dummyTxOuts :: [TxOut]
dummyTxOuts = []

dummyPOSIXTimeRange :: V1.POSIXTimeRange
dummyPOSIXTimeRange :: POSIXTimeRange
dummyPOSIXTimeRange = POSIXTime -> POSIXTimeRange
forall a. a -> Interval a
V1.from (POSIXTime -> POSIXTimeRange) -> POSIXTime -> POSIXTimeRange
forall a b. (a -> b) -> a -> b
$ Integer -> POSIXTime
V1.POSIXTime Integer
42

dummyScriptPurpose :: Maybe V1.ScriptPurpose
dummyScriptPurpose :: Maybe ScriptPurpose
dummyScriptPurpose = Maybe ScriptPurpose
forall a. Maybe a
Nothing

getTxInInfoFromTxIn
  :: Shelley.UTxO (Alonzo.AlonzoEra StandardCrypto)
  -> Ledger.TxIn StandardCrypto
  -> Maybe V1.TxInInfo
getTxInInfoFromTxIn :: UTxO (AlonzoEra StandardCrypto)
-> TxIn StandardCrypto -> Maybe TxInInfo
getTxInInfoFromTxIn (Shelley.UTxO Map
  (TxIn (Crypto (AlonzoEra StandardCrypto)))
  (TxOut (AlonzoEra StandardCrypto))
utxoMap) TxIn StandardCrypto
txIn = do
  TxOut (AlonzoEra StandardCrypto)
txOut <- TxIn StandardCrypto
-> Map (TxIn StandardCrypto) (TxOut (AlonzoEra StandardCrypto))
-> Maybe (TxOut (AlonzoEra StandardCrypto))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn StandardCrypto
txIn Map (TxIn StandardCrypto) (TxOut (AlonzoEra StandardCrypto))
Map
  (TxIn (Crypto (AlonzoEra StandardCrypto)))
  (TxOut (AlonzoEra StandardCrypto))
utxoMap
  TxIn (Crypto (AlonzoEra StandardCrypto))
-> TxOut (AlonzoEra StandardCrypto) -> Maybe TxInInfo
forall era c i.
(Era era, Value era ~ Value (Crypto era),
 HasField "datahash" (TxOut era) (StrictMaybe (SafeHash c i))) =>
TxIn (Crypto era) -> TxOut era -> Maybe TxInInfo
Alonzo.txInfoIn TxIn StandardCrypto
TxIn (Crypto (AlonzoEra StandardCrypto))
txIn TxOut (AlonzoEra StandardCrypto)
TxOut (AlonzoEra StandardCrypto)
txOut

sampleTestV2ScriptContextDataJSON :: LB.ByteString
sampleTestV2ScriptContextDataJSON :: ByteString
sampleTestV2ScriptContextDataJSON =
  Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode
    (Value -> ByteString)
-> (PV2CustomRedeemer -> Value) -> PV2CustomRedeemer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptDataJsonSchema -> ScriptData -> Value
scriptDataToJson ScriptDataJsonSchema
ScriptDataJsonDetailedSchema
    (ScriptData -> Value)
-> (PV2CustomRedeemer -> ScriptData) -> PV2CustomRedeemer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCustomRedeemer -> ScriptData
customRedeemerToScriptData
    (AnyCustomRedeemer -> ScriptData)
-> (PV2CustomRedeemer -> AnyCustomRedeemer)
-> PV2CustomRedeemer
-> ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PV2CustomRedeemer -> AnyCustomRedeemer
AnyPV2CustomRedeemer
    (PV2CustomRedeemer -> ByteString)
-> PV2CustomRedeemer -> ByteString
forall a b. (a -> b) -> a -> b
$ PV2CustomRedeemer :: [TxInInfo]
-> [TxInInfo]
-> [TxOut]
-> Value
-> Value
-> [DCert]
-> Map StakingCredential Integer
-> POSIXTimeRange
-> [PubKeyHash]
-> Map ScriptPurpose Redeemer
-> Map DatumHash Datum
-> Maybe ScriptPurpose
-> PV2CustomRedeemer
PV2CustomRedeemer
       { pv2Inputs :: [TxInInfo]
pv2Inputs = []
       , pv2RefInputs :: [TxInInfo]
pv2RefInputs = []
       , pv2Outputs :: [TxOut]
pv2Outputs = []
       , pv2Fee :: Value
pv2Fee = Value
forall a. Monoid a => a
PPrelude.mempty
       , pv2Mint :: Value
pv2Mint = Value
forall a. Monoid a => a
PPrelude.mempty
       , pv2DCert :: [DCert]
pv2DCert = []
       , pv2Wdrl :: Map StakingCredential Integer
pv2Wdrl = Map StakingCredential Integer
forall k v. Map k v
PMap.empty
       , pv2ValidRange :: POSIXTimeRange
pv2ValidRange = POSIXTimeRange
forall a. Interval a
V2.always
       , pv2Signatories :: [PubKeyHash]
pv2Signatories = []
       , pv2Redeemers :: Map ScriptPurpose Redeemer
pv2Redeemers = Map ScriptPurpose Redeemer
forall k v. Map k v
PMap.empty
       , pv2Data :: Map DatumHash Datum
pv2Data = Map DatumHash Datum
forall k v. Map k v
PMap.empty
       , pv2ScriptPurpose :: Maybe ScriptPurpose
pv2ScriptPurpose = Maybe ScriptPurpose
forall a. Maybe a
Nothing
       }