{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Shelley.UTxO (
  EraUTxO (..),
  ShelleyScriptsNeeded (..),
  getShelleyScriptsNeeded,
  getConsumedCoin,
  shelleyProducedValue,
  consumed,
  produced,
  getShelleyMinFeeTxUtxo,
  getShelleyWitsVKeyNeeded,
  getShelleyWitsVKeyNeededNoGov,
  module UTxO,
)
where

import Cardano.Ledger.Address (Addr (..), bootstrapKeyHash)
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.CertState (
  CertState (..),
  certDStateL,
  certPStateL,
  certVStateL,
  dsGenDelegs,
  lookupDepositDState,
  lookupDepositVState,
  psStakePoolParamsL,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential (..), credKeyHashWitness, credScriptHash)
import Cardano.Ledger.Keys (
  GenDelegs (..),
  asWitness,
  genDelegKeyHash,
 )
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (ProposedPPUpdates), Update (..))
import Cardano.Ledger.Shelley.Tx ()
import Cardano.Ledger.Shelley.TxBody (
  ShelleyEraTxBody (..),
  Withdrawals (..),
  raCredential,
 )
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.UTxO as UTxO
import Cardano.Ledger.Val ((<+>))
import qualified Cardano.Ledger.Val as Val
import Control.SetAlgebra (eval, (◁))
import Data.Foldable (Foldable (fold), foldr', toList)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Lens.Micro ((^.))

-- | Compute the subset of inputs of the set 'txIns' for which each input is
-- locked by a script in the UTxO 'u'.
txinsScriptHashes ::
  EraTxOut era =>
  Set TxIn ->
  UTxO era ->
  Set ScriptHash
txinsScriptHashes :: forall era. EraTxOut era => Set TxIn -> UTxO era -> Set ScriptHash
txinsScriptHashes Set TxIn
txInps (UTxO Map TxIn (TxOut era)
u) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TxIn -> Set ScriptHash -> Set ScriptHash
add forall a. Set a
Set.empty Set TxIn
txInps
  where
    -- to get subset, start with empty, and only insert those inputs in txInps
    -- that are locked in u
    add :: TxIn -> Set ScriptHash -> Set ScriptHash
add TxIn
input Set ScriptHash
ans = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
input Map TxIn (TxOut era)
u of
      Just TxOut era
txOut -> case TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era. EraTxOut era => Lens' (TxOut era) Addr
addrTxOutL of
        Addr Network
_ (ScriptHashObj ScriptHash
h) StakeReference
_ -> forall a. Ord a => a -> Set a -> Set a
Set.insert ScriptHash
h Set ScriptHash
ans
        Addr
_ -> Set ScriptHash
ans
      Maybe (TxOut era)
Nothing -> Set ScriptHash
ans

getShelleyScriptsNeeded ::
  EraTxBody era =>
  UTxO era ->
  TxBody era ->
  ShelleyScriptsNeeded era
getShelleyScriptsNeeded :: forall era.
EraTxBody era =>
UTxO era -> TxBody era -> ShelleyScriptsNeeded era
getShelleyScriptsNeeded UTxO era
u TxBody era
txBody =
  forall era. Set ScriptHash -> ShelleyScriptsNeeded era
ShelleyScriptsNeeded
    ( Set ScriptHash
scriptHashes
        forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall a. Ord a => [a] -> Set a
Set.fromList
          [ScriptHash
sh | RewardAccount
w <- [RewardAccount]
withdrawals, Just ScriptHash
sh <- [forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash (RewardAccount -> Credential 'Staking
raCredential RewardAccount
w)]]
        forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall a. Ord a => [a] -> Set a
Set.fromList
          [ScriptHash
sh | TxCert era
c <- [TxCert era]
certificates, Just ScriptHash
sh <- [forall era. EraTxCert era => TxCert era -> Maybe ScriptHash
getScriptWitnessTxCert TxCert era
c]]
    )
  where
    withdrawals :: [RewardAccount]
withdrawals = forall k a. Map k a -> [k]
Map.keys (Withdrawals -> Map RewardAccount Coin
unWithdrawals (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL))
    scriptHashes :: Set ScriptHash
scriptHashes = forall era. EraTxOut era => Set TxIn -> UTxO era -> Set ScriptHash
txinsScriptHashes (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL) UTxO era
u
    certificates :: [TxCert era]
certificates = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL)

-- | For eras before Conway, VState is expected to have an empty Map for vsDReps, and so deposit summed up is zero.
consumed ::
  EraUTxO era =>
  PParams era ->
  CertState era ->
  UTxO era ->
  TxBody era ->
  Value era
consumed :: forall era.
EraUTxO era =>
PParams era -> CertState era -> UTxO era -> TxBody era -> Value era
consumed PParams era
pp CertState era
certState =
  forall era.
