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

module Cardano.Ledger.Allegra.UTxO () where

import Cardano.Ledger.Allegra.Core
import Cardano.Ledger.Allegra.Era (AllegraEra)
import Cardano.Ledger.Allegra.State ()
import Cardano.Ledger.Shelley.UTxO (
  ShelleyScriptsNeeded (..),
  getConsumedCoin,
  getShelleyMinFeeTxUtxo,
  getShelleyScriptsNeeded,
  getShelleyWitsVKeyNeeded,
  shelleyConsumed,
  shelleyProducedValue,
 )
import Cardano.Ledger.State (EraUTxO (..), ScriptsProvided (..))
import Lens.Micro

instance EraUTxO AllegraEra where
  type ScriptsNeeded AllegraEra = ShelleyScriptsNeeded AllegraEra

  consumed :: forall (t :: TxLevel).
PParams AllegraEra
-> CertState AllegraEra
-> UTxO AllegraEra
-> TxBody t AllegraEra
-> Value AllegraEra
consumed = PParams AllegraEra
-> CertState AllegraEra
-> UTxO AllegraEra
-> TxBody t AllegraEra
-> Value AllegraEra
forall era (l :: TxLevel).
(EraUTxO era, EraCertState era) =>
PParams era
-> CertState era -> UTxO era -> TxBody l era -> Value era
shelleyConsumed

  getConsumedValue :: forall (t :: TxLevel).
PParams AllegraEra
-> (Credential Staking -> Maybe Coin)
-> (Credential DRepRole -> Maybe Coin)
-> UTxO AllegraEra
-> TxBody t AllegraEra
-> Value AllegraEra
getConsumedValue PParams AllegraEra
pp Credential Staking -> Maybe Coin
lookupKeyDeposit Credential DRepRole -> Maybe Coin
_ = PParams AllegraEra
-> (Credential Staking -> Maybe Coin)
-> UTxO AllegraEra
-> TxBody t AllegraEra
-> Coin
forall era (l :: TxLevel).
EraTxBody era =>
PParams era
-> (Credential Staking -> Maybe Coin)
-> UTxO era
-> TxBody l era
-> Coin
getConsumedCoin PParams AllegraEra
pp Credential Staking -> Maybe Coin
lookupKeyDeposit

  getProducedValue :: forall (t :: TxLevel).
PParams AllegraEra
-> (KeyHash StakePool -> Bool)
-> TxBody t AllegraEra
-> Value AllegraEra
getProducedValue PParams AllegraEra
pp KeyHash StakePool -> Bool
isRegPoolId TxBody t AllegraEra
txBody =
    TxBody t AllegraEra -> (TxBody TopTx AllegraEra -> Coin) -> Coin
forall (t :: TxLevel -> * -> *) era (l :: TxLevel) a.
(HasEraTxLevel t era, STxLevel l era ~ STxTopLevel l era) =>
t l era -> (t TopTx era -> a) -> a
withTopTxLevelOnly TxBody t AllegraEra
txBody (PParams AllegraEra
-> (KeyHash StakePool -> Bool)
-> TxBody TopTx AllegraEra
-> Value AllegraEra
forall era.
EraTxBody era =>
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody TopTx era -> Value era
shelleyProducedValue PParams AllegraEra
pp KeyHash StakePool -> Bool
isRegPoolId)

  getScriptsProvided :: forall (t :: TxLevel).
