Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- type family BlockProtocol blk :: Type
- data family BlockConfig blk :: Type
- data family CodecConfig blk :: Type
- data family StorageConfig blk :: Type
-
class
(
HasHeader
blk,
GetHeader
blk) =>
GetPrevHash
blk
where
- headerPrevHash :: Header blk -> ChainHash blk
- blockPrevHash :: GetPrevHash blk => blk -> ChainHash blk
-
class
HasHeader
(
Header
blk) =>
GetHeader
blk
where
- getHeader :: blk -> Header blk
- blockMatchesHeader :: Header blk -> blk -> Bool
- headerIsEBB :: Header blk -> Maybe EpochNo
- data family Header blk :: Type
- blockIsEBB :: GetHeader blk => blk -> Maybe EpochNo
- blockToIsEBB :: GetHeader blk => blk -> IsEBB
- getBlockHeaderFields :: GetHeader blk => blk -> HeaderFields blk
- headerHash :: HasHeader ( Header blk) => Header blk -> HeaderHash blk
- headerPoint :: HasHeader ( Header blk) => Header blk -> Point blk
- headerToIsEBB :: GetHeader blk => Header blk -> IsEBB
-
class
ConvertRawHash
blk
where
- toRawHash :: proxy blk -> HeaderHash blk -> ByteString
- fromRawHash :: proxy blk -> ByteString -> HeaderHash blk
- toShortRawHash :: proxy blk -> HeaderHash blk -> ShortByteString
- fromShortRawHash :: proxy blk -> ShortByteString -> HeaderHash blk
- hashSize :: proxy blk -> Word32
- decodeRawHash :: ConvertRawHash blk => proxy blk -> forall s. Decoder s ( HeaderHash blk)
- encodeRawHash :: ConvertRawHash blk => proxy blk -> HeaderHash blk -> Encoding
- succWithOrigin :: ( Bounded t, Enum t) => WithOrigin t -> t
-
data
ChainHash
b
- = GenesisHash
- | BlockHash !( HeaderHash b)
-
class
(
StandardHash
b,
Typeable
b) =>
HasHeader
b
where
- getHeaderFields :: b -> HeaderFields b
- data HeaderFields b = HeaderFields { }
- type family HeaderHash b
-
data
Point
block
where
- pattern GenesisPoint :: Point block
- pattern BlockPoint :: SlotNo -> HeaderHash block -> Point block
- class ( Eq ( HeaderHash b), Ord ( HeaderHash b), Show ( HeaderHash b), Typeable ( HeaderHash b), NoThunks ( HeaderHash b)) => StandardHash b
- blockHash :: HasHeader b => b -> HeaderHash b
- blockNo :: HasHeader b => b -> BlockNo
- blockPoint :: HasHeader block => block -> Point block
- blockSlot :: HasHeader b => b -> SlotNo
- castHash :: Coercible ( HeaderHash b) ( HeaderHash b') => ChainHash b -> ChainHash b'
- castHeaderFields :: HeaderHash b ~ HeaderHash b' => HeaderFields b -> HeaderFields b'
- castPoint :: Coercible ( HeaderHash b) ( HeaderHash b') => Point b -> Point b'
- pointHash :: Point block -> ChainHash block
- pointSlot :: Point block -> WithOrigin SlotNo
- newtype BlockNo = BlockNo { }
- newtype EpochNo = EpochNo { }
- newtype EpochSize = EpochSize { }
- newtype SlotNo = SlotNo { }
-
data
WithOrigin
t
where
- Origin
- pattern NotOrigin :: t -> WithOrigin t
- fromWithOrigin :: t -> WithOrigin t -> t
- withOrigin :: b -> (t -> b) -> WithOrigin t -> b
- withOriginFromMaybe :: Maybe t -> WithOrigin t
- withOriginToMaybe :: WithOrigin t -> Maybe t
Protocol
type family BlockProtocol blk :: Type Source #
Map block to consensus protocol
Instances
type BlockProtocol ( Header blk) Source # | |
Defined in Ouroboros.Consensus.Block.Abstract |
|
type BlockProtocol ( HardForkBlock xs) Source # | |
|
|
type BlockProtocol ( DualBlock m a) Source # | |
Defined in Ouroboros.Consensus.Ledger.Dual |
Configuration
data family BlockConfig blk :: Type Source #
Static configuration required to work with this type of blocks
Instances
Isomorphic BlockConfig Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Embed.Unary project :: NoHardForks blk => BlockConfig ( HardForkBlock '[blk]) -> BlockConfig blk Source # inject :: NoHardForks blk => BlockConfig blk -> BlockConfig ( HardForkBlock '[blk]) Source # |
|
NoThunks ( BlockConfig ( DualBlock m a)) Source # | |
CanHardFork xs => NoThunks ( BlockConfig ( HardForkBlock xs)) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Basics noThunks :: Context -> BlockConfig ( HardForkBlock xs) -> IO ( Maybe ThunkInfo ) Source # wNoThunks :: Context -> BlockConfig ( HardForkBlock xs) -> IO ( Maybe ThunkInfo ) Source # showTypeOf :: Proxy ( BlockConfig ( HardForkBlock xs)) -> String Source # |
|
newtype BlockConfig ( HardForkBlock xs) Source # | |
|
|
data BlockConfig ( DualBlock m a) Source # | |
Defined in Ouroboros.Consensus.Ledger.Dual |
data family CodecConfig blk :: Type Source #
Static configuration required for serialisation and deserialisation of types pertaining to this type of block.
Data family instead of type family to get better type inference.
Instances
data family StorageConfig blk :: Type Source #
Config needed for the
NodeInitStorage
class. Defined here to
avoid circular dependencies.
Instances
Previous hash
class ( HasHeader blk, GetHeader blk) => GetPrevHash blk where Source #
headerPrevHash :: Header blk -> ChainHash blk Source #
Get the hash of the predecessor of this block
Instances
CanHardFork xs => GetPrevHash ( HardForkBlock xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Block headerPrevHash :: Header ( HardForkBlock xs) -> ChainHash ( HardForkBlock xs) Source # |
|
Bridge m a => GetPrevHash ( DualBlock m a) Source # | |
Defined in Ouroboros.Consensus.Ledger.Dual |
blockPrevHash :: GetPrevHash blk => blk -> ChainHash blk Source #
Working with headers
class HasHeader ( Header blk) => GetHeader blk where Source #
getHeader :: blk -> Header blk Source #
blockMatchesHeader :: Header blk -> blk -> Bool Source #
Check whether the header is the header of the block.
For example, by checking whether the hash of the body stored in the header matches that of the block.
headerIsEBB :: Header blk -> Maybe EpochNo Source #
When the given header is the header of an Epoch Boundary Block, returns its epoch number.
Instances
CanHardFork xs => GetHeader ( HardForkBlock xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Block getHeader :: HardForkBlock xs -> Header ( HardForkBlock xs) Source # blockMatchesHeader :: Header ( HardForkBlock xs) -> HardForkBlock xs -> Bool Source # headerIsEBB :: Header ( HardForkBlock xs) -> Maybe EpochNo Source # |
|
Bridge m a => GetHeader ( DualBlock m a) Source # | |
data family Header blk :: Type Source #
Instances
blockToIsEBB :: GetHeader blk => blk -> IsEBB Source #
getBlockHeaderFields :: GetHeader blk => blk -> HeaderFields blk Source #
Get the
HeaderFields
of a block, without requiring 'HasHeader blk'
This is primarily useful as a a simple definition of
HasHeader
for
block types:
instance HasHeader SomeBlock where getHeaderFields = getBlockHeaderFields
provided that there is a
HasHeader
instance for the header.
Unfortunately we cannot give a
HasHeader
instance once and for all; if we
mapped from a header to a block instead we could do
instance HasHeader hdr => HasHeader (Block hdr) where ..
but we can't do that when we do things this way around.
headerHash :: HasHeader ( Header blk) => Header blk -> HeaderHash blk Source #
Raw hash
class ConvertRawHash blk where Source #
Convert a hash from/to raw bytes
Variants of
toRawHash
and
fromRawHash
for
ShortByteString
are
included. Override the default implementations to avoid an extra step in
case the
HeaderHash
is a
ShortByteString
under the hood.
hashSize , ( toRawHash | toShortRawHash ), ( fromRawHash | fromShortRawHash )
toRawHash :: proxy blk -> HeaderHash blk -> ByteString Source #
Get the raw bytes from a hash
fromRawHash :: proxy blk -> ByteString -> HeaderHash blk Source #
Construct the hash from a raw hash
PRECONDITION: the bytestring's size must match
hashSize
toShortRawHash :: proxy blk -> HeaderHash blk -> ShortByteString Source #
Variant of
toRawHash
for
ShortByteString
fromShortRawHash :: proxy blk -> ShortByteString -> HeaderHash blk Source #
Variant of
fromRawHash
for
ShortByteString
hashSize :: proxy blk -> Word32 Source #
The size of the hash in number of bytes
Instances
decodeRawHash :: ConvertRawHash blk => proxy blk -> forall s. Decoder s ( HeaderHash blk) Source #
encodeRawHash :: ConvertRawHash blk => proxy blk -> HeaderHash blk -> Encoding Source #
Utilities for working with WithOrigin
succWithOrigin :: ( Bounded t, Enum t) => WithOrigin t -> t Source #
Return the successor of a
WithOrigin
value. Useful in combination with
SlotNo
and
BlockNo
.
Re-export basic definitions from
ouroboros-network
GenesisHash | |
BlockHash !( HeaderHash b) |
Instances
class ( StandardHash b, Typeable b) => HasHeader b where Source #
Abstract over the shape of blocks (or indeed just block headers)
getHeaderFields :: b -> HeaderFields b Source #
Instances
( StandardHash b, Typeable b) => HasHeader ( HeaderFields b) | |
Defined in Ouroboros.Network.Block getHeaderFields :: HeaderFields b -> HeaderFields ( HeaderFields b) Source # |
|
CanHardFork xs => HasHeader ( Header ( HardForkBlock xs)) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Block getHeaderFields :: Header ( HardForkBlock xs) -> HeaderFields ( Header ( HardForkBlock xs)) Source # |
|
CanHardFork xs => HasHeader ( HardForkBlock xs) Source # | |
Defined in Ouroboros.Consensus.HardFork.Combinator.Block getHeaderFields :: HardForkBlock xs -> HeaderFields ( HardForkBlock xs) Source # |
|
Bridge m a => HasHeader ( DualHeader m a) Source # | |
Defined in Ouroboros.Consensus.Ledger.Dual getHeaderFields :: DualHeader m a -> HeaderFields ( DualHeader m a) Source # |
|
Bridge m a => HasHeader ( DualBlock m a) Source # | |
Defined in Ouroboros.Consensus.Ledger.Dual getHeaderFields :: DualBlock m a -> HeaderFields ( DualBlock m a) Source # |
data HeaderFields b Source #
Header fields we expect to be present in a block
These fields are lazy because they are extracted from a block or block header; this type is not intended for storage.
Instances
type family HeaderHash b Source #
Header hash
Instances
type HeaderHash ( HeaderFields b) | |
Defined in Ouroboros.Network.Block |
|
type HeaderHash ( Serialised block) | |
Defined in Ouroboros.Network.Block |
|
type HeaderHash ( Ticked l) Source # | |
Defined in Ouroboros.Consensus.Ledger.Basics |
|
type HeaderHash ( Header blk) Source # | |
Defined in Ouroboros.Consensus.Block.Abstract |
|
type HeaderHash ( LedgerState blk) Source # | |
Defined in Ouroboros.Consensus.Ledger.Basics |
|
type HeaderHash ( SerialisedHeader blk) Source # |
Only needed for the
|
Defined in Ouroboros.Consensus.Storage.Serialisation |
|
type HeaderHash ( ExtLedgerState blk) Source # | |
Defined in Ouroboros.Consensus.Ledger.Extended |
|
type HeaderHash ( LedgerDB l) Source # | |
|
|
type HeaderHash ( HardForkBlock xs) Source # | |
|
|
type HeaderHash ( DualBlock m a) Source # | |
Defined in Ouroboros.Consensus.Ledger.Dual |
|
type HeaderHash ( WithPoint blk b) Source # | |
Defined in Ouroboros.Consensus.Storage.ChainDB.API |
data Point block where Source #
A point on the chain is identified by its
Slot
and
HeaderHash
.
The
Slot
tells us where to look and the
HeaderHash
either simply serves
as a check, or in some contexts it disambiguates blocks from different forks
that were in the same slot.
It's a newtype rather than a type synonym, because using a type synonym would lead to ambiguity, since HeaderHash is a non-injective type family.
pattern GenesisPoint :: Point block | |
pattern BlockPoint :: SlotNo -> HeaderHash block -> Point block |
Instances
StandardHash block => Eq ( Point block) | |
StandardHash block => Ord ( Point block) | |
Defined in Ouroboros.Network.Block compare :: Point block -> Point block -> Ordering Source # (<) :: Point block -> Point block -> Bool Source # (<=) :: Point block -> Point block -> Bool Source # (>) :: Point block -> Point block -> Bool Source # (>=) :: Point block -> Point block -> Bool Source # |
|
StandardHash block => Show ( Point block) | |
Generic ( Point block) | |
StandardHash block => NoThunks ( Point block) | |
Serialise ( HeaderHash block) => Serialise ( Point block) | |
Condense ( HeaderHash block) => Condense ( Point block) Source # | |
ShowProxy block => ShowProxy ( Point block :: Type ) | |
type Rep ( Point block) | |
Defined in Ouroboros.Network.Block
type
Rep
(
Point
block) =
D1
('
MetaData
"Point" "Ouroboros.Network.Block" "ouroboros-network-0.1.0.1-2UgqzRSdBh49QYumtriFSI" '
True
) (
C1
('
MetaCons
"Point" '
PrefixI
'
True
) (
S1
('
MetaSel
('
Just
"getPoint") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
(
WithOrigin
(
Block
SlotNo
(
HeaderHash
block))))))
|
class ( Eq ( HeaderHash b), Ord ( HeaderHash b), Show ( HeaderHash b), Typeable ( HeaderHash b), NoThunks ( HeaderHash b)) => StandardHash b Source #
StandardHash
summarises the constraints we want header hashes to have
Without this class we would need to write
deriving instance Eq (HeaderHash block) => Eq (ChainHash block)`
That requires
UndecidableInstances
; not a problem by itself, but it also
means that we can then not use
deriving Eq
anywhere else for datatypes
that reference
Hash
, which is very frustrating; see
Introducing the
StandardHash
class avoids this problem.
Having these constraints directly as part of the
HasHeader
class is
possible but libraries that
use
the networking layer may wish to be able to
talk about
StandardHash
independently of
HasHeader
since the latter may
impose yet further constraints.
Instances
StandardHash b => StandardHash ( HeaderFields b) | |
Defined in Ouroboros.Network.Block |
|
StandardHash block => StandardHash ( Serialised block) | |
Defined in Ouroboros.Network.Block |
|
HasHeader blk => StandardHash ( Header blk) Source # | |
Defined in Ouroboros.Consensus.Block.Abstract |
|
StandardHash blk => StandardHash ( SerialisedHeader blk) Source # | |
Defined in Ouroboros.Consensus.Storage.Serialisation |
|
CanHardFork xs => StandardHash ( HardForkBlock xs) Source # | |
StandardHash m => StandardHash ( DualBlock m a) Source # | |
Defined in Ouroboros.Consensus.Ledger.Dual |
|
StandardHash blk => StandardHash ( WithPoint blk b) Source # | |
Defined in Ouroboros.Consensus.Storage.ChainDB.API |
blockHash :: HasHeader b => b -> HeaderHash b Source #
blockPoint :: HasHeader block => block -> Point block Source #
castHash :: Coercible ( HeaderHash b) ( HeaderHash b') => ChainHash b -> ChainHash b' Source #
castHeaderFields :: HeaderHash b ~ HeaderHash b' => HeaderFields b -> HeaderFields b' Source #
castPoint :: Coercible ( HeaderHash b) ( HeaderHash b') => Point b -> Point b' Source #
Re-export basic definitions from
cardano-base
The 0-based index of the block in the blockchain. BlockNo is <= SlotNo and is only equal at slot N if there is a block for every slot where N <= SlotNo.
Instances
Bounded BlockNo | |
Enum BlockNo | |
Defined in Cardano.Slotting.Block succ :: BlockNo -> BlockNo Source # pred :: BlockNo -> BlockNo Source # toEnum :: Int -> BlockNo Source # fromEnum :: BlockNo -> Int Source # enumFrom :: BlockNo -> [ BlockNo ] Source # enumFromThen :: BlockNo -> BlockNo -> [ BlockNo ] Source # enumFromTo :: BlockNo -> BlockNo -> [ BlockNo ] Source # enumFromThenTo :: BlockNo -> BlockNo -> BlockNo -> [ BlockNo ] Source # |
|
Eq BlockNo | |
Num BlockNo | |
Defined in Cardano.Slotting.Block |
|
Ord BlockNo | |
Defined in Cardano.Slotting.Block |
|
Show BlockNo | |
Generic BlockNo | |
ToCBOR BlockNo | |
FromCBOR BlockNo | |
NFData BlockNo | |
Defined in Cardano.Slotting.Block |
|
NoThunks BlockNo | |
Serialise BlockNo | |
Condense BlockNo Source # | |
type Rep BlockNo | |
Defined in Cardano.Slotting.Block |
An epoch, i.e. the number of the epoch.
Instances
Enum EpochNo | |
Defined in Cardano.Slotting.Slot succ :: EpochNo -> EpochNo Source # pred :: EpochNo -> EpochNo Source # toEnum :: Int -> EpochNo Source # fromEnum :: EpochNo -> Int Source # enumFrom :: EpochNo -> [ EpochNo ] Source # enumFromThen :: EpochNo -> EpochNo -> [ EpochNo ] Source # enumFromTo :: EpochNo -> EpochNo -> [ EpochNo ] Source # enumFromThenTo :: EpochNo -> EpochNo -> EpochNo -> [ EpochNo ] Source # |
|
Eq EpochNo | |
Num EpochNo | |
Defined in Cardano.Slotting.Slot |
|
Ord EpochNo | |
Defined in Cardano.Slotting.Slot |
|
Show EpochNo | |
Generic EpochNo | |
ToJSON EpochNo | |
FromJSON EpochNo | |
ToCBOR EpochNo | |
FromCBOR EpochNo | |
NFData EpochNo | |
Defined in Cardano.Slotting.Slot |
|
NoThunks EpochNo | |
Serialise EpochNo | |
Condense EpochNo Source # | |
type Rep EpochNo | |
Defined in Cardano.Slotting.Slot |
Instances
The 0-based index for the Ourboros time slot.
Instances
data WithOrigin t Source #
pattern NotOrigin :: t -> WithOrigin t |
Custom pattern for
This avoids clashing with our (extensive) use of
|
Instances
fromWithOrigin :: t -> WithOrigin t -> t Source #
withOrigin :: b -> (t -> b) -> WithOrigin t -> b Source #
withOriginFromMaybe :: Maybe t -> WithOrigin t Source #
withOriginToMaybe :: WithOrigin t -> Maybe t Source #