{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Protocol.TPraos.Rules.Prtcl
  ( PRTCL,
    State,
    PrtclEnv (..),
    PrtclState (..),
    PrtclPredicateFailure (..),
    PredicateFailure,
    PrtlSeqFailure (..),
    prtlSeqChecks,
  )
where

import Cardano.Binary
  ( FromCBOR (fromCBOR),
    ToCBOR (toCBOR),
    encodeListLen,
  )
import qualified Cardano.Crypto.VRF as VRF
import Cardano.Ledger.BaseTypes
  ( Nonce,
    Seed,
    ShelleyBase,
    UnitInterval,
  )
import Cardano.Ledger.Crypto (Crypto, VRF)
import Cardano.Ledger.Keys
  ( DSignable,
    GenDelegs (..),
    KESignable,
    KeyHash,
    KeyRole (..),
    VRFSignable,
  )
import Cardano.Ledger.PoolDistr (PoolDistr)
import Cardano.Ledger.Serialization (decodeRecordNamed)
import Cardano.Ledger.Slot (BlockNo, SlotNo)
import Cardano.Protocol.TPraos.BHeader
  ( BHBody (..),
    BHeader (..),
    LastAppliedBlock (..),
    PrevHash,
    bhbody,
    bnonce,
    lastAppliedHash,
  )
import Cardano.Protocol.TPraos.OCert (OCertSignable)
import Cardano.Protocol.TPraos.Rules.Overlay (OVERLAY, OverlayEnv (..))
import Cardano.Protocol.TPraos.Rules.Updn (UPDN, UpdnEnv (..), UpdnState (..))
import Cardano.Slotting.Slot (WithOrigin (..))
import Control.Monad (unless)
import Control.Monad.Except (MonadError, throwError)
import Control.State.Transition
import Data.Map.Strict (Map)
import Data.Void (Void)
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))

data PRTCL crypto