UTxO AllegraEra -> Tx t AllegraEra -> ScriptsProvided AllegraEra
getScriptsProvided UTxO AllegraEra
_ Tx t AllegraEra
tx = Map ScriptHash (Script AllegraEra) -> ScriptsProvided AllegraEra
forall era. Map ScriptHash (Script era) -> ScriptsProvided era
ScriptsProvided (Tx t AllegraEra
tx Tx t AllegraEra
-> Getting
     (Map ScriptHash (Timelock AllegraEra))
     (Tx t AllegraEra)
     (Map ScriptHash (Timelock AllegraEra))
-> Map ScriptHash (Timelock AllegraEra)
forall s a. s -> Getting a s a -> a
^. (TxWits AllegraEra
 -> Const
      (Map ScriptHash (Timelock AllegraEra)) (TxWits AllegraEra))
-> Tx t AllegraEra
-> Const (Map ScriptHash (Timelock AllegraEra)) (Tx t AllegraEra)
(ShelleyTxWits AllegraEra
 -> Const
      (Map ScriptHash (Timelock AllegraEra)) (ShelleyTxWits AllegraEra))
-> Tx t AllegraEra
-> Const (Map ScriptHash (Timelock AllegraEra)) (Tx t AllegraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l AllegraEra) (TxWits AllegraEra)
witsTxL ((ShelleyTxWits AllegraEra
  -> Const
       (Map ScriptHash (Timelock AllegraEra)) (ShelleyTxWits AllegraEra))
 -> Tx t AllegraEra
 -> Const (Map ScriptHash (Timelock AllegraEra)) (Tx t AllegraEra))
-> ((Map ScriptHash (Timelock AllegraEra)
     -> Const
          (Map ScriptHash (Timelock AllegraEra))
          (Map ScriptHash (Timelock AllegraEra)))
    -> ShelleyTxWits AllegraEra
    -> Const
         (Map ScriptHash (Timelock AllegraEra)) (ShelleyTxWits AllegraEra))
-> Getting
     (Map ScriptHash (Timelock AllegraEra))
     (Tx t AllegraEra)
     (Map ScriptHash (Timelock AllegraEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script AllegraEra)
 -> Const
      (Map ScriptHash (Timelock AllegraEra))
      (Map ScriptHash (Script AllegraEra)))
-> TxWits AllegraEra
-> Const (Map ScriptHash (Timelock AllegraEra)) (TxWits AllegraEra)
(Map ScriptHash (Timelock AllegraEra)
 -> Const
      (Map ScriptHash (Timelock AllegraEra))
      (Map ScriptHash (Timelock AllegraEra)))
-> ShelleyTxWits AllegraEra
-> Const
     (Map ScriptHash (Timelock AllegraEra)) (ShelleyTxWits AllegraEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits AllegraEra) (Map ScriptHash (Script AllegraEra))
scriptTxWitsL)

  getScriptsNeeded :: forall (t :: TxLevel).
UTxO AllegraEra -> TxBody t AllegraEra -> ScriptsNeeded AllegraEra
getScriptsNeeded = UTxO AllegraEra -> TxBody t AllegraEra -> ScriptsNeeded AllegraEra
UTxO AllegraEra
-> TxBody t AllegraEra -> ShelleyScriptsNeeded AllegraEra
forall era (l :: TxLevel).
EraTxBody era =>
UTxO era -> TxBody l era -> ShelleyScriptsNeeded era
getShelleyScriptsNeeded

  getScriptsHashesNeeded :: ScriptsNeeded AllegraEra -> Set ScriptHash
getScriptsHashesNeeded (ShelleyScriptsNeeded Set ScriptHash
scriptHashes) = Set ScriptHash
scriptHashes

  getWitsVKeyNeeded :: forall (t :: TxLevel).
CertState AllegraEra
-> UTxO AllegraEra -> TxBody t AllegraEra -> Set (KeyHash Witness)
getWitsVKeyNeeded = CertState AllegraEra
-> UTxO AllegraEra -> TxBody t AllegraEra -> Set (KeyHash Witness)
forall era (l :: TxLevel).
(EraTx era, ShelleyEraTxBody era, EraCertState era,
 STxLevel l era ~ STxTopLevel l era) =>
CertState era -> UTxO era -> TxBody l era -> Set (KeyHash Witness)
getShelleyWitsVKeyNeeded

  getMinFeeTxUtxo :: forall (t :: TxLevel).
PParams AllegraEra -> Tx t AllegraEra -> UTxO AllegraEra -> Coin
getMinFeeTxUtxo PParams AllegraEra
pp Tx t AllegraEra
tx UTxO AllegraEra
_ = PParams AllegraEra -> Tx t AllegraEra -> Coin
forall era (l :: TxLevel).
EraTx era =>
PParams era -> Tx l era -> Coin
getShelleyMinFeeTxUtxo PParams AllegraEra
pp Tx t AllegraEra
tx