{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Byron.Ledger.Inspect (
    ByronLedgerUpdate (..)
    -- * Layer around the Byron protocol update inteface
  , ProtocolUpdate (..)
  , UpdateState (..)
  , protocolUpdates
  ) where

import qualified Cardano.Chain.Block as CC
import qualified Cardano.Chain.Common as CC
import qualified Cardano.Chain.Genesis as CC.Genesis
import qualified Cardano.Chain.ProtocolConstants as CC
import qualified Cardano.Chain.Slotting as CC
import qualified Cardano.Chain.Update as U
import qualified Cardano.Chain.Update.Validation.Endorsement as U.E
import qualified Cardano.Chain.Update.Validation.Interface as U.I
import qualified Cardano.Chain.Update.Validation.Registration as U.R
import           Control.Monad
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.Void
import           Data.Word
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Byron.Ledger.Block
import           Ouroboros.Consensus.Byron.Ledger.Conversions
import           Ouroboros.Consensus.Byron.Ledger.Ledger
import           Ouroboros.Consensus.Config
import qualified Ouroboros.Consensus.HardFork.History.Util as History
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.Inspect
import           Ouroboros.Consensus.Util.Condense

{-------------------------------------------------------------------------------
  Protocol update
-------------------------------------------------------------------------------}

-- | Wrapper around a Byron protocol update with information about its state
--
-- NOTE: We don't currently record the 'U.ProtocolParameters' here because  we
-- don't really need to track them, and adding them would add a lot of  output
-- to the 'Show' instance. We could easily add them however if that would be
-- useful.
data ProtocolUpdate = ProtocolUpdate {
      ProtocolUpdate -> ProtocolVersion
protocolUpdateVersion :: U.ProtocolVersion
    , ProtocolUpdate -> UpdateState
protocolUpdateState   :: UpdateState
    }
  deriving (Int -> ProtocolUpdate -> ShowS
[ProtocolUpdate] -> ShowS
ProtocolUpdate -> String
(Int -> ProtocolUpdate -> ShowS)
-> (ProtocolUpdate -> String)
-> ([ProtocolUpdate] -> ShowS)
-> Show ProtocolUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolUpdate -> ShowS
showsPrec :: Int -> ProtocolUpdate -> ShowS
$cshow :: ProtocolUpdate -> String
show :: ProtocolUpdate -> String
$cshowList :: [ProtocolUpdate] -> ShowS
showList :: [ProtocolUpdate] -> ShowS
Show, ProtocolUpdate -> ProtocolUpdate -> Bool
(ProtocolUpdate -> ProtocolUpdate -> Bool)
-> (ProtocolUpdate -> ProtocolUpdate -> Bool) -> Eq ProtocolUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtocolUpdate -> ProtocolUpdate -> Bool
== :: ProtocolUpdate -> ProtocolUpdate -> Bool
$c/= :: ProtocolUpdate -> ProtocolUpdate -> Bool
/= :: ProtocolUpdate -> ProtocolUpdate -> Bool
Eq)

-- | The various states a protocol update goes through
--
-- Listed in chronological order.
data UpdateState =
    -- | The update was registered, but does not yet have any votes
    --
    -- We record the 'SlotNo' of the slot in which the update was registered.
    -- After registration, nodes must vote on it.
    UpdateRegistered SlotNo

    -- | The update is accumulating votes
    --
    -- We record which nodes have voted for the proposal. The proposal must
    -- accumulate a sufficient number of votes before it can be confirmed.
  | UpdateActive (Set CC.KeyHash)

    -- | The update has amassed a sufficient number of votes
    --
    -- We record the 'SlotNo' of the slot in which the required threshold of
    -- votes was met. At this point @2k@ slots need to pass before the update
    -- can be endorsed.
  | UpdateConfirmed SlotNo

    -- | The votes are stable. We can start to accumulate endorsements.
    --
    -- We record which nodes have endorsed the proposal. The proposal must
    -- accumulate a sufficient number of endorsements before it is nominated
    -- and becomes a candidate.
  | UpdateStablyConfirmed (Set CC.KeyHash)

    -- | The update has amassed a sufficient number of endorsements
    --
    -- We record the 'SlotNo' of the slot in which the required threshold of
    -- endorsement was met. At this point a further @2k@ slots need to pass
    -- before the update becomes a stable candidate and can be adopted.
    --
    -- We additionally record the 'EpochNo' in which the candidate will be
    -- adopted, /if/ it becomes stable.
  | UpdateCandidate SlotNo EpochNo

    -- | The endorsements are stable. The update will be accepted.
    --
    -- We record the 'EpochNo' of the epoch in which it will become active.
  | UpdateStableCandidate EpochNo
  deriving (Int -> UpdateState -> ShowS
[UpdateState] -> ShowS
UpdateState -> String
(Int -> UpdateState -> ShowS)
-> (UpdateState -> String)
-> ([UpdateState] -> ShowS)
-> Show UpdateState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateState -> ShowS
showsPrec :: Int -> UpdateState -> ShowS
$cshow :: UpdateState -> String
show :: UpdateState -> String
$cshowList :: [UpdateState] -> ShowS
showList :: [UpdateState] -> ShowS
Show, UpdateState -> UpdateState -> Bool
(UpdateState -> UpdateState -> Bool)
-> (UpdateState -> UpdateState -> Bool) -> Eq UpdateState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateState -> UpdateState -> Bool
== :: UpdateState -> UpdateState -> Bool
$c/= :: UpdateState -> UpdateState -> Bool
/= :: UpdateState -> UpdateState -> Bool
Eq)

-- | All proposal updates, from new to old
protocolUpdates ::
       LedgerConfig ByronBlock
    -> LedgerState ByronBlock
    -> [ProtocolUpdate]
protocolUpdates :: LedgerConfig ByronBlock
-> LedgerState ByronBlock -> [ProtocolUpdate]
protocolUpdates LedgerConfig ByronBlock
genesis LedgerState ByronBlock
st = [[ProtocolUpdate]] -> [ProtocolUpdate]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
      (CandidateProtocolUpdate -> ProtocolUpdate)
-> [CandidateProtocolUpdate] -> [ProtocolUpdate]
forall a b. (a -> b) -> [a] -> [b]
map CandidateProtocolUpdate -> ProtocolUpdate
fromCandidate [CandidateProtocolUpdate]
candidates

      -- Don't record an update both as a proposal and a candidate
    , ((UpId, ProtocolUpdateProposal) -> ProtocolUpdate)
-> [(UpId, ProtocolUpdateProposal)] -> [ProtocolUpdate]
forall a b. (a -> b) -> [a] -> [b]
map (UpId, ProtocolUpdateProposal) -> ProtocolUpdate
fromRegistered ([(UpId, ProtocolUpdateProposal)] -> [ProtocolUpdate])
-> (Map UpId ProtocolUpdateProposal
    -> [(UpId, ProtocolUpdateProposal)])
-> Map UpId ProtocolUpdateProposal
-> [ProtocolUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map UpId ProtocolUpdateProposal -> [(UpId, ProtocolUpdateProposal)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map UpId ProtocolUpdateProposal -> [ProtocolUpdate])
-> Map UpId ProtocolUpdateProposal -> [ProtocolUpdate]
forall a b. (a -> b) -> a -> b
$
        (ProtocolUpdateProposal -> Bool)
-> Map UpId ProtocolUpdateProposal
-> Map UpId ProtocolUpdateProposal
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool)
-> (ProtocolUpdateProposal -> Bool)
-> ProtocolUpdateProposal
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolVersion -> Bool
hasCandidate (ProtocolVersion -> Bool)
-> (ProtocolUpdateProposal -> ProtocolVersion)
-> ProtocolUpdateProposal
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolUpdateProposal -> ProtocolVersion
U.R.pupProtocolVersion) Map UpId ProtocolUpdateProposal
registered
    ]
  where
    -- Configuration

    k                :: CC.BlockCount
    epochSize        :: CC.EpochSlots
    stableAfter      :: Word64
    takesEffectAfter :: Word64

    k :: BlockCount
