{-# 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
  , 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
_ (Witnessable thing (ShelleyLedgerEra era)
witnessable, BuildTxWith (Old.ScriptWitness ScriptWitnessInCtx witctx
_ Old.SimpleScriptWitness{})) =
  (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
_ 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))
convertToNewPlutusScriptWitness 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

convertToNewPlutusScriptWitness
  :: AlonzoEraOnwards era
  -> Old.ScriptWitness witctx era
  -> Witnessable thing (ShelleyLedgerEra era)
  -> Either
       CBOR.DecoderError
       (Witnessable thing (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era))
convertToNewPlutusScriptWitness :: forall era witctx (thing :: WitnessableItem).
AlonzoEraOnwards era
-> ScriptWitness witctx era
-> Witnessable thing (ShelleyLedgerEra era)
-> Either
     DecoderError
     (Witnessable thing (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
convertToNewPlutusScriptWitness 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)
convertToNewPlutusScriptWitness 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 -> 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. 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.eraProtVerLow @(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