{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}

module Cardano.Api.Internal.Experimental.Plutus.Shim.LegacyScripts
  ( legacyWitnessToScriptRequirements
  , legacyWitnessConversion
  , toPlutusSLanguage
  )
where

import Cardano.Api.Internal.Eon.AlonzoEraOnwards
import Cardano.Api.Internal.Eon.ShelleyBasedEra
import Cardano.Api.Internal.Experimental.Plutus.IndexedPlutusScriptWitness
import Cardano.Api.Internal.Experimental.Plutus.Script
import Cardano.Api.Internal.Experimental.Plutus.ScriptWitness
import Cardano.Api.Internal.Experimental.Simple.Script
import Cardano.Api.Internal.Experimental.Witness.AnyWitness
import Cardano.Api.Internal.Experimental.Witness.TxScriptWitnessRequirements
import Cardano.Api.Internal.Pretty
import Cardano.Api.Internal.Script
  ( ExecutionUnits
  , Witness
  )
import Cardano.Api.Internal.Script qualified as Old
import Cardano.Api.Internal.Tx.BuildTxWith

import Cardano.Binary qualified as CBOR
import Cardano.Ledger.Alonzo.Scripts qualified as L
import Cardano.Ledger.BaseTypes (Version)
import Cardano.Ledger.Core qualified as L
import Cardano.Ledger.Plutus.Language qualified as L

import Data.Text qualified as Text

-- | This module is concerned with converting legacy api scripts and by extension
-- script witnesses to the new api.

-- Remember we don't care about simple script witnesses beyond the fact that they require key witnesses
-- and therefore contribute to the determination of the script witness index.
toAnyWitness
  :: AlonzoEraOnwards era
  -> (Witnessable thing (ShelleyLedgerEra era), BuildTxWith BuildTx (Witness witctx era))
  -> Either
       CBOR.DecoderError
       (Witnessable thing (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era))
toAnyWitness :: forall era (thing :: WitnessableItem) witctx.
AlonzoEraOnwards era
-> (Witnessable thing (ShelleyLedgerEra era),
    BuildTxWith BuildTx (Witness witctx era))