k                = GenesisData -> BlockCount
CC.Genesis.gdK (GenesisData -> BlockCount) -> GenesisData -> BlockCount
forall a b. (a -> b) -> a -> b
$ Config -> GenesisData
CC.Genesis.configGenesisData Config
LedgerConfig ByronBlock
genesis
    epochSize :: EpochSlots
epochSize        = Config -> EpochSlots
CC.Genesis.configEpochSlots Config
LedgerConfig ByronBlock
genesis
    stableAfter :: Word64
stableAfter      = SlotCount -> Word64
CC.unSlotCount (SlotCount -> Word64) -> SlotCount -> Word64
forall a b. (a -> b) -> a -> b
$ BlockCount -> SlotCount
CC.kSlotSecurityParam    BlockCount
k
    takesEffectAfter :: Word64
takesEffectAfter = SlotCount -> Word64
CC.unSlotCount (SlotCount -> Word64) -> SlotCount -> Word64
forall a b. (a -> b) -> a -> b
$ BlockCount -> SlotCount
CC.kUpdateStabilityParam BlockCount
k

    -- The impossible cases are impossible because these slots refer to
    -- the slots of blocks on the chain.
    isStable :: SlotNo -> Bool
    isStable :: SlotNo -> Bool
isStable SlotNo
slotNo = Word64
depth Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
stableAfter
      where
        depth :: Word64
        depth :: Word64
