{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Babbage.TxWits (
  module BabbageTxWitsReExport,
)
where

import Cardano.Ledger.Alonzo.TxWits (
  AlonzoEraTxWits (..),
  AlonzoTxWits (..),
  addrAlonzoTxWitsL,
  bootAddrAlonzoTxWitsL,
  datsAlonzoTxWitsL,
  rdmrsAlonzoTxWitsL,
  scriptAlonzoTxWitsL,
 )
import Cardano.Ledger.Alonzo.TxWits as BabbageTxWitsReExport (
  AlonzoEraTxWits (..),
  AlonzoTxWits (..),
  upgradeRedeemers,
  upgradeTxDats,
 )
import Cardano.Ledger.Babbage.Era (BabbageEra)
import Cardano.Ledger.Babbage.TxBody ()
import Cardano.Ledger.Core
import Cardano.Ledger.Crypto

instance Crypto c => EraTxWits (BabbageEra c) where
  {-# SPECIALIZE instance EraTxWits (BabbageEra StandardCrypto) #-}

  type TxWits (BabbageEra c) = AlonzoTxWits (BabbageEra c)

  mkBasicTxWits :: TxWits (BabbageEra c)
mkBasicTxWits = forall a. Monoid a => a
mempty

  addrTxWitsL :: Lens'
  (TxWits (BabbageEra c))
  (Set (WitVKey 'Witness (EraCrypto (BabbageEra c))))
addrTxWitsL = forall era.
AlonzoEraScript era =>
Lens' (AlonzoTxWits era) (Set (WitVKey 'Witness (EraCrypto era)))
addrAlonzoTxWitsL
  {-# INLINE addrTxWitsL #-}

  bootAddrTxWitsL :: Lens'
  (TxWits (BabbageEra c))
  (Set (BootstrapWitness (EraCrypto (BabbageEra c))))
bootAddrTxWitsL = forall era.
AlonzoEraScript era =>
Lens' (AlonzoTxWits era) (Set (BootstrapWitness (EraCrypto era)))
bootAddrAlonzoTxWitsL
  {-# INLINE bootAddrTxWitsL #-}

  scriptTxWitsL :: Lens'
  (TxWits (BabbageEra c))
  (Map
     (ScriptHash (EraCrypto (BabbageEra c))) (Script (BabbageEra c)))
scriptTxWitsL = forall era.
AlonzoEraScript era =>
Lens'
  (AlonzoTxWits era) (Map (ScriptHash (EraCrypto era)) (Script era))
scriptAlonzoTxWitsL
  {-# INLINE scriptTxWitsL #-}

  upgradeTxWits :: EraTxWits (PreviousEra (BabbageEra c)) =>
TxWits (PreviousEra (BabbageEra c)) -> TxWits (BabbageEra c)
upgradeTxWits TxWits (PreviousEra (BabbageEra c))
atw =
    AlonzoTxWits
      { txwitsVKey :: Set (WitVKey 'Witness (EraCrypto (BabbageEra c)))
txwitsVKey = forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (WitVKey 'Witness (EraCrypto era))
txwitsVKey TxWits (PreviousEra (BabbageEra c))
atw
      , txwitsBoot :: Set (BootstrapWitness (EraCrypto (BabbageEra c)))
txwitsBoot = forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (BootstrapWitness (EraCrypto era))
txwitsBoot TxWits (PreviousEra (BabbageEra c))
atw
      , txscripts :: Map (ScriptHash (EraCrypto (BabbageEra c))) (Script (BabbageEra c))
txscripts = forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Map (ScriptHash (EraCrypto era)) (Script era)
txscripts TxWits (PreviousEra (BabbageEra c))
atw
      , txdats :: TxDats (BabbageEra c)
txdats = forall era1 era2.
(Era era1, Era era2, EraCrypto era1 ~ EraCrypto era2) =>
TxDats era1 -> TxDats era2
upgradeTxDats (forall era. AlonzoEraScript era => AlonzoTxWits era -> TxDats era
txdats TxWits (PreviousEra (BabbageEra c))
atw)
      , txrdmrs :: Redeemers (BabbageEra c)
txrdmrs = forall era.
(AlonzoEraScript (PreviousEra era), AlonzoEraScript era) =>
Redeemers (PreviousEra era) -> Redeemers era
upgradeRedeemers (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Redeemers era
txrdmrs TxWits (PreviousEra (BabbageEra c))
atw)
      }

instance Crypto c => AlonzoEraTxWits (BabbageEra c) where
  {-# SPECIALIZE instance AlonzoEraTxWits (BabbageEra StandardCrypto) #-}

  datsTxWitsL :: Lens' (TxWits (BabbageEra c)) (TxDats (BabbageEra c))
datsTxWitsL = forall era.
AlonzoEraScript era =>
Lens' (AlonzoTxWits era) (TxDats era)
datsAlonzoTxWitsL
  {-# INLINE datsTxWitsL #-}

  rdmrsTxWitsL :: Lens' (TxWits (BabbageEra c)) (Redeemers (BabbageEra c))
rdmrsTxWitsL = forall era.
AlonzoEraScript era =>
Lens' (AlonzoTxWits era) (Redeemers era)
rdmrsAlonzoTxWitsL
  {-# INLINE rdmrsTxWitsL #-}