{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.Api.Experimental.Tx.Internal.Body
  ( extractAllIndexedPlutusScriptWitnesses
  )
where

import Cardano.Api.Era
import Cardano.Api.Experimental.Era
import Cardano.Api.Experimental.Plutus
import Cardano.Api.Plutus.Internal.Script
import Cardano.Api.Tx.Internal.Body

import Cardano.Binary qualified as CBOR

extractAllIndexedPlutusScriptWitnesses
  :: forall era
   . Era era
  -> TxBodyContent BuildTx era
  -> Either
       CBOR.DecoderError
       [AnyIndexedPlutusScriptWitness (LedgerEra era)]
extractAllIndexedPlutusScriptWitnesses :: forall era.
Era era
-> TxBodyContent BuildTx era
-> Either
     DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
extractAllIndexedPlutusScriptWitnesses Era era
era TxBodyContent BuildTx era
b = Era era
-> (EraCommonConstraints era =>
    Either
      DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> Either
     DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era =>
  Either
    DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)])
 -> Either
      DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> (EraCommonConstraints era =>
    Either
      DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> Either
     DecoderError [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$ do
  let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
      aeon :: AlonzoEraOnwards era
aeon = Era era -> AlonzoEraOnwards era
forall era. Era era -> AlonzoEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
      legacyTxInWits :: [(Witnessable 'TxInItem (ShelleyLedgerEra era),
  BuildTxWith BuildTx (Witness WitCtxTxIn era))]
legacyTxInWits = AlonzoEraOnwards era
-> TxIns BuildTx era
-> [(Witnessable 'TxInItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxTxIn era))]
forall era.
AlonzoEraOnwards era
-> TxIns BuildTx era
-> [(Witnessable 'TxInItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxTxIn era))]
extractWitnessableTxIns AlonzoEraOnwards era
aeon (TxIns BuildTx era
 -> [(Witnessable 'TxInItem (ShelleyLedgerEra era),
      BuildTxWith BuildTx (Witness WitCtxTxIn era))])
-> TxIns BuildTx era
-> [(Witnessable 'TxInItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxTxIn era))]
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx era -> TxIns BuildTx era
forall build era. TxBodyContent build era -> TxIns build era
txIns TxBodyContent BuildTx era
b
      legacyCertWits :: [(Witnessable 'CertItem (ShelleyLedgerEra era),
  BuildTxWith BuildTx (Witness WitCtxStake era))]
legacyCertWits = AlonzoEraOnwards era
-> TxCertificates BuildTx era
-> [(Witnessable 'CertItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxStake era))]
forall era.
AlonzoEraOnwards era
-> TxCertificates BuildTx era
-> [(Witnessable 'CertItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxStake era))]
extractWitnessableCertificates AlonzoEraOnwards era
aeon (TxCertificates BuildTx era
 -> [(Witnessable 'CertItem (ShelleyLedgerEra era),
      BuildTxWith BuildTx (Witness WitCtxStake era))])
-> TxCertificates BuildTx era
-> [(Witnessable 'CertItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxStake era))]
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx era -> TxCertificates BuildTx era
forall build era.
TxBodyContent build era -> TxCertificates build era
txCertificates TxBodyContent BuildTx era
b
      legacyMintWits :: [(Witnessable 'MintItem (ShelleyLedgerEra era),
  BuildTxWith BuildTx (Witness WitCtxMint era))]
legacyMintWits = AlonzoEraOnwards era
-> TxMintValue BuildTx era
-> [(Witnessable 'MintItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxMint era))]
forall era build.
AlonzoEraOnwards era
-> TxMintValue build era
-> [(Witnessable 'MintItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxMint era))]
extractWitnessableMints AlonzoEraOnwards era
aeon (TxMintValue BuildTx era
 -> [(Witnessable 'MintItem (ShelleyLedgerEra era),
      BuildTxWith BuildTx (Witness WitCtxMint era))])
-> TxMintValue BuildTx era
-> [(Witnessable 'MintItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxMint era))]
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx era -> TxMintValue BuildTx era
forall build era. TxBodyContent build era -> TxMintValue build era
txMintValue TxBodyContent BuildTx era
b
      [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
  BuildTxWith BuildTx (Witness WitCtxStake era))]
proposalWits
        :: [(Witnessable ProposalItem (ShelleyLedgerEra era), BuildTxWith BuildTx (Witness WitCtxStake era))] =
          (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era
 -> [(Witnessable 'ProposalItem (LedgerEra era),
      BuildTxWith BuildTx (Witness WitCtxStake era))])
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era
    -> [(Witnessable 'ProposalItem (LedgerEra era),
         BuildTxWith BuildTx (Witness WitCtxStake era))])
-> ShelleyBasedEra era
-> [(Witnessable 'ProposalItem (LedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxStake era))]
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
            ([(Witnessable 'ProposalItem (LedgerEra era),
  BuildTxWith BuildTx (Witness WitCtxStake era))]
-> ShelleyToBabbageEra era
-> [(Witnessable 'ProposalItem (LedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxStake era))]
forall a b. a -> b -> a
const [])
            (ConwayEraOnwards era
-> Maybe
     (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
-> [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxStake era))]
forall era (eon :: * -> *).
ConwayEraOnwards era
-> Maybe (Featured eon era (TxProposalProcedures BuildTx era))
-> [(Witnessable 'ProposalItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxStake era))]
`extractWitnessableProposals` TxBodyContent BuildTx era
-> Maybe
     (Featured ConwayEraOnwards era (TxProposalProcedures BuildTx era))
forall build era.
TxBodyContent build era
-> Maybe
     (Featured ConwayEraOnwards era (TxProposalProcedures build era))
txProposalProcedures TxBodyContent BuildTx era
b)
            ShelleyBasedEra era
sbe
      legacyWithdrawalWits :: [(Witnessable 'WithdrawalItem (ShelleyLedgerEra era),
  BuildTxWith BuildTx (Witness WitCtxStake era))]
legacyWithdrawalWits = AlonzoEraOnwards era
-> TxWithdrawals BuildTx era
-> [(Witnessable 'WithdrawalItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxStake era))]
forall era.
AlonzoEraOnwards era
-> TxWithdrawals BuildTx era
-> [(Witnessable 'WithdrawalItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxStake era))]
extractWitnessableWithdrawals AlonzoEraOnwards era
aeon (TxWithdrawals BuildTx era
 -> [(Witnessable 'WithdrawalItem (ShelleyLedgerEra era),
      BuildTxWith BuildTx (Witness WitCtxStake era))])
-> TxWithdrawals BuildTx era
-> [(Witnessable 'WithdrawalItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxStake era))]
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx era -> TxWithdrawals BuildTx era
forall build era.
TxBodyContent build era -> TxWithdrawals build era
txWithdrawals TxBodyContent BuildTx era
b
      [(Witnessable 'VoterItem (ShelleyLedgerEra era),
  BuildTxWith BuildTx (Witness WitCtxStake era))]
legacyVoteWits
        :: [(Witnessable VoterItem (ShelleyLedgerEra era), BuildTxWith BuildTx (Witness WitCtxStake era))] =
          (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era
 -> [(Witnessable 'VoterItem (LedgerEra era),
      BuildTxWith BuildTx (Witness WitCtxStake era))])
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era
    -> [(Witnessable 'VoterItem (LedgerEra era),
         BuildTxWith BuildTx (Witness WitCtxStake era))])
-> ShelleyBasedEra era
-> [(Witnessable 'VoterItem (LedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxStake era))]
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
            ([(Witnessable 'VoterItem (LedgerEra era),
  BuildTxWith BuildTx (Witness WitCtxStake era))]
-> ShelleyToBabbageEra era
-> [(Witnessable 'VoterItem (LedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxStake era))]
forall a b. a -> b -> a
const [])
            (ConwayEraOnwards era
-> Maybe
     (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era))
-> [(Witnessable 'VoterItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxStake era))]
forall era (eon :: * -> *).
ConwayEraOnwards era
-> Maybe (Featured eon era (TxVotingProcedures BuildTx era))
-> [(Witnessable 'VoterItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxStake era))]
`extractWitnessableVotes` TxBodyContent BuildTx era
-> Maybe
     (Featured ConwayEraOnwards era (TxVotingProcedures BuildTx era))
forall build era.
TxBodyContent build era
-> Maybe
     (Featured ConwayEraOnwards era (TxVotingProcedures build era))
txVotingProcedures TxBodyContent BuildTx era
b)
            ShelleyBasedEra era
sbe

  txInWits <- AlonzoEraOnwards era
-> [(Witnessable 'TxInItem (ShelleyLedgerEra era),
     BuildTxWith BuildTx (Witness WitCtxTxIn era))]
-> Either
     DecoderError
     [(Witnessable 'TxInItem (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
aeon [(Witnessable 'TxInItem (ShelleyLedgerEra era),
  BuildTxWith BuildTx (Witness WitCtxTxIn era))]
legacyTxInWits
  let indexedScriptTxInWits = AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
aeon ((AlonzoEraOnwardsConstraints era =>
  [AnyIndexedPlutusScriptWitness (LedgerEra era)])
 -> [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> (AlonzoEraOnwardsConstraints era =>
    [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$ [(Witnessable 'TxInItem (LedgerEra era),
  AnyWitness (LedgerEra era))]
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era (witnessable :: WitnessableItem).
AlonzoEraScript era =>
[(Witnessable witnessable era, AnyWitness era)]
-> [AnyIndexedPlutusScriptWitness era]
createIndexedPlutusScriptWitnesses [(Witnessable 'TxInItem (LedgerEra era),
  AnyWitness (LedgerEra era))]
txInWits

  certWits <- legacyWitnessConversion aeon legacyCertWits
  let indexedCertScriptWits = AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
aeon ((AlonzoEraOnwardsConstraints era =>
  [AnyIndexedPlutusScriptWitness (LedgerEra era)])
 -> [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> (AlonzoEraOnwardsConstraints era =>
    [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$ [(Witnessable 'CertItem (LedgerEra era),
  AnyWitness (LedgerEra era))]
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era (witnessable :: WitnessableItem).
AlonzoEraScript era =>
[(Witnessable witnessable era, AnyWitness era)]
-> [AnyIndexedPlutusScriptWitness era]
createIndexedPlutusScriptWitnesses [(Witnessable 'CertItem (LedgerEra era),
  AnyWitness (LedgerEra era))]
certWits

  mintWits <- legacyWitnessConversion aeon legacyMintWits
  let indexedMintScriptWits = AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
aeon ((AlonzoEraOnwardsConstraints era =>
  [AnyIndexedPlutusScriptWitness (LedgerEra era)])
 -> [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> (AlonzoEraOnwardsConstraints era =>
    [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$ [(Witnessable 'MintItem (LedgerEra era),
  AnyWitness (LedgerEra era))]
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era (witnessable :: WitnessableItem).
AlonzoEraScript era =>
[(Witnessable witnessable era, AnyWitness era)]
-> [AnyIndexedPlutusScriptWitness era]
createIndexedPlutusScriptWitnesses [(Witnessable 'MintItem (LedgerEra era),
  AnyWitness (LedgerEra era))]
mintWits

  withdrawalWits <- legacyWitnessConversion aeon legacyWithdrawalWits
  let indexedWithdrawalScriptWits = AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
aeon ((AlonzoEraOnwardsConstraints era =>
  [AnyIndexedPlutusScriptWitness (LedgerEra era)])
 -> [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> (AlonzoEraOnwardsConstraints era =>
    [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$ [(Witnessable 'WithdrawalItem (LedgerEra era),
  AnyWitness (LedgerEra era))]
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era (witnessable :: WitnessableItem).
AlonzoEraScript era =>
[(Witnessable witnessable era, AnyWitness era)]
-> [AnyIndexedPlutusScriptWitness era]
createIndexedPlutusScriptWitnesses [(Witnessable 'WithdrawalItem (LedgerEra era),
  AnyWitness (LedgerEra era))]
withdrawalWits

  proposalScriptWits <- legacyWitnessConversion aeon proposalWits
  let indexedProposalScriptWits = AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
aeon ((AlonzoEraOnwardsConstraints era =>
  [AnyIndexedPlutusScriptWitness (LedgerEra era)])
 -> [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> (AlonzoEraOnwardsConstraints era =>
    [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$ [(Witnessable 'ProposalItem (LedgerEra era),
  AnyWitness (LedgerEra era))]
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era (witnessable :: WitnessableItem).
AlonzoEraScript era =>
[(Witnessable witnessable era, AnyWitness era)]
-> [AnyIndexedPlutusScriptWitness era]
createIndexedPlutusScriptWitnesses [(Witnessable 'ProposalItem (LedgerEra era),
  AnyWitness (LedgerEra era))]
proposalScriptWits

  voteWits <- legacyWitnessConversion aeon legacyVoteWits
  let indexedVoteScriptWits = AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
aeon ((AlonzoEraOnwardsConstraints era =>
  [AnyIndexedPlutusScriptWitness (LedgerEra era)])
 -> [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> (AlonzoEraOnwardsConstraints era =>
    [AnyIndexedPlutusScriptWitness (LedgerEra era)])
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall a b. (a -> b) -> a -> b
$ [(Witnessable 'VoterItem (LedgerEra era),
  AnyWitness (LedgerEra era))]
-> [AnyIndexedPlutusScriptWitness (LedgerEra era)]
forall era (witnessable :: WitnessableItem).
AlonzoEraScript era =>
[(Witnessable witnessable era, AnyWitness era)]
-> [AnyIndexedPlutusScriptWitness era]
createIndexedPlutusScriptWitnesses [(Witnessable 'VoterItem (LedgerEra era),
  AnyWitness (LedgerEra era))]
voteWits
  return $
    mconcat
      [ indexedScriptTxInWits
      , indexedMintScriptWits
      , indexedCertScriptWits
      , indexedWithdrawalScriptWits
      , indexedProposalScriptWits
      , indexedVoteScriptWits
      ]