{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Shelley.Spec.Ledger.API.Protocol
( PraosCrypto,
GetLedgerView (..),
LedgerView (..),
FutureLedgerViewError (..),
ChainDepState (..),
ChainTransitionError (..),
tickChainDepState,
updateChainDepState,
reupdateChainDepState,
)
where
import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen)
import Cardano.Ledger.Core (ChainData, SerialisableData)
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Era (Crypto)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.Constraints (ShelleyBased)
import Control.Arrow (left, right)
import Control.Monad.Except
import Control.Monad.Trans.Reader (runReader)
import Control.State.Transition.Extended
( PredicateFailure,
TRC (..),
applySTS,
reapplySTS,
)
import Data.Either (fromRight)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Shelley.Spec.Ledger.BaseTypes
( Globals,
Nonce,
Seed,
UnitInterval,
)
import Shelley.Spec.Ledger.BlockChain
( BHBody,
BHeader,
bhbody,
bheaderPrev,
prevHashToNonce,
)
import Shelley.Spec.Ledger.Delegation.Certificates (PoolDistr)
import Shelley.Spec.Ledger.Hashing (EraIndependentTxBody)
import Shelley.Spec.Ledger.Keys (DSignable, GenDelegs, Hash, KESignable, VRFSignable)
import Shelley.Spec.Ledger.LedgerState
( EpochState (..),
NewEpochState (..),
_delegationState,
_dstate,
_genDelegs,
)
import Shelley.Spec.Ledger.OCert (OCertSignable)
import Shelley.Spec.Ledger.PParams (PParams' (..))
import Shelley.Spec.Ledger.STS.Chain (ChainChecksData, pparamsToChainChecksData)
import qualified Shelley.Spec.Ledger.STS.Prtcl as STS.Prtcl
import Shelley.Spec.Ledger.STS.Tick (TICKF)
import qualified Shelley.Spec.Ledger.STS.Tickn as STS.Tickn
import Shelley.Spec.Ledger.Serialization (decodeRecordNamed)
import Shelley.Spec.Ledger.Slot (SlotNo)
class
( CC.Crypto c,
DSignable c (OCertSignable c),
DSignable c (Hash c EraIndependentTxBody),
KESignable c (BHBody c),
VRFSignable c Seed
) =>
PraosCrypto c
class
( ChainData (ChainDepState (Crypto era)),
SerialisableData (ChainDepState (Crypto era)),
Eq (ChainTransitionError (Crypto era)),
Show (ChainTransitionError (Crypto era)),
Show (LedgerView (Crypto era)),
Show (FutureLedgerViewError era)
) =>
GetLedgerView era
where
currentLedgerView ::
NewEpochState era ->
LedgerView (Crypto era)
currentLedgerView = NewEpochState era -> LedgerView (Crypto era)
forall era. NewEpochState era -> LedgerView (Crypto era)
view
futureLedgerView ::
MonadError (FutureLedgerViewError era) m =>
Globals ->
NewEpochState era ->
SlotNo ->
m (LedgerView (Crypto era))
default futureLedgerView ::
(ShelleyBased era, MonadError (FutureLedgerViewError era) m) =>
Globals ->
NewEpochState era ->
SlotNo ->
m (LedgerView (Crypto era))
futureLedgerView = Globals
-> NewEpochState era -> SlotNo -> m (LedgerView (Crypto era))
forall era (m :: * -> *).
(ShelleyBased era, MonadError (FutureLedgerViewError era) m) =>
Globals
-> NewEpochState era -> SlotNo -> m (LedgerView (Crypto era))
futureView
instance PraosCrypto crypto => GetLedgerView (ShelleyEra crypto)
data LedgerView crypto = LedgerView
{ LedgerView crypto -> UnitInterval
lvD :: UnitInterval,
:: Nonce,
LedgerView crypto -> PoolDistr crypto
lvPoolDistr :: PoolDistr crypto,
LedgerView crypto -> GenDelegs crypto
lvGenDelegs :: GenDelegs crypto,
LedgerView crypto -> ChainChecksData
lvChainChecks :: ChainChecksData
}
deriving (LedgerView crypto -> LedgerView crypto -> Bool
(LedgerView crypto -> LedgerView crypto -> Bool)
-> (LedgerView crypto -> LedgerView crypto -> Bool)
-> Eq (LedgerView crypto)
forall crypto. LedgerView crypto -> LedgerView crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LedgerView crypto -> LedgerView crypto -> Bool
$c/= :: forall crypto. LedgerView crypto -> LedgerView crypto -> Bool
== :: LedgerView crypto -> LedgerView crypto -> Bool
$c== :: forall crypto. LedgerView crypto -> LedgerView crypto -> Bool
Eq, Int -> LedgerView crypto -> ShowS
[LedgerView crypto] -> ShowS
LedgerView crypto -> String
(Int -> LedgerView crypto -> ShowS)
-> (LedgerView crypto -> String)
-> ([LedgerView crypto] -> ShowS)
-> Show (LedgerView crypto)
forall crypto. Int -> LedgerView crypto -> ShowS
forall crypto. [LedgerView crypto] -> ShowS
forall crypto. LedgerView crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LedgerView crypto] -> ShowS
$cshowList :: forall crypto. [LedgerView crypto] -> ShowS
show :: LedgerView crypto -> String
$cshow :: forall crypto. LedgerView crypto -> String
showsPrec :: Int -> LedgerView crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> LedgerView crypto -> ShowS
Show, (forall x. LedgerView crypto -> Rep (LedgerView crypto) x)
-> (forall x. Rep (LedgerView crypto) x -> LedgerView crypto)
-> Generic (LedgerView crypto)
forall x. Rep (LedgerView crypto) x -> LedgerView crypto
forall x. LedgerView crypto -> Rep (LedgerView crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (LedgerView crypto) x -> LedgerView crypto
forall crypto x. LedgerView crypto -> Rep (LedgerView crypto) x
$cto :: forall crypto x. Rep (LedgerView crypto) x -> LedgerView crypto
$cfrom :: forall crypto x. LedgerView crypto -> Rep (LedgerView crypto) x
Generic)
instance NoThunks (LedgerView crypto)
mkPrtclEnv ::
LedgerView crypto ->
Nonce ->
STS.Prtcl.PrtclEnv crypto
mkPrtclEnv :: LedgerView crypto -> Nonce -> PrtclEnv crypto
mkPrtclEnv
LedgerView
{ UnitInterval
lvD :: UnitInterval
lvD :: forall crypto. LedgerView crypto -> UnitInterval
lvD,
PoolDistr crypto
lvPoolDistr :: PoolDistr crypto
lvPoolDistr :: forall crypto. LedgerView crypto -> PoolDistr crypto
lvPoolDistr,
GenDelegs crypto
lvGenDelegs :: GenDelegs crypto
lvGenDelegs :: forall crypto. LedgerView crypto -> GenDelegs crypto
lvGenDelegs
} =
UnitInterval
-> PoolDistr crypto -> GenDelegs crypto -> Nonce -> PrtclEnv crypto
forall crypto.
UnitInterval
-> PoolDistr crypto -> GenDelegs crypto -> Nonce -> PrtclEnv crypto
STS.Prtcl.PrtclEnv
UnitInterval
lvD
PoolDistr crypto
lvPoolDistr
GenDelegs crypto
lvGenDelegs
view :: NewEpochState era -> LedgerView (Crypto era)
view :: NewEpochState era -> LedgerView (Crypto era)
view
NewEpochState
{ PoolDistr (Crypto era)
nesPd :: forall era. NewEpochState era -> PoolDistr (Crypto era)
nesPd :: PoolDistr (Crypto era)
nesPd,
EpochState era
nesEs :: forall era. NewEpochState era -> EpochState era
nesEs :: EpochState era
nesEs
} =
LedgerView :: forall crypto.
UnitInterval
-> Nonce
-> PoolDistr crypto
-> GenDelegs crypto
-> ChainChecksData
-> LedgerView crypto
LedgerView
{ lvD :: UnitInterval
lvD = PParams' Identity era -> UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_d (PParams' Identity era -> UnitInterval)
-> (EpochState era -> PParams' Identity era)
-> EpochState era
-> UnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> PParams' Identity era
forall era. EpochState era -> PParams era
esPp (EpochState era -> UnitInterval) -> EpochState era -> UnitInterval
forall a b. (a -> b) -> a -> b
$ EpochState era
nesEs,
lvExtraEntropy :: Nonce
lvExtraEntropy = PParams' Identity era -> Nonce
forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
_extraEntropy (PParams' Identity era -> Nonce)
-> (EpochState era -> PParams' Identity era)
-> EpochState era
-> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> PParams' Identity era
forall era. EpochState era -> PParams era
esPp (EpochState era -> Nonce) -> EpochState era -> Nonce
forall a b. (a -> b) -> a -> b
$ EpochState era
nesEs,
lvPoolDistr :: PoolDistr (Crypto era)
lvPoolDistr = PoolDistr (Crypto era)
nesPd,
lvGenDelegs :: GenDelegs (Crypto era)
lvGenDelegs =
DState (Crypto era) -> GenDelegs (Crypto era)
forall crypto. DState crypto -> GenDelegs crypto
_genDelegs (DState (Crypto era) -> GenDelegs (Crypto era))
-> (LedgerState era -> DState (Crypto era))
-> LedgerState era
-> GenDelegs (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DPState (Crypto era) -> DState (Crypto era)
forall crypto. DPState crypto -> DState crypto
_dstate
(DPState (Crypto era) -> DState (Crypto era))
-> (LedgerState era -> DPState (Crypto era))
-> LedgerState 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)
_delegationState
(LedgerState era -> GenDelegs (Crypto era))
-> LedgerState era -> GenDelegs (Crypto era)
forall a b. (a -> b) -> a -> b
$ EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
nesEs,
lvChainChecks :: ChainChecksData
lvChainChecks = PParams' Identity era -> ChainChecksData
forall era. PParams era -> ChainChecksData
pparamsToChainChecksData (PParams' Identity era -> ChainChecksData)
-> (EpochState era -> PParams' Identity era)
-> EpochState era
-> ChainChecksData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> PParams' Identity era
forall era. EpochState era -> PParams era
esPp (EpochState era -> ChainChecksData)
-> EpochState era -> ChainChecksData
forall a b. (a -> b) -> a -> b
$ EpochState era
nesEs
}
newtype FutureLedgerViewError era
= FutureLedgerViewError [PredicateFailure (TICKF era)]
deriving stock instance
(Eq (PredicateFailure (TICKF era))) =>
Eq (FutureLedgerViewError era)
deriving stock instance
(Show (PredicateFailure (TICKF era))) =>
Show (FutureLedgerViewError era)
futureView ::
forall era m.
( ShelleyBased era,
MonadError (FutureLedgerViewError era) m
) =>
Globals ->
NewEpochState era ->
SlotNo ->
m (LedgerView (Crypto era))
futureView :: Globals
-> NewEpochState era -> SlotNo -> m (LedgerView (Crypto era))
futureView Globals
globals NewEpochState era
ss SlotNo
slot =
Either (FutureLedgerViewError era) (LedgerView (Crypto era))
-> m (LedgerView (Crypto era))
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
(Either (FutureLedgerViewError era) (LedgerView (Crypto era))
-> m (LedgerView (Crypto era)))
-> (Either [[TickfPredicateFailure era]] (NewEpochState era)
-> Either (FutureLedgerViewError era) (LedgerView (Crypto era)))
-> Either [[TickfPredicateFailure era]] (NewEpochState era)
-> m (LedgerView (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NewEpochState era -> LedgerView (Crypto era))
-> Either (FutureLedgerViewError era) (NewEpochState era)
-> Either (FutureLedgerViewError era) (LedgerView (Crypto era))
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right NewEpochState era -> LedgerView (Crypto era)
forall era. NewEpochState era -> LedgerView (Crypto era)
view
(Either (FutureLedgerViewError era) (NewEpochState era)
-> Either (FutureLedgerViewError era) (LedgerView (Crypto era)))
-> (Either [[TickfPredicateFailure era]] (NewEpochState era)
-> Either (FutureLedgerViewError era) (NewEpochState era))
-> Either [[TickfPredicateFailure era]] (NewEpochState era)
-> Either (FutureLedgerViewError era) (LedgerView (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[TickfPredicateFailure era]] -> FutureLedgerViewError era)
-> Either [[TickfPredicateFailure era]] (NewEpochState era)
-> Either (FutureLedgerViewError era) (NewEpochState era)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ([TickfPredicateFailure era] -> FutureLedgerViewError era
forall era.
[PredicateFailure (TICKF era)] -> FutureLedgerViewError era
FutureLedgerViewError ([TickfPredicateFailure era] -> FutureLedgerViewError era)
-> ([[TickfPredicateFailure era]] -> [TickfPredicateFailure era])
-> [[TickfPredicateFailure era]]
-> FutureLedgerViewError era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[TickfPredicateFailure era]] -> [TickfPredicateFailure era]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join)
(Either [[TickfPredicateFailure era]] (NewEpochState era)
-> m (LedgerView (Crypto era)))
-> Either [[TickfPredicateFailure era]] (NewEpochState era)
-> m (LedgerView (Crypto era))
forall a b. (a -> b) -> a -> b
$ Either [[TickfPredicateFailure era]] (NewEpochState era)
res
where
res :: Either [[TickfPredicateFailure era]] (NewEpochState era)
res =
(Reader
Globals (Either [[TickfPredicateFailure era]] (NewEpochState era))
-> Globals
-> Either [[TickfPredicateFailure era]] (NewEpochState era))
-> Globals
-> Reader
Globals (Either [[TickfPredicateFailure era]] (NewEpochState era))
-> Either [[TickfPredicateFailure era]] (NewEpochState era)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reader
Globals (Either [[TickfPredicateFailure era]] (NewEpochState era))
-> Globals
-> Either [[TickfPredicateFailure era]] (NewEpochState era)
forall r a. Reader r a -> r -> a
runReader Globals
globals
(Reader
Globals (Either [[TickfPredicateFailure era]] (NewEpochState era))
-> Either [[TickfPredicateFailure era]] (NewEpochState era))
-> (TRC (TICKF era)
-> Reader
Globals (Either [[TickfPredicateFailure era]] (NewEpochState era)))
-> TRC (TICKF era)
-> Either [[TickfPredicateFailure era]] (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s -> m (Either [[PredicateFailure s]] (State s))
forall (m :: * -> *) (rtype :: RuleType).
(STS (TICKF era), RuleTypeRep rtype, m ~ BaseM (TICKF era)) =>
RuleContext rtype (TICKF era)
-> m (Either [[PredicateFailure (TICKF era)]] (State (TICKF era)))
applySTS @(TICKF era)
(TRC (TICKF era)
-> Either [[TickfPredicateFailure era]] (NewEpochState era))
-> TRC (TICKF era)
-> Either [[TickfPredicateFailure era]] (NewEpochState era)
forall a b. (a -> b) -> a -> b
$ (Environment (TICKF era), State (TICKF era), Signal (TICKF era))
-> TRC (TICKF era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((), State (TICKF era)
NewEpochState era
ss, SlotNo
Signal (TICKF era)
slot)
data ChainDepState crypto = ChainDepState
{ ChainDepState crypto -> PrtclState crypto
csProtocol :: !(STS.Prtcl.PrtclState crypto),
ChainDepState crypto -> TicknState
csTickn :: !STS.Tickn.TicknState,
ChainDepState crypto -> Nonce
csLabNonce :: !Nonce
}
deriving (ChainDepState crypto -> ChainDepState crypto -> Bool
(ChainDepState crypto -> ChainDepState crypto -> Bool)
-> (ChainDepState crypto -> ChainDepState crypto -> Bool)
-> Eq (ChainDepState crypto)
forall crypto. ChainDepState crypto -> ChainDepState crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainDepState crypto -> ChainDepState crypto -> Bool
$c/= :: forall crypto. ChainDepState crypto -> ChainDepState crypto -> Bool
== :: ChainDepState crypto -> ChainDepState crypto -> Bool
$c== :: forall crypto. ChainDepState crypto -> ChainDepState crypto -> Bool
Eq, Int -> ChainDepState crypto -> ShowS
[ChainDepState crypto] -> ShowS
ChainDepState crypto -> String
(Int -> ChainDepState crypto -> ShowS)
-> (ChainDepState crypto -> String)
-> ([ChainDepState crypto] -> ShowS)
-> Show (ChainDepState crypto)
forall crypto. Int -> ChainDepState crypto -> ShowS
forall crypto. [ChainDepState crypto] -> ShowS
forall crypto. ChainDepState crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainDepState crypto] -> ShowS
$cshowList :: forall crypto. [ChainDepState crypto] -> ShowS
show :: ChainDepState crypto -> String
$cshow :: forall crypto. ChainDepState crypto -> String
showsPrec :: Int -> ChainDepState crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> ChainDepState crypto -> ShowS
Show, (forall x. ChainDepState crypto -> Rep (ChainDepState crypto) x)
-> (forall x. Rep (ChainDepState crypto) x -> ChainDepState crypto)
-> Generic (ChainDepState crypto)
forall x. Rep (ChainDepState crypto) x -> ChainDepState crypto
forall x. ChainDepState crypto -> Rep (ChainDepState crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (ChainDepState crypto) x -> ChainDepState crypto
forall crypto x.
ChainDepState crypto -> Rep (ChainDepState crypto) x
$cto :: forall crypto x.
Rep (ChainDepState crypto) x -> ChainDepState crypto
$cfrom :: forall crypto x.
ChainDepState crypto -> Rep (ChainDepState crypto) x
Generic)
instance CC.Crypto crypto => NoThunks (ChainDepState crypto)
instance CC.Crypto crypto => FromCBOR (ChainDepState crypto) where
fromCBOR :: Decoder s (ChainDepState crypto)
fromCBOR =
Text
-> (ChainDepState crypto -> Int)
-> Decoder s (ChainDepState crypto)
-> Decoder s (ChainDepState crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed
Text
"ChainDepState"
(Int -> ChainDepState crypto -> Int
forall a b. a -> b -> a
const Int
3)
( PrtclState crypto -> TicknState -> Nonce -> ChainDepState crypto
forall crypto.
PrtclState crypto -> TicknState -> Nonce -> ChainDepState crypto
ChainDepState
(PrtclState crypto -> TicknState -> Nonce -> ChainDepState crypto)
-> Decoder s (PrtclState crypto)
-> Decoder s (TicknState -> Nonce -> ChainDepState crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (PrtclState crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
Decoder s (TicknState -> Nonce -> ChainDepState crypto)
-> Decoder s TicknState
-> Decoder s (Nonce -> ChainDepState crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s TicknState
forall a s. FromCBOR a => Decoder s a
fromCBOR
Decoder s (Nonce -> ChainDepState crypto)
-> Decoder s Nonce -> Decoder s (ChainDepState 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 CC.Crypto crypto => ToCBOR (ChainDepState crypto) where
toCBOR :: ChainDepState crypto -> Encoding
toCBOR
ChainDepState
{ PrtclState crypto
csProtocol :: PrtclState crypto
csProtocol :: forall crypto. ChainDepState crypto -> PrtclState crypto
csProtocol,
TicknState
csTickn :: TicknState
csTickn :: forall crypto. ChainDepState crypto -> TicknState
csTickn,
Nonce
csLabNonce :: Nonce
csLabNonce :: forall crypto. ChainDepState crypto -> Nonce
csLabNonce
} =
[Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
[ Word -> Encoding
encodeListLen Word
3,
PrtclState crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PrtclState crypto
csProtocol,
TicknState -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TicknState
csTickn,
Nonce -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Nonce
csLabNonce
]
newtype ChainTransitionError crypto
= ChainTransitionError [PredicateFailure (STS.Prtcl.PRTCL crypto)]
deriving ((forall x.
ChainTransitionError crypto -> Rep (ChainTransitionError crypto) x)
-> (forall x.
Rep (ChainTransitionError crypto) x -> ChainTransitionError crypto)
-> Generic (ChainTransitionError crypto)
forall x.
Rep (ChainTransitionError crypto) x -> ChainTransitionError crypto
forall x.
ChainTransitionError crypto -> Rep (ChainTransitionError crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (ChainTransitionError crypto) x -> ChainTransitionError crypto
forall crypto x.
ChainTransitionError crypto -> Rep (ChainTransitionError crypto) x
$cto :: forall crypto x.
Rep (ChainTransitionError crypto) x -> ChainTransitionError crypto
$cfrom :: forall crypto x.
ChainTransitionError crypto -> Rep (ChainTransitionError crypto) x
Generic)
instance (CC.Crypto crypto) => NoThunks (ChainTransitionError crypto)
deriving instance (CC.Crypto crypto) => Eq (ChainTransitionError crypto)
deriving instance (CC.Crypto crypto) => Show (ChainTransitionError crypto)
tickChainDepState ::
Globals ->
LedgerView crypto ->
Bool ->
ChainDepState crypto ->
ChainDepState crypto
tickChainDepState :: Globals
-> LedgerView crypto
-> Bool
-> ChainDepState crypto
-> ChainDepState crypto
tickChainDepState
Globals
globals
LedgerView {Nonce
lvExtraEntropy :: Nonce
lvExtraEntropy :: forall crypto. LedgerView crypto -> Nonce
lvExtraEntropy}
Bool
isNewEpoch
cs :: ChainDepState crypto
cs@ChainDepState {PrtclState crypto
csProtocol :: PrtclState crypto
csProtocol :: forall crypto. ChainDepState crypto -> PrtclState crypto
csProtocol, TicknState
csTickn :: TicknState
csTickn :: forall crypto. ChainDepState crypto -> TicknState
csTickn, Nonce
csLabNonce :: Nonce
csLabNonce :: forall crypto. ChainDepState crypto -> Nonce
csLabNonce} = ChainDepState crypto
cs {csTickn :: TicknState
csTickn = TicknState
newTickState}
where
STS.Prtcl.PrtclState Map (KeyHash 'BlockIssuer crypto) Word64
_ Nonce
_ Nonce
candidateNonce = PrtclState crypto
csProtocol
err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"Panic! tickChainDepState failed."
newTickState :: TicknState
newTickState =
TicknState
-> Either [[TicknPredicateFailure]] TicknState -> TicknState
forall b a. b -> Either a b -> b
fromRight TicknState
forall a. a
err (Either [[TicknPredicateFailure]] TicknState -> TicknState)
-> (TRC TICKN -> Either [[TicknPredicateFailure]] TicknState)
-> TRC TICKN
-> TicknState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reader Globals (Either [[TicknPredicateFailure]] TicknState)
-> Globals -> Either [[TicknPredicateFailure]] TicknState)
-> Globals
-> Reader Globals (Either [[TicknPredicateFailure]] TicknState)
-> Either [[TicknPredicateFailure]] TicknState
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reader Globals (Either [[TicknPredicateFailure]] TicknState)
-> Globals -> Either [[TicknPredicateFailure]] TicknState
forall r a. Reader r a -> r -> a
runReader Globals
globals
(Reader Globals (Either [[TicknPredicateFailure]] TicknState)
-> Either [[TicknPredicateFailure]] TicknState)
-> (TRC TICKN
-> Reader Globals (Either [[TicknPredicateFailure]] TicknState))
-> TRC TICKN
-> Either [[TicknPredicateFailure]] TicknState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s -> m (Either [[PredicateFailure s]] (State s))
forall (m :: * -> *) (rtype :: RuleType).
(STS TICKN, RuleTypeRep rtype, m ~ BaseM TICKN) =>
RuleContext rtype TICKN
-> m (Either [[PredicateFailure TICKN]] (State TICKN))
applySTS @STS.Tickn.TICKN
(TRC TICKN -> TicknState) -> TRC TICKN -> TicknState
forall a b. (a -> b) -> a -> b
$ (Environment TICKN, State TICKN, Signal TICKN) -> TRC TICKN
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC
( Nonce -> Nonce -> Nonce -> TicknEnv
STS.Tickn.TicknEnv
Nonce
lvExtraEntropy
Nonce
candidateNonce
Nonce
csLabNonce,
State TICKN
TicknState
csTickn,
Bool
Signal TICKN
isNewEpoch
)
updateChainDepState ::
forall crypto m.
( PraosCrypto crypto,
MonadError (ChainTransitionError crypto) m
) =>
Globals ->
LedgerView crypto ->
BHeader crypto ->
ChainDepState crypto ->
m (ChainDepState crypto)
updateChainDepState :: Globals
-> LedgerView crypto
-> BHeader crypto
-> ChainDepState crypto
-> m (ChainDepState crypto)
updateChainDepState
Globals
globals
LedgerView crypto
lv
BHeader crypto
bh
cs :: ChainDepState crypto
cs@ChainDepState {PrtclState crypto
csProtocol :: PrtclState crypto
csProtocol :: forall crypto. ChainDepState crypto -> PrtclState crypto
csProtocol, TicknState
csTickn :: TicknState
csTickn :: forall crypto. ChainDepState crypto -> TicknState
csTickn} =
Either (ChainTransitionError crypto) (ChainDepState crypto)
-> m (ChainDepState crypto)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
(Either (ChainTransitionError crypto) (ChainDepState crypto)
-> m (ChainDepState crypto))
-> (Either [[PrtclPredicateFailure crypto]] (PrtclState crypto)
-> Either (ChainTransitionError crypto) (ChainDepState crypto))
-> Either [[PrtclPredicateFailure crypto]] (PrtclState crypto)
-> m (ChainDepState crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrtclState crypto -> ChainDepState crypto)
-> Either (ChainTransitionError crypto) (PrtclState crypto)
-> Either (ChainTransitionError crypto) (ChainDepState crypto)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right
( \PrtclState crypto
newPrtclState ->
ChainDepState crypto
cs
{ csProtocol :: PrtclState crypto
csProtocol = PrtclState crypto
newPrtclState,
csLabNonce :: Nonce
csLabNonce = PrevHash crypto -> Nonce
forall crypto. PrevHash crypto -> Nonce
prevHashToNonce (BHBody crypto -> PrevHash crypto
forall crypto. BHBody crypto -> PrevHash crypto
bheaderPrev (BHBody crypto -> PrevHash crypto)
-> (BHeader crypto -> BHBody crypto)
-> BHeader crypto
-> PrevHash crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHeader crypto -> BHBody crypto
forall crypto. Crypto crypto => BHeader crypto -> BHBody crypto
bhbody (BHeader crypto -> PrevHash crypto)
-> BHeader crypto -> PrevHash crypto
forall a b. (a -> b) -> a -> b
$ BHeader crypto
bh)
}
)
(Either (ChainTransitionError crypto) (PrtclState crypto)
-> Either (ChainTransitionError crypto) (ChainDepState crypto))
-> (Either [[PrtclPredicateFailure crypto]] (PrtclState crypto)
-> Either (ChainTransitionError crypto) (PrtclState crypto))
-> Either [[PrtclPredicateFailure crypto]] (PrtclState crypto)
-> Either (ChainTransitionError crypto) (ChainDepState crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[PrtclPredicateFailure crypto]] -> ChainTransitionError crypto)
-> Either [[PrtclPredicateFailure crypto]] (PrtclState crypto)
-> Either (ChainTransitionError crypto) (PrtclState crypto)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ([PrtclPredicateFailure crypto] -> ChainTransitionError crypto
forall crypto.
[PredicateFailure (PRTCL crypto)] -> ChainTransitionError crypto
ChainTransitionError ([PrtclPredicateFailure crypto] -> ChainTransitionError crypto)
-> ([[PrtclPredicateFailure crypto]]
-> [PrtclPredicateFailure crypto])
-> [[PrtclPredicateFailure crypto]]
-> ChainTransitionError crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[PrtclPredicateFailure crypto]] -> [PrtclPredicateFailure crypto]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join)
(Either [[PrtclPredicateFailure crypto]] (PrtclState crypto)
-> m (ChainDepState crypto))
-> Either [[PrtclPredicateFailure crypto]] (PrtclState crypto)
-> m (ChainDepState crypto)
forall a b. (a -> b) -> a -> b
$ Either [[PrtclPredicateFailure crypto]] (PrtclState crypto)
res
where
res :: Either [[PrtclPredicateFailure crypto]] (PrtclState crypto)
res =
(Reader
Globals
(Either [[PrtclPredicateFailure crypto]] (PrtclState crypto))
-> Globals
-> Either [[PrtclPredicateFailure crypto]] (PrtclState crypto))
-> Globals
-> Reader
Globals
(Either [[PrtclPredicateFailure crypto]] (PrtclState crypto))
-> Either [[PrtclPredicateFailure crypto]] (PrtclState crypto)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reader
Globals
(Either [[PrtclPredicateFailure crypto]] (PrtclState crypto))
-> Globals
-> Either [[PrtclPredicateFailure crypto]] (PrtclState crypto)
forall r a. Reader r a -> r -> a
runReader Globals
globals
(Reader
Globals
(Either [[PrtclPredicateFailure crypto]] (PrtclState crypto))
-> Either [[PrtclPredicateFailure crypto]] (PrtclState crypto))
-> (TRC (PRTCL crypto)
-> Reader
Globals
(Either [[PrtclPredicateFailure crypto]] (PrtclState crypto)))
-> TRC (PRTCL crypto)
-> Either [[PrtclPredicateFailure crypto]] (PrtclState crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s -> m (Either [[PredicateFailure s]] (State s))
forall (m :: * -> *) (rtype :: RuleType).
(STS (PRTCL crypto), RuleTypeRep rtype,
m ~ BaseM (PRTCL crypto)) =>
RuleContext rtype (PRTCL crypto)
-> m (Either
[[PredicateFailure (PRTCL crypto)]] (State (PRTCL crypto)))
applySTS @(STS.Prtcl.PRTCL crypto)
(TRC (PRTCL crypto)
-> Either [[PrtclPredicateFailure crypto]] (PrtclState crypto))
-> TRC (PRTCL crypto)
-> Either [[PrtclPredicateFailure crypto]] (PrtclState crypto)
forall a b. (a -> b) -> a -> b
$ (Environment (PRTCL crypto), State (PRTCL crypto),
Signal (PRTCL crypto))
-> TRC (PRTCL crypto)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC
( LedgerView crypto -> Nonce -> PrtclEnv crypto
forall crypto. LedgerView crypto -> Nonce -> PrtclEnv crypto
mkPrtclEnv LedgerView crypto
lv Nonce
epochNonce,
State (PRTCL crypto)
PrtclState crypto
csProtocol,
Signal (PRTCL crypto)
BHeader crypto
bh
)
epochNonce :: Nonce
epochNonce = TicknState -> Nonce
STS.Tickn.ticknStateEpochNonce TicknState
csTickn
reupdateChainDepState ::
forall crypto.
PraosCrypto crypto =>
Globals ->
LedgerView crypto ->
BHeader crypto ->
ChainDepState crypto ->
ChainDepState crypto
reupdateChainDepState :: Globals
-> LedgerView crypto
-> BHeader crypto
-> ChainDepState crypto
-> ChainDepState crypto
reupdateChainDepState
Globals
globals
LedgerView crypto
lv
BHeader crypto
bh
cs :: ChainDepState crypto
cs@ChainDepState {PrtclState crypto
csProtocol :: PrtclState crypto
csProtocol :: forall crypto. ChainDepState crypto -> PrtclState crypto
csProtocol, TicknState
csTickn :: TicknState
csTickn :: forall crypto. ChainDepState crypto -> TicknState
csTickn} =
ChainDepState crypto
cs
{ csProtocol :: PrtclState crypto
csProtocol = PrtclState crypto
res,
csLabNonce :: Nonce
csLabNonce = PrevHash crypto -> Nonce
forall crypto. PrevHash crypto -> Nonce
prevHashToNonce (BHBody crypto -> PrevHash crypto
forall crypto. BHBody crypto -> PrevHash crypto
bheaderPrev (BHBody crypto -> PrevHash crypto)
-> (BHeader crypto -> BHBody crypto)
-> BHeader crypto
-> PrevHash crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHeader crypto -> BHBody crypto
forall crypto. Crypto crypto => BHeader crypto -> BHBody crypto
bhbody (BHeader crypto -> PrevHash crypto)
-> BHeader crypto -> PrevHash crypto
forall a b. (a -> b) -> a -> b
$ BHeader crypto
bh)
}
where
res :: PrtclState crypto
res =
(Reader Globals (PrtclState crypto)
-> Globals -> PrtclState crypto)
-> Globals
-> Reader Globals (PrtclState crypto)
-> PrtclState crypto
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reader Globals (PrtclState crypto) -> Globals -> PrtclState crypto
forall r a. Reader r a -> r -> a
runReader Globals
globals
(Reader Globals (PrtclState crypto) -> PrtclState crypto)
-> (TRC (PRTCL crypto) -> Reader Globals (PrtclState crypto))
-> TRC (PRTCL crypto)
-> PrtclState crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s -> m (State s)
forall (m :: * -> *) (rtype :: RuleType).
(STS (PRTCL crypto), RuleTypeRep rtype,
m ~ BaseM (PRTCL crypto)) =>
RuleContext rtype (PRTCL crypto) -> m (State (PRTCL crypto))
reapplySTS @(STS.Prtcl.PRTCL crypto)
(TRC (PRTCL crypto) -> PrtclState crypto)
-> TRC (PRTCL crypto) -> PrtclState crypto
forall a b. (a -> b) -> a -> b
$ (Environment (PRTCL crypto), State (PRTCL crypto),
Signal (PRTCL crypto))
-> TRC (PRTCL crypto)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC
( LedgerView crypto -> Nonce -> PrtclEnv crypto
forall crypto. LedgerView crypto -> Nonce -> PrtclEnv crypto
mkPrtclEnv LedgerView crypto
lv Nonce
epochNonce,
State (PRTCL crypto)
PrtclState crypto
csProtocol,
Signal (PRTCL crypto)
BHeader crypto
bh
)
epochNonce :: Nonce
epochNonce = TicknState -> Nonce
STS.Tickn.ticknStateEpochNonce TicknState
csTickn