{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}

module Cardano.Tracing.Queries
  (LedgerQueries(..))
where

import           Prelude (Int, (.))

import qualified Data.Map.Strict as Map

import           Ouroboros.Consensus.HardFork.Combinator
import           Ouroboros.Consensus.HardFork.Combinator.Unary

import qualified Cardano.Chain.Block as Byron
import qualified Cardano.Chain.UTxO as Byron
import qualified Ouroboros.Consensus.Byron.Ledger.Block as Byron
import qualified Ouroboros.Consensus.Byron.Ledger.Ledger as Byron

import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley
import qualified Shelley.Spec.Ledger.LedgerState as Shelley
import qualified Shelley.Spec.Ledger.UTxO as Shelley

import qualified Ouroboros.Consensus.Cardano as Cardano
import qualified Ouroboros.Consensus.Cardano.Block as Cardano


class LedgerQueries blk where
  ledgerUtxoSize :: LedgerState blk -> Int

instance LedgerQueries Byron.ByronBlock where
  ledgerUtxoSize :: LedgerState ByronBlock -> Int
ledgerUtxoSize = Map CompactTxIn CompactTxOut -> Int
forall k a. Map k a -> Int
Map.size (Map CompactTxIn CompactTxOut -> Int)
-> (LedgerState ByronBlock -> Map CompactTxIn CompactTxOut)
-> LedgerState ByronBlock
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> Map CompactTxIn CompactTxOut
Byron.unUTxO (UTxO -> Map CompactTxIn CompactTxOut)
-> (LedgerState ByronBlock -> UTxO)
-> LedgerState ByronBlock
-> Map CompactTxIn CompactTxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainValidationState -> UTxO
Byron.cvsUtxo (ChainValidationState -> UTxO)
-> (LedgerState ByronBlock -> ChainValidationState)
-> LedgerState ByronBlock
-> UTxO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState ByronBlock -> ChainValidationState
Byron.byronLedgerState

instance LedgerQueries (Shelley.ShelleyBlock era) where
  ledgerUtxoSize :: LedgerState (ShelleyBlock era) -> Int
ledgerUtxoSize =
      (\(Shelley.UTxO Map (TxIn era) (TxOut era)
xs)-> Map (TxIn era) (TxOut era) -> Int
forall k a. Map k a -> Int
Map.size Map (TxIn era) (TxOut era)
xs)
    (UTxO era -> Int)
-> (LedgerState (ShelleyBlock era) -> UTxO era)
-> LedgerState (ShelleyBlock era)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
Shelley._utxo
    (UTxOState era -> UTxO era)
-> (LedgerState (ShelleyBlock era) -> UTxOState era)
-> LedgerState (ShelleyBlock era)
-> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
Shelley._utxoState
    (LedgerState era -> UTxOState era)
-> (LedgerState (ShelleyBlock era) -> LedgerState era)
-> LedgerState (ShelleyBlock era)
-> UTxOState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
Shelley.esLState
    (EpochState era -> LedgerState era)
-> (LedgerState (ShelleyBlock era) -> EpochState era)
-> LedgerState (ShelleyBlock era)
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
Shelley.nesEs
    (NewEpochState era -> EpochState era)
-> (LedgerState (ShelleyBlock era) -> NewEpochState era)
-> LedgerState (ShelleyBlock era)
-> EpochState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock era) -> NewEpochState era
forall era. LedgerState (ShelleyBlock era) -> NewEpochState era
Shelley.shelleyLedgerState

instance (LedgerQueries x, NoHardForks x)
      => LedgerQueries (HardForkBlock '[x]) where
  ledgerUtxoSize :: LedgerState (HardForkBlock '[x]) -> Int
ledgerUtxoSize = LedgerState x -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize (LedgerState x -> Int)
-> (LedgerState (HardForkBlock '[x]) -> LedgerState x)
-> LedgerState (HardForkBlock '[x])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (HardForkBlock '[x]) -> LedgerState x
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f (HardForkBlock '[blk]) -> f blk
project

instance LedgerQueries (Cardano.CardanoBlock c) where
  ledgerUtxoSize :: LedgerState (CardanoBlock c) -> Int
ledgerUtxoSize = \case
    Cardano.LedgerStateByron   LedgerState ByronBlock
ledgerByron   -> LedgerState ByronBlock -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState ByronBlock
ledgerByron
    Cardano.LedgerStateShelley LedgerState (ShelleyBlock (ShelleyEra c))
ledgerShelley -> LedgerState (ShelleyBlock (ShelleyEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState (ShelleyBlock (ShelleyEra c))
ledgerShelley
    Cardano.LedgerStateAllegra LedgerState (ShelleyBlock (ShelleyEra c))
ledgerAllegra -> LedgerState (ShelleyBlock (ShelleyEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState (ShelleyBlock (ShelleyEra c))
ledgerAllegra
    Cardano.LedgerStateMary    LedgerState (ShelleyBlock (ShelleyEra c))
ledgerMary    -> LedgerState (ShelleyBlock (ShelleyEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState (ShelleyBlock (ShelleyEra c))
ledgerMary