{-# LANGUAGE DataKinds #-}

module Test.Cardano.Ledger.Api.State.Query (
  -- * Old versions of queries

  --
  -- These are useful for testing and benchmarking
  getFilteredDelegationsAndRewardAccounts,
)
where

import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Keys (KeyHash, KeyRole (StakePool, Staking))
import Cardano.Ledger.UMap (UMap, UView (SPoolUView), domRestrictedMap, rewardMap)
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)

-- | This is an old implementation for @GetFilteredDelegationsAndRewardAccounts@ query
getFilteredDelegationsAndRewardAccounts ::
  UMap c ->
  Set (Credential 'Staking c) ->
  (Map (Credential 'Staking c) (KeyHash 'StakePool c), Map (Credential 'Staking c) Coin)
getFilteredDelegationsAndRewardAccounts :: forall c.
UMap c
-> Set (Credential 'Staking c)
-> (Map (Credential 'Staking c) (KeyHash 'StakePool c),
    Map (Credential 'Staking c) Coin)
getFilteredDelegationsAndRewardAccounts UMap c
umap Set (Credential 'Staking c)
creds =
  (Map (Credential 'Staking c) (KeyHash 'StakePool c)
filteredDelegations, Map (Credential 'Staking c) Coin
filteredRwdAcnts)
  where
    filteredDelegations :: Map (Credential 'Staking c) (KeyHash 'StakePool c)
filteredDelegations = forall k c v. Set k -> UView c k v -> Map k v
domRestrictedMap Set (Credential 'Staking c)
creds forall a b. (a -> b) -> a -> b
$ forall c.
UMap c -> UView c (Credential 'Staking c) (KeyHash 'StakePool c)
SPoolUView UMap c
umap
    filteredRwdAcnts :: Map (Credential 'Staking c) Coin
filteredRwdAcnts = forall c. UMap c -> Map (Credential 'Staking c) Coin
rewardMap UMap c
umap forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set (Credential 'Staking c)
creds