data PrtclState crypto
  = PrtclState
      !(Map (KeyHash 'BlockIssuer crypto) Word64)
      -- ^ Operation Certificate counters
      !Nonce
      -- ^ Evolving nonce
      !Nonce
      -- ^ Candidate nonce
  deriving ((forall x. PrtclState crypto -> Rep (PrtclState crypto) x)
-> (forall x. Rep (PrtclState crypto) x -> PrtclState crypto)
-> Generic (PrtclState crypto)
forall x. Rep (PrtclState crypto) x -> PrtclState crypto
forall x. PrtclState crypto -> Rep (PrtclState crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (PrtclState crypto) x -> PrtclState crypto
forall crypto x. PrtclState crypto -> Rep (PrtclState crypto) x
$cto :: forall crypto x. Rep (PrtclState crypto) x -> PrtclState crypto
$cfrom :: forall crypto x. PrtclState crypto -> Rep (PrtclState crypto) x
Generic, Int -> PrtclState crypto -> ShowS
[PrtclState crypto] -> ShowS
PrtclState crypto -> String
(Int -> PrtclState crypto -> ShowS)
-> (PrtclState crypto -> String)
-> ([PrtclState crypto] -> ShowS)
-> Show (PrtclState crypto)
forall crypto. Int -> PrtclState crypto -> ShowS
forall crypto. [PrtclState crypto] -> ShowS
forall crypto. PrtclState crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrtclState crypto] -> ShowS
$cshowList :: forall crypto. [PrtclState crypto] -> ShowS
show :: PrtclState crypto -> String
$cshow :: forall crypto. PrtclState crypto -> String
showsPrec :: Int -> PrtclState crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> PrtclState crypto -> ShowS
Show, PrtclState crypto -> PrtclState crypto -> Bool
(PrtclState crypto -> PrtclState crypto -> Bool)
-> (PrtclState crypto -> PrtclState crypto -> Bool)
-> Eq (PrtclState crypto)
forall crypto. PrtclState crypto -> PrtclState crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrtclState crypto -> PrtclState crypto -> Bool
$c/= :: forall crypto. PrtclState crypto -> PrtclState crypto -> Bool
== :: PrtclState crypto -> PrtclState crypto -> Bool
$c== :: forall crypto. PrtclState crypto -> PrtclState crypto -> Bool
Eq)

instance Crypto crypto => ToCBOR (PrtclState crypto) where
  toCBOR :: PrtclState crypto -> Encoding
toCBOR (PrtclState Map (KeyHash 'BlockIssuer crypto) Word64
m Nonce
n1 Nonce
n2) =
    [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
      [ Word -> Encoding
encodeListLen Word
3,
        Map (KeyHash 'BlockIssuer crypto) Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map (KeyHash 'BlockIssuer crypto) Word64
m,
        Nonce -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Nonce
n1,
        Nonce -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Nonce
n2
      ]

instance Crypto crypto => FromCBOR (PrtclState crypto) where
  fromCBOR :: Decoder s (PrtclState crypto)
fromCBOR =
    Text
-> (PrtclState crypto -> Int)
-> Decoder s (PrtclState crypto)
-> Decoder s (PrtclState crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed
      Text
"PrtclState"
      (Int -> PrtclState crypto -> Int
forall a b. a -> b -> a
const Int
3)
      ( Map (KeyHash 'BlockIssuer crypto) Word64
-> Nonce -> Nonce -> PrtclState crypto
forall crypto.
Map (KeyHash 'BlockIssuer crypto) Word64
-> Nonce -> Nonce -> PrtclState crypto
PrtclState
          (Map (KeyHash 'BlockIssuer crypto) Word64
 -> Nonce -> Nonce -> PrtclState crypto)
-> Decoder s (Map (KeyHash 'BlockIssuer crypto) Word64)
-> Decoder s (Nonce -> Nonce -> PrtclState crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map (KeyHash 'BlockIssuer crypto) Word64)
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Decoder s (Nonce -> Nonce -> PrtclState crypto)
-> Decoder s Nonce -> Decoder s (Nonce -> PrtclState crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Nonce
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Decoder s (Nonce -> PrtclState crypto)
-> Decoder s Nonce -> Decoder s (PrtclState crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Nonce
forall a s. FromCBOR a => Decoder s a
fromCBOR
      )

instance Crypto crypto => NoThunks (PrtclState crypto)

data PrtclEnv crypto
  = PrtclEnv
      UnitInterval -- the decentralization paramater @d@ from the protocal parameters
      (PoolDistr crypto)
      (GenDelegs crypto)
      Nonce
  deriving ((forall x. PrtclEnv crypto -> Rep (PrtclEnv crypto) x)
-> (forall x. Rep (PrtclEnv crypto) x -> PrtclEnv crypto)
-> Generic (PrtclEnv crypto)
forall x. Rep (PrtclEnv crypto) x -> PrtclEnv crypto
forall x. PrtclEnv crypto -> Rep (PrtclEnv crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (PrtclEnv crypto) x -> PrtclEnv crypto
forall crypto x. PrtclEnv crypto -> Rep (PrtclEnv crypto) x
$cto :: forall crypto x. Rep (PrtclEnv crypto) x -> PrtclEnv crypto
$cfrom :: forall crypto x. PrtclEnv crypto -> Rep (PrtclEnv crypto) x
Generic)

instance NoThunks (PrtclEnv crypto)

data PrtclPredicateFailure crypto
  = OverlayFailure (PredicateFailure (OVERLAY crypto)) -- Subtransition Failures
  | UpdnFailure (PredicateFailure (UPDN crypto)) -- Subtransition Failures
  deriving ((forall x.
 PrtclPredicateFailure crypto
 -> Rep (PrtclPredicateFailure crypto) x)
-> (forall x.
    Rep (PrtclPredicateFailure crypto) x
    -> PrtclPredicateFailure crypto)
-> Generic (PrtclPredicateFailure crypto)
forall x.
Rep (PrtclPredicateFailure crypto) x
-> PrtclPredicateFailure crypto
forall x.
PrtclPredicateFailure crypto
-> Rep (PrtclPredicateFailure crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (PrtclPredicateFailure crypto) x
-> PrtclPredicateFailure crypto
forall crypto x.
PrtclPredicateFailure crypto
-> Rep (PrtclPredicateFailure crypto) x
$cto :: forall crypto x.
Rep (PrtclPredicateFailure crypto) x
-> PrtclPredicateFailure crypto
$cfrom :: forall crypto x.
PrtclPredicateFailure crypto
-> Rep (PrtclPredicateFailure crypto) x
Generic)

data PrtclEvent crypto
  = UpdnEvent (Event (UPDN crypto)) -- Subtransition Failures
  | NoEvent Void

deriving instance
  (VRF.VRFAlgorithm (VRF crypto)) =>
  Show (PrtclPredicateFailure crypto)

deriving instance
  (VRF.VRFAlgorithm (VRF crypto)) =>
  Eq (PrtclPredicateFailure crypto)

instance
  ( Crypto crypto,
    DSignable crypto (OCertSignable crypto),
    KESignable crypto (BHBody crypto),
    VRFSignable crypto Seed
  ) =>
  STS (PRTCL crypto)
  where
  type
    State (PRTCL crypto) =
      PrtclState crypto

  type
    Signal (PRTCL crypto) =
      BHeader crypto

  type
    Environment (PRTCL crypto) =
      PrtclEnv crypto

  type BaseM (PRTCL crypto) = ShelleyBase
  type PredicateFailure (PRTCL crypto) = PrtclPredicateFailure crypto
  type Event (PRTCL crypto) = PrtclEvent crypto

  initialRules :: [InitialRule (PRTCL crypto)]
initialRules = []

  transitionRules :: [TransitionRule (PRTCL crypto)]
transitionRules = [TransitionRule (PRTCL crypto)
forall crypto.
(Crypto crypto, DSignable crypto (OCertSignable crypto),
 KESignable crypto (BHBody crypto), VRFSignable crypto Seed) =>
TransitionRule (PRTCL crypto)
prtclTransition]

prtclTransition ::
  forall crypto.
  ( Crypto crypto,
    DSignable crypto (OCertSignable crypto),
    KESignable crypto (BHBody crypto),
    VRFSignable crypto Seed
  ) =>
  TransitionRule (PRTCL crypto)
prtclTransition :: TransitionRule (PRTCL crypto)
prtclTransition = do
  TRC
    ( PrtclEnv dval pd dms eta0,
      PrtclState cs etaV etaC,
      Signal (PRTCL crypto)
bh
      ) <-
    F (Clause (PRTCL crypto) 'Transition) (TRC (PRTCL crypto))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let bhb :: BHBody crypto
bhb = BHeader crypto -> BHBody crypto
forall crypto. Crypto crypto => BHeader crypto -> BHBody crypto
bhbody Signal (PRTCL crypto)
BHeader crypto
bh
      slot :: SlotNo
slot = BHBody crypto -> SlotNo
forall crypto. BHBody crypto -> SlotNo
bheaderSlotNo BHBody crypto
bhb
      eta :: Nonce
eta = BHBody crypto -> Nonce
forall crypto. BHBody crypto -> Nonce
bnonce BHBody crypto
bhb

  UpdnState Nonce
etaV' Nonce
etaC' <-
    forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
forall super (rtype :: RuleType).
Embed (UPDN crypto) super =>
RuleContext rtype (UPDN crypto)
-> Rule super rtype (State (UPDN crypto))
trans @(UPDN crypto) (RuleContext 'Transition (UPDN crypto)
 -> Rule (PRTCL crypto) 'Transition (State (UPDN crypto)))
-> RuleContext 'Transition (UPDN crypto)
-> Rule (PRTCL crypto) 'Transition (State (UPDN crypto))
forall a b. (a -> b) -> a -> b
$
      (Environment (UPDN crypto), State (UPDN crypto),
 Signal (UPDN crypto))
-> TRC (UPDN crypto)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC
        ( Nonce -> UpdnEnv
UpdnEnv Nonce
eta,
          Nonce -> Nonce -> UpdnState
UpdnState Nonce
etaV Nonce
etaC,
          SlotNo
Signal (UPDN crypto)
slot
        )
  Map (KeyHash 'BlockIssuer crypto) Word64
cs' <-
    forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
forall super (rtype :: RuleType).
Embed (OVERLAY crypto) super =>
RuleContext rtype (OVERLAY crypto)
-> Rule super rtype (State (OVERLAY crypto))
trans @(OVERLAY crypto) (RuleContext 'Transition (OVERLAY crypto)
 -> Rule (PRTCL crypto) 'Transition (State (OVERLAY crypto)))
-> RuleContext 'Transition (OVERLAY crypto)
-> Rule (PRTCL crypto) 'Transition (State (OVERLAY crypto))
forall a b. (a -> b) -> a -> b
$
      (Environment (OVERLAY crypto), State (OVERLAY crypto),
 Signal (OVERLAY crypto))
-> TRC (OVERLAY crypto)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (UnitInterval
-> PoolDistr crypto
-> GenDelegs crypto
-> Nonce
-> OverlayEnv crypto
forall crypto.
UnitInterval
-> PoolDistr crypto
-> GenDelegs crypto
-> Nonce
-> OverlayEnv crypto
OverlayEnv UnitInterval
dval PoolDistr crypto
pd GenDelegs crypto
dms Nonce
eta0, Map (KeyHash 'BlockIssuer crypto) Word64
State (OVERLAY crypto)
cs, Signal (OVERLAY crypto)
Signal (PRTCL crypto)
bh)

  PrtclState crypto
-> F (Clause (PRTCL crypto) 'Transition) (PrtclState crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrtclState crypto
 -> F (Clause (PRTCL crypto) 'Transition) (PrtclState crypto))
-> PrtclState crypto
-> F (Clause (PRTCL crypto) 'Transition) (PrtclState crypto)
forall a b. (a -> b) -> a -> b
$
    Map (KeyHash 'BlockIssuer crypto) Word64
-> Nonce -> Nonce -> PrtclState crypto
forall crypto.
Map (KeyHash 'BlockIssuer crypto) Word64
-> Nonce -> Nonce -> PrtclState crypto
PrtclState
      Map (KeyHash 'BlockIssuer crypto) Word64
cs'
      Nonce
etaV'
      Nonce
etaC'

instance (Crypto crypto) => NoThunks (PrtclPredicateFailure crypto)

instance
  ( Crypto crypto,
    DSignable crypto (OCertSignable crypto),
    KESignable crypto (BHBody crypto),
    VRFSignable crypto Seed
  ) =>
  Embed (OVERLAY crypto) (PRTCL crypto)
  where
  wrapFailed :: PredicateFailure (OVERLAY crypto)
-> PredicateFailure (PRTCL crypto)
wrapFailed = PredicateFailure (OVERLAY crypto)
-> PredicateFailure (PRTCL crypto)
forall crypto.
PredicateFailure (OVERLAY crypto) -> PrtclPredicateFailure crypto
OverlayFailure
  wrapEvent :: Event (OVERLAY crypto) -> Event (PRTCL crypto)
wrapEvent = Event (OVERLAY crypto) -> Event (PRTCL crypto)
forall crypto. Void -> PrtclEvent crypto
NoEvent

instance
  ( Crypto crypto,
    DSignable crypto (OCertSignable crypto),
    KESignable crypto (BHBody crypto),
    VRFSignable crypto Seed
  ) =>
  Embed (UPDN crypto) (PRTCL crypto)
  where
  wrapFailed :: PredicateFailure (UPDN crypto) -> PredicateFailure (PRTCL crypto)
wrapFailed = PredicateFailure (UPDN crypto) -> PredicateFailure (PRTCL crypto)
forall crypto.
PredicateFailure (UPDN crypto) -> PrtclPredicateFailure crypto
UpdnFailure
  wrapEvent :: Event (UPDN crypto) -> Event (PRTCL crypto)
wrapEvent = Event (UPDN crypto) -> Event (PRTCL crypto)
forall crypto. Event (UPDN crypto) -> PrtclEvent crypto
UpdnEvent

data PrtlSeqFailure crypto
  = WrongSlotIntervalPrtclSeq
      SlotNo
      -- ^ Last slot number.
      SlotNo
      -- ^ Current slot number.
  | WrongBlockNoPrtclSeq
      (WithOrigin (LastAppliedBlock crypto))
      -- ^ Last applied block.
      BlockNo
      -- ^ Current block number.
  | WrongBlockSequencePrtclSeq
      (PrevHash crypto)
      -- ^ Last applied hash
      (PrevHash crypto)
      -- ^ Current block's previous hash
  deriving (Int -> PrtlSeqFailure crypto -> ShowS
[PrtlSeqFailure crypto] -> ShowS
PrtlSeqFailure crypto -> String
(Int -> PrtlSeqFailure crypto -> ShowS)
-> (PrtlSeqFailure crypto -> String)
-> ([PrtlSeqFailure crypto] -> ShowS)
-> Show (PrtlSeqFailure crypto)
forall crypto. Int -> PrtlSeqFailure crypto -> ShowS
forall crypto. [PrtlSeqFailure crypto] -> ShowS
forall crypto. PrtlSeqFailure crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrtlSeqFailure crypto] -> ShowS
$cshowList :: forall crypto. [PrtlSeqFailure crypto] -> ShowS
show :: PrtlSeqFailure crypto -> String
$cshow :: forall crypto. PrtlSeqFailure crypto -> String
showsPrec :: Int -> PrtlSeqFailure crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> PrtlSeqFailure crypto -> ShowS
Show, PrtlSeqFailure crypto -> PrtlSeqFailure crypto -> Bool
(PrtlSeqFailure crypto -> PrtlSeqFailure crypto -> Bool)
-> (PrtlSeqFailure crypto -> PrtlSeqFailure crypto -> Bool)
-> Eq (PrtlSeqFailure crypto)
forall crypto.
PrtlSeqFailure crypto -> PrtlSeqFailure crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrtlSeqFailure crypto -> PrtlSeqFailure crypto -> Bool
$c/= :: forall crypto.
PrtlSeqFailure crypto -> PrtlSeqFailure crypto -> Bool
== :: PrtlSeqFailure crypto -> PrtlSeqFailure crypto -> Bool
$c== :: forall crypto.
PrtlSeqFailure crypto -> PrtlSeqFailure crypto -> Bool
Eq, (forall x. PrtlSeqFailure crypto -> Rep (PrtlSeqFailure crypto) x)
-> (forall x.
    Rep (PrtlSeqFailure crypto) x -> PrtlSeqFailure crypto)
-> Generic (PrtlSeqFailure crypto)
forall x. Rep (PrtlSeqFailure crypto) x -> PrtlSeqFailure crypto
forall x. PrtlSeqFailure crypto -> Rep (PrtlSeqFailure crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (PrtlSeqFailure crypto) x -> PrtlSeqFailure crypto
forall crypto x.
PrtlSeqFailure crypto -> Rep (PrtlSeqFailure crypto) x
$cto :: forall crypto x.
Rep (PrtlSeqFailure crypto) x -> PrtlSeqFailure crypto
$cfrom :: forall crypto x.
PrtlSeqFailure crypto -> Rep (PrtlSeqFailure crypto) x
Generic)

instance Crypto crypto => NoThunks (PrtlSeqFailure crypto)

prtlSeqChecks ::
  (MonadError (PrtlSeqFailure crypto) m, Crypto crypto) =>
  WithOrigin (LastAppliedBlock crypto) ->
  BHeader crypto ->
  m ()
prtlSeqChecks :: WithOrigin (LastAppliedBlock crypto) -> BHeader crypto -> m ()
prtlSeqChecks WithOrigin (LastAppliedBlock crypto)
lab BHeader crypto
bh =
  case WithOrigin (LastAppliedBlock crypto)
lab of
    WithOrigin (LastAppliedBlock crypto)
Origin -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    At (LastAppliedBlock BlockNo
bL SlotNo
sL HashHeader crypto
_) -> do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SlotNo
sL SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo
slot) (m () -> m ())
-> (PrtlSeqFailure crypto -> m ()) -> PrtlSeqFailure crypto -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrtlSeqFailure crypto -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PrtlSeqFailure crypto -> m ()) -> PrtlSeqFailure crypto -> m ()
forall a b. (a -> b) -> a -> b
$ SlotNo -> SlotNo -> PrtlSeqFailure crypto
forall crypto. SlotNo -> SlotNo -> PrtlSeqFailure crypto
WrongSlotIntervalPrtclSeq SlotNo
sL SlotNo
slot
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BlockNo
bL BlockNo -> BlockNo -> BlockNo
forall a. Num a => a -> a -> a
+ BlockNo
1 BlockNo -> BlockNo -> Bool
forall a. Eq a => a -> a -> Bool
== BlockNo
bn) (m () -> m ())
-> (PrtlSeqFailure crypto -> m ()) -> PrtlSeqFailure crypto -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrtlSeqFailure crypto -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PrtlSeqFailure crypto -> m ()) -> PrtlSeqFailure crypto -> m ()
forall a b. (a -> b) -> a -> b
$ WithOrigin (LastAppliedBlock crypto)
-> BlockNo -> PrtlSeqFailure crypto
forall crypto.
WithOrigin (LastAppliedBlock crypto)
-> BlockNo -> PrtlSeqFailure crypto
WrongBlockNoPrtclSeq WithOrigin (LastAppliedBlock crypto)
lab BlockNo
bn
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PrevHash crypto
ph PrevHash crypto -> PrevHash crypto -> Bool
forall a. Eq a => a -> a -> Bool
== BHBody crypto -> PrevHash crypto
forall crypto. BHBody crypto -> PrevHash crypto
bheaderPrev BHBody crypto
bhb) (m () -> m ())
-> (PrtlSeqFailure crypto -> m ()) -> PrtlSeqFailure crypto -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrtlSeqFailure crypto -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PrtlSeqFailure crypto -> m ()) -> PrtlSeqFailure crypto -> m ()
forall a b. (a -> b) -> a -> b
$ PrevHash crypto -> PrevHash crypto -> PrtlSeqFailure crypto
forall crypto.
PrevHash crypto -> PrevHash crypto -> PrtlSeqFailure crypto
WrongBlockSequencePrtclSeq PrevHash crypto
ph (BHBody crypto -> PrevHash crypto
forall crypto. BHBody crypto -> PrevHash crypto
bheaderPrev BHBody crypto
bhb)
  where
    bhb :: BHBody crypto
bhb = BHeader crypto -> BHBody crypto
forall crypto. Crypto crypto => BHeader crypto -> BHBody crypto
bhbody BHeader crypto
bh
    bn :: BlockNo
bn = BHBody crypto -> BlockNo
forall crypto. BHBody crypto -> BlockNo
bheaderBlockNo BHBody crypto
bhb
    slot :: SlotNo
slot = BHBody crypto -> SlotNo
forall crypto. BHBody crypto -> SlotNo
bheaderSlotNo BHBody crypto
bhb
    ph :: PrevHash crypto
ph = WithOrigin (LastAppliedBlock crypto) -> PrevHash crypto
forall crypto.
WithOrigin (LastAppliedBlock crypto) -> PrevHash crypto
lastAppliedHash WithOrigin (LastAppliedBlock crypto)
lab