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

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

import           Prelude (Int, (.))

import qualified Data.Map.Strict as Map

import           Shardagnostic.Consensus.HardFork.Combinator
import           Shardagnostic.Consensus.HardFork.Combinator.Embed.Unary

import qualified Bcc.Chain.Block as Cole
import qualified Bcc.Chain.UTxO as Cole
import qualified Shardagnostic.Consensus.Cole.Ledger.Block as Cole
import qualified Shardagnostic.Consensus.Cole.Ledger.Ledger as Cole

import qualified Shardagnostic.Consensus.Sophie.Ledger as Sophie
import qualified Sophie.Spec.Ledger.LedgerState as Sophie
import qualified Sophie.Spec.Ledger.UTxO as Sophie

import qualified Shardagnostic.Consensus.Bcc as Bcc
import qualified Shardagnostic.Consensus.Bcc.Block as Bcc


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

instance LedgerQueries Cole.ColeBlock where
  ledgerUtxoSize :: LedgerState ColeBlock -> Int
ledgerUtxoSize = Map CompactTxIn CompactTxOut -> Int
forall k a. Map k a -> Int
Map.size (Map CompactTxIn CompactTxOut -> Int)
-> (LedgerState ColeBlock -> Map CompactTxIn CompactTxOut)
-> LedgerState ColeBlock
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> Map CompactTxIn CompactTxOut
Cole.unUTxO (UTxO -> Map CompactTxIn CompactTxOut)
-> (LedgerState ColeBlock -> UTxO)
-> LedgerState ColeBlock
-> Map CompactTxIn CompactTxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainValidationState -> UTxO
Cole.cvsUtxo (ChainValidationState -> UTxO)
-> (LedgerState ColeBlock -> ChainValidationState)
-> LedgerState ColeBlock
-> UTxO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState ColeBlock -> ChainValidationState
Cole.coleLedgerState
  ledgerDelegMapSize :: LedgerState ColeBlock -> Int
ledgerDelegMapSize LedgerState ColeBlock
_ = Int
0

instance LedgerQueries (Sophie.SophieBlock era) where
  ledgerUtxoSize :: LedgerState (SophieBlock era) -> Int
ledgerUtxoSize =
      (\(Sophie.UTxO Map (TxIn (Crypto era)) (TxOut era)
xs)-> Map (TxIn (Crypto era)) (TxOut era) -> Int
forall k a. Map k a -> Int
Map.size Map (TxIn (Crypto era)) (TxOut era)
xs)
    (UTxO era -> Int)
-> (LedgerState (SophieBlock era) -> UTxO era)
-> LedgerState (SophieBlock era)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
Sophie._utxo
    (UTxOState era -> UTxO era)
-> (LedgerState (SophieBlock era) -> UTxOState era)
-> LedgerState (SophieBlock era)
-> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
Sophie._utxoState
    (LedgerState era -> UTxOState era)
-> (LedgerState (SophieBlock era) -> LedgerState era)
-> LedgerState (SophieBlock era)
-> UTxOState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
Sophie.esLState
    (EpochState era -> LedgerState era)
-> (LedgerState (SophieBlock era) -> EpochState era)
-> LedgerState (SophieBlock era)
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
Sophie.nesEs
    (NewEpochState era -> EpochState era)
-> (LedgerState (SophieBlock era) -> NewEpochState era)
-> LedgerState (SophieBlock era)
-> EpochState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (SophieBlock era) -> NewEpochState era
forall era. LedgerState (SophieBlock era) -> NewEpochState era
Sophie.sophieLedgerState
  ledgerDelegMapSize :: LedgerState (SophieBlock era) -> Int
