{-# 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.Crypto (Crypto, StandardCrypto)
import Cardano.Ledger.Shelley.TxWits (
  ShelleyTxWits (..),
  addrShelleyTxWitsL,
  bootAddrShelleyTxWitsL,
  scriptShelleyTxWitsL,
 )

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

  type TxWits (AllegraEra c) = ShelleyTxWits (AllegraEra c)

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

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

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

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

  upgradeTxWits :: EraTxWits (PreviousEra (AllegraEra c)) =>
TxWits (PreviousEra (AllegraEra c)) -> TxWits (AllegraEra c)
upgradeTxWits TxWits (PreviousEra (AllegraEra c))
stw =
    forall era.
EraScript era =>
Set (WitVKey 'Witness (EraCrypto era))
-> Map (ScriptHash (EraCrypto era)) (Script era)
-> Set (BootstrapWitness (EraCrypto era))
-> ShelleyTxWits era
ShelleyTxWits
      (forall era.
EraScript era =>
ShelleyTxWits era -> Set (WitVKey 'Witness (EraCrypto era))
addrWits TxWits (PreviousEra (AllegraEra c))
stw)
      (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.
EraScript era =>
ShelleyTxWits era -> Map (ScriptHash (EraCrypto era)) (Script era)
scriptWits TxWits (PreviousEra (AllegraEra c))
stw)
      (forall era.
EraScript era =>
ShelleyTxWits era -> Set (BootstrapWitness (EraCrypto era))
bootWits TxWits (PreviousEra (AllegraEra c))
stw)