{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Shelley.Ledger.Inspect (
    ShelleyLedgerUpdate (..)
  , pparamsUpdate
  ) where

import           Cardano.Ledger.BaseTypes (StrictMaybe (..))
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Ledger.Shelley.Core as Core
import qualified Cardano.Ledger.Shelley.Governance as SL
import qualified Cardano.Ledger.Shelley.LedgerState as SL
import           Control.Monad
import           Data.Void
import           Lens.Micro ((^.))
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.Inspect
import           Ouroboros.Consensus.Shelley.Ledger.Block
import           Ouroboros.Consensus.Shelley.Ledger.Ledger
import           Ouroboros.Consensus.Util.Condense

data ShelleyLedgerUpdate era =
  ShelleyUpdatedPParams
    !(StrictMaybe (Core.PParams era))
    !EpochNo

deriving instance Eq (Core.PParams era) => Eq (ShelleyLedgerUpdate era)
deriving instance Show (Core.PParams era) => Show (ShelleyLedgerUpdate era)

instance Show (Core.PParams era) => Condense (ShelleyLedgerUpdate era) where
  condense :: ShelleyLedgerUpdate era -> String
condense = ShelleyLedgerUpdate era -> String
forall a. Show a => a -> String
show

instance ShelleyBasedEra era => InspectLedger (ShelleyBlock proto era) where
  type LedgerWarning (ShelleyBlock proto era) = Void
  type LedgerUpdate  (ShelleyBlock proto era) = ShelleyLedgerUpdate era

  inspectLedger :: TopLevelConfig (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era)
-> [LedgerEvent (ShelleyBlock proto era)]
inspectLedger TopLevelConfig (ShelleyBlock proto era)
_tlc LedgerState (ShelleyBlock proto era)
before LedgerState (ShelleyBlock proto era)
after = do
      Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ ShelleyLedgerUpdate era
updatesBefore ShelleyLedgerUpdate era -> ShelleyLedgerUpdate era -> Bool
forall a. Eq a => a -> a -> Bool
/= ShelleyLedgerUpdate era
updatesAfter
      LedgerEvent (ShelleyBlock proto era)
-> [LedgerEvent (ShelleyBlock proto era)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (LedgerEvent (ShelleyBlock proto era)
 -> [LedgerEvent (ShelleyBlock proto era)])
-> LedgerEvent (ShelleyBlock proto era)
-> [LedgerEvent (ShelleyBlock proto era)]
forall a b. (a -> b) -> a -> b
$ LedgerUpdate (ShelleyBlock proto era)
-> LedgerEvent (ShelleyBlock proto era)
forall blk. LedgerUpdate blk -> LedgerEvent blk
LedgerUpdate LedgerUpdate (ShelleyBlock proto era)
ShelleyLedgerUpdate era
updatesAfter
    where

      updatesBefore, updatesAfter :: ShelleyLedgerUpdate era
      updatesBefore :: ShelleyLedgerUpdate era
updatesBefore = LedgerState (ShelleyBlock proto era) -> ShelleyLedgerUpdate era
forall era proto.
ShelleyBasedEra era =>
LedgerState (ShelleyBlock proto era) -> ShelleyLedgerUpdate era
pparamsUpdate LedgerState (ShelleyBlock proto era)
before
      updatesAfter :: ShelleyLedgerUpdate era
updatesAfter  = LedgerState (ShelleyBlock proto era) -> ShelleyLedgerUpdate era
forall era proto.
ShelleyBasedEra era =>
LedgerState (ShelleyBlock proto era) -> ShelleyLedgerUpdate era
pparamsUpdate LedgerState (ShelleyBlock proto era)
after

pparamsUpdate ::
       forall era proto. ShelleyBasedEra era
    => LedgerState (ShelleyBlock proto era)
    -> ShelleyLedgerUpdate era
pparamsUpdate :: forall era proto.
ShelleyBasedEra era =>
LedgerState (ShelleyBlock proto era) -> ShelleyLedgerUpdate era
pparamsUpdate LedgerState (ShelleyBlock proto era)
st =
    let nes :: NewEpochState era
nes = LedgerState (ShelleyBlock proto era) -> NewEpochState era
forall proto era.
LedgerState (ShelleyBlock proto era) -> NewEpochState era
shelleyLedgerState LedgerState (ShelleyBlock proto era)
st
     in StrictMaybe (PParams era) -> EpochNo -> ShelleyLedgerUpdate era
forall era.
StrictMaybe (PParams era) -> EpochNo -> ShelleyLedgerUpdate era
ShelleyUpdatedPParams
          (GovState era -> StrictMaybe (PParams era)
forall era. EraGov era => GovState era -> StrictMaybe (PParams era)
SL.nextEpochUpdatedPParams (NewEpochState era
nes NewEpochState era
-> Getting (GovState era) (NewEpochState era) (GovState era)
-> GovState era
forall s a. s -> Getting a s a -> a
^. Getting (GovState era) (NewEpochState era) (GovState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
SL.newEpochStateGovStateL))
          (EpochNo -> EpochNo
forall a. Enum a => a -> a
succ (NewEpochState era -> EpochNo
forall era. NewEpochState era -> EpochNo
SL.nesEL NewEpochState era
nes))