ledgerDelegMapSize =
      Map
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
-> Int
forall k a. Map k a -> Int
Map.size
    (Map
   (Credential 'Staking (Crypto era))
   (KeyHash 'StakePool (Crypto era))
 -> Int)
-> (LedgerState (SophieBlock era)
    -> Map
         (Credential 'Staking (Crypto era))
         (KeyHash 'StakePool (Crypto era)))
-> LedgerState (SophieBlock era)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DState (Crypto era)
-> Map
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
forall crypto.
DState crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
Sophie._delegations
    (DState (Crypto era)
 -> Map
      (Credential 'Staking (Crypto era))
      (KeyHash 'StakePool (Crypto era)))
-> (LedgerState (SophieBlock era) -> DState (Crypto era))
-> LedgerState (SophieBlock era)
-> Map
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DPState (Crypto era) -> DState (Crypto era)
forall crypto. DPState crypto -> DState crypto
Sophie._dstate
    (DPState (Crypto era) -> DState (Crypto era))
-> (LedgerState (SophieBlock era) -> DPState (Crypto era))
-> LedgerState (SophieBlock era)
-> DState (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> DPState (Crypto era)
forall era. LedgerState era -> DPState (Crypto era)
Sophie._delegationState
    (LedgerState era -> DPState (Crypto era))
-> (LedgerState (SophieBlock era) -> LedgerState era)
-> LedgerState (SophieBlock era)
-> DPState (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
Sophie.esLState
    (EpochState era -> LedgerState era)
-> (LedgerState (SophieBlock era) -> EpochState era)
-> LedgerState (SophieBlock era)
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
Sophie.nesEs
    (NewEpochState era -> EpochState era)
-> (LedgerState (SophieBlock era) -> NewEpochState era)
-> LedgerState (SophieBlock era)
-> EpochState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (SophieBlock era) -> NewEpochState era
forall era. LedgerState (SophieBlock era) -> NewEpochState era
Sophie.sophieLedgerState

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
  ledgerDelegMapSize :: LedgerState (HardForkBlock '[x]) -> Int
ledgerDelegMapSize = LedgerState x -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerDelegMapSize (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 (Bcc.BccBlock c) where
  ledgerUtxoSize :: LedgerState (BccBlock c) -> Int
ledgerUtxoSize = \case
    Bcc.LedgerStateCole   LedgerState ColeBlock
ledgerCole   -> LedgerState ColeBlock -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState ColeBlock
ledgerCole
    Bcc.LedgerStateSophie LedgerState (SophieBlock (SophieEra c))
ledgerSophie -> LedgerState (SophieBlock (SophieEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState (SophieBlock (SophieEra c))
ledgerSophie
    Bcc.LedgerStateEvie LedgerState (SophieBlock (EvieEra c))
ledgerEvie -> LedgerState (SophieBlock (EvieEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState (SophieBlock (EvieEra c))
ledgerEvie
    Bcc.LedgerStateJen    LedgerState (SophieBlock (JenEra c))
ledgerJen    -> LedgerState (SophieBlock (JenEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState (SophieBlock (JenEra c))
ledgerJen
    Bcc.LedgerStateAurum  LedgerState (SophieBlock (AurumEra c))
ledgerAurum  -> LedgerState (SophieBlock (AurumEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerUtxoSize LedgerState (SophieBlock (AurumEra c))
ledgerAurum
  ledgerDelegMapSize :: LedgerState (BccBlock c) -> Int
ledgerDelegMapSize = \case
    Bcc.LedgerStateCole   LedgerState ColeBlock
ledgerCole   -> LedgerState ColeBlock -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerDelegMapSize LedgerState ColeBlock
ledgerCole
    Bcc.LedgerStateSophie LedgerState (SophieBlock (SophieEra c))
ledgerSophie -> LedgerState (SophieBlock (SophieEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerDelegMapSize LedgerState (SophieBlock (SophieEra c))
ledgerSophie
    Bcc.LedgerStateEvie LedgerState (SophieBlock (EvieEra c))
ledgerEvie -> LedgerState (SophieBlock (EvieEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerDelegMapSize LedgerState (SophieBlock (EvieEra c))
ledgerEvie
    Bcc.LedgerStateJen    LedgerState (SophieBlock (JenEra c))
ledgerJen    -> LedgerState (SophieBlock (JenEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerDelegMapSize LedgerState (SophieBlock (JenEra c))
ledgerJen
    Bcc.LedgerStateAurum  LedgerState (SophieBlock (AurumEra c))
ledgerAurum  -> LedgerState (SophieBlock (AurumEra c)) -> Int
forall blk. LedgerQueries blk => LedgerState blk -> Int
ledgerDelegMapSize LedgerState (SophieBlock (AurumEra c))
ledgerAurum