{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}
module Ouroboros.Consensus.Storage.Common (
tipIsGenesis
, PrefixLen (..)
, addPrefixLen
, takePrefix
, BinaryBlockInfo (..)
, extractHeader
, StreamFrom (..)
, StreamTo (..)
, validBounds
, BlockComponent (..)
, SizeInBytes
) where
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as Short
import Data.Word
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block
import Ouroboros.Network.SizeInBytes (SizeInBytes)
tipIsGenesis :: WithOrigin r -> Bool
tipIsGenesis :: forall r. WithOrigin r -> Bool
tipIsGenesis WithOrigin r
Origin = Bool
True
tipIsGenesis (NotOrigin r
_) = Bool
False
newtype PrefixLen = PrefixLen {
PrefixLen -> Word8
getPrefixLen :: Word8
}
deriving stock (PrefixLen -> PrefixLen -> Bool
(PrefixLen -> PrefixLen -> Bool)
-> (PrefixLen -> PrefixLen -> Bool) -> Eq PrefixLen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrefixLen -> PrefixLen -> Bool
== :: PrefixLen -> PrefixLen -> Bool
$c/= :: PrefixLen -> PrefixLen -> Bool
/= :: PrefixLen -> PrefixLen -> Bool
Eq, Eq PrefixLen
Eq PrefixLen =>
(PrefixLen -> PrefixLen -> Ordering)
-> (PrefixLen -> PrefixLen -> Bool)
-> (PrefixLen -> PrefixLen -> Bool)
-> (PrefixLen -> PrefixLen -> Bool)
-> (PrefixLen -> PrefixLen -> Bool)
-> (PrefixLen -> PrefixLen -> PrefixLen)
-> (PrefixLen -> PrefixLen -> PrefixLen)
-> Ord PrefixLen
PrefixLen -> PrefixLen -> Bool
PrefixLen -> PrefixLen -> Ordering
PrefixLen -> PrefixLen -> PrefixLen
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PrefixLen -> PrefixLen -> Ordering
compare :: PrefixLen -> PrefixLen -> Ordering
$c< :: PrefixLen -> PrefixLen -> Bool
< :: PrefixLen -> PrefixLen -> Bool
$c<= :: PrefixLen -> PrefixLen -> Bool
<= :: PrefixLen -> PrefixLen -> Bool
$c> :: PrefixLen -> PrefixLen -> Bool
> :: PrefixLen -> PrefixLen -> Bool
$c>= :: PrefixLen -> PrefixLen -> Bool
>= :: PrefixLen -> PrefixLen -> Bool
$cmax :: PrefixLen -> PrefixLen -> PrefixLen
max :: PrefixLen -> PrefixLen -> PrefixLen
$cmin :: PrefixLen -> PrefixLen -> PrefixLen
min :: PrefixLen -> PrefixLen -> PrefixLen
Ord, Int -> PrefixLen -> ShowS
[PrefixLen] -> ShowS
PrefixLen -> String
(Int -> PrefixLen -> ShowS)
-> (PrefixLen -> String)
-> ([PrefixLen] -> ShowS)
-> Show PrefixLen
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrefixLen -> ShowS
showsPrec :: Int -> PrefixLen -> ShowS
$cshow :: PrefixLen -> String
show :: PrefixLen -> String
$cshowList :: [PrefixLen] -> ShowS
showList :: [PrefixLen] -> ShowS
Show, (forall x. PrefixLen -> Rep PrefixLen x)
-> (forall x. Rep PrefixLen x -> PrefixLen) -> Generic PrefixLen
forall x. Rep PrefixLen x -> PrefixLen
forall x. PrefixLen -> Rep PrefixLen x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PrefixLen -> Rep PrefixLen x
from :: forall x. PrefixLen -> Rep PrefixLen x
$cto :: forall x. Rep PrefixLen x -> PrefixLen
to :: forall x. Rep PrefixLen x -> PrefixLen
Generic)
deriving newtype (Context -> PrefixLen -> IO (Maybe ThunkInfo)
Proxy PrefixLen -> String
(Context -> PrefixLen -> IO (Maybe ThunkInfo))
-> (Context -> PrefixLen -> IO (Maybe ThunkInfo))
-> (Proxy PrefixLen -> String)
-> NoThunks PrefixLen
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> PrefixLen -> IO (Maybe ThunkInfo)
noThunks :: Context -> PrefixLen -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PrefixLen -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PrefixLen -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PrefixLen -> String
showTypeOf :: Proxy PrefixLen -> String
NoThunks)
addPrefixLen :: Word8 -> PrefixLen -> PrefixLen
addPrefixLen :: Word8 -> PrefixLen -> PrefixLen
addPrefixLen Word8
m (PrefixLen Word8
n) = Word8 -> PrefixLen
PrefixLen (Word8
m Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
n)
takePrefix :: PrefixLen -> BL.ByteString -> ShortByteString
takePrefix :: PrefixLen -> ByteString -> ShortByteString
takePrefix (PrefixLen Word8
n) =
ByteString -> ShortByteString
Short.toShort (ByteString -> ShortByteString)
-> (ByteString -> ByteString) -> ByteString -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> ByteString
BL.take (Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n)
data BinaryBlockInfo = BinaryBlockInfo
{ :: !Word16
, :: !Word16
} deriving (BinaryBlockInfo -> BinaryBlockInfo -> Bool
(BinaryBlockInfo -> BinaryBlockInfo -> Bool)
-> (BinaryBlockInfo -> BinaryBlockInfo -> Bool)
-> Eq BinaryBlockInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinaryBlockInfo -> BinaryBlockInfo -> Bool
== :: BinaryBlockInfo -> BinaryBlockInfo -> Bool
$c/= :: BinaryBlockInfo -> BinaryBlockInfo -> Bool
/= :: BinaryBlockInfo -> BinaryBlockInfo -> Bool
Eq, Int -> BinaryBlockInfo -> ShowS
[BinaryBlockInfo] -> ShowS
BinaryBlockInfo -> String
(Int -> BinaryBlockInfo -> ShowS)
-> (BinaryBlockInfo -> String)
-> ([BinaryBlockInfo] -> ShowS)
-> Show BinaryBlockInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinaryBlockInfo -> ShowS
showsPrec :: Int -> BinaryBlockInfo -> ShowS
$cshow :: BinaryBlockInfo -> String
show :: BinaryBlockInfo -> String
$cshowList :: [BinaryBlockInfo] -> ShowS
showList :: [BinaryBlockInfo] -> ShowS
Show, (forall x. BinaryBlockInfo -> Rep BinaryBlockInfo x)
-> (forall x. Rep BinaryBlockInfo x -> BinaryBlockInfo)
-> Generic BinaryBlockInfo
forall x. Rep BinaryBlockInfo x -> BinaryBlockInfo
forall x. BinaryBlockInfo -> Rep BinaryBlockInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinaryBlockInfo -> Rep BinaryBlockInfo x
from :: forall x. BinaryBlockInfo -> Rep BinaryBlockInfo x
$cto :: forall x. Rep BinaryBlockInfo x -> BinaryBlockInfo
to :: forall x. Rep BinaryBlockInfo x -> BinaryBlockInfo
Generic)
extractHeader :: BinaryBlockInfo -> ByteString -> ByteString
BinaryBlockInfo { Word16
headerOffset :: BinaryBlockInfo -> Word16
headerOffset :: Word16
headerOffset, Word16
headerSize :: BinaryBlockInfo -> Word16
headerSize :: Word16
headerSize } =
Int64 -> ByteString -> ByteString
BL.take (Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
headerSize)
(ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> ByteString
BL.drop (Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
headerOffset)
data StreamFrom blk =
StreamFromInclusive !(RealPoint blk)
| StreamFromExclusive !(Point blk)
deriving stock (Int -> StreamFrom blk -> ShowS
[StreamFrom blk] -> ShowS
StreamFrom blk -> String
(Int -> StreamFrom blk -> ShowS)
-> (StreamFrom blk -> String)
-> ([StreamFrom blk] -> ShowS)
-> Show (StreamFrom blk)
forall blk. StandardHash blk => Int -> StreamFrom blk -> ShowS
forall blk. StandardHash blk => [StreamFrom blk] -> ShowS
forall blk. StandardHash blk => StreamFrom blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall blk. StandardHash blk => Int -> StreamFrom blk -> ShowS
showsPrec :: Int -> StreamFrom blk -> ShowS
$cshow :: forall blk. StandardHash blk => StreamFrom blk -> String
show :: StreamFrom blk -> String
$cshowList :: forall blk. StandardHash blk => [StreamFrom blk] -> ShowS
showList :: [StreamFrom blk] -> ShowS
Show, StreamFrom blk -> StreamFrom blk -> Bool
(StreamFrom blk -> StreamFrom blk -> Bool)
-> (StreamFrom blk -> StreamFrom blk -> Bool)
-> Eq (StreamFrom blk)
forall blk.
StandardHash blk =>
StreamFrom blk -> StreamFrom blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall blk.
StandardHash blk =>
StreamFrom blk -> StreamFrom blk -> Bool
== :: StreamFrom blk -> StreamFrom blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
StreamFrom blk -> StreamFrom blk -> Bool
/= :: StreamFrom blk -> StreamFrom blk -> Bool
Eq, (forall x. StreamFrom blk -> Rep (StreamFrom blk) x)
-> (forall x. Rep (StreamFrom blk) x -> StreamFrom blk)
-> Generic (StreamFrom blk)
forall x. Rep (StreamFrom blk) x -> StreamFrom blk
forall x. StreamFrom blk -> Rep (StreamFrom blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (StreamFrom blk) x -> StreamFrom blk
forall blk x. StreamFrom blk -> Rep (StreamFrom blk) x
$cfrom :: forall blk x. StreamFrom blk -> Rep (StreamFrom blk) x
from :: forall x. StreamFrom blk -> Rep (StreamFrom blk) x
$cto :: forall blk x. Rep (StreamFrom blk) x -> StreamFrom blk
to :: forall x. Rep (StreamFrom blk) x -> StreamFrom blk
Generic)
deriving anyclass (Context -> StreamFrom blk -> IO (Maybe ThunkInfo)
Proxy (StreamFrom blk) -> String
(Context -> StreamFrom blk -> IO (Maybe ThunkInfo))
-> (Context -> StreamFrom blk -> IO (Maybe ThunkInfo))
-> (Proxy (StreamFrom blk) -> String)
-> NoThunks (StreamFrom blk)
forall blk.
(StandardHash blk, Typeable blk) =>
Context -> StreamFrom blk -> IO (Maybe ThunkInfo)
forall blk.
(StandardHash blk, Typeable blk) =>
Proxy (StreamFrom blk) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall blk.
(StandardHash blk, Typeable blk) =>
Context -> StreamFrom blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> StreamFrom blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall blk.
(StandardHash blk, Typeable blk) =>
Context -> StreamFrom blk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> StreamFrom blk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall blk.
(StandardHash blk, Typeable blk) =>
Proxy (StreamFrom blk) -> String
showTypeOf :: Proxy (StreamFrom blk) -> String
NoThunks)
newtype StreamTo blk =
StreamToInclusive (RealPoint blk)
deriving stock (Int -> StreamTo blk -> ShowS
[StreamTo blk] -> ShowS
StreamTo blk -> String
(Int -> StreamTo blk -> ShowS)
-> (StreamTo blk -> String)
-> ([StreamTo blk] -> ShowS)
-> Show (StreamTo blk)
forall blk. StandardHash blk => Int -> StreamTo blk -> ShowS
forall blk. StandardHash blk => [StreamTo blk] -> ShowS
forall blk. StandardHash blk => StreamTo blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall blk. StandardHash blk => Int -> StreamTo blk -> ShowS
showsPrec :: Int -> StreamTo blk -> ShowS
$cshow :: forall blk. StandardHash blk => StreamTo blk -> String
show :: StreamTo blk -> String
$cshowList :: forall blk. StandardHash blk => [StreamTo blk] -> ShowS
showList :: [StreamTo blk] -> ShowS
Show, StreamTo blk -> StreamTo blk -> Bool
(StreamTo blk -> StreamTo blk -> Bool)
-> (StreamTo blk -> StreamTo blk -> Bool) -> Eq (StreamTo blk)
forall blk.
StandardHash blk =>
StreamTo blk -> StreamTo blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall blk.
StandardHash blk =>
StreamTo blk -> StreamTo blk -> Bool
== :: StreamTo blk -> StreamTo blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
StreamTo blk -> StreamTo blk -> Bool
/= :: StreamTo blk -> StreamTo blk -> Bool
Eq, (forall x. StreamTo blk -> Rep (StreamTo blk) x)
-> (forall x. Rep (StreamTo blk) x -> StreamTo blk)
-> Generic (StreamTo blk)
forall x. Rep (StreamTo blk) x -> StreamTo blk
forall x. StreamTo blk -> Rep (StreamTo blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (StreamTo blk) x -> StreamTo blk
forall blk x. StreamTo blk -> Rep (StreamTo blk) x
$cfrom :: forall blk x. StreamTo blk -> Rep (StreamTo blk) x
from :: forall x. StreamTo blk -> Rep (StreamTo blk) x
$cto :: forall blk x. Rep (StreamTo blk) x -> StreamTo blk
to :: forall x. Rep (StreamTo blk) x -> StreamTo blk
Generic)
deriving anyclass (Context -> StreamTo blk -> IO (Maybe ThunkInfo)
Proxy (StreamTo blk) -> String
(Context -> StreamTo blk -> IO (Maybe ThunkInfo))
-> (Context -> StreamTo blk -> IO (Maybe ThunkInfo))
-> (Proxy (StreamTo blk) -> String)
-> NoThunks (StreamTo blk)
forall blk.
(StandardHash blk, Typeable blk) =>
Context -> StreamTo blk -> IO (Maybe ThunkInfo)
forall blk.
(StandardHash blk, Typeable blk) =>
Proxy (StreamTo blk) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall blk.
(StandardHash blk, Typeable blk) =>
Context -> StreamTo blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> StreamTo blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall blk.
(StandardHash blk, Typeable blk) =>
Context -> StreamTo blk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> StreamTo blk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall blk.
(StandardHash blk, Typeable blk) =>
Proxy (StreamTo blk) -> String
showTypeOf :: Proxy (StreamTo blk) -> String
NoThunks)
validBounds :: StandardHash blk => StreamFrom blk -> StreamTo blk -> Bool
validBounds :: forall blk.
StandardHash blk =>
StreamFrom blk -> StreamTo blk -> Bool
validBounds StreamFrom blk
from (StreamToInclusive (RealPoint SlotNo
sto HeaderHash blk
hto)) =
case StreamFrom blk
from of
StreamFromExclusive Point blk
GenesisPoint -> Bool
True
StreamFromExclusive (BlockPoint SlotNo
sfrom HeaderHash blk
hfrom) -> HeaderHash blk
hfrom HeaderHash blk -> HeaderHash blk -> Bool
forall a. Eq a => a -> a -> Bool
/= HeaderHash blk
hto Bool -> Bool -> Bool
&& SlotNo
sfrom SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
sto
StreamFromInclusive (RealPoint SlotNo
sfrom HeaderHash blk
_) -> SlotNo
sfrom SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
sto
data BlockComponent blk a where
GetVerifiedBlock :: BlockComponent blk blk
GetBlock :: BlockComponent blk blk
GetRawBlock :: BlockComponent blk ByteString
:: BlockComponent blk (Header blk)
:: BlockComponent blk ByteString
GetHash :: BlockComponent blk (HeaderHash blk)
GetSlot :: BlockComponent blk SlotNo
GetIsEBB :: BlockComponent blk IsEBB
GetBlockSize :: BlockComponent blk SizeInBytes
:: BlockComponent blk Word16
GetNestedCtxt :: BlockComponent blk (SomeSecond (NestedCtxt Header) blk)
GetPure :: a
-> BlockComponent blk a
GetApply :: BlockComponent blk (a -> b)
-> BlockComponent blk a
-> BlockComponent blk b
instance Functor (BlockComponent blk) where
fmap :: forall a b.
(a -> b) -> BlockComponent blk a -> BlockComponent blk b
fmap a -> b
f = ((a -> b) -> BlockComponent blk (a -> b)
forall a blk. a -> BlockComponent blk a
GetPure a -> b
f BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>)
instance Applicative (BlockComponent blk) where
pure :: forall a. a -> BlockComponent blk a
pure = a -> BlockComponent blk a
forall a blk. a -> BlockComponent blk a
GetPure
<*> :: forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
(<*>) = BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall blk a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
GetApply