{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Ouroboros.Consensus.Ledger.Basics
(
LedgerCfg
, LedgerState
, TickedLedgerState
, ComputeLedgerEvents (..)
, IsLedger (..)
, AuxLedgerEvent
, applyChainTick
, LedgerResult (..)
, VoidLedgerEvent
, castLedgerResult
, embedLedgerResult
, pureLedgerResult
, GetTip (..)
, GetTipSTM (..)
, getTipHash
, getTipM
, getTipSlot
, LedgerConfig
, LedgerError
) where
import Data.Kind (Constraint, Type)
import GHC.Generics
import Ouroboros.Consensus.Block.Abstract
import Ouroboros.Consensus.Ledger.Tables.Kinds
import Ouroboros.Consensus.Ledger.Tables.MapKind
import Ouroboros.Consensus.Ticked
import Ouroboros.Consensus.Util ((...:))
import Ouroboros.Consensus.Util.IOLike
type GetTip :: LedgerStateKind -> Constraint
class GetTip l where
getTip :: forall mk. l mk -> Point l
getTipHash :: GetTip l => l mk -> ChainHash l
getTipHash :: forall (l :: LedgerStateKind) (mk :: MapKind).
GetTip l =>
l mk -> ChainHash l
getTipHash = Point l -> ChainHash l
forall {k} (block :: k). Point block -> ChainHash block
pointHash (Point l -> ChainHash l)
-> (l mk -> Point l) -> l mk -> ChainHash l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l mk -> Point l
forall (mk :: MapKind). l mk -> Point l
forall (l :: LedgerStateKind) (mk :: MapKind).
GetTip l =>
l mk -> Point l
getTip
getTipSlot :: GetTip l => l mk -> WithOrigin SlotNo
getTipSlot :: forall (l :: LedgerStateKind) (mk :: MapKind).
GetTip l =>
l mk -> WithOrigin SlotNo
getTipSlot = Point l -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot (Point l -> WithOrigin SlotNo)
-> (l mk -> Point l) -> l mk -> WithOrigin SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l mk -> Point l
forall (mk :: MapKind). l mk -> Point l
forall (l :: LedgerStateKind) (mk :: MapKind).
GetTip l =>
l mk -> Point l
getTip
type GetTipSTM :: (Type -> Type) -> Type -> Constraint
class GetTipSTM m l where
getTipSTM :: l -> STM m (Point l)
getTipM :: (GetTipSTM m l, MonadSTM m) => l -> m (Point l)
getTipM :: forall (m :: * -> *) l.
(GetTipSTM m l, MonadSTM m) =>
l -> m (Point l)
getTipM = STM m (Point l) -> m (Point l)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Point l) -> m (Point l))
-> (l -> STM m (Point l)) -> l -> m (Point l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l -> STM m (Point l)
forall (m :: * -> *) l. GetTipSTM m l => l -> STM m (Point l)
getTipSTM
type VoidLedgerEvent :: Type
data VoidLedgerEvent
type LedgerResult :: Type -> Type -> Type
data LedgerResult blk a = LedgerResult
{ forall blk a. LedgerResult blk a -> [AuxLedgerEvent blk]
lrEvents :: [AuxLedgerEvent blk]
, forall blk a. LedgerResult blk a -> a
lrResult :: !a
}
deriving ((forall m. Monoid m => LedgerResult blk m -> m)
-> (forall m a. Monoid m => (a -> m) -> LedgerResult blk a -> m)
-> (forall m a. Monoid m => (a -> m) -> LedgerResult blk a -> m)
-> (forall a b. (a -> b -> b) -> b -> LedgerResult blk a -> b)
-> (forall a b. (a -> b -> b) -> b -> LedgerResult blk a -> b)
-> (forall b a. (b -> a -> b) -> b -> LedgerResult blk a -> b)
-> (forall b a. (b -> a -> b) -> b -> LedgerResult blk a -> b)
-> (forall a. (a -> a -> a) -> LedgerResult blk a -> a)
-> (forall a. (a -> a -> a) -> LedgerResult blk a -> a)
-> (forall a. LedgerResult blk a -> [a])
-> (forall a. LedgerResult blk a -> Bool)
-> (forall a. LedgerResult blk a -> Int)
-> (forall a. Eq a => a -> LedgerResult blk a -> Bool)
-> (forall a. Ord a => LedgerResult blk a -> a)
-> (forall a. Ord a => LedgerResult blk a -> a)
-> (forall a. Num a => LedgerResult blk a -> a)
-> (forall a. Num a => LedgerResult blk a -> a)
-> Foldable (LedgerResult blk)
forall a. Eq a => a -> LedgerResult blk a -> Bool
forall a. Num a => LedgerResult blk a -> a
forall a. Ord a => LedgerResult blk a -> a
forall m. Monoid m => LedgerResult blk m -> m
forall a. LedgerResult blk a -> Bool
forall a. LedgerResult blk a -> Int
forall a. LedgerResult blk a -> [a]
forall a. (a -> a -> a) -> LedgerResult blk a -> a
forall blk a. Eq a => a -> LedgerResult blk a -> Bool
forall blk a. Num a => LedgerResult blk a -> a
forall blk a. Ord a => LedgerResult blk a -> a
forall m a. Monoid m => (a -> m) -> LedgerResult blk a -> m
forall blk m. Monoid m => LedgerResult blk m -> m
forall blk a. LedgerResult blk a -> Bool
forall blk a. LedgerResult blk a -> Int
forall blk a. LedgerResult blk a -> [a]
forall b a. (b -> a -> b) -> b -> LedgerResult blk a -> b
forall a b. (a -> b -> b) -> b -> LedgerResult blk a -> b
forall blk a. (a -> a -> a) -> LedgerResult blk a -> a
forall blk m a. Monoid m => (a -> m) -> LedgerResult blk a -> m
forall blk b a. (b -> a -> b) -> b -> LedgerResult blk a -> b
forall blk a b. (a -> b -> b) -> b -> LedgerResult blk a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall blk m. Monoid m => LedgerResult blk m -> m
fold :: forall m. Monoid m => LedgerResult blk m -> m
$cfoldMap :: forall blk m a. Monoid m => (a -> m) -> LedgerResult blk a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> LedgerResult blk a -> m
$cfoldMap' :: forall blk m a. Monoid m => (a -> m) -> LedgerResult blk a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> LedgerResult blk a -> m
$cfoldr :: forall blk a b. (a -> b -> b) -> b -> LedgerResult blk a -> b
foldr :: forall a b. (a -> b -> b) -> b -> LedgerResult blk a -> b
$cfoldr' :: forall blk a b. (a -> b -> b) -> b -> LedgerResult blk a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> LedgerResult blk a -> b
$cfoldl :: forall blk b a. (b -> a -> b) -> b -> LedgerResult blk a -> b
foldl :: forall b a. (b -> a -> b) -> b -> LedgerResult blk a -> b
$cfoldl' :: forall blk b a. (b -> a -> b) -> b -> LedgerResult blk a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> LedgerResult blk a -> b
$cfoldr1 :: forall blk a. (a -> a -> a) -> LedgerResult blk a -> a
foldr1 :: forall a. (a -> a -> a) -> LedgerResult blk a -> a
$cfoldl1 :: forall blk a. (a -> a -> a) -> LedgerResult blk a -> a
foldl1 :: forall a. (a -> a -> a) -> LedgerResult blk a -> a
$ctoList :: forall blk a. LedgerResult blk a -> [a]
toList :: forall a. LedgerResult blk a -> [a]
$cnull :: forall blk a. LedgerResult blk a -> Bool
null :: forall a. LedgerResult blk a -> Bool
$clength :: forall blk a. LedgerResult blk a -> Int
length :: forall a. LedgerResult blk a -> Int
$celem :: forall blk a. Eq a => a -> LedgerResult blk a -> Bool
elem :: forall a. Eq a => a -> LedgerResult blk a -> Bool
$cmaximum :: forall blk a. Ord a => LedgerResult blk a -> a
maximum :: forall a. Ord a => LedgerResult blk a -> a
$cminimum :: forall blk a. Ord a => LedgerResult blk a -> a
minimum :: forall a. Ord a => LedgerResult blk a -> a
$csum :: forall blk a. Num a => LedgerResult blk a -> a
sum :: forall a. Num a => LedgerResult blk a -> a
$cproduct :: forall blk a. Num a => LedgerResult blk a -> a
product :: forall a. Num a => LedgerResult blk a -> a
Foldable, (forall a b. (a -> b) -> LedgerResult blk a -> LedgerResult blk b)
-> (forall a b. a -> LedgerResult blk b -> LedgerResult blk a)
-> Functor (LedgerResult blk)
forall a b. a -> LedgerResult blk b -> LedgerResult blk a
forall a b. (a -> b) -> LedgerResult blk a -> LedgerResult blk b
forall blk a b. a -> LedgerResult blk b -> LedgerResult blk a
forall blk a b.
(a -> b) -> LedgerResult blk a -> LedgerResult blk b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall blk a b.
(a -> b) -> LedgerResult blk a -> LedgerResult blk b
fmap :: forall a b. (a -> b) -> LedgerResult blk a -> LedgerResult blk b
$c<$ :: forall blk a b. a -> LedgerResult blk b -> LedgerResult blk a
<$ :: forall a b. a -> LedgerResult blk b -> LedgerResult blk a
Functor, Functor (LedgerResult blk)
Foldable (LedgerResult blk)
(Functor (LedgerResult blk), Foldable (LedgerResult blk)) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LedgerResult blk a -> f (LedgerResult blk b))
-> (forall (f :: * -> *) a.
Applicative f =>
LedgerResult blk (f a) -> f (LedgerResult blk a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LedgerResult blk a -> m (LedgerResult blk b))
-> (forall (m :: * -> *) a.
Monad m =>
LedgerResult blk (m a) -> m (LedgerResult blk a))
-> Traversable (LedgerResult blk)
forall blk. Functor (LedgerResult blk)
forall blk. Foldable (LedgerResult blk)
forall blk (m :: * -> *) a.
Monad m =>
LedgerResult blk (m a) -> m (LedgerResult blk a)
forall blk (f :: * -> *) a.
Applicative f =>
LedgerResult blk (f a) -> f (LedgerResult blk a)
forall blk (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LedgerResult blk a -> m (LedgerResult blk b)
forall blk (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LedgerResult blk a -> f (LedgerResult blk b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
LedgerResult blk (m a) -> m (LedgerResult blk a)
forall (f :: * -> *) a.
Applicative f =>
LedgerResult blk (f a) -> f (LedgerResult blk a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LedgerResult blk a -> m (LedgerResult blk b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LedgerResult blk a -> f (LedgerResult blk b)
$ctraverse :: forall blk (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LedgerResult blk a -> f (LedgerResult blk b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LedgerResult blk a -> f (LedgerResult blk b)
$csequenceA :: forall blk (f :: * -> *) a.
Applicative f =>
LedgerResult blk (f a) -> f (LedgerResult blk a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
LedgerResult blk (f a) -> f (LedgerResult blk a)
$cmapM :: forall blk (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LedgerResult blk a -> m (LedgerResult blk b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LedgerResult blk a -> m (LedgerResult blk b)
$csequence :: forall blk (m :: * -> *) a.
Monad m =>
LedgerResult blk (m a) -> m (LedgerResult blk a)
sequence :: forall (m :: * -> *) a.
Monad m =>
LedgerResult blk (m a) -> m (LedgerResult blk a)
Traversable)
castLedgerResult ::
AuxLedgerEvent l ~ AuxLedgerEvent l' =>
LedgerResult l a ->
LedgerResult l' a
castLedgerResult :: forall l l' a.
(AuxLedgerEvent l ~ AuxLedgerEvent l') =>
LedgerResult l a -> LedgerResult l' a
castLedgerResult (LedgerResult [AuxLedgerEvent l]
x0 a
x1) = [AuxLedgerEvent l'] -> a -> LedgerResult l' a
forall blk a. [AuxLedgerEvent blk] -> a -> LedgerResult blk a
LedgerResult [AuxLedgerEvent l]
[AuxLedgerEvent l']
x0 a
x1
embedLedgerResult ::
(AuxLedgerEvent l -> AuxLedgerEvent l') ->
LedgerResult l a ->
LedgerResult l' a
embedLedgerResult :: forall l l' a.
(AuxLedgerEvent l -> AuxLedgerEvent l')
-> LedgerResult l a -> LedgerResult l' a
embedLedgerResult AuxLedgerEvent l -> AuxLedgerEvent l'
inj LedgerResult l a
lr = LedgerResult l a
lr{lrEvents = inj `map` lrEvents lr}
pureLedgerResult :: a -> LedgerResult l a
pureLedgerResult :: forall a l. a -> LedgerResult l a
pureLedgerResult a
a =
LedgerResult
{ lrEvents :: [AuxLedgerEvent l]
lrEvents = [AuxLedgerEvent l]
forall a. Monoid a => a
mempty
, lrResult :: a
lrResult = a
a
}
type LedgerCfg :: StateKind -> Type -> Type
type family LedgerCfg l blk :: Type
type AuxLedgerEvent :: Type -> Type
type family AuxLedgerEvent blk :: Type
data ComputeLedgerEvents = ComputeLedgerEvents | OmitLedgerEvents
deriving (ComputeLedgerEvents -> ComputeLedgerEvents -> Bool
(ComputeLedgerEvents -> ComputeLedgerEvents -> Bool)
-> (ComputeLedgerEvents -> ComputeLedgerEvents -> Bool)
-> Eq ComputeLedgerEvents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComputeLedgerEvents -> ComputeLedgerEvents -> Bool
== :: ComputeLedgerEvents -> ComputeLedgerEvents -> Bool
$c/= :: ComputeLedgerEvents -> ComputeLedgerEvents -> Bool
/= :: ComputeLedgerEvents -> ComputeLedgerEvents -> Bool
Eq, Int -> ComputeLedgerEvents -> ShowS
[ComputeLedgerEvents] -> ShowS
ComputeLedgerEvents -> String
(Int -> ComputeLedgerEvents -> ShowS)
-> (ComputeLedgerEvents -> String)
-> ([ComputeLedgerEvents] -> ShowS)
-> Show ComputeLedgerEvents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComputeLedgerEvents -> ShowS
showsPrec :: Int -> ComputeLedgerEvents -> ShowS
$cshow :: ComputeLedgerEvents -> String
show :: ComputeLedgerEvents -> String
$cshowList :: [ComputeLedgerEvents] -> ShowS
showList :: [ComputeLedgerEvents] -> ShowS
Show, (forall x. ComputeLedgerEvents -> Rep ComputeLedgerEvents x)
-> (forall x. Rep ComputeLedgerEvents x -> ComputeLedgerEvents)
-> Generic ComputeLedgerEvents
forall x. Rep ComputeLedgerEvents x -> ComputeLedgerEvents
forall x. ComputeLedgerEvents -> Rep ComputeLedgerEvents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ComputeLedgerEvents -> Rep ComputeLedgerEvents x
from :: forall x. ComputeLedgerEvents -> Rep ComputeLedgerEvents x
$cto :: forall x. Rep ComputeLedgerEvents x -> ComputeLedgerEvents
to :: forall x. Rep ComputeLedgerEvents x -> ComputeLedgerEvents
Generic, Context -> ComputeLedgerEvents -> IO (Maybe ThunkInfo)
Proxy ComputeLedgerEvents -> String
(Context -> ComputeLedgerEvents -> IO (Maybe ThunkInfo))
-> (Context -> ComputeLedgerEvents -> IO (Maybe ThunkInfo))
-> (Proxy ComputeLedgerEvents -> String)
-> NoThunks ComputeLedgerEvents
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ComputeLedgerEvents -> IO (Maybe ThunkInfo)
noThunks :: Context -> ComputeLedgerEvents -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ComputeLedgerEvents -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ComputeLedgerEvents -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ComputeLedgerEvents -> String
showTypeOf :: Proxy ComputeLedgerEvents -> String
NoThunks)
type IsLedger :: StateKind -> Type -> Constraint
class
(
forall mk. EqMK mk => Eq (l blk mk)
, forall mk. NoThunksMK mk => NoThunks (l blk mk)
, forall mk. ShowMK mk => Show (l blk mk)
,
NoThunks (LedgerCfg l blk)
,
Show (LedgerErr l blk)
, Eq (LedgerErr l blk)
, NoThunks (LedgerErr l blk)
,
GetTip (l blk)
, GetTip (Ticked l blk)
) =>
IsLedger l blk
where
type LedgerErr l blk :: Type
applyChainTickLedgerResult ::
ComputeLedgerEvents ->
LedgerCfg l blk ->
SlotNo ->
l blk EmptyMK ->
LedgerResult blk (Ticked l blk DiffMK)
applyChainTick ::
IsLedger l blk =>
ComputeLedgerEvents ->
LedgerCfg l blk ->
SlotNo ->
l blk EmptyMK ->
Ticked l blk DiffMK
applyChainTick :: forall (l :: StateKind) blk.
IsLedger l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> SlotNo
-> l blk EmptyMK
-> Ticked l blk DiffMK
applyChainTick = LedgerResult blk (Ticked l blk DiffMK) -> Ticked l blk DiffMK
forall blk a. LedgerResult blk a -> a
lrResult (LedgerResult blk (Ticked l blk DiffMK) -> Ticked l blk DiffMK)
-> (ComputeLedgerEvents
-> LedgerCfg l blk
-> SlotNo
-> l blk EmptyMK
-> LedgerResult blk (Ticked l blk DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg l blk
-> SlotNo
-> l blk EmptyMK
-> Ticked l blk DiffMK
forall y z x0 x1 x2 x3.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> y) -> x0 -> x1 -> x2 -> x3 -> z
...: ComputeLedgerEvents
-> LedgerCfg l blk
-> SlotNo
-> l blk EmptyMK
-> LedgerResult blk (Ticked l blk DiffMK)
forall (l :: StateKind) blk.
IsLedger l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> SlotNo
-> l blk EmptyMK
-> LedgerResult blk (Ticked l blk DiffMK)
applyChainTickLedgerResult
type LedgerState :: Type -> LedgerStateKind
data family LedgerState blk mk
type TickedLedgerState blk = Ticked LedgerState blk
type instance (LedgerState blk) = HeaderHash blk
instance StandardHash blk => StandardHash (LedgerState blk)
type LedgerConfig blk = LedgerCfg LedgerState blk
type LedgerError blk = LedgerErr LedgerState blk