{-# 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 :: PParams AllegraEra
-> CertState AllegraEra
-> UTxO AllegraEra
-> TxBody AllegraEra
-> Value AllegraEra
consumed = PParams AllegraEra
-> CertState AllegraEra
-> UTxO AllegraEra
-> TxBody AllegraEra
-> Value AllegraEra
forall era.
(EraUTxO era, EraCertState era) =>
PParams era -> CertState era -> UTxO era -> TxBody era -> Value era
shelleyConsumed

  getConsumedValue :: PParams AllegraEra
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO AllegraEra
-> TxBody 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 AllegraEra
-> Coin
forall era.
EraTxBody era =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> UTxO era
-> TxBody era
-> Coin
getConsumedCoin PParams AllegraEra
pp Credential 'Staking -> Maybe Coin
lookupKeyDeposit

  getProducedValue :: PParams AllegraEra
-> (KeyHash 'StakePool -> Bool)
-> TxBody AllegraEra
-> Value AllegraEra
getProducedValue = PParams AllegraEra
-> (KeyHash 'StakePool -> Bool)
-> TxBody AllegraEra
-> Value AllegraEra
forall era.
EraTxBody era =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> TxBody era -> Value era
shelleyProducedValue

  getScriptsProvided :: UTxO AllegraEra -> Tx AllegraEra -> ScriptsProvided AllegraEra
getScriptsProvided UTxO AllegraEra
_ Tx AllegraEra
tx = Map ScriptHash (Script AllegraEra) -> ScriptsProvided AllegraEra
forall era. Map ScriptHash (Script era) -> ScriptsProvided era
ScriptsProvided (Tx AllegraEra
ShelleyTx AllegraEra
tx ShelleyTx AllegraEra
-> Getting
     (Map ScriptHash (Timelock AllegraEra))
     (ShelleyTx 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 AllegraEra
-> Const (Map ScriptHash (Timelock AllegraEra)) (Tx AllegraEra)
(TxWits AllegraEra
 -> Const
      (Map ScriptHash (Timelock AllegraEra)) (TxWits AllegraEra))
-> ShelleyTx AllegraEra
-> Const
     (Map ScriptHash (Timelock AllegraEra)) (ShelleyTx AllegraEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx AllegraEra) (TxWits AllegraEra)
witsTxL ((TxWits AllegraEra
  -> Const
       (Map ScriptHash (Timelock AllegraEra)) (TxWits AllegraEra))
 -> ShelleyTx AllegraEra
 -> Const
      (Map ScriptHash (Timelock AllegraEra)) (ShelleyTx AllegraEra))
-> ((Map ScriptHash (Timelock AllegraEra)
     -> Const
          (Map ScriptHash (Timelock AllegraEra))
          (Map ScriptHash (Timelock AllegraEra)))
    -> TxWits AllegraEra
    -> Const
         (Map ScriptHash (Timelock AllegraEra)) (TxWits AllegraEra))
-> Getting
     (Map ScriptHash (Timelock AllegraEra))
     (ShelleyTx 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)))
-> TxWits AllegraEra
-> Const (Map ScriptHash (Timelock AllegraEra)) (TxWits AllegraEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits AllegraEra) (Map ScriptHash (Script AllegraEra))
scriptTxWitsL)

  getScriptsNeeded :: UTxO AllegraEra -> TxBody AllegraEra -> ScriptsNeeded AllegraEra
getScriptsNeeded = UTxO AllegraEra -> TxBody AllegraEra -> ScriptsNeeded AllegraEra
UTxO AllegraEra
-> TxBody AllegraEra -> ShelleyScriptsNeeded AllegraEra
forall era.
EraTxBody era =>
UTxO era -> TxBody era -> ShelleyScriptsNeeded era
getShelleyScriptsNeeded

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

  getWitsVKeyNeeded :: CertState AllegraEra
-> UTxO AllegraEra -> TxBody AllegraEra -> Set (KeyHash 'Witness)
getWitsVKeyNeeded = CertState AllegraEra
-> UTxO AllegraEra -> TxBody AllegraEra -> Set (KeyHash 'Witness)
forall era.
(EraTx era, ShelleyEraTxBody era, EraCertState era) =>
CertState era -> UTxO era -> TxBody era -> Set (KeyHash 'Witness)
getShelleyWitsVKeyNeeded

  getMinFeeTxUtxo :: PParams AllegraEra -> Tx AllegraEra -> UTxO AllegraEra -> Coin
getMinFeeTxUtxo PParams AllegraEra
pp Tx AllegraEra
tx UTxO AllegraEra
_ = PParams AllegraEra -> Tx AllegraEra -> Coin
forall era. EraTx era => PParams era -> Tx era -> Coin
getShelleyMinFeeTxUtxo PParams AllegraEra
pp Tx AllegraEra
tx