depth = case LedgerState ByronBlock -> WithOrigin SlotNo
forall blk.
UpdateLedger blk =>
LedgerState blk -> WithOrigin SlotNo
ledgerTipSlot LedgerState ByronBlock
st of
                  WithOrigin SlotNo
Origin       -> String -> Word64
forall a. HasCallStack => String -> a
error String
"isStable: impossible"
                  NotOrigin SlotNo
s  -> if SlotNo
s SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo
slotNo
                                    then String -> Word64
forall a. HasCallStack => String -> a
error String
"isStable: impossible"
                                    else HasCallStack => SlotNo -> SlotNo -> Word64
SlotNo -> SlotNo -> Word64
History.countSlots SlotNo
s SlotNo
slotNo

    -- Extract relevant bits from the update state

    updState     :: U.I.State
    registered   :: U.R.ProtocolUpdateProposals
    registeredAt :: Map U.UpId CC.SlotNumber
    confirmed    :: Map U.UpId CC.SlotNumber
    votes        :: Map U.UpId (Set CC.KeyHash)
    candidates   :: [U.E.CandidateProtocolUpdate]
    endorsements :: Map U.ProtocolVersion (Set CC.KeyHash)

    updState :: State
updState     = ChainValidationState -> State
CC.cvsUpdateState (ChainValidationState -> State) -> ChainValidationState -> State
forall a b. (a -> b) -> a -> b
$ LedgerState ByronBlock -> ChainValidationState
byronLedgerState LedgerState ByronBlock
st
    registered :: Map UpId ProtocolUpdateProposal
registered   = State -> Map UpId ProtocolUpdateProposal
U.I.registeredProtocolUpdateProposals State
updState
    registeredAt :: Map UpId SlotNumber
registeredAt = State -> Map UpId SlotNumber
U.I.proposalRegistrationSlot          State
updState
    confirmed :: Map UpId SlotNumber
confirmed    = State -> Map UpId SlotNumber
U.I.confirmedProposals                State
updState
    votes :: Map UpId (Set KeyHash)
votes        = State -> Map UpId (Set KeyHash)
U.I.proposalVotes                     State
updState
    candidates :: [CandidateProtocolUpdate]
candidates   = State -> [CandidateProtocolUpdate]
U.I.candidateProtocolUpdates          State
updState
    endorsements :: Map ProtocolVersion (Set KeyHash)
endorsements = (Set KeyHash -> Set KeyHash -> Set KeyHash)
-> [(ProtocolVersion, Set KeyHash)]
-> Map ProtocolVersion (Set KeyHash)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set KeyHash -> Set KeyHash -> Set KeyHash
forall a. Ord a => Set a -> Set a -> Set a
Set.union
                 ([(ProtocolVersion, Set KeyHash)]
 -> Map ProtocolVersion (Set KeyHash))
