{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Ledger.Mary.UTxO (
getConsumedMaryValue,
getProducedMaryValue,
) where
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Crypto
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import Cardano.Ledger.Mary.Core
import Cardano.Ledger.Mary.Era (MaryEra)
import Cardano.Ledger.Mary.Value (MaryValue (..), filterMultiAsset, mapMaybeMultiAsset, policyID)
import Cardano.Ledger.Shelley.UTxO (
ShelleyScriptsNeeded (..),
getShelleyMinFeeTxUtxo,
getShelleyScriptsNeeded,
getShelleyWitsVKeyNeeded,
shelleyProducedValue,
)
import Cardano.Ledger.UTxO (
EraUTxO (..),
ScriptsProvided (..),
UTxO,
balance,
txInsFilter,
)
import Cardano.Ledger.Val (inject)
import Data.Foldable (fold)
import qualified Data.Set as Set
import Lens.Micro
instance Crypto c => EraUTxO (MaryEra c) where
type ScriptsNeeded (MaryEra c) = ShelleyScriptsNeeded (MaryEra c)
getConsumedValue :: PParams (MaryEra c)
-> (Credential 'Staking (EraCrypto (MaryEra c)) -> Maybe Coin)
-> (Credential 'DRepRole (EraCrypto (MaryEra c)) -> Maybe Coin)
-> UTxO (MaryEra c)
-> TxBody (MaryEra c)
-> Value (MaryEra c)
getConsumedValue = forall era.
(MaryEraTxBody era, Value era ~ MaryValue (EraCrypto era)) =>
PParams era
-> (Credential 'Staking (EraCrypto era) -> Maybe Coin)
-> (Credential 'DRepRole (EraCrypto era) -> Maybe Coin)
-> UTxO era
-> TxBody era
-> MaryValue (EraCrypto era)
getConsumedMaryValue
getProducedValue :: PParams (MaryEra c)
-> (KeyHash 'StakePool (EraCrypto (MaryEra c)) -> Bool)
-> TxBody (MaryEra c)
-> Value (MaryEra c)
getProducedValue = forall era.
(MaryEraTxBody era, Value era ~ MaryValue (EraCrypto era)) =>
PParams era
-> (KeyHash 'StakePool (EraCrypto era) -> Bool)
-> TxBody era
-> MaryValue (EraCrypto era)
getProducedMaryValue
getScriptsProvided :: UTxO (MaryEra c) -> Tx (MaryEra c) -> ScriptsProvided (MaryEra c)
getScriptsProvided UTxO (MaryEra c)
_ Tx (MaryEra c)
tx = forall era.
Map (ScriptHash (EraCrypto era)) (Script era)
-> ScriptsProvided era
ScriptsProvided (Tx (MaryEra 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 (MaryEra c) -> TxBody (MaryEra c) -> ScriptsNeeded (MaryEra c)
getScriptsNeeded = forall era.
(ShelleyEraTxBody era, MaryEraTxBody era) =>
UTxO era -> TxBody era -> ShelleyScriptsNeeded era
getMaryScriptsNeeded
getScriptsHashesNeeded :: ScriptsNeeded (MaryEra c)
-> Set (ScriptHash (EraCrypto (MaryEra c)))
getScriptsHashesNeeded (ShelleyScriptsNeeded Set (ScriptHash (EraCrypto (MaryEra c)))
scriptHashes) = Set (ScriptHash (EraCrypto (MaryEra c)))
scriptHashes
getWitsVKeyNeeded :: CertState (MaryEra c)
-> UTxO (MaryEra c)
-> TxBody (MaryEra c)
-> Set (KeyHash 'Witness (EraCrypto (MaryEra c)))
getWitsVKeyNeeded = forall era.
(EraTx era, ShelleyEraTxBody era) =>
CertState era
-> UTxO era -> TxBody era -> Set (KeyHash 'Witness (EraCrypto era))
getShelleyWitsVKeyNeeded
getMinFeeTxUtxo :: PParams (MaryEra c) -> Tx (MaryEra c) -> UTxO (MaryEra c) -> Coin
getMinFeeTxUtxo PParams (MaryEra c)
pp Tx (MaryEra c)
tx UTxO (MaryEra c)
_ = forall era. EraTx era => PParams era -> Tx era -> Coin
getShelleyMinFeeTxUtxo PParams (MaryEra c)
pp Tx (MaryEra c)
tx
getConsumedMaryValue ::
(MaryEraTxBody era, Value era ~ MaryValue (EraCrypto era)) =>
PParams era ->
(Credential 'Staking (EraCrypto era) -> Maybe Coin) ->
(Credential 'DRepRole (EraCrypto era) -> Maybe Coin) ->
UTxO era ->
TxBody era ->
MaryValue (EraCrypto era)
getConsumedMaryValue :: forall era.
(MaryEraTxBody era, Value era ~ MaryValue (EraCrypto era)) =>
PParams era
-> (Credential 'Staking (EraCrypto era) -> Maybe Coin)
-> (Credential 'DRepRole (EraCrypto era) -> Maybe Coin)
-> UTxO era
-> TxBody era
-> MaryValue (EraCrypto era)
getConsumedMaryValue PParams era
pp Credential 'Staking (EraCrypto era) -> Maybe Coin
lookupStakingDeposit Credential 'DRepRole (EraCrypto era) -> Maybe Coin
lookupDRepDeposit UTxO era
utxo TxBody era
txBody =
MaryValue (EraCrypto era)
consumedValue forall a. Semigroup a => a -> a -> a
<> forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue forall a. Monoid a => a
mempty MultiAsset (EraCrypto era)
mintedMultiAsset
where
mintedMultiAsset :: MultiAsset (EraCrypto era)
mintedMultiAsset = forall c.
(PolicyID c -> AssetName -> Integer -> Bool)
-> MultiAsset c -> MultiAsset c
filterMultiAsset (\PolicyID (EraCrypto era)
_ AssetName
_ -> (forall a. Ord a => a -> a -> Bool
> Integer
0)) forall a b. (a -> b) -> a -> b
$ TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL
consumedValue :: MaryValue (EraCrypto era)
consumedValue =
forall era. EraTxOut era => UTxO era -> Value era
balance (forall era. UTxO era -> Set (TxIn (EraCrypto era)) -> UTxO era
txInsFilter UTxO era
utxo (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL))
forall a. Semigroup a => a -> a -> a
<> forall t s. Inject t s => t -> s
inject (Coin
refunds forall a. Semigroup a => a -> a -> a
<> Coin
withdrawals)
refunds :: Coin
refunds = forall era.
EraTxBody era =>
PParams era
-> (Credential 'Staking (EraCrypto era) -> Maybe Coin)
-> (Credential 'DRepRole (EraCrypto era) -> Maybe Coin)
-> TxBody era
-> Coin
getTotalRefundsTxBody PParams era
pp Credential 'Staking (EraCrypto era) -> Maybe Coin
lookupStakingDeposit Credential 'DRepRole (EraCrypto era) -> Maybe Coin
lookupDRepDeposit TxBody era
txBody
withdrawals :: Coin
withdrawals = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Withdrawals c -> Map (RewardAcnt c) Coin
unWithdrawals forall a b. (a -> b) -> a -> b
$ TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL
getProducedMaryValue ::
(MaryEraTxBody era, Value era ~ MaryValue (EraCrypto era)) =>
PParams era ->
(KeyHash 'StakePool (EraCrypto era) -> Bool) ->
TxBody era ->
MaryValue (EraCrypto era)
getProducedMaryValue :: forall era.
(MaryEraTxBody era, Value era ~ MaryValue (EraCrypto era)) =>
PParams era
-> (KeyHash 'StakePool (EraCrypto era) -> Bool)
-> TxBody era
-> MaryValue (EraCrypto era)
getProducedMaryValue PParams era
pp KeyHash 'StakePool (EraCrypto era) -> Bool
isPoolRegistered TxBody era
txBody =
forall era.
EraTxBody era =>
PParams era
-> (KeyHash 'StakePool (EraCrypto era) -> Bool)
-> TxBody era
-> Value era
shelleyProducedValue PParams era
pp KeyHash 'StakePool (EraCrypto era) -> Bool
isPoolRegistered TxBody era
txBody forall a. Semigroup a => a -> a -> a
<> forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue forall a. Monoid a => a
mempty MultiAsset (EraCrypto era)
burnedMultiAsset
where
burnedMultiAsset :: MultiAsset (EraCrypto era)
burnedMultiAsset =
forall c.
(PolicyID c -> AssetName -> Integer -> Maybe Integer)
-> MultiAsset c -> MultiAsset c
mapMaybeMultiAsset (\PolicyID (EraCrypto era)
_ AssetName
_ Integer
v -> if Integer
v forall a. Ord a => a -> a -> Bool
< Integer
0 then forall a. a -> Maybe a
Just (forall a. Num a => a -> a
negate Integer
v) else forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$
TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL
getMaryScriptsNeeded ::
(ShelleyEraTxBody era, MaryEraTxBody era) =>
UTxO era ->
TxBody era ->
ShelleyScriptsNeeded era
getMaryScriptsNeeded :: forall era.
(ShelleyEraTxBody era, MaryEraTxBody era) =>
UTxO era -> TxBody era -> ShelleyScriptsNeeded era
getMaryScriptsNeeded UTxO era
u TxBody era
txBody =
case forall era.
EraTxBody era =>
UTxO era -> TxBody era -> ShelleyScriptsNeeded era
getShelleyScriptsNeeded UTxO era
u TxBody era
txBody of
ShelleyScriptsNeeded Set (ScriptHash (EraCrypto era))
shelleyScriptsNeeded ->
forall era.
Set (ScriptHash (EraCrypto era)) -> ShelleyScriptsNeeded era
ShelleyScriptsNeeded forall a b. (a -> b) -> a -> b
$
Set (ScriptHash (EraCrypto era))
shelleyScriptsNeeded forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall c. PolicyID c -> ScriptHash c
policyID (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
MaryEraTxBody era =>
SimpleGetter (TxBody era) (Set (PolicyID (EraCrypto era)))
mintedTxBodyF)