EraUTxO era =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody era
-> Value era
getConsumedValue
    PParams era
pp
    (forall era. DState era -> Credential 'Staking -> Maybe Coin
lookupDepositDState forall a b. (a -> b) -> a -> b
$ CertState era
certState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (CertState era) (DState era)
certDStateL)
    (forall era. VState era -> Credential 'DRepRole -> Maybe Coin
lookupDepositVState forall a b. (a -> b) -> a -> b
$ CertState era
certState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (CertState era) (VState era)
certVStateL)

-- | Compute the lovelace which are created by the transaction
-- For eras before Conway, VState is expected to have an empty Map for vsDReps, and so deposit summed up is zero.
produced ::
  EraUTxO era =>
  PParams era ->
  CertState era ->
  TxBody era ->
  Value era
produced :: forall era.
EraUTxO era =>
PParams era -> CertState era -> TxBody era -> Value era
produced PParams era
pp CertState era
certState =
  forall era.
EraUTxO era =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> TxBody era -> Value era
getProducedValue PParams era
pp (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Bool
Map.member forall a b. (a -> b) -> a -> b
$ CertState era
certState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (CertState era) (PState era)
certPStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (PState era) (Map (KeyHash 'StakePool) PoolParams)
psStakePoolParamsL)

shelleyProducedValue ::
  EraTxBody era =>
  PParams era ->
  -- | Check whether a pool with a supplied PoolStakeId is already registered.
  (KeyHash 'StakePool -> Bool) ->
  TxBody era ->
  Value era
shelleyProducedValue :: forall era.
EraTxBody era =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> TxBody era -> Value era
shelleyProducedValue PParams era
pp KeyHash 'StakePool -> Bool
isRegPoolId TxBody era
txBody =
  forall era (f :: * -> *).
(EraTxOut era, Foldable f) =>
f (TxOut era) -> Value era
sumAllValue (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL)
    forall t. Val t => t -> t -> t
<+> forall t s. Inject t s => t -> s
Val.inject
      (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL forall t. Val t => t -> t -> t
<+> forall era.
EraTxBody era =>
PParams era -> (KeyHash 'StakePool -> Bool) -> TxBody era -> Coin
getTotalDepositsTxBody PParams era
pp KeyHash 'StakePool -> Bool
isRegPoolId TxBody era
txBody)

-- | Compute the lovelace which are destroyed by the transaction. This implementation is
-- suitable for Shelley and Allegra only.
getConsumedCoin ::
  EraTxBody era =>
  PParams era ->
  (Credential 'Staking -> Maybe Coin) ->
  UTxO era ->
  TxBody era ->
  Coin
getConsumedCoin :: forall era.
EraTxBody era =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> UTxO era
-> TxBody era
-> Coin
getConsumedCoin PParams era
pp Credential 'Staking -> Maybe Coin
lookupRefund UTxO era
utxo TxBody era
txBody =
  {- balance (txins tx ◁ u) + wbalance (txwdrls tx) + keyRefunds dpstate tx -}
  forall era. EraTxOut era => UTxO era -> Coin
coinBalance (forall era. UTxO era -> Set TxIn -> 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)
inputsTxBodyL))
    forall a. Semigroup a => a -> a -> a
<> Coin
refunds
    forall a. Semigroup a => a -> a -> a
<> Coin
withdrawals
  where
    refunds :: Coin
refunds = forall era.
EraTxBody era =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> TxBody era
-> Coin
getTotalRefundsTxBody PParams era
pp Credential 'Staking -> Maybe Coin
lookupRefund (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) 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
. Withdrawals -> Map RewardAccount 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
withdrawalsTxBodyL

newtype ShelleyScriptsNeeded era = ShelleyScriptsNeeded (Set ScriptHash)
  deriving (ShelleyScriptsNeeded era -> ShelleyScriptsNeeded era -> Bool
forall era.
ShelleyScriptsNeeded era -> ShelleyScriptsNeeded era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShelleyScriptsNeeded era -> ShelleyScriptsNeeded era -> Bool
$c/= :: forall era.
ShelleyScriptsNeeded era -> ShelleyScriptsNeeded era -> Bool
== :: ShelleyScriptsNeeded era -> ShelleyScriptsNeeded era -> Bool
$c== :: forall era.
ShelleyScriptsNeeded era -> ShelleyScriptsNeeded era -> Bool
Eq, Int -> ShelleyScriptsNeeded era -> ShowS
forall era. Int -> ShelleyScriptsNeeded era -> ShowS
forall era. [ShelleyScriptsNeeded era] -> ShowS
forall era. ShelleyScriptsNeeded era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyScriptsNeeded era] -> ShowS
$cshowList :: forall era. [ShelleyScriptsNeeded era] -> ShowS
show :: ShelleyScriptsNeeded era -> String
$cshow :: forall era. ShelleyScriptsNeeded era -> String
showsPrec :: Int -> ShelleyScriptsNeeded era -> ShowS
$cshowsPrec :: forall era. Int -> ShelleyScriptsNeeded era -> ShowS
Show)

instance EraUTxO ShelleyEra where
  type ScriptsNeeded ShelleyEra = ShelleyScriptsNeeded ShelleyEra

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

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

  getScriptsProvided :: UTxO ShelleyEra -> Tx ShelleyEra -> ScriptsProvided ShelleyEra
getScriptsProvided UTxO ShelleyEra
_ Tx ShelleyEra
tx = forall era. Map ScriptHash (Script era) -> ScriptsProvided era
ScriptsProvided (Tx ShelleyEra
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 (Script era))
scriptTxWitsL)

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

  getScriptsHashesNeeded :: ScriptsNeeded ShelleyEra -> Set ScriptHash
getScriptsHashesNeeded (ShelleyScriptsNeeded Set ScriptHash
scriptsHashes) = Set ScriptHash
scriptsHashes

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

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

-- We don't consider the reference scripts in the calculation before Conway
getShelleyMinFeeTxUtxo :: EraTx era => PParams era -> Tx era -> Coin
getShelleyMinFeeTxUtxo :: forall era. EraTx era => PParams era -> Tx era -> Coin
getShelleyMinFeeTxUtxo PParams era
pparams Tx era
tx = forall era. EraTx era => PParams era -> Tx era -> Int -> Coin
getMinFeeTx PParams era
pparams Tx era
tx Int
0

-- | Collect the set of hashes of keys that needs to sign a
--  given transaction. This set consists of the txin owners,
--  certificate authors, and withdrawal reward accounts.
witsVKeyNeededGenDelegs ::
  forall era.
  ShelleyEraTxBody era =>
  TxBody era ->
  GenDelegs ->
  Set (KeyHash 'Witness)
witsVKeyNeededGenDelegs :: forall era.
ShelleyEraTxBody era =>
TxBody era -> GenDelegs -> Set (KeyHash 'Witness)
witsVKeyNeededGenDelegs TxBody era
txBody (GenDelegs Map (KeyHash 'Genesis) GenDelegPair
genDelegs) =
  forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness forall b a. Ord b => (a -> b) -> Set a -> Set b
`Set.map` StrictMaybe (Update era) -> Set (KeyHash 'Witness)
proposedUpdatesWitnesses (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL)
  where
    -- Calculate the set of hash keys of the required witnesses for update
    -- proposals.
    proposedUpdatesWitnesses :: StrictMaybe (Update era) -> Set (KeyHash 'Witness)
proposedUpdatesWitnesses = \case
      StrictMaybe (Update era)
SNothing -> forall a. Set a
Set.empty
      SJust (Update (ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate era)
pup) EpochNo
_) ->
        forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems Map (KeyHash 'Genesis) (KeyHash 'GenesisDelegate)
updateKeys''
        where
          updateKeys' :: Map (KeyHash 'Genesis) GenDelegPair
updateKeys' = forall s t. Embed s t => Exp t -> s
eval (forall k a. Map k a -> Set k
Map.keysSet Map (KeyHash 'Genesis) (PParamsUpdate era)
pup forall k s1 s2 (f :: * -> * -> *) v.
(Ord k, HasExp s1 (Sett k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
◁ Map (KeyHash 'Genesis) GenDelegPair
genDelegs)
          updateKeys'' :: Map (KeyHash 'Genesis) (KeyHash 'GenesisDelegate)
updateKeys'' = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map GenDelegPair -> KeyHash 'GenesisDelegate
genDelegKeyHash Map (KeyHash 'Genesis) GenDelegPair
updateKeys'

-- | Extract witnesses from UTxO and TxBody. Does not enforce witnesses for governance
-- related Keys, i.e. `GenDelegs`
getShelleyWitsVKeyNeededNoGov ::
  forall era.
  EraTx era =>
  UTxO era ->
  TxBody era ->
  Set (KeyHash 'Witness)
getShelleyWitsVKeyNeededNoGov :: forall era.
EraTx era =>
UTxO era -> TxBody era -> Set (KeyHash 'Witness)
getShelleyWitsVKeyNeededNoGov UTxO era
utxo' TxBody era
txBody =
  Set (KeyHash 'Witness)
certAuthors
    forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (KeyHash 'Witness)
inputAuthors
    forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (KeyHash 'Witness)
owners
    forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (KeyHash 'Witness)
wdrlAuthors
  where
    inputAuthors :: Set (KeyHash 'Witness)
    inputAuthors :: Set (KeyHash 'Witness)
inputAuthors = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' TxIn -> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
accum forall a. Set a
Set.empty (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => SimpleGetter (TxBody era) (Set TxIn)
spendableInputsTxBodyF)
      where
        accum :: TxIn -> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
accum TxIn
txin !Set (KeyHash 'Witness)
ans =
          case forall era. TxIn -> UTxO era -> Maybe (TxOut era)
txinLookup TxIn
txin UTxO era
utxo' of
            Just TxOut era
txOut ->
              case TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era. EraTxOut era => Lens' (TxOut era) Addr
addrTxOutL of
                Addr Network
_ (KeyHashObj KeyHash 'Payment
pay) StakeReference
_ -> forall a. Ord a => a -> Set a -> Set a
Set.insert (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyHash 'Payment
pay) Set (KeyHash 'Witness)
ans
                AddrBootstrap BootstrapAddress
bootAddr ->
                  forall a. Ord a => a -> Set a -> Set a
Set.insert (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (BootstrapAddress -> KeyHash 'Payment
bootstrapKeyHash BootstrapAddress
bootAddr)) Set (KeyHash 'Witness)
ans
                Addr
_ -> Set (KeyHash 'Witness)
ans
            Maybe (TxOut era)
Nothing -> Set (KeyHash 'Witness)
ans

    wdrlAuthors :: Set (KeyHash 'Witness)
    wdrlAuthors :: Set (KeyHash 'Witness)
wdrlAuthors = forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' forall {p}.
RewardAccount
-> p -> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
accum forall a. Set a
Set.empty (Withdrawals -> Map RewardAccount Coin
unWithdrawals (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL))
      where
        accum :: RewardAccount
-> p -> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
accum RewardAccount
key p
_ !Set (KeyHash 'Witness)
ans =
          case forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness (RewardAccount -> Credential 'Staking
raCredential RewardAccount
key) of
            Maybe (KeyHash 'Witness)
Nothing -> Set (KeyHash 'Witness)
ans
            Just KeyHash 'Witness
vkeyWit -> forall a. Ord a => a -> Set a -> Set a
Set.insert KeyHash 'Witness
vkeyWit Set (KeyHash 'Witness)
ans
    owners :: Set (KeyHash 'Witness)
    owners :: Set (KeyHash 'Witness)
owners = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' forall {era}.
EraTxCert era =>
TxCert era -> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
accum forall a. Set a
Set.empty (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL)
      where
        accum :: TxCert era -> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
accum (RegPoolTxCert PoolParams
pool) !Set (KeyHash 'Witness)
ans =
          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 (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (PoolParams -> Set (KeyHash 'Staking)
ppOwners PoolParams
pool))
            Set (KeyHash 'Witness)
ans
        accum TxCert era
_cert Set (KeyHash 'Witness)
ans = Set (KeyHash 'Witness)
ans
    certAuthors :: Set (KeyHash 'Witness)
    certAuthors :: Set (KeyHash 'Witness)
certAuthors = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' forall {era}.
EraTxCert era =>
TxCert era -> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
accum forall a. Set a
Set.empty (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL)
      where
        accum :: TxCert era -> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
accum TxCert era
cert !Set (KeyHash 'Witness)
ans =
          case forall era. EraTxCert era => TxCert era -> Maybe (KeyHash 'Witness)
getVKeyWitnessTxCert TxCert era
cert of
            Maybe (KeyHash 'Witness)
Nothing -> Set (KeyHash 'Witness)
ans
            Just KeyHash 'Witness
vkeyWit -> forall a. Ord a => a -> Set a -> Set a
Set.insert KeyHash 'Witness
vkeyWit Set (KeyHash 'Witness)
ans

getShelleyWitsVKeyNeeded ::
  forall era.
  (EraTx era, ShelleyEraTxBody era) =>
  CertState era ->
  UTxO era ->
  TxBody era ->
  Set (KeyHash 'Witness)
getShelleyWitsVKeyNeeded :: forall era.
(EraTx era, ShelleyEraTxBody era) =>
CertState era -> UTxO era -> TxBody era -> Set (KeyHash 'Witness)
getShelleyWitsVKeyNeeded CertState era
certState UTxO era
utxo TxBody era
txBody =
  forall era.
EraTx era =>
UTxO era -> TxBody era -> Set (KeyHash 'Witness)
getShelleyWitsVKeyNeededNoGov UTxO era
utxo TxBody era
txBody
    forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall era.
ShelleyEraTxBody era =>
TxBody era -> GenDelegs -> Set (KeyHash 'Witness)
witsVKeyNeededGenDelegs TxBody era
txBody (forall era. DState era -> GenDelegs
dsGenDelegs (CertState era
certState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (CertState era) (DState era)
certDStateL))