-> Either
     DecoderError
     (Witnessable thing (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
toAnyWitness AlonzoEraOnwards era
_ (Witnessable thing (ShelleyLedgerEra era)
witnessable, BuildTxWith (Old.KeyWitness KeyWitnessInCtx witctx
_)) =
  (Witnessable thing (ShelleyLedgerEra era),
 AnyWitness (ShelleyLedgerEra era))
-> Either
     DecoderError
     (Witnessable thing (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
forall a. a -> Either DecoderError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Witnessable thing (ShelleyLedgerEra era)
witnessable, AnyWitness (ShelleyLedgerEra era)
forall era. AnyWitness era
AnyKeyWitnessPlaceholder)
toAnyWitness AlonzoEraOnwards era
eon (Witnessable thing (ShelleyLedgerEra era)
witnessable, BuildTxWith (Old.ScriptWitness ScriptWitnessInCtx witctx
_ oldSw :: ScriptWitness witctx era
oldSw@Old.SimpleScriptWitness{})) =
  AlonzoEraOnwards era
-> ScriptWitness witctx era
-> Witnessable thing (ShelleyLedgerEra era)
-> Either
     DecoderError
     (Witnessable thing (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
forall era witctx (thing :: WitnessableItem).
AlonzoEraOnwards era
-> ScriptWitness witctx era
-> Witnessable thing (ShelleyLedgerEra era)
-> Either
     DecoderError
     (Witnessable thing (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
convertToNewScriptWitness AlonzoEraOnwards era
eon ScriptWitness witctx era
oldSw Witnessable thing (ShelleyLedgerEra era)
witnessable
toAnyWitness AlonzoEraOnwards era
eon (Witnessable thing (ShelleyLedgerEra era)
witnessable, BuildTxWith (Old.ScriptWitness ScriptWitnessInCtx witctx
_ ScriptWitness witctx era
oldApiPlutusScriptWitness)) =
  AlonzoEraOnwards era
-> ScriptWitness witctx era
-> Witnessable thing (ShelleyLedgerEra era)
-> Either
     DecoderError
     (Witnessable thing (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
forall era witctx (thing :: WitnessableItem).
AlonzoEraOnwards era
-> ScriptWitness witctx era
-> Witnessable thing (ShelleyLedgerEra era)
-> Either
     DecoderError
     (Witnessable thing (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
convertToNewScriptWitness AlonzoEraOnwards era
eon ScriptWitness witctx era
oldApiPlutusScriptWitness Witnessable thing (ShelleyLedgerEra era)
witnessable

type family ToPlutusScriptPurpose witnessable = (purpose :: PlutusScriptPurpose) | purpose -> witnessable where
  ToPlutusScriptPurpose TxInItem = SpendingScript
  ToPlutusScriptPurpose CertItem = MintingScript
  ToPlutusScriptPurpose MintItem = CertifyingScript
  ToPlutusScriptPurpose WithdrawalItem = WithdrawingScript
  ToPlutusScriptPurpose VoterItem = ProposingScript
  ToPlutusScriptPurpose ProposalItem = VotingScript

convertToNewScriptWitness
  :: AlonzoEraOnwards era
  -> Old.ScriptWitness witctx era
  -> Witnessable thing (ShelleyLedgerEra era)
  -> Either
       CBOR.DecoderError
       (Witnessable thing (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era))
convertToNewScriptWitness :: forall era witctx (thing :: WitnessableItem).
AlonzoEraOnwards era
-> ScriptWitness witctx era
-> Witnessable thing (ShelleyLedgerEra era)
-> Either
     DecoderError
     (Witnessable thing (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
convertToNewScriptWitness AlonzoEraOnwards era
eon (Old.PlutusScriptWitness ScriptLanguageInEra lang era
_ PlutusScriptVersion lang
v PlutusScriptOrReferenceInput lang
scriptOrRefInput ScriptDatum witctx
datum ScriptRedeemer
scriptRedeemer ExecutionUnits
execUnits) Witnessable thing (ShelleyLedgerEra era)
witnessable = do
  let d :: PlutusScriptDatum (ToLedgerPlutusLanguage lang) 'SpendingScript
d = Witnessable thing (ShelleyLedgerEra era)
-> PlutusScriptVersion lang
-> ScriptDatum witctx
-> PlutusScriptDatum (ToLedgerPlutusLanguage lang) 'SpendingScript
forall (thing :: WitnessableItem) era lang witctx.
Witnessable thing era
-> PlutusScriptVersion lang
-> ScriptDatum witctx
-> PlutusScriptDatum (ToLedgerPlutusLanguage lang) 'SpendingScript
createPlutusScriptDatum Witnessable thing (ShelleyLedgerEra era)
witnessable PlutusScriptVersion lang
v ScriptDatum witctx
datum
  AnyWitness (ShelleyLedgerEra era)
newScriptWitness <-
    PlutusScriptVersion lang
-> (PlutusLanguage (ToLedgerPlutusLanguage lang) =>
    Either DecoderError (AnyWitness (ShelleyLedgerEra era)))
-> Either DecoderError (AnyWitness (ShelleyLedgerEra era))
forall lang a.
PlutusScriptVersion lang
-> (PlutusLanguage (ToLedgerPlutusLanguage lang) => a) -> a
obtainConstraints PlutusScriptVersion lang
v ((PlutusLanguage (ToLedgerPlutusLanguage lang) =>
  Either DecoderError (AnyWitness (ShelleyLedgerEra era)))
 -> Either DecoderError (AnyWitness (ShelleyLedgerEra era)))
-> (PlutusLanguage (ToLedgerPlutusLanguage lang) =>
    Either DecoderError (AnyWitness (ShelleyLedgerEra era)))
-> Either DecoderError (AnyWitness (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
      AlonzoEraOnwards era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptRedeemer
-> ExecutionUnits
-> PlutusScriptDatum (ToLedgerPlutusLanguage lang) 'SpendingScript
-> Either DecoderError (AnyWitness (ShelleyLedgerEra era))
forall era lang (purpose :: PlutusScriptPurpose).
PlutusLanguage (ToLedgerPlutusLanguage lang) =>
AlonzoEraOnwards era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptRedeemer
-> ExecutionUnits
-> PlutusScriptDatum (ToLedgerPlutusLanguage lang) purpose
-> Either DecoderError (AnyWitness (ShelleyLedgerEra era))
toNewPlutusScriptWitness
        AlonzoEraOnwards era
eon
        PlutusScriptVersion lang
v
        PlutusScriptOrReferenceInput lang
scriptOrRefInput
        ScriptRedeemer
scriptRedeemer
        ExecutionUnits
execUnits
        PlutusScriptDatum (ToLedgerPlutusLanguage lang) 'SpendingScript
d
  (Witnessable thing (ShelleyLedgerEra era),
 AnyWitness (ShelleyLedgerEra era))
-> Either
     DecoderError
     (Witnessable thing (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
forall a. a -> Either DecoderError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Witnessable thing (ShelleyLedgerEra era)
witnessable, AnyWitness (ShelleyLedgerEra era)
newScriptWitness)
convertToNewScriptWitness AlonzoEraOnwards era
eon (Old.SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
_ SimpleScriptOrReferenceInput SimpleScript'
scriptOrRefInput) Witnessable thing (ShelleyLedgerEra era)
witnessable =
  case SimpleScriptOrReferenceInput SimpleScript'
scriptOrRefInput of
    Old.SScript SimpleScript
simpleScript -> AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    Either
      DecoderError
      (Witnessable thing (ShelleyLedgerEra era),
       AnyWitness (ShelleyLedgerEra era)))
-> Either
     DecoderError
     (Witnessable thing (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
eon ((AlonzoEraOnwardsConstraints era =>
  Either
    DecoderError
    (Witnessable thing (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era)))
 -> Either
      DecoderError
      (Witnessable thing (ShelleyLedgerEra era),
       AnyWitness (ShelleyLedgerEra era)))
-> (AlonzoEraOnwardsConstraints era =>
    Either
      DecoderError
      (Witnessable thing (ShelleyLedgerEra era),
       AnyWitness (ShelleyLedgerEra era)))
-> Either
     DecoderError
     (Witnessable thing (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ do
      let timelock :: NativeScript (ShelleyLedgerEra era)
timelock = AlonzoEraOnwards era
-> SimpleScript -> NativeScript (ShelleyLedgerEra era)
forall era.
AlonzoEraOnwards era
-> SimpleScript -> NativeScript (ShelleyLedgerEra era)
convertTotimelock AlonzoEraOnwards era
eon SimpleScript
simpleScript
      (Witnessable thing (ShelleyLedgerEra era),
 AnyWitness (ShelleyLedgerEra era))
-> Either
     DecoderError
     (Witnessable thing (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
forall a. a -> Either DecoderError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Witnessable thing (ShelleyLedgerEra era)
witnessable, SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
-> AnyWitness (ShelleyLedgerEra era)
forall era. SimpleScriptOrReferenceInput era -> AnyWitness era
AnySimpleScriptWitness (SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
 -> AnyWitness (ShelleyLedgerEra era))
-> SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
-> AnyWitness (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ SimpleScript (ShelleyLedgerEra era)
-> SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
forall era. SimpleScript era -> SimpleScriptOrReferenceInput era
SScript (SimpleScript (ShelleyLedgerEra era)
 -> SimpleScriptOrReferenceInput (ShelleyLedgerEra era))
-> SimpleScript (ShelleyLedgerEra era)
-> SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ NativeScript (ShelleyLedgerEra era)
-> SimpleScript (ShelleyLedgerEra era)
forall era. EraScript era => NativeScript era -> SimpleScript era
SimpleScript NativeScript (ShelleyLedgerEra era)
timelock)
    Old.SReferenceScript TxIn
txIn ->
      (Witnessable thing (ShelleyLedgerEra era),
 AnyWitness (ShelleyLedgerEra era))
-> Either
     DecoderError
     (Witnessable thing (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
forall a. a -> Either DecoderError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Witnessable thing (ShelleyLedgerEra era)
witnessable, SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
-> AnyWitness (ShelleyLedgerEra era)
forall era. SimpleScriptOrReferenceInput era -> AnyWitness era
AnySimpleScriptWitness (SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
 -> AnyWitness (ShelleyLedgerEra era))
-> SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
-> AnyWitness (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ TxIn -> SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
forall era. TxIn -> SimpleScriptOrReferenceInput era
SReferenceScript TxIn
txIn)

convertTotimelock
  :: AlonzoEraOnwards era -> Old.SimpleScript -> L.NativeScript (ShelleyLedgerEra era)
convertTotimelock :: forall era.
AlonzoEraOnwards era
-> SimpleScript -> NativeScript (ShelleyLedgerEra era)
convertTotimelock AlonzoEraOnwards era
eon SimpleScript
s = AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    NativeScript (ShelleyLedgerEra era))
-> NativeScript (ShelleyLedgerEra era)
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
eon ((AlonzoEraOnwardsConstraints era =>
  NativeScript (ShelleyLedgerEra era))
 -> NativeScript (ShelleyLedgerEra era))
-> (AlonzoEraOnwardsConstraints era =>
    NativeScript (ShelleyLedgerEra era))
-> NativeScript (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ SimpleScript -> NativeScript (ShelleyLedgerEra era)
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
SimpleScript -> NativeScript era
Old.toAllegraTimelock SimpleScript
s

createPlutusScriptDatum
  :: Witnessable thing era
  -> Old.PlutusScriptVersion lang
  -> Old.ScriptDatum witctx
  -> PlutusScriptDatum (Old.ToLedgerPlutusLanguage lang) SpendingScript
createPlutusScriptDatum :: forall (thing :: WitnessableItem) era lang witctx.
Witnessable thing era
-> PlutusScriptVersion lang
-> ScriptDatum witctx
-> PlutusScriptDatum (ToLedgerPlutusLanguage lang) 'SpendingScript
createPlutusScriptDatum Witnessable thing era
missingContext PlutusScriptVersion lang
plutusVersion ScriptDatum witctx
oldDatum =
  case (Witnessable thing era
missingContext, ScriptDatum witctx
oldDatum) of
    (w :: Witnessable thing era
w@WitTxIn{}, d :: ScriptDatum witctx
d@Old.ScriptDatumForTxIn{}) -> Witnessable 'TxInItem era
-> PlutusScriptVersion lang
-> ScriptDatum WitCtxTxIn
-> PlutusScriptDatum
     (ToLedgerPlutusLanguage lang) (ToPlutusScriptPurpose 'TxInItem)
forall era lang.
Witnessable 'TxInItem era
-> PlutusScriptVersion lang
-> ScriptDatum WitCtxTxIn
-> PlutusScriptDatum
     (ToLedgerPlutusLanguage lang) (ToPlutusScriptPurpose 'TxInItem)
toPlutusScriptDatum Witnessable thing era
Witnessable 'TxInItem era
w PlutusScriptVersion lang
plutusVersion ScriptDatum witctx
ScriptDatum WitCtxTxIn
d
    (WitTxIn{}, ScriptDatum witctx
_) -> PlutusScriptDatum (ToLedgerPlutusLanguage lang) 'SpendingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
NoScriptDatum
    (WitMint{}, ScriptDatum witctx
_) -> PlutusScriptDatum (ToLedgerPlutusLanguage lang) 'SpendingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
NoScriptDatum
    (WitWithdrawal{}, ScriptDatum witctx
_) -> PlutusScriptDatum (ToLedgerPlutusLanguage lang) 'SpendingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
NoScriptDatum
    (WitProposal{}, ScriptDatum witctx
_) -> PlutusScriptDatum (ToLedgerPlutusLanguage lang) 'SpendingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
NoScriptDatum
    (WitVote{}, ScriptDatum witctx
_) -> PlutusScriptDatum (ToLedgerPlutusLanguage lang) 'SpendingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
NoScriptDatum
    (WitTxCert{}, ScriptDatum witctx
_) -> PlutusScriptDatum (ToLedgerPlutusLanguage lang) 'SpendingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
NoScriptDatum

toPlutusScriptDatum
  :: Witnessable TxInItem era
  -> Old.PlutusScriptVersion lang
  -> Old.ScriptDatum Old.WitCtxTxIn
  -> PlutusScriptDatum (Old.ToLedgerPlutusLanguage lang) (ToPlutusScriptPurpose TxInItem)
-- ^ Encapsulates CIP-69: V3 spending script datums are optional
toPlutusScriptDatum :: forall era lang.
Witnessable 'TxInItem era
-> PlutusScriptVersion lang
-> ScriptDatum WitCtxTxIn
-> PlutusScriptDatum
     (ToLedgerPlutusLanguage lang) (ToPlutusScriptPurpose 'TxInItem)
toPlutusScriptDatum WitTxIn{} PlutusScriptVersion lang
Old.PlutusScriptV3 (Old.ScriptDatumForTxIn Maybe ScriptRedeemer
r) = PlutusScriptDatumF 'PlutusV3 'SpendingScript
-> PlutusScriptDatum 'PlutusV3 'SpendingScript
forall (lang :: Language).
PlutusScriptDatumF lang 'SpendingScript
-> PlutusScriptDatum lang 'SpendingScript
SpendingScriptDatum Maybe ScriptRedeemer
PlutusScriptDatumF 'PlutusV3 'SpendingScript
r
-- \^ V2 and V1 spending script datums are required
toPlutusScriptDatum WitTxIn{} PlutusScriptVersion lang
Old.PlutusScriptV2 (Old.ScriptDatumForTxIn (Just ScriptRedeemer
r)) = PlutusScriptDatumF 'PlutusV2 'SpendingScript
-> PlutusScriptDatum 'PlutusV2 'SpendingScript
forall (lang :: Language).
PlutusScriptDatumF lang 'SpendingScript
-> PlutusScriptDatum lang 'SpendingScript
SpendingScriptDatum ScriptRedeemer
PlutusScriptDatumF 'PlutusV2 'SpendingScript
r
toPlutusScriptDatum WitTxIn{} PlutusScriptVersion lang
Old.PlutusScriptV1 (Old.ScriptDatumForTxIn (Just ScriptRedeemer
r)) = PlutusScriptDatumF 'PlutusV1 'SpendingScript
-> PlutusScriptDatum 'PlutusV1 'SpendingScript
forall (lang :: Language).
PlutusScriptDatumF lang 'SpendingScript
-> PlutusScriptDatum lang 'SpendingScript
SpendingScriptDatum ScriptRedeemer
PlutusScriptDatumF 'PlutusV1 'SpendingScript
r
-- \^ V2 and V3 scripts can have inline datums
toPlutusScriptDatum WitTxIn{} PlutusScriptVersion lang
Old.PlutusScriptV3 ScriptDatum WitCtxTxIn
Old.InlineScriptDatum = PlutusScriptDatum 'PlutusV3 'SpendingScript
PlutusScriptDatum
  (ToLedgerPlutusLanguage lang) (ToPlutusScriptPurpose 'TxInItem)
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
InlineDatum
toPlutusScriptDatum WitTxIn{} PlutusScriptVersion lang
Old.PlutusScriptV2 ScriptDatum WitCtxTxIn
Old.InlineScriptDatum = PlutusScriptDatum 'PlutusV2 'SpendingScript
PlutusScriptDatum
  (ToLedgerPlutusLanguage lang) (ToPlutusScriptPurpose 'TxInItem)
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
InlineDatum
-- \^ Everything else is not allowed. The old api does not prevent these invalid combinations.
-- The valid combinations are enforced in the PlutusScriptDatum type family within the
-- resultant PlutusScriptDatum GADT.
toPlutusScriptDatum WitTxIn{} PlutusScriptVersion lang
Old.PlutusScriptV1 ScriptDatum WitCtxTxIn
Old.InlineScriptDatum = PlutusScriptDatum 'PlutusV1 'SpendingScript
PlutusScriptDatum
  (ToLedgerPlutusLanguage lang) (ToPlutusScriptPurpose 'TxInItem)
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
NoScriptDatum
toPlutusScriptDatum WitTxIn{} PlutusScriptVersion lang
Old.PlutusScriptV1 (Old.ScriptDatumForTxIn Maybe ScriptRedeemer
Nothing) = PlutusScriptDatum 'PlutusV1 'SpendingScript
PlutusScriptDatum
  (ToLedgerPlutusLanguage lang) (ToPlutusScriptPurpose 'TxInItem)
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
NoScriptDatum
toPlutusScriptDatum WitTxIn{} PlutusScriptVersion lang
Old.PlutusScriptV2 (Old.ScriptDatumForTxIn Maybe ScriptRedeemer
Nothing) = PlutusScriptDatum 'PlutusV2 'SpendingScript
PlutusScriptDatum
  (ToLedgerPlutusLanguage lang) (ToPlutusScriptPurpose 'TxInItem)
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
NoScriptDatum

toNewPlutusScriptWitness
  :: forall era lang purpose
   . L.PlutusLanguage (Old.ToLedgerPlutusLanguage lang)
  => AlonzoEraOnwards era
  -> Old.PlutusScriptVersion lang
  -> Old.PlutusScriptOrReferenceInput lang
  -> ScriptRedeemer
  -> ExecutionUnits
  -> PlutusScriptDatum (Old.ToLedgerPlutusLanguage lang) purpose
  -> Either
       CBOR.DecoderError
       ( AnyWitness
           (ShelleyLedgerEra era)
       )
toNewPlutusScriptWitness :: forall era lang (purpose :: PlutusScriptPurpose).
PlutusLanguage (ToLedgerPlutusLanguage lang) =>
AlonzoEraOnwards era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptRedeemer
-> ExecutionUnits
-> PlutusScriptDatum (ToLedgerPlutusLanguage lang) purpose
-> Either DecoderError (AnyWitness (ShelleyLedgerEra era))
toNewPlutusScriptWitness AlonzoEraOnwards era
eon PlutusScriptVersion lang
l (Old.PScript (Old.PlutusScriptSerialised ShortByteString
scriptShortBs)) ScriptRedeemer
scriptRedeemer ExecutionUnits
execUnits PlutusScriptDatum (ToLedgerPlutusLanguage lang) purpose
datum = do
  let protocolVersion :: Version
protocolVersion = AlonzoEraOnwards era -> Version
forall era. AlonzoEraOnwards era -> Version
getVersion AlonzoEraOnwards era
eon
      plutusScript :: Plutus (ToLedgerPlutusLanguage lang)
plutusScript = PlutusBinary -> Plutus (ToLedgerPlutusLanguage lang)
forall (l :: Language). PlutusBinary -> Plutus l
L.Plutus (PlutusBinary -> Plutus (ToLedgerPlutusLanguage lang))
-> PlutusBinary -> Plutus (ToLedgerPlutusLanguage lang)
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
L.PlutusBinary ShortByteString
scriptShortBs

  case forall (l :: Language).
PlutusLanguage l =>
Version -> Plutus l -> Either ScriptDecodeError (PlutusRunnable l)
L.decodePlutusRunnable @(Old.ToLedgerPlutusLanguage lang) Version
protocolVersion Plutus (ToLedgerPlutusLanguage lang)
plutusScript of
    Left ScriptDecodeError
e ->
      DecoderError
-> Either DecoderError (AnyWitness (ShelleyLedgerEra era))
forall a b. a -> Either a b
Left (DecoderError
 -> Either DecoderError (AnyWitness (ShelleyLedgerEra era)))
-> DecoderError
-> Either DecoderError (AnyWitness (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> DecoderError
CBOR.DecoderErrorCustom Text
"PlutusLedgerApi.Common.ScriptDecodeError" (String -> Text
Text.pack (String -> Text) -> (Doc Any -> String) -> Doc Any -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> Text) -> Doc Any -> Text
forall a b. (a -> b) -> a -> b
$ ScriptDecodeError -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. ScriptDecodeError -> Doc ann
pretty ScriptDecodeError
e)
    Right PlutusRunnable (ToLedgerPlutusLanguage lang)
plutusScriptRunnable ->
      AnyWitness (ShelleyLedgerEra era)
-> Either DecoderError (AnyWitness (ShelleyLedgerEra era))
forall a. a -> Either DecoderError a
forall (m :: * -> *) a. Monad m => a -> m a
return
        (AnyWitness (ShelleyLedgerEra era)
 -> Either DecoderError (AnyWitness (ShelleyLedgerEra era)))
-> (PlutusScriptWitness
      (ToLedgerPlutusLanguage lang) purpose (ShelleyLedgerEra era)
    -> AnyWitness (ShelleyLedgerEra era))
-> PlutusScriptWitness
     (ToLedgerPlutusLanguage lang) purpose (ShelleyLedgerEra era)
-> Either DecoderError (AnyWitness (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptWitness
  (ToLedgerPlutusLanguage lang) purpose (ShelleyLedgerEra era)
-> AnyWitness (ShelleyLedgerEra era)
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
PlutusScriptWitness lang purpose era -> AnyWitness era
AnyPlutusScriptWitness
        (PlutusScriptWitness
   (ToLedgerPlutusLanguage lang) purpose (ShelleyLedgerEra era)
 -> Either DecoderError (AnyWitness (ShelleyLedgerEra era)))
-> PlutusScriptWitness
     (ToLedgerPlutusLanguage lang) purpose (ShelleyLedgerEra era)
-> Either DecoderError (AnyWitness (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ AlonzoEraOnwards era
-> SLanguage (ToLedgerPlutusLanguage lang)
-> PlutusRunnable (ToLedgerPlutusLanguage lang)
-> PlutusScriptDatum (ToLedgerPlutusLanguage lang) purpose
-> ScriptRedeemer
-> ExecutionUnits
-> PlutusScriptWitness
     (ToLedgerPlutusLanguage lang) purpose (ShelleyLedgerEra era)
forall era (plutuslang :: Language)
       (purpose :: PlutusScriptPurpose).
AlonzoEraOnwards era
-> SLanguage plutuslang
-> PlutusRunnable plutuslang
-> PlutusScriptDatum plutuslang purpose
-> ScriptRedeemer
-> ExecutionUnits
-> PlutusScriptWitness plutuslang purpose (ShelleyLedgerEra era)
mkPlutusScriptWitness
          AlonzoEraOnwards era
eon
          (PlutusScriptVersion lang -> SLanguage (ToLedgerPlutusLanguage lang)
forall lang.
PlutusScriptVersion lang -> SLanguage (ToLedgerPlutusLanguage lang)
toPlutusSLanguage PlutusScriptVersion lang
l)
          PlutusRunnable (ToLedgerPlutusLanguage lang)
plutusScriptRunnable
          PlutusScriptDatum (ToLedgerPlutusLanguage lang) purpose
datum
          ScriptRedeemer
scriptRedeemer
          ExecutionUnits
execUnits
toNewPlutusScriptWitness AlonzoEraOnwards era
_ PlutusScriptVersion lang
l (Old.PReferenceScript TxIn
refInput) ScriptRedeemer
scriptRedeemer ExecutionUnits
execUnits PlutusScriptDatum (ToLedgerPlutusLanguage lang) purpose
datum =
  AnyWitness (ShelleyLedgerEra era)
-> Either DecoderError (AnyWitness (ShelleyLedgerEra era))
forall a. a -> Either DecoderError a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyWitness (ShelleyLedgerEra era)
 -> Either DecoderError (AnyWitness (ShelleyLedgerEra era)))
-> (PlutusScriptWitness
      (ToLedgerPlutusLanguage lang) purpose (ShelleyLedgerEra era)
    -> AnyWitness (ShelleyLedgerEra era))
-> PlutusScriptWitness
     (ToLedgerPlutusLanguage lang) purpose (ShelleyLedgerEra era)
-> Either DecoderError (AnyWitness (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptWitness
  (ToLedgerPlutusLanguage lang) purpose (ShelleyLedgerEra era)
-> AnyWitness (ShelleyLedgerEra era)
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
PlutusScriptWitness lang purpose era -> AnyWitness era
AnyPlutusScriptWitness (PlutusScriptWitness
   (ToLedgerPlutusLanguage lang) purpose (ShelleyLedgerEra era)
 -> Either DecoderError (AnyWitness (ShelleyLedgerEra era)))
-> PlutusScriptWitness
     (ToLedgerPlutusLanguage lang) purpose (ShelleyLedgerEra era)
-> Either DecoderError (AnyWitness (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
    SLanguage (ToLedgerPlutusLanguage lang)
-> PlutusScriptOrReferenceInput
     (ToLedgerPlutusLanguage lang) (ShelleyLedgerEra era)
-> PlutusScriptDatum (ToLedgerPlutusLanguage lang) purpose
-> ScriptRedeemer
-> ExecutionUnits
-> PlutusScriptWitness
     (ToLedgerPlutusLanguage lang) purpose (ShelleyLedgerEra era)
forall (lang :: Language) era (purpose :: PlutusScriptPurpose).
SLanguage lang
-> PlutusScriptOrReferenceInput lang era
-> PlutusScriptDatum lang purpose
-> ScriptRedeemer
-> ExecutionUnits
-> PlutusScriptWitness lang purpose era
PlutusScriptWitness (PlutusScriptVersion lang -> SLanguage (ToLedgerPlutusLanguage lang)
forall lang.
PlutusScriptVersion lang -> SLanguage (ToLedgerPlutusLanguage lang)
toPlutusSLanguage PlutusScriptVersion lang
l) (TxIn
-> PlutusScriptOrReferenceInput
     (ToLedgerPlutusLanguage lang) (ShelleyLedgerEra era)
forall (lang :: Language) era.
TxIn -> PlutusScriptOrReferenceInput lang era
PReferenceScript TxIn
refInput) PlutusScriptDatum (ToLedgerPlutusLanguage lang) purpose
datum ScriptRedeemer
scriptRedeemer ExecutionUnits
execUnits

-- | When it comes to using plutus scripts we need to provide
-- the following to the tx:
--
-- 1. The redeemer pointer map
-- 2. The set of plutus languages in use
-- 3. The set of plutus scripts in use (present in the t)
-- 4. The datum map
legacyWitnessConversion
  :: AlonzoEraOnwards era
  -> [(Witnessable witnessable (ShelleyLedgerEra era), BuildTxWith BuildTx (Witness ctx era))]
  -> Either
       CBOR.DecoderError
       [(Witnessable witnessable (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era))]
legacyWitnessConversion :: forall era (witnessable :: WitnessableItem) ctx.
AlonzoEraOnwards era
-> [(Witnessable witnessable (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness ctx era))]
-> Either
     DecoderError
     [(Witnessable witnessable (ShelleyLedgerEra era),
       AnyWitness (ShelleyLedgerEra era))]
legacyWitnessConversion AlonzoEraOnwards era
eon = ((Witnessable witnessable (ShelleyLedgerEra era),
  BuildTxWith BuildTx (Witness ctx era))
 -> Either
      DecoderError
      (Witnessable witnessable (ShelleyLedgerEra era),
       AnyWitness (ShelleyLedgerEra era)))
-> [(Witnessable witnessable (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness ctx era))]
-> Either
     DecoderError
     [(Witnessable witnessable (ShelleyLedgerEra era),
       AnyWitness (ShelleyLedgerEra era))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (AlonzoEraOnwards era
-> (Witnessable witnessable (ShelleyLedgerEra era),
    BuildTxWith BuildTx (Witness ctx era))
-> Either
     DecoderError
     (Witnessable witnessable (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
forall era (thing :: WitnessableItem) witctx.
AlonzoEraOnwards era
-> (Witnessable thing (ShelleyLedgerEra era),
    BuildTxWith BuildTx (Witness witctx era))
-> Either
     DecoderError
     (Witnessable thing (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
toAnyWitness AlonzoEraOnwards era
eon)

legacyWitnessToScriptRequirements
  :: AlonzoEraOnwards era
  -> [(Witnessable witnessable (ShelleyLedgerEra era), BuildTxWith BuildTx (Witness ctx era))]
  -> Either CBOR.DecoderError (TxScriptWitnessRequirements (ShelleyLedgerEra era))
legacyWitnessToScriptRequirements :: forall era (witnessable :: WitnessableItem) ctx.
AlonzoEraOnwards era
-> [(Witnessable witnessable (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness ctx era))]
-> Either
     DecoderError (TxScriptWitnessRequirements (ShelleyLedgerEra era))
legacyWitnessToScriptRequirements AlonzoEraOnwards era
eon [(Witnessable witnessable (ShelleyLedgerEra era),
  BuildTxWith BuildTx (Witness ctx era))]
wits = do
  [(Witnessable witnessable (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
r <- AlonzoEraOnwards era
-> [(Witnessable witnessable (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness ctx era))]
-> Either
     DecoderError
     [(Witnessable witnessable (ShelleyLedgerEra era),
       AnyWitness (ShelleyLedgerEra era))]
forall era (witnessable :: WitnessableItem) ctx.
AlonzoEraOnwards era
-> [(Witnessable witnessable (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness ctx era))]
-> Either
     DecoderError
     [(Witnessable witnessable (ShelleyLedgerEra era),
       AnyWitness (ShelleyLedgerEra era))]
legacyWitnessConversion AlonzoEraOnwards era
eon [(Witnessable witnessable (ShelleyLedgerEra era),
  BuildTxWith BuildTx (Witness ctx era))]
wits
  TxScriptWitnessRequirements (ShelleyLedgerEra era)
-> Either
     DecoderError (TxScriptWitnessRequirements (ShelleyLedgerEra era))
forall a. a -> Either DecoderError a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxScriptWitnessRequirements (ShelleyLedgerEra era)
 -> Either
      DecoderError (TxScriptWitnessRequirements (ShelleyLedgerEra era)))
-> TxScriptWitnessRequirements (ShelleyLedgerEra era)
-> Either
     DecoderError (TxScriptWitnessRequirements (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ AlonzoEraOnwards era
-> [(Witnessable witnessable (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> TxScriptWitnessRequirements (ShelleyLedgerEra era)
forall era (witnessable :: WitnessableItem).
AlonzoEraOnwards era
-> [(Witnessable witnessable (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> TxScriptWitnessRequirements (ShelleyLedgerEra era)
getTxScriptWitnessesRequirements AlonzoEraOnwards era
eon [(Witnessable witnessable (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
r

-- Misc helpers

getVersion :: forall era. AlonzoEraOnwards era -> Version
getVersion :: forall era. AlonzoEraOnwards era -> Version
getVersion AlonzoEraOnwards era
eon = AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era => Version) -> Version
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
eon ((AlonzoEraOnwardsConstraints era => Version) -> Version)
-> (AlonzoEraOnwardsConstraints era => Version) -> Version
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Version
L.eraProtVerHigh @(ShelleyLedgerEra era)

obtainConstraints
  :: Old.PlutusScriptVersion lang
  -> (L.PlutusLanguage (Old.ToLedgerPlutusLanguage lang) => a)
  -> a
obtainConstraints :: forall lang a.
PlutusScriptVersion lang
-> (PlutusLanguage (ToLedgerPlutusLanguage lang) => a) -> a
obtainConstraints PlutusScriptVersion lang
v =
  case PlutusScriptVersion lang
v of
    PlutusScriptVersion lang
Old.PlutusScriptV1 -> a -> a
(PlutusLanguage (ToLedgerPlutusLanguage lang) => a) -> a
forall a. a -> a
id
    PlutusScriptVersion lang
Old.PlutusScriptV2 -> a -> a
(PlutusLanguage (ToLedgerPlutusLanguage lang) => a) -> a
forall a. a -> a
id
    PlutusScriptVersion lang
Old.PlutusScriptV3 -> a -> a
(PlutusLanguage (ToLedgerPlutusLanguage lang) => a) -> a
forall a. a -> a
id

toPlutusSLanguage
  :: Old.PlutusScriptVersion lang -> L.SLanguage (Old.ToLedgerPlutusLanguage lang)
toPlutusSLanguage :: forall lang.
PlutusScriptVersion lang -> SLanguage (ToLedgerPlutusLanguage lang)
toPlutusSLanguage = \case
  PlutusScriptVersion lang
Old.PlutusScriptV1 -> SLanguage 'PlutusV1
SLanguage (ToLedgerPlutusLanguage lang)
L.SPlutusV1
  PlutusScriptVersion lang
Old.PlutusScriptV2 -> SLanguage 'PlutusV2
SLanguage (ToLedgerPlutusLanguage lang)
L.SPlutusV2
  PlutusScriptVersion lang
Old.PlutusScriptV3 -> SLanguage 'PlutusV3
SLanguage (ToLedgerPlutusLanguage lang)
L.SPlutusV3