{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} -- Just to keep 'HasCallstack' on 'validExtension'. {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- | Reference implementation of a representation of a block chain -- module Ouroboros.Network.MockChain.Chain ( -- * Chain type and fundamental operations Chain (..) , valid , validExtension , foldChain , chainToList -- ** Block re-exports , HasHeader (..) , HeaderHash -- * Point type , Point (..) , blockPoint -- * Chain construction and inspection -- ** Genesis , genesis -- ** Head inspection , headPoint , headSlot , headHash , headTip , headBlockNo , headAnchor -- ** Basic operations , head , toNewestFirst , toOldestFirst , fromNewestFirst , fromOldestFirst , drop , length , null , takeWhile -- ** Update type and operations , ChainUpdate (..) , addBlock , rollback , applyChainUpdate , applyChainUpdates -- * Special operations , pointOnChain , pointIsAfter , successorBlock , selectChain , selectPoints , findBlock , selectBlockRange , findFirstPoint , intersectChains , isPrefixOf -- * Conversion to/from AnchoredFragment , fromAnchoredFragment , toAnchoredFragment -- * Helper functions , prettyPrintChain ) where import Prelude hiding (drop, head, length, null, takeWhile) import qualified Prelude import Codec.CBOR.Decoding (decodeListLen) import Codec.CBOR.Encoding (encodeListLen) import Codec.Serialise (Serialise (..)) import Control.Exception (assert) import qualified Data.List as L import GHC.Stack import Ouroboros.Network.AnchoredFragment (Anchor (..)) import qualified Ouroboros.Network.AnchoredFragment as AF import Ouroboros.Network.Block import Ouroboros.Network.Point (WithOrigin (..)) -- -- Blockchain type -- data Chain block = Genesis | Chain block :> block deriving (Chain block -> Chain block -> Bool (Chain block -> Chain block -> Bool) -> (Chain block -> Chain block -> Bool) -> Eq (Chain block) forall block. Eq block => Chain block -> Chain block -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Chain block -> Chain block -> Bool $c/= :: forall block. Eq block => Chain block -> Chain block -> Bool == :: Chain block -> Chain block -> Bool $c== :: forall block. Eq block => Chain block -> Chain block -> Bool Eq, Eq (Chain block) Eq (Chain block) -> (Chain block -> Chain block -> Ordering) -> (Chain block -> Chain block -> Bool) -> (Chain block -> Chain block -> Bool) -> (Chain block -> Chain block -> Bool) -> (Chain block -> Chain block -> Bool) -> (Chain block -> Chain block -> Chain block) -> (Chain block -> Chain block -> Chain block) -> Ord (Chain block) Chain block -> Chain block -> Bool Chain block -> Chain block -> Ordering Chain block -> Chain block -> Chain block 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 forall block. Ord block => Eq (Chain block) forall block. Ord block => Chain block -> Chain block -> Bool forall block. Ord block => Chain block -> Chain block -> Ordering forall block. Ord block => Chain block -> Chain block -> Chain block min :: Chain block -> Chain block -> Chain block $cmin :: forall block. Ord block => Chain block -> Chain block -> Chain block max :: Chain block -> Chain block -> Chain block $cmax :: forall block. Ord block => Chain block -> Chain block -> Chain block >= :: Chain block -> Chain block -> Bool $c>= :: forall block. Ord block => Chain block -> Chain block -> Bool > :: Chain block -> Chain block -> Bool $c> :: forall block. Ord block => Chain block -> Chain block -> Bool <= :: Chain block -> Chain block -> Bool $c<= :: forall block. Ord block => Chain block -> Chain block -> Bool < :: Chain block -> Chain block -> Bool $c< :: forall block. Ord block => Chain block -> Chain block -> Bool compare :: Chain block -> Chain block -> Ordering $ccompare :: forall block. Ord block => Chain block -> Chain block -> Ordering $cp1Ord :: forall block. Ord block => Eq (Chain block) Ord, Int -> Chain block -> ShowS [Chain block] -> ShowS Chain block -> String (Int -> Chain block -> ShowS) -> (Chain block -> String) -> ([Chain block] -> ShowS) -> Show (Chain block) forall block. Show block => Int -> Chain block -> ShowS forall block. Show block => [Chain block] -> ShowS forall block. Show block => Chain block -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Chain block] -> ShowS $cshowList :: forall block. Show block => [Chain block] -> ShowS show :: Chain block -> String $cshow :: forall block. Show block => Chain block -> String showsPrec :: Int -> Chain block -> ShowS $cshowsPrec :: forall block. Show block => Int -> Chain block -> ShowS Show, a -> Chain b -> Chain a (a -> b) -> Chain a -> Chain b (forall a b. (a -> b) -> Chain a -> Chain b) -> (forall a b. a -> Chain b -> Chain a) -> Functor Chain forall a b. a -> Chain b -> Chain a forall a b. (a -> b) -> Chain a -> Chain b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: a -> Chain b -> Chain a $c<$ :: forall a b. a -> Chain b -> Chain a fmap :: (a -> b) -> Chain a -> Chain b $cfmap :: forall a b. (a -> b) -> Chain a -> Chain b Functor) infixl 5 :> takeWhile :: (blk -> Bool) -> Chain blk -> Chain blk takeWhile :: (blk -> Bool) -> Chain blk -> Chain blk takeWhile blk -> Bool p Chain blk c = Chain blk -> [blk] -> Chain blk go Chain blk forall block. Chain block Genesis (Chain blk -> [blk] forall block. Chain block -> [block] toOldestFirst Chain blk c) where go :: Chain blk -> [blk] -> Chain blk go Chain blk acc [] = Chain blk acc go Chain blk acc (blk b : [blk] bs) = if blk -> Bool p blk b then Chain blk -> [blk] -> Chain blk go (Chain blk acc Chain blk -> blk -> Chain blk forall block. Chain block -> block -> Chain block :> blk b) [blk] bs else Chain blk acc foldChain :: (a -> b -> a) -> a -> Chain b -> a foldChain :: (a -> b -> a) -> a -> Chain b -> a foldChain a -> b -> a _blk a gen Chain b Genesis = a gen foldChain a -> b -> a blk a gen (Chain b c :> b b) = a -> b -> a blk ((a -> b -> a) -> a -> Chain b -> a forall a b. (a -> b -> a) -> a -> Chain b -> a foldChain a -> b -> a blk a gen Chain b c) b b -- | Make a list from a 'Chain', in newest-to-oldest order. chainToList :: Chain block -> [block] chainToList :: Chain block -> [block] chainToList = ([block] -> block -> [block]) -> [block] -> Chain block -> [block] forall a b. (a -> b -> a) -> a -> Chain b -> a foldChain ((block -> [block] -> [block]) -> [block] -> block -> [block] forall a b c. (a -> b -> c) -> b -> a -> c flip (:)) [] prettyPrintChain :: String -> (block -> String) -> Chain block -> String prettyPrintChain :: String -> (block -> String) -> Chain block -> String prettyPrintChain String nl block -> String ppBlock = (String -> block -> String) -> String -> Chain block -> String forall a b. (a -> b -> a) -> a -> Chain b -> a foldChain (\String s block b -> String s String -> ShowS forall a. [a] -> [a] -> [a] ++ String nl String -> ShowS forall a. [a] -> [a] -> [a] ++ String " " String -> ShowS forall a. [a] -> [a] -> [a] ++ block -> String ppBlock block b) String "Genesis" genesis :: Chain b genesis :: Chain b genesis = Chain b forall block. Chain block Genesis valid :: HasFullHeader block => Chain block -> Bool valid :: Chain block -> Bool valid Chain block Genesis = Bool True valid (Chain block c :> block b) = Chain block -> Bool forall block. HasFullHeader block => Chain block -> Bool valid Chain block c Bool -> Bool -> Bool && Chain block -> block -> Bool forall block. (HasCallStack, HasFullHeader block) => Chain block -> block -> Bool validExtension Chain block c block b validExtension :: (HasCallStack, HasFullHeader block) => Chain block -> block -> Bool validExtension :: Chain block -> block -> Bool validExtension Chain block c block b = block -> Bool forall b. HasFullHeader b => b -> Bool blockInvariant block b Bool -> Bool -> Bool && Chain block -> ChainHash block forall block. HasHeader block => Chain block -> ChainHash block headHash Chain block c ChainHash block -> ChainHash block -> Bool forall a. Eq a => a -> a -> Bool == block -> ChainHash block forall b. HasFullHeader b => b -> ChainHash b blockPrevHash block b -- The Ord instance for WithOrigin puts At _ after Origin. -- An EBB has the same SlotNo as the block after it, hence -- the loose inequality. Bool -> Bool -> Bool && Chain block -> WithOrigin SlotNo forall block. HasHeader block => Chain block -> WithOrigin SlotNo headSlot Chain block c WithOrigin SlotNo -> WithOrigin SlotNo -> Bool forall a. Ord a => a -> a -> Bool <= SlotNo -> WithOrigin SlotNo forall t. t -> WithOrigin t At (block -> SlotNo forall b. HasHeader b => b -> SlotNo blockSlot block b) -- The block number must be non-strictly increasing. An EBB -- has the same block number as its parent. It can increase -- by at most one. Bool -> Bool -> Bool && case Chain block -> WithOrigin BlockNo forall block. HasHeader block => Chain block -> WithOrigin BlockNo headBlockNo Chain block c of WithOrigin BlockNo Origin -> block -> BlockNo forall b. HasHeader b => b -> BlockNo blockNo block b BlockNo -> BlockNo -> Bool forall a. Eq a => a -> a -> Bool == BlockNo 0 At BlockNo prevNo -> block -> BlockNo forall b. HasHeader b => b -> BlockNo blockNo block b BlockNo -> BlockNo -> Bool forall a. Eq a => a -> a -> Bool == BlockNo -> BlockNo forall a. Enum a => a -> a succ BlockNo prevNo Bool -> Bool -> Bool || block -> BlockNo forall b. HasHeader b => b -> BlockNo blockNo block b BlockNo -> BlockNo -> Bool forall a. Eq a => a -> a -> Bool == BlockNo prevNo head :: Chain b -> Maybe b head :: Chain b -> Maybe b head Chain b Genesis = Maybe b forall a. Maybe a Nothing head (Chain b _ :> b b) = b -> Maybe b forall a. a -> Maybe a Just b b headPoint :: HasHeader block => Chain block -> Point block headPoint :: Chain block -> Point block headPoint Chain block Genesis = Point block forall block. Point block genesisPoint headPoint (Chain block _ :> block b) = block -> Point block forall block. HasHeader block => block -> Point block blockPoint block b headSlot :: HasHeader block => Chain block -> WithOrigin SlotNo headSlot :: Chain block -> WithOrigin SlotNo headSlot = Point block -> WithOrigin SlotNo forall block. Point block -> WithOrigin SlotNo pointSlot (Point block -> WithOrigin SlotNo) -> (Chain block -> Point block) -> Chain block -> WithOrigin SlotNo forall b c a. (b -> c) -> (a -> b) -> a -> c . Chain block -> Point block forall block. HasHeader block => Chain block -> Point block headPoint headHash :: HasHeader block => Chain block -> ChainHash block headHash :: Chain block -> ChainHash block headHash = Point block -> ChainHash block forall block. Point block -> ChainHash block pointHash (Point block -> ChainHash block) -> (Chain block -> Point block) -> Chain block -> ChainHash block forall b c a. (b -> c) -> (a -> b) -> a -> c . Chain block -> Point block forall block. HasHeader block => Chain block -> Point block headPoint headTip :: HasHeader block => Chain block -> Tip block headTip :: Chain block -> Tip block headTip Chain block Genesis = Tip block forall b. Tip b TipGenesis headTip (Chain block _ :> block b) = SlotNo -> HeaderHash block -> BlockNo -> Tip block forall b. SlotNo -> HeaderHash b -> BlockNo -> Tip b Tip (block -> SlotNo forall b. HasHeader b => b -> SlotNo blockSlot block b) (block -> HeaderHash block forall b. HasHeader b => b -> HeaderHash b blockHash block b) (block -> BlockNo forall b. HasHeader b => b -> BlockNo blockNo block b) headAnchor :: HasHeader block => Chain block -> Anchor block headAnchor :: Chain block -> Anchor block headAnchor Chain block Genesis = Anchor block forall block. Anchor block AnchorGenesis headAnchor (Chain block _ :> block b) = block -> Anchor block forall block. HasHeader block => block -> Anchor block AF.anchorFromBlock block b headBlockNo :: HasHeader block => Chain block -> WithOrigin BlockNo headBlockNo :: Chain block -> WithOrigin BlockNo headBlockNo Chain block Genesis = WithOrigin BlockNo forall t. WithOrigin t Origin headBlockNo (Chain block _ :> block b) = BlockNo -> WithOrigin BlockNo forall t. t -> WithOrigin t At (block -> BlockNo forall b. HasHeader b => b -> BlockNo blockNo block b) -- | Produce the list of blocks, from most recent back to genesis -- toNewestFirst :: Chain block -> [block] toNewestFirst :: Chain block -> [block] toNewestFirst = ([block] -> block -> [block]) -> [block] -> Chain block -> [block] forall a b. (a -> b -> a) -> a -> Chain b -> a foldChain ((block -> [block] -> [block]) -> [block] -> block -> [block] forall a b c. (a -> b -> c) -> b -> a -> c flip (:)) [] -- | Produce the list of blocks, from genesis to the most recent toOldestFirst :: Chain block -> [block] toOldestFirst :: Chain block -> [block] toOldestFirst = [block] -> [block] forall a. [a] -> [a] reverse ([block] -> [block]) -> (Chain block -> [block]) -> Chain block -> [block] forall b c a. (b -> c) -> (a -> b) -> a -> c . Chain block -> [block] forall block. Chain block -> [block] toNewestFirst -- | Make a chain from a list of blocks. The head of the list is the head -- of the chain. -- fromNewestFirst :: HasHeader block => [block] -> Chain block fromNewestFirst :: [block] -> Chain block fromNewestFirst [block] bs = (block -> Chain block -> Chain block) -> Chain block -> [block] -> Chain block forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr ((Chain block -> block -> Chain block) -> block -> Chain block -> Chain block forall a b c. (a -> b -> c) -> b -> a -> c flip Chain block -> block -> Chain block forall block. Chain block -> block -> Chain block (:>)) Chain block forall block. Chain block Genesis [block] bs -- | Construct chain from list of blocks from oldest to newest fromOldestFirst :: HasHeader block => [block] -> Chain block fromOldestFirst :: [block] -> Chain block fromOldestFirst [block] bs = (Chain block -> block -> Chain block) -> Chain block -> [block] -> Chain block forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b L.foldl' Chain block -> block -> Chain block forall block. Chain block -> block -> Chain block (:>) Chain block forall block. Chain block Genesis [block] bs drop :: Int -> Chain block -> Chain block drop :: Int -> Chain block -> Chain block drop Int 0 Chain block c = Chain block c drop Int _ Chain block Genesis = Chain block forall block. Chain block Genesis drop Int n (Chain block c :> block _) = Int -> Chain block -> Chain block forall block. Int -> Chain block -> Chain block drop (Int n Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1) Chain block c length :: Chain block -> Int length :: Chain block -> Int length = (Int -> block -> Int) -> Int -> Chain block -> Int forall a b. (a -> b -> a) -> a -> Chain b -> a foldChain (\Int n block _ -> Int nInt -> Int -> Int forall a. Num a => a -> a -> a +Int 1) Int 0 null :: Chain block -> Bool null :: Chain block -> Bool null Chain block Genesis = Bool True null Chain block _ = Bool False addBlock :: HasHeader block => block -> Chain block -> Chain block addBlock :: block -> Chain block -> Chain block addBlock block b Chain block c = Chain block c Chain block -> block -> Chain block forall block. Chain block -> block -> Chain block :> block b pointOnChain :: HasHeader block => Point block -> Chain block -> Bool pointOnChain :: Point block -> Chain block -> Bool pointOnChain Point block GenesisPoint Chain block _ = Bool True pointOnChain (BlockPoint SlotNo _ HeaderHash block _) Chain block Genesis = Bool False pointOnChain p :: Point block p@(BlockPoint SlotNo pslot HeaderHash block phash) (Chain block c :> block b) | SlotNo pslot SlotNo -> SlotNo -> Bool forall a. Ord a => a -> a -> Bool > block -> SlotNo forall b. HasHeader b => b -> SlotNo blockSlot block b = Bool False | HeaderHash block phash HeaderHash block -> HeaderHash block -> Bool forall a. Eq a => a -> a -> Bool == block -> HeaderHash block forall b. HasHeader b => b -> HeaderHash b blockHash block b = Bool True | Bool otherwise = Point block -> Chain block -> Bool forall block. HasHeader block => Point block -> Chain block -> Bool pointOnChain Point block p Chain block c -- | Check whether the first point is after the second point on the chain. -- Usually, this can simply be checked using the 'SlotNo's, but some blocks -- may have the same 'SlotNo'. -- -- When the first point equals the second point, the answer will be 'False'. -- -- PRECONDITION: both points are on the chain. pointIsAfter :: HasHeader block => Point block -> Point block -> Chain block -> Bool pointIsAfter :: Point block -> Point block -> Chain block -> Bool pointIsAfter Point block pt1 Point block pt2 Chain block c = Bool -> Bool -> Bool forall a. HasCallStack => Bool -> a -> a assert (Point block -> Chain block -> Bool forall block. HasHeader block => Point block -> Chain block -> Bool pointOnChain Point block pt1 Chain block c Bool -> Bool -> Bool && Point block -> Chain block -> Bool forall block. HasHeader block => Point block -> Chain block -> Bool pointOnChain Point block pt2 Chain block c) (Bool -> Bool) -> Bool -> Bool forall a b. (a -> b) -> a -> b $ case Point block -> WithOrigin SlotNo forall block. Point block -> WithOrigin SlotNo pointSlot Point block pt1 WithOrigin SlotNo -> WithOrigin SlotNo -> Ordering forall a. Ord a => a -> a -> Ordering `compare` Point block -> WithOrigin SlotNo forall block. Point block -> WithOrigin SlotNo pointSlot Point block pt2 of Ordering LT -> Bool False Ordering GT -> Bool True Ordering EQ | Just (AnchoredFragment block _, AnchoredFragment block afterPt2) <- AnchoredFragment block -> Point block -> Maybe (AnchoredFragment block, AnchoredFragment block) forall block1 block2. (HasHeader block1, HeaderHash block1 ~ HeaderHash block2) => AnchoredFragment block1 -> Point block2 -> Maybe (AnchoredFragment block1, AnchoredFragment block1) AF.splitAfterPoint (Chain block -> AnchoredFragment block forall block. HasHeader block => Chain block -> AnchoredFragment block toAnchoredFragment Chain block c) Point block pt2 -> Point block -> AnchoredFragment block -> Bool forall block. HasHeader block => Point block -> AnchoredFragment block -> Bool AF.pointOnFragment Point block pt1 AnchoredFragment block afterPt2 | Bool otherwise -> Bool False rollback :: HasHeader block => Point block -> Chain block -> Maybe (Chain block) rollback :: Point block -> Chain block -> Maybe (Chain block) rollback Point block p (Chain block c :> block b) | block -> Point block forall block. HasHeader block => block -> Point block blockPoint block b Point block -> Point block -> Bool forall a. Eq a => a -> a -> Bool == Point block p = Chain block -> Maybe (Chain block) forall a. a -> Maybe a Just (Chain block c Chain block -> block -> Chain block forall block. Chain block -> block -> Chain block :> block b) | Bool otherwise = Point block -> Chain block -> Maybe (Chain block) forall block. HasHeader block => Point block -> Chain block -> Maybe (Chain block) rollback Point block p Chain block c rollback Point block p Chain block Genesis | Point block p Point block -> Point block -> Bool forall a. Eq a => a -> a -> Bool == Point block forall block. Point block genesisPoint = Chain block -> Maybe (Chain block) forall a. a -> Maybe a Just Chain block forall block. Chain block Genesis | Bool otherwise = Maybe (Chain block) forall a. Maybe a Nothing successorBlock :: HasHeader block => Point block -> Chain block -> Maybe block successorBlock :: Point block -> Chain block -> Maybe block successorBlock Point block p Chain block c0 | Chain block -> Point block forall block. HasHeader block => Chain block -> Point block headPoint Chain block c0 Point block -> Point block -> Bool forall a. Eq a => a -> a -> Bool == Point block p = Maybe block forall a. Maybe a Nothing successorBlock Point block p Chain block c0 = Chain block -> Maybe block go Chain block c0 where go :: Chain block -> Maybe block go (Chain block c :> block b' :> block b) | block -> Point block forall block. HasHeader block => block -> Point block blockPoint block b' Point block -> Point block -> Bool forall a. Eq a => a -> a -> Bool == Point block p = block -> Maybe block forall a. a -> Maybe a Just block b | Bool otherwise = Chain block -> Maybe block go (Chain block c Chain block -> block -> Chain block forall block. Chain block -> block -> Chain block :> block b') go (Chain block Genesis :> block b) | Point block p Point block -> Point block -> Bool forall a. Eq a => a -> a -> Bool == Point block forall block. Point block genesisPoint = block -> Maybe block forall a. a -> Maybe a Just block b go Chain block _ = String -> Maybe block forall a. HasCallStack => String -> a error String "successorBlock: point not on chain" selectChain :: HasHeader block => Chain block -> Chain block -> Chain block selectChain :: Chain block -> Chain block -> Chain block selectChain Chain block c1 Chain block c2 = -- NB: it's not true in general that headBlockNo c = length c, since the -- block number is non-strictly increasing. A chain c2 can be shorter in -- _length_ i.e. number of blocks than c1, but still have a higher block -- number than c1. if Chain block -> WithOrigin BlockNo forall block. HasHeader block => Chain block -> WithOrigin BlockNo headBlockNo Chain block c1 WithOrigin BlockNo -> WithOrigin BlockNo -> Bool forall a. Ord a => a -> a -> Bool >= Chain block -> WithOrigin BlockNo forall block. HasHeader block => Chain block -> WithOrigin BlockNo headBlockNo Chain block c2 then Chain block c1 else Chain block c2 isPrefixOf :: Eq block => Chain block -> Chain block -> Bool Chain block a isPrefixOf :: Chain block -> Chain block -> Bool `isPrefixOf` Chain block b = [block] -> [block] forall a. [a] -> [a] reverse (Chain block -> [block] forall block. Chain block -> [block] toNewestFirst Chain block a) [block] -> [block] -> Bool forall a. Eq a => [a] -> [a] -> Bool `L.isPrefixOf` [block] -> [block] forall a. [a] -> [a] reverse (Chain block -> [block] forall block. Chain block -> [block] toNewestFirst Chain block b) applyChainUpdate :: HasHeader block => ChainUpdate block block -> Chain block -> Maybe (Chain block) applyChainUpdate :: ChainUpdate block block -> Chain block -> Maybe (Chain block) applyChainUpdate (AddBlock block b) Chain block c = Chain block -> Maybe (Chain block) forall a. a -> Maybe a Just (block -> Chain block -> Chain block forall block. HasHeader block => block -> Chain block -> Chain block addBlock block b Chain block c) applyChainUpdate (RollBack Point block p) Chain block c = Point block -> Chain block -> Maybe (Chain block) forall block. HasHeader block => Point block -> Chain block -> Maybe (Chain block) rollback Point block p Chain block c applyChainUpdates :: HasHeader block => [ChainUpdate block block] -> Chain block -> Maybe (Chain block) applyChainUpdates :: [ChainUpdate block block] -> Chain block -> Maybe (Chain block) applyChainUpdates [] Chain block c = Chain block -> Maybe (Chain block) forall a. a -> Maybe a Just Chain block c applyChainUpdates (ChainUpdate block block u:[ChainUpdate block block] us) Chain block c = [ChainUpdate block block] -> Chain block -> Maybe (Chain block) forall block. HasHeader block => [ChainUpdate block block] -> Chain block -> Maybe (Chain block) applyChainUpdates [ChainUpdate block block] us (Chain block -> Maybe (Chain block)) -> Maybe (Chain block) -> Maybe (Chain block) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< ChainUpdate block block -> Chain block -> Maybe (Chain block) forall block. HasHeader block => ChainUpdate block block -> Chain block -> Maybe (Chain block) applyChainUpdate ChainUpdate block block u Chain block c -- | Select a bunch of 'Point's based on offsets from the head of the chain. -- This is used in the chain consumer protocol as part of finding the -- intersection between a local and remote chain. -- -- The typical pattern is to use a selection of offsets covering the last K -- blocks, biased towards more recent blocks. For example: -- -- > selectPoints (0 : [ fib n | n <- [1 .. 17] ]) -- selectPoints :: HasHeader block => [Int] -> Chain block -> [Point block] selectPoints :: [Int] -> Chain block -> [Point block] selectPoints [Int] offsets = [Int] -> Chain block -> [Point block] forall block. HasHeader block => [Int] -> Chain block -> [Point block] go [Int] relativeOffsets where relativeOffsets :: [Int] relativeOffsets = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith (-) [Int] offsets (Int 0Int -> [Int] -> [Int] forall a. a -> [a] -> [a] :[Int] offsets) go :: [Int] -> Chain block -> [Point block] go [] Chain block _ = [] go [Int] _ Chain block Genesis = [] go (Int off:[Int] offs) Chain block c = Chain block -> Point block forall block. HasHeader block => Chain block -> Point block headPoint Chain block c' Point block -> [Point block] -> [Point block] forall a. a -> [a] -> [a] : [Int] -> Chain block -> [Point block] go [Int] offs Chain block c' where c' :: Chain block c' = Int -> Chain block -> Chain block forall block. Int -> Chain block -> Chain block drop Int off Chain block c findBlock :: (block -> Bool) -> Chain block -> Maybe block findBlock :: (block -> Bool) -> Chain block -> Maybe block findBlock block -> Bool _ Chain block Genesis = Maybe block forall a. Maybe a Nothing findBlock block -> Bool p (Chain block c :> block b) | block -> Bool p block b = block -> Maybe block forall a. a -> Maybe a Just block b | Bool otherwise = (block -> Bool) -> Chain block -> Maybe block forall block. (block -> Bool) -> Chain block -> Maybe block findBlock block -> Bool p Chain block c selectBlockRange :: HasHeader block => Chain block -> Point block -> Point block -> Maybe [block] selectBlockRange :: Chain block -> Point block -> Point block -> Maybe [block] selectBlockRange Chain block c Point block from Point block to | Point block -> Chain block -> Bool forall block. HasHeader block => Point block -> Chain block -> Bool pointOnChain Point block from Chain block c , Point block -> Chain block -> Bool forall block. HasHeader block => Point block -> Chain block -> Bool pointOnChain Point block to Chain block c = [block] -> Maybe [block] forall a. a -> Maybe a Just ([block] -> Maybe [block]) -> (Chain block -> [block]) -> Chain block -> Maybe [block] forall b c a. (b -> c) -> (a -> b) -> a -> c . [block] -> [block] forall a. [a] -> [a] reverse ([block] -> [block]) -> (Chain block -> [block]) -> Chain block -> [block] forall b c a. (b -> c) -> (a -> b) -> a -> c . (block -> Bool) -> [block] -> [block] forall a. (a -> Bool) -> [a] -> [a] Prelude.takeWhile (\block b -> block -> Point block forall block. HasHeader block => block -> Point block blockPoint block b Point block -> Point block -> Bool forall a. Eq a => a -> a -> Bool /= Point block from) ([block] -> [block]) -> (Chain block -> [block]) -> Chain block -> [block] forall b c a. (b -> c) -> (a -> b) -> a -> c . (block -> Bool) -> [block] -> [block] forall a. (a -> Bool) -> [a] -> [a] dropWhile (\block b -> block -> Point block forall block. HasHeader block => block -> Point block blockPoint block b Point block -> Point block -> Bool forall a. Eq a => a -> a -> Bool /= Point block to) ([block] -> [block]) -> (Chain block -> [block]) -> Chain block -> [block] forall b c a. (b -> c) -> (a -> b) -> a -> c . Chain block -> [block] forall block. Chain block -> [block] toNewestFirst (Chain block -> Maybe [block]) -> Chain block -> Maybe [block] forall a b. (a -> b) -> a -> b $ Chain block c | Bool otherwise = Maybe [block] forall a. Maybe a Nothing findFirstPoint :: HasHeader block => [Point block] -> Chain block -> Maybe (Point block) findFirstPoint :: [Point block] -> Chain block -> Maybe (Point block) findFirstPoint [] Chain block _ = Maybe (Point block) forall a. Maybe a Nothing findFirstPoint (Point block p:[Point block] ps) Chain block c | Point block -> Chain block -> Bool forall block. HasHeader block => Point block -> Chain block -> Bool pointOnChain Point block p Chain block c = Point block -> Maybe (Point block) forall a. a -> Maybe a Just Point block p | Bool otherwise = [Point block] -> Chain block -> Maybe (Point block) forall block. HasHeader block => [Point block] -> Chain block -> Maybe (Point block) findFirstPoint [Point block] ps Chain block c intersectChains :: HasHeader block => Chain block -> Chain block -> Maybe (Point block) intersectChains :: Chain block -> Chain block -> Maybe (Point block) intersectChains Chain block _ Chain block Genesis = Maybe (Point block) forall a. Maybe a Nothing intersectChains Chain block c (Chain block bs :> block b) = let p :: Point block p = block -> Point block forall block. HasHeader block => block -> Point block blockPoint block b in if Point block -> Chain block -> Bool forall block. HasHeader block => Point block -> Chain block -> Bool pointOnChain (block -> Point block forall block. HasHeader block => block -> Point block blockPoint block b) Chain block c then Point block -> Maybe (Point block) forall a. a -> Maybe a Just Point block p else Chain block -> Chain block -> Maybe (Point block) forall block. HasHeader block => Chain block -> Chain block -> Maybe (Point block) intersectChains Chain block c Chain block bs -- * Conversions to/from 'AnchoredFragment' -- | Convert a 'Chain' to an 'AnchoredFragment'. -- -- The anchor of the fragment will be 'Chain.genesisPoint'. toAnchoredFragment :: HasHeader block => Chain block -> AF.AnchoredFragment block toAnchoredFragment :: Chain block -> AnchoredFragment block toAnchoredFragment = Anchor block -> [block] -> AnchoredFragment block forall v a b. Anchorable v a b => a -> [b] -> AnchoredSeq v a b AF.fromOldestFirst Anchor block forall block. Anchor block AF.AnchorGenesis ([block] -> AnchoredFragment block) -> (Chain block -> [block]) -> Chain block -> AnchoredFragment block forall b c a. (b -> c) -> (a -> b) -> a -> c . Chain block -> [block] forall block. Chain block -> [block] toOldestFirst -- | Convert an 'AnchoredFragment' to a 'Chain'. -- -- The anchor of the fragment must be 'Chain.genesisPoint', otherwise -- 'Nothing' is returned. fromAnchoredFragment :: HasHeader block => AF.AnchoredFragment block -> Maybe (Chain block) fromAnchoredFragment :: AnchoredFragment block -> Maybe (Chain block) fromAnchoredFragment AnchoredFragment block af | AnchoredFragment block -> Point block forall block. AnchoredFragment block -> Point block AF.anchorPoint AnchoredFragment block af Point block -> Point block -> Bool forall a. Eq a => a -> a -> Bool == Point block forall block. Point block genesisPoint = Chain block -> Maybe (Chain block) forall a. a -> Maybe a Just (Chain block -> Maybe (Chain block)) -> Chain block -> Maybe (Chain block) forall a b. (a -> b) -> a -> b $ [block] -> Chain block forall block. HasHeader block => [block] -> Chain block fromNewestFirst ([block] -> Chain block) -> [block] -> Chain block forall a b. (a -> b) -> a -> b $ AnchoredFragment block -> [block] forall v a b. AnchoredSeq v a b -> [b] AF.toNewestFirst AnchoredFragment block af | Bool otherwise = Maybe (Chain block) forall a. Maybe a Nothing -- -- Serialisation -- instance Serialise block => Serialise (Chain block) where encode :: Chain block -> Encoding encode Chain block c = Word -> Encoding encodeListLen (Int -> Word forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> Word) -> Int -> Word forall a b. (a -> b) -> a -> b $ Chain block -> Int forall block. Chain block -> Int length Chain block c) Encoding -> Encoding -> Encoding forall a. Semigroup a => a -> a -> a <> (Encoding -> block -> Encoding) -> Encoding -> Chain block -> Encoding forall a b. (a -> b -> a) -> a -> Chain b -> a foldChain (\Encoding e block b -> Encoding e Encoding -> Encoding -> Encoding forall a. Semigroup a => a -> a -> a <> block -> Encoding forall a. Serialise a => a -> Encoding encode block b) Encoding forall a. Monoid a => a mempty Chain block c decode :: Decoder s (Chain block) decode = do Int n <- Decoder s Int forall s. Decoder s Int decodeListLen Chain block -> Int -> Decoder s (Chain block) forall t block s. (Eq t, Num t, Serialise block) => Chain block -> t -> Decoder s (Chain block) go Chain block forall block. Chain block genesis Int n where go :: Chain block -> t -> Decoder s (Chain block) go Chain block c t 0 = Chain block -> Decoder s (Chain block) forall (m :: * -> *) a. Monad m => a -> m a return Chain block c go Chain block c t n = do block b <- Decoder s block forall a s. Serialise a => Decoder s a decode Chain block -> t -> Decoder s (Chain block) go (Chain block c Chain block -> block -> Chain block forall block. Chain block -> block -> Chain block :> block b) (t nt -> t -> t forall a. Num a => a -> a -> a -t 1)