{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Api.Query.Types
  ( DebugLedgerState (..)
  , toDebugLedgerStatePair
  )
where

import           Cardano.Api.Eon.ShelleyBasedEra
import           Cardano.Api.Orphans ()

import           Cardano.Binary
import qualified Cardano.Ledger.Binary.Plain as Plain
import qualified Cardano.Ledger.Shelley.API as Shelley

import           Data.Aeson (ToJSON (..), object, (.=))
import qualified Data.Aeson as Aeson

newtype DebugLedgerState era = DebugLedgerState
  { forall era.
DebugLedgerState era -> NewEpochState (ShelleyLedgerEra era)
unDebugLedgerState :: Shelley.NewEpochState (ShelleyLedgerEra era)
  }

instance IsShelleyBasedEra era => FromCBOR (DebugLedgerState era) where
  fromCBOR :: forall s. Decoder s (DebugLedgerState era)
fromCBOR =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Decoder s (DebugLedgerState era))
-> Decoder s (DebugLedgerState era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era =>
  Decoder s (DebugLedgerState era))
 -> Decoder s (DebugLedgerState era))
-> (ShelleyBasedEraConstraints era =>
    Decoder s (DebugLedgerState era))
-> Decoder s (DebugLedgerState era)
forall a b. (a -> b) -> a -> b
$
      NewEpochState (ShelleyLedgerEra era) -> DebugLedgerState era
forall era.
NewEpochState (ShelleyLedgerEra era) -> DebugLedgerState era
DebugLedgerState
        (NewEpochState (ShelleyLedgerEra era) -> DebugLedgerState era)
-> Decoder s (NewEpochState (ShelleyLedgerEra era))
-> Decoder s (DebugLedgerState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Decoder s (NewEpochState (ShelleyLedgerEra era))
forall {s}. Decoder s (NewEpochState (ShelleyLedgerEra era))
forall a s. FromCBOR a => Decoder s a
fromCBOR :: Plain.Decoder s (Shelley.NewEpochState (ShelleyLedgerEra era)))

instance IsShelleyBasedEra era => ToJSON (DebugLedgerState era) where
  toJSON :: DebugLedgerState era -> Value
toJSON =
    let sbe :: ShelleyBasedEra era
sbe = forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era
     in [Pair] -> Value
object ([Pair] -> Value)
-> (DebugLedgerState era -> [Pair])
-> DebugLedgerState era
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era -> DebugLedgerState era -> [Pair]
forall e a era.
KeyValue e a =>
ShelleyBasedEra era -> DebugLedgerState era -> [a]
toDebugLedgerStatePair ShelleyBasedEra era
sbe
  toEncoding :: DebugLedgerState era -> Encoding
toEncoding =
    let sbe :: ShelleyBasedEra era
sbe = forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era
     in Series -> Encoding
Aeson.pairs (Series -> Encoding)
-> (DebugLedgerState era -> Series)
-> DebugLedgerState era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (DebugLedgerState era -> [Series])
-> DebugLedgerState era
-> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era -> DebugLedgerState era -> [Series]
forall e a era.
KeyValue e a =>
ShelleyBasedEra era -> DebugLedgerState era -> [a]
toDebugLedgerStatePair ShelleyBasedEra era
sbe

toDebugLedgerStatePair
  :: ()
  => Aeson.KeyValue e a
  => ShelleyBasedEra era
  -> DebugLedgerState era
  -> [a]
toDebugLedgerStatePair :: forall e a era.
KeyValue e a =>
ShelleyBasedEra era -> DebugLedgerState era -> [a]
toDebugLedgerStatePair ShelleyBasedEra era
sbe (DebugLedgerState NewEpochState (ShelleyLedgerEra era)
newEpochS) =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => [a]) -> [a]
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => [a]) -> [a])
-> (ShelleyBasedEraConstraints era => [a]) -> [a]
forall a b. (a -> b) -> a -> b
$
    let !nesEL :: EpochNo
nesEL = NewEpochState (ShelleyLedgerEra era) -> EpochNo
forall era. NewEpochState era -> EpochNo
Shelley.nesEL NewEpochState (ShelleyLedgerEra era)
newEpochS
        !nesBprev :: BlocksMade (EraCrypto (ShelleyLedgerEra era))
nesBprev = NewEpochState (ShelleyLedgerEra era)
-> BlocksMade (EraCrypto (ShelleyLedgerEra era))
forall era. NewEpochState era -> BlocksMade (EraCrypto era)
Shelley.nesBprev NewEpochState (ShelleyLedgerEra era)
newEpochS
        !nesBcur :: BlocksMade (EraCrypto (ShelleyLedgerEra era))
nesBcur = NewEpochState (ShelleyLedgerEra era)
-> BlocksMade (EraCrypto (ShelleyLedgerEra era))
forall era. NewEpochState era -> BlocksMade (EraCrypto era)
Shelley.nesBcur NewEpochState (ShelleyLedgerEra era)
newEpochS
        !nesEs :: EpochState (ShelleyLedgerEra era)
nesEs = NewEpochState (ShelleyLedgerEra era)
-> EpochState (ShelleyLedgerEra era)
forall era. NewEpochState era -> EpochState era
Shelley.nesEs NewEpochState (ShelleyLedgerEra era)
newEpochS
        !nesRu :: StrictMaybe (PulsingRewUpdate (EraCrypto (ShelleyLedgerEra era)))
nesRu = NewEpochState (ShelleyLedgerEra era)
-> StrictMaybe
     (PulsingRewUpdate (EraCrypto (ShelleyLedgerEra era)))
forall era.
NewEpochState era -> StrictMaybe (PulsingRewUpdate (EraCrypto era))
Shelley.nesRu NewEpochState (ShelleyLedgerEra era)
newEpochS
        !nesPd :: PoolDistr (EraCrypto (ShelleyLedgerEra era))
nesPd = NewEpochState (ShelleyLedgerEra era)
-> PoolDistr (EraCrypto (ShelleyLedgerEra era))
forall era. NewEpochState era -> PoolDistr (EraCrypto era)
Shelley.nesPd NewEpochState (ShelleyLedgerEra era)
newEpochS
     in [ Key
"lastEpoch" Key -> EpochNo -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EpochNo
nesEL
        , Key
"blocksBefore" Key -> BlocksMade StandardCrypto -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlocksMade (EraCrypto (ShelleyLedgerEra era))
BlocksMade StandardCrypto
nesBprev
        , Key
"blocksCurrent" Key -> BlocksMade StandardCrypto -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlocksMade (EraCrypto (ShelleyLedgerEra era))
BlocksMade StandardCrypto
nesBcur
        , Key
"stateBefore" Key -> EpochState (ShelleyLedgerEra era) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EpochState (ShelleyLedgerEra era)
nesEs
        , Key
"possibleRewardUpdate" Key -> StrictMaybe (PulsingRewUpdate StandardCrypto) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe (PulsingRewUpdate (EraCrypto (ShelleyLedgerEra era)))
StrictMaybe (PulsingRewUpdate StandardCrypto)
nesRu
        , Key
"stakeDistrib" Key -> PoolDistr StandardCrypto -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolDistr (EraCrypto (ShelleyLedgerEra era))
PoolDistr StandardCrypto
nesPd
        ]