-> (Set Endorsement -> [(ProtocolVersion, Set KeyHash)])
-> Set Endorsement
-> Map ProtocolVersion (Set KeyHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Endorsement -> (ProtocolVersion, Set KeyHash))
-> [Endorsement] -> [(ProtocolVersion, Set KeyHash)]
forall a b. (a -> b) -> [a] -> [b]
map (\Endorsement
e -> ( Endorsement -> ProtocolVersion
U.E.endorsementProtocolVersion        Endorsement
e
                              , KeyHash -> Set KeyHash
forall a. a -> Set a
Set.singleton (Endorsement -> KeyHash
U.E.endorsementKeyHash Endorsement
e)
                              ))
                 ([Endorsement] -> [(ProtocolVersion, Set KeyHash)])
-> (Set Endorsement -> [Endorsement])
-> Set Endorsement
-> [(ProtocolVersion, Set KeyHash)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Endorsement -> [Endorsement]
forall a. Set a -> [a]
Set.toList
                 (Set Endorsement -> Map ProtocolVersion (Set KeyHash))
-> Set Endorsement -> Map ProtocolVersion (Set KeyHash)
forall a b. (a -> b) -> a -> b
$ State -> Set Endorsement
U.I.registeredEndorsements State
updState

    -- From registered proposals

    fromRegistered :: (U.UpId, U.R.ProtocolUpdateProposal) -> ProtocolUpdate
    fromRegistered :: (UpId, ProtocolUpdateProposal) -> ProtocolUpdate
fromRegistered (UpId
upId, ProtocolUpdateProposal
proposal) = ProtocolUpdate {
          protocolUpdateVersion :: ProtocolVersion
protocolUpdateVersion = ProtocolVersion
version
        , protocolUpdateState :: UpdateState
protocolUpdateState   =
            -- We do the checks in reverse chronological order
            if | Bool -> Bool
not (Set KeyHash -> Bool
forall a. Set a -> Bool
Set.null Set KeyHash
updEndorsed) ->
                   Set KeyHash -> UpdateState
UpdateStablyConfirmed Set KeyHash
updEndorsed

               | Just SlotNo
confirmedInSlot <- Maybe SlotNo
updConfirmed ->
                   if SlotNo -> Bool
isStable SlotNo
confirmedInSlot
                     then Set KeyHash -> UpdateState
UpdateStablyConfirmed Set KeyHash
forall a. Set a
Set.empty
                     else SlotNo -> UpdateState
UpdateConfirmed SlotNo
confirmedInSlot

               | Bool -> Bool
not (Set KeyHash -> Bool
forall a. Set a -> Bool
Set.null Set KeyHash
updVotes) ->
                   Set KeyHash -> UpdateState
UpdateActive Set KeyHash
updVotes

               | Bool
otherwise ->
                   SlotNo -> UpdateState
UpdateRegistered SlotNo
updSlot
        }
      where
        version :: U.ProtocolVersion
        version :: ProtocolVersion
version = ProtocolUpdateProposal -> ProtocolVersion
U.R.pupProtocolVersion ProtocolUpdateProposal
proposal

        updVotes     :: Set CC.KeyHash
        updConfirmed :: Maybe SlotNo
        updEndorsed  :: Set CC.KeyHash
        updSlot      :: SlotNo

        updVotes :: Set KeyHash
updVotes     = Set KeyHash -> UpId -> Map UpId (Set KeyHash) -> Set KeyHash
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set KeyHash
forall a. Set a
Set.empty UpId
upId Map UpId (Set KeyHash)
votes
        updConfirmed :: Maybe SlotNo
updConfirmed = SlotNumber -> SlotNo
fromByronSlotNo (SlotNumber -> SlotNo) -> Maybe SlotNumber -> Maybe SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpId -> Map UpId SlotNumber -> Maybe SlotNumber
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UpId
upId Map UpId SlotNumber
confirmed
        updEndorsed :: Set KeyHash
updEndorsed  = Set KeyHash
-> ProtocolVersion
-> Map ProtocolVersion (Set KeyHash)
-> Set KeyHash
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set KeyHash
forall a. Set a
Set.empty ProtocolVersion
version Map ProtocolVersion (Set KeyHash)
endorsements
        updSlot :: SlotNo
updSlot      = case UpId -> Map UpId SlotNumber -> Maybe SlotNumber
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UpId
upId Map UpId SlotNumber
registeredAt of
                         Maybe SlotNumber
Nothing   -> String -> SlotNo
forall a. HasCallStack => String -> a
error String
"updSlot: invalid Byron state"
                         Just SlotNumber
slot -> SlotNumber -> SlotNo
fromByronSlotNo SlotNumber
slot

    -- From candidate proposals

    fromCandidate :: U.E.CandidateProtocolUpdate -> ProtocolUpdate
    fromCandidate :: CandidateProtocolUpdate -> ProtocolUpdate
fromCandidate CandidateProtocolUpdate
candidate = ProtocolUpdate {
          protocolUpdateVersion :: ProtocolVersion
protocolUpdateVersion = ProtocolVersion
version
        , protocolUpdateState :: UpdateState
protocolUpdateState   =
            if Bool -> Bool
not (SlotNo -> Bool
isStable SlotNo
slot)
              then SlotNo -> EpochNo -> UpdateState
UpdateCandidate SlotNo
slot  (SlotNo -> EpochNo
cpuEpoch SlotNo
slot)
              else EpochNo -> UpdateState
UpdateStableCandidate (SlotNo -> EpochNo
cpuEpoch SlotNo
slot)
        }
      where
        slot    :: SlotNo
        version :: U.ProtocolVersion

        slot :: SlotNo
slot    = SlotNumber -> SlotNo
fromByronSlotNo (SlotNumber -> SlotNo) -> SlotNumber -> SlotNo
forall a b. (a -> b) -> a -> b
$ CandidateProtocolUpdate -> SlotNumber
U.E.cpuSlot CandidateProtocolUpdate
candidate
        version :: ProtocolVersion
version = CandidateProtocolUpdate -> ProtocolVersion
U.E.cpuProtocolVersion        CandidateProtocolUpdate
candidate

    -- Is there a candidate for this version?
    hasCandidate :: U.ProtocolVersion -> Bool
    hasCandidate :: ProtocolVersion -> Bool
hasCandidate ProtocolVersion
v = (CandidateProtocolUpdate -> Bool)
-> [CandidateProtocolUpdate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((ProtocolVersion -> ProtocolVersion -> Bool
forall a. Eq a => a -> a -> Bool
== ProtocolVersion
v) (ProtocolVersion -> Bool)
-> (CandidateProtocolUpdate -> ProtocolVersion)
-> CandidateProtocolUpdate
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CandidateProtocolUpdate -> ProtocolVersion
U.E.cpuProtocolVersion) [CandidateProtocolUpdate]
candidates

    -- Given the 'SlotNo' of a candidate, compute in which 'Epoch' it will
    -- become active.
    --
    -- This follows the same structure as the computation in the A/B test. Let
    -- @s@ be the slot the update proposal was endorsed (gathered enough
    -- endorsements). Note that the very first slot in which the transition
    -- /could/ occur is @s + 1@; adding the required stability, the first slot
    -- in which the transition could occur is @s + 4k + 1@. This means that the
    -- last slot which /must/ be in /this/ era is @s + 4k@. Hence the last
    -- /epoch/ that must be in this era is @epoch (s + 4k)@, and the first epoch
    -- of the /next/ era is @succ (epoch (s + 4k))@.
    cpuEpoch :: SlotNo -> EpochNo
    cpuEpoch :: SlotNo -> EpochNo
cpuEpoch = EpochNo -> EpochNo
forall a. Enum a => a -> a
succ (EpochNo -> EpochNo) -> (SlotNo -> EpochNo) -> SlotNo -> EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> EpochNo
slotToEpoch (SlotNo -> EpochNo) -> (SlotNo -> SlotNo) -> SlotNo -> EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo -> SlotNo
History.addSlots Word64
takesEffectAfter

    -- Slot conversion
    --
    -- This is valid for slots in the Byron era only; just like the Byron
    -- ledger itself, it assumes the Byron era is the /first/ era.
    slotToEpoch :: SlotNo -> EpochNo
    slotToEpoch :: SlotNo -> EpochNo
slotToEpoch (SlotNo Word64
s) = Word64 -> EpochNo
EpochNo (Word64
s Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` EpochSlots -> Word64
CC.unEpochSlots EpochSlots
epochSize)

{-------------------------------------------------------------------------------
  Inspection
-------------------------------------------------------------------------------}

data ByronLedgerUpdate =
    ByronUpdatedProtocolUpdates [ProtocolUpdate]
  deriving (Int -> ByronLedgerUpdate -> ShowS
[ByronLedgerUpdate] -> ShowS
ByronLedgerUpdate -> String
(Int -> ByronLedgerUpdate -> ShowS)
-> (ByronLedgerUpdate -> String)
-> ([ByronLedgerUpdate] -> ShowS)
-> Show ByronLedgerUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronLedgerUpdate -> ShowS
showsPrec :: Int -> ByronLedgerUpdate -> ShowS
$cshow :: ByronLedgerUpdate -> String
show :: ByronLedgerUpdate -> String
$cshowList :: [ByronLedgerUpdate] -> ShowS
showList :: [ByronLedgerUpdate] -> ShowS
Show, ByronLedgerUpdate -> ByronLedgerUpdate -> Bool
(ByronLedgerUpdate -> ByronLedgerUpdate -> Bool)
-> (ByronLedgerUpdate -> ByronLedgerUpdate -> Bool)
-> Eq ByronLedgerUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByronLedgerUpdate -> ByronLedgerUpdate -> Bool
== :: ByronLedgerUpdate -> ByronLedgerUpdate -> Bool
$c/= :: ByronLedgerUpdate -> ByronLedgerUpdate -> Bool
/= :: ByronLedgerUpdate -> ByronLedgerUpdate -> Bool
Eq)

instance Condense ByronLedgerUpdate where
  condense :: ByronLedgerUpdate -> String
condense = ByronLedgerUpdate -> String
forall a. Show a => a -> String
show

instance InspectLedger ByronBlock where
  type LedgerWarning ByronBlock = Void
  type LedgerUpdate  ByronBlock = ByronLedgerUpdate

  inspectLedger :: TopLevelConfig ByronBlock
-> LedgerState ByronBlock
-> LedgerState ByronBlock
-> [LedgerEvent ByronBlock]
inspectLedger TopLevelConfig ByronBlock
tlc LedgerState ByronBlock
before LedgerState ByronBlock
after = do
      Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ [ProtocolUpdate]
updatesBefore [ProtocolUpdate] -> [ProtocolUpdate] -> Bool
forall a. Eq a => a -> a -> Bool
/= [ProtocolUpdate]
updatesAfter
      LedgerEvent ByronBlock -> [LedgerEvent ByronBlock]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (LedgerEvent ByronBlock -> [LedgerEvent ByronBlock])
-> LedgerEvent ByronBlock -> [LedgerEvent ByronBlock]
forall a b. (a -> b) -> a -> b
$ LedgerUpdate ByronBlock -> LedgerEvent ByronBlock
forall blk. LedgerUpdate blk -> LedgerEvent blk
LedgerUpdate (LedgerUpdate ByronBlock -> LedgerEvent ByronBlock)
-> LedgerUpdate ByronBlock -> LedgerEvent ByronBlock
forall a b. (a -> b) -> a -> b
$ [ProtocolUpdate] -> ByronLedgerUpdate
ByronUpdatedProtocolUpdates [ProtocolUpdate]
updatesAfter
    where
      updatesBefore, updatesAfter :: [ProtocolUpdate]
      updatesBefore :: [ProtocolUpdate]
updatesBefore = LedgerConfig ByronBlock
-> LedgerState ByronBlock -> [ProtocolUpdate]
protocolUpdates (TopLevelConfig ByronBlock -> LedgerConfig ByronBlock
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger TopLevelConfig ByronBlock
tlc) LedgerState ByronBlock
before
      updatesAfter :: [ProtocolUpdate]
updatesAfter  = LedgerConfig ByronBlock
-> LedgerState ByronBlock -> [ProtocolUpdate]
protocolUpdates (TopLevelConfig ByronBlock -> LedgerConfig ByronBlock
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger TopLevelConfig ByronBlock
tlc) LedgerState ByronBlock
after