{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Dijkstra.UTxO (
  getDijkstraScriptsNeeded,
) where

import Cardano.Ledger.Alonzo.UTxO (
  AlonzoEraUTxO (..),
  AlonzoScriptsNeeded (..),
  getAlonzoScriptsHashesNeeded,
  zipAsIxItem,
 )
import Cardano.Ledger.Babbage.UTxO (
  getBabbageScriptsProvided,
  getBabbageSpendingDatum,
  getBabbageSupplementalDataHashes,
 )
import Cardano.Ledger.Conway.UTxO (
  conwayConsumed,
  conwayProducedValue,
  getConwayMinFeeTxUtxo,
  getConwayScriptsNeeded,
  getConwayWitsVKeyNeeded,
 )
import Cardano.Ledger.Credential (credScriptHash)
import Cardano.Ledger.Dijkstra.Core (AsIxItem (..), EraTxBody (..))
import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
import Cardano.Ledger.Dijkstra.Scripts (DijkstraEraScript (..), pattern GuardingPurpose)
import Cardano.Ledger.Dijkstra.State (EraUTxO (..), UTxO)
import Cardano.Ledger.Dijkstra.State.CertState ()
import Cardano.Ledger.Dijkstra.Tx ()
import Cardano.Ledger.Dijkstra.TxBody (DijkstraEraTxBody (..))
import Cardano.Ledger.Mary.UTxO (getConsumedMaryValue)
import Data.Maybe (catMaybes)
import Lens.Micro ((^.))

instance EraUTxO DijkstraEra where
  type ScriptsNeeded DijkstraEra = AlonzoScriptsNeeded DijkstraEra

  consumed :: PParams DijkstraEra
-> CertState DijkstraEra
-> UTxO DijkstraEra
-> TxBody DijkstraEra
-> Value DijkstraEra
consumed = PParams DijkstraEra
-> CertState DijkstraEra
-> UTxO DijkstraEra
-> TxBody DijkstraEra
-> Value DijkstraEra
forall era.
(EraUTxO era, ConwayEraCertState era) =>
PParams era -> CertState era -> UTxO era -> TxBody era -> Value era
conwayConsumed

  getConsumedValue :: PParams DijkstraEra
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO DijkstraEra
-> TxBody DijkstraEra
-> Value DijkstraEra
getConsumedValue = PParams DijkstraEra
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO DijkstraEra
-> TxBody DijkstraEra
-> Value DijkstraEra
PParams DijkstraEra
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO DijkstraEra
-> TxBody DijkstraEra
-> MaryValue
forall era.
(MaryEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody era
-> MaryValue
getConsumedMaryValue

  getProducedValue :: PParams DijkstraEra
-> (KeyHash 'StakePool -> Bool)
-> TxBody DijkstraEra
-> Value DijkstraEra
getProducedValue = PParams DijkstraEra
-> (KeyHash 'StakePool -> Bool)
-> TxBody DijkstraEra
-> Value DijkstraEra
forall era.
(ConwayEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> TxBody era -> Value era
conwayProducedValue

  getScriptsProvided :: UTxO DijkstraEra -> Tx DijkstraEra -> ScriptsProvided DijkstraEra
getScriptsProvided = UTxO DijkstraEra -> Tx DijkstraEra -> ScriptsProvided DijkstraEra
forall era.
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx era -> ScriptsProvided era
getBabbageScriptsProvided

  getScriptsNeeded :: UTxO DijkstraEra -> TxBody DijkstraEra -> ScriptsNeeded DijkstraEra
getScriptsNeeded = UTxO DijkstraEra -> TxBody DijkstraEra -> ScriptsNeeded DijkstraEra
UTxO DijkstraEra
-> TxBody DijkstraEra -> AlonzoScriptsNeeded DijkstraEra
forall era.
(DijkstraEraTxBody era, DijkstraEraScript era) =>
UTxO era -> TxBody era -> AlonzoScriptsNeeded era
getDijkstraScriptsNeeded

  getScriptsHashesNeeded :: ScriptsNeeded DijkstraEra -> Set ScriptHash
getScriptsHashesNeeded = ScriptsNeeded DijkstraEra -> Set ScriptHash
AlonzoScriptsNeeded DijkstraEra -> Set ScriptHash
forall era. AlonzoScriptsNeeded era -> Set ScriptHash
getAlonzoScriptsHashesNeeded

  getWitsVKeyNeeded :: CertState DijkstraEra
-> UTxO DijkstraEra -> TxBody DijkstraEra -> Set (KeyHash 'Witness)
getWitsVKeyNeeded CertState DijkstraEra
_ = UTxO DijkstraEra -> TxBody DijkstraEra -> Set (KeyHash 'Witness)
forall era.
(EraTx era, ConwayEraTxBody era) =>
UTxO era -> TxBody era -> Set (KeyHash 'Witness)
getConwayWitsVKeyNeeded

  getMinFeeTxUtxo :: PParams DijkstraEra -> Tx DijkstraEra -> UTxO DijkstraEra -> Coin
getMinFeeTxUtxo = PParams DijkstraEra -> Tx DijkstraEra -> UTxO DijkstraEra -> Coin
forall era.
(EraTx era, BabbageEraTxBody era) =>
PParams era -> Tx era -> UTxO era -> Coin
getConwayMinFeeTxUtxo

getDijkstraScriptsNeeded ::
  (DijkstraEraTxBody era, DijkstraEraScript era) => UTxO era -> TxBody era -> AlonzoScriptsNeeded era
getDijkstraScriptsNeeded :: forall era.
(DijkstraEraTxBody era, DijkstraEraScript era) =>
UTxO era -> TxBody era -> AlonzoScriptsNeeded era
getDijkstraScriptsNeeded UTxO era
utxo TxBody era
txb =
  UTxO era -> TxBody era -> AlonzoScriptsNeeded era
forall era.
ConwayEraTxBody era =>
UTxO era -> TxBody era -> AlonzoScriptsNeeded era
getConwayScriptsNeeded UTxO era
utxo TxBody era
txb
    AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall a. Semigroup a => a -> a -> a
<> AlonzoScriptsNeeded era
guardingScriptsNeeded
  where
    guardingScriptsNeeded :: AlonzoScriptsNeeded era
guardingScriptsNeeded = [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall era.
[(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded ([(PlutusPurpose AsIxItem era, ScriptHash)]
 -> AlonzoScriptsNeeded era)
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall a b. (a -> b) -> a -> b
$
      [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
 -> [(PlutusPurpose AsIxItem era, ScriptHash)])
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
        OSet (Credential 'Guard)
-> (AsIxItem Word32 (Credential 'Guard)
    -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
forall (f :: * -> *) it c.
Foldable f =>
f it -> (AsIxItem Word32 it -> c) -> [c]
zipAsIxItem (TxBody era
txb TxBody era
-> Getting
     (OSet (Credential 'Guard)) (TxBody era) (OSet (Credential 'Guard))
-> OSet (Credential 'Guard)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (Credential 'Guard)) (TxBody era) (OSet (Credential 'Guard))
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody era) (OSet (Credential 'Guard))
Lens' (TxBody era) (OSet (Credential 'Guard))
guardsTxBodyL) ((AsIxItem Word32 (Credential 'Guard)
  -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
 -> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)])
-> (AsIxItem Word32 (Credential 'Guard)
    -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
          \(AsIxItem Word32
idx Credential 'Guard
cred) -> (\ScriptHash
sh -> (AsIxItem Word32 ScriptHash -> PlutusPurpose AsIxItem era
forall era (f :: * -> * -> *).
DijkstraEraScript era =>
f Word32 ScriptHash -> PlutusPurpose f era
GuardingPurpose (Word32 -> ScriptHash -> AsIxItem Word32 ScriptHash
forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
idx ScriptHash
sh), ScriptHash
sh)) (ScriptHash -> (PlutusPurpose AsIxItem era, ScriptHash))
-> Maybe ScriptHash
-> Maybe (PlutusPurpose AsIxItem era, ScriptHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential 'Guard -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'Guard
cred

instance AlonzoEraUTxO DijkstraEra where
  getSupplementalDataHashes :: UTxO DijkstraEra -> TxBody DijkstraEra -> Set DataHash
getSupplementalDataHashes = UTxO DijkstraEra -> TxBody DijkstraEra -> Set DataHash
forall era.
BabbageEraTxBody era =>
UTxO era -> TxBody era -> Set DataHash
getBabbageSupplementalDataHashes

  getSpendingDatum :: UTxO DijkstraEra
-> Tx DijkstraEra
-> PlutusPurpose AsItem DijkstraEra
-> Maybe (Data DijkstraEra)
getSpendingDatum = UTxO DijkstraEra
-> Tx DijkstraEra
-> PlutusPurpose AsItem DijkstraEra
-> Maybe (Data DijkstraEra)
forall era.
(AlonzoEraTx era, BabbageEraTxOut era) =>
UTxO era -> Tx era -> PlutusPurpose AsItem era -> Maybe (Data era)
getBabbageSpendingDatum