{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Allegra.TxWits () where

import Cardano.Ledger.Allegra.Era (AllegraEra)
import Cardano.Ledger.Allegra.TxAuxData ()
import Cardano.Ledger.Core (EraScript (upgradeScript), EraTxWits (..))
import Cardano.Ledger.Shelley.TxWits (
  ShelleyTxWits (..),
  addrShelleyTxWitsL,
  bootAddrShelleyTxWitsL,
  scriptShelleyTxWitsL,
 )

instance EraTxWits AllegraEra where
  type TxWits AllegraEra = ShelleyTxWits AllegraEra

  mkBasicTxWits :: TxWits AllegraEra
mkBasicTxWits = TxWits AllegraEra
ShelleyTxWits AllegraEra
forall a. Monoid a => a
mempty

  addrTxWitsL :: Lens' (TxWits AllegraEra) (Set (WitVKey 'Witness))
addrTxWitsL = (Set (WitVKey 'Witness) -> f (Set (WitVKey 'Witness)))
-> TxWits AllegraEra -> f (TxWits AllegraEra)
(Set (WitVKey 'Witness) -> f (Set (WitVKey 'Witness)))
-> ShelleyTxWits AllegraEra -> f (ShelleyTxWits AllegraEra)
forall era.
EraScript era =>
Lens' (ShelleyTxWits era) (Set (WitVKey 'Witness))
Lens' (ShelleyTxWits AllegraEra) (Set (WitVKey 'Witness))
addrShelleyTxWitsL
  {-# INLINE addrTxWitsL #-}

  bootAddrTxWitsL :: Lens' (TxWits AllegraEra) (Set BootstrapWitness)
bootAddrTxWitsL = (Set BootstrapWitness -> f (Set BootstrapWitness))
-> TxWits AllegraEra -> f (TxWits AllegraEra)
(Set BootstrapWitness -> f (Set BootstrapWitness))
-> ShelleyTxWits AllegraEra -> f (ShelleyTxWits AllegraEra)
forall era.
EraScript era =>
Lens' (ShelleyTxWits era) (Set BootstrapWitness)
Lens' (ShelleyTxWits AllegraEra) (Set BootstrapWitness)
bootAddrShelleyTxWitsL
  {-# INLINE bootAddrTxWitsL #-}

  scriptTxWitsL :: Lens' (TxWits AllegraEra) (Map ScriptHash (Script AllegraEra))
scriptTxWitsL = (Map ScriptHash (Script AllegraEra)
 -> f (Map ScriptHash (Script AllegraEra)))
-> TxWits AllegraEra -> f (TxWits AllegraEra)
(Map ScriptHash (Script AllegraEra)
 -> f (Map ScriptHash (Script AllegraEra)))
-> ShelleyTxWits AllegraEra -> f (ShelleyTxWits AllegraEra)
forall era.
EraScript era =>
Lens' (ShelleyTxWits era) (Map ScriptHash (Script era))
Lens'
  (ShelleyTxWits AllegraEra) (Map ScriptHash (Script AllegraEra))
scriptShelleyTxWitsL
  {-# INLINE scriptTxWitsL #-}

  upgradeTxWits :: EraTxWits (PreviousEra AllegraEra) =>
TxWits (PreviousEra AllegraEra) -> TxWits AllegraEra
upgradeTxWits TxWits (PreviousEra AllegraEra)
stw =
    Set (WitVKey 'Witness)
-> Map ScriptHash (Script AllegraEra)
-> Set BootstrapWitness
-> ShelleyTxWits AllegraEra
forall era.
EraScript era =>
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWits era
ShelleyTxWits
      (ShelleyTxWits ShelleyEra -> Set (WitVKey 'Witness)
forall era.
EraScript era =>
ShelleyTxWits era -> Set (WitVKey 'Witness)
addrWits TxWits (PreviousEra AllegraEra)
ShelleyTxWits ShelleyEra
stw)
      (Script (PreviousEra AllegraEra) -> Script AllegraEra
Script (PreviousEra AllegraEra) -> Timelock AllegraEra
forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript (Script (PreviousEra AllegraEra) -> Timelock AllegraEra)
-> Map ScriptHash (Script (PreviousEra AllegraEra))
-> Map ScriptHash (Timelock AllegraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShelleyTxWits ShelleyEra -> Map ScriptHash (Script ShelleyEra)
forall era.
EraScript era =>
ShelleyTxWits era -> Map ScriptHash (Script era)
scriptWits TxWits (PreviousEra AllegraEra)
ShelleyTxWits ShelleyEra
stw)
      (ShelleyTxWits ShelleyEra -> Set BootstrapWitness
forall era.
EraScript era =>
ShelleyTxWits era -> Set BootstrapWitness
bootWits TxWits (PreviousEra AllegraEra)
ShelleyTxWits ShelleyEra
stw)