{-# 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.Crypto (Crypto)
import Cardano.Ledger.Shelley.UTxO (
  ShelleyScriptsNeeded (..),
  getConsumedCoin,
  getShelleyMinFeeTxUtxo,
  getShelleyScriptsNeeded,
  getShelleyWitsVKeyNeeded,
  shelleyProducedValue,
 )
import Cardano.Ledger.UTxO (EraUTxO (..), ScriptsProvided (..))
import Lens.Micro

instance Crypto c => EraUTxO (AllegraEra c) where
  type ScriptsNeeded (AllegraEra c) = ShelleyScriptsNeeded (AllegraEra c)

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

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

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

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

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

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

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