{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}

module Ouroboros.Network.AnchoredFragment
  ( -- * AnchoredFragment type and fundamental operations
    AnchoredFragment
  , AnchoredSeq (Empty, (:>), (:<))
  , anchor
  , anchorPoint
  , anchorBlockNo
    -- * Anchor
  , Anchor (..)
  , anchorFromBlock
  , anchorFromPoint
  , anchorToPoint
  , anchorToSlotNo
  , anchorToBlockNo
  , anchorToHash
  , anchorIsGenesis
  , anchorToHeaderFields
  , anchorToTip
  , castAnchor
  , valid
  , validExtension
    -- ** Block re-exports
  , HasHeader (..)
  , Point (..)
  , castPoint
  , blockPoint
    -- * AnchoredFragment construction and inspection
    -- ** Head inspection
  , headPoint
  , headAnchor
  , headSlot
  , headHash
  , headBlockNo
    -- ** Basic operations
  , head
  , last
  , lastPoint
  , lastSlot
  , toNewestFirst
  , toOldestFirst
  , fromNewestFirst
  , fromOldestFirst
  , splitAt
  , dropNewest
  , takeOldest
  , dropWhileNewest
  , takeWhileOldest
  , length
  , null
    -- ** Update type and operations
  , ChainUpdate (..)
  , addBlock
  , rollback
  , applyChainUpdate
  , applyChainUpdates
    -- * Special operations
  , pointOnFragment
  , withinFragmentBounds
  , findFirstPoint
  , successorBlock
  , selectPoints
  , isPrefixOf
  , splitAfterPoint
  , splitAtSlot
  , splitBeforePoint
  , sliceRange
  , join
  , intersect
  , intersectionPoint
  , mapAnchoredFragment
  , anchorNewest
  , filter
  , filterWithStop
    -- * Helper functions
  , prettyPrint
    -- * Reference implementations for testing
  , pointOnFragmentSpec
  , selectPointsSpec
  , filterWithStopSpec
  ) where

import Prelude hiding (filter, head, last, length, map, null, splitAt)

import Data.Either (isRight)
import Data.List qualified as L
import GHC.Generics (Generic)
import GHC.Stack
import NoThunks.Class (NoThunks)

import Ouroboros.Network.AnchoredSeq hiding (join, prettyPrint, rollback)
import Ouroboros.Network.AnchoredSeq qualified as AS
import Ouroboros.Network.Block
import Ouroboros.Network.Point (WithOrigin (At, Origin), withOrigin)

{-------------------------------------------------------------------------------
  Anchor
-------------------------------------------------------------------------------}

-- | Anchor of an 'AnchoredFragment'
data Anchor block =
    -- | The fragment is anchored at genesis
    AnchorGenesis

    -- | The fragment is anchored after genesis
    --
    -- We don't use the 'Point' type directly as that has its /own/ use of
    -- 'WithOrigin', and we want to enforce here that we have a block number
    -- if and only if the point is not 'Origin'.
    --
    -- Note that we don't use 'HeaderFields' here because that is a view of a
    -- header with lazy fields and thus unfit for long-term in-memory storage.
    --
    -- Moreover, we don't reuse the 'Tip' type, because that type is sent across
    -- the network, while this type is not. This means we can freely change this
    -- type to suit our needs without worrying about binary compatibility.
  | Anchor !SlotNo !(HeaderHash block) !BlockNo
  deriving ((forall x. Anchor block -> Rep (Anchor block) x)
-> (forall x. Rep (Anchor block) x -> Anchor block)
-> Generic (Anchor block)
forall x. Rep (Anchor block) x -> Anchor block
forall x. Anchor block -> Rep (Anchor block) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall block x. Rep (Anchor block) x -> Anchor block
forall block x. Anchor block -> Rep (Anchor block) x
$cfrom :: forall block x. Anchor block -> Rep (Anchor block) x
from :: forall x. Anchor block -> Rep (Anchor block) x
$cto :: forall block x. Rep (Anchor block) x -> Anchor block
to :: forall x. Rep (Anchor block) x -> Anchor block
Generic)

deriving instance StandardHash block => Show     (Anchor block)
deriving instance StandardHash block => Eq       (Anchor block)
deriving instance StandardHash block => NoThunks (Anchor block)

-- | The equivalent of 'castPoint' for 'Anchor'
castAnchor :: (HeaderHash a ~ HeaderHash b) => Anchor a -> Anchor b
castAnchor :: forall a b. (HeaderHash a ~ HeaderHash b) => Anchor a -> Anchor b
castAnchor Anchor a
AnchorGenesis  = Anchor b
forall block. Anchor block
AnchorGenesis
castAnchor (Anchor SlotNo
s HeaderHash a
h BlockNo
b) = SlotNo -> HeaderHash b -> BlockNo -> Anchor b
forall block. SlotNo -> HeaderHash block -> BlockNo -> Anchor block
Anchor SlotNo
s HeaderHash a
HeaderHash b
h BlockNo
b

-- | Does this anchor represent genesis (i.e., empty chain)?
anchorIsGenesis :: Anchor block -> Bool
anchorIsGenesis :: forall block. Anchor block -> Bool
anchorIsGenesis Anchor block
AnchorGenesis = Bool
True
anchorIsGenesis Anchor{}      = Bool
False

-- | Construct anchor from a block
--
-- In other words, this would be the block immediately /before/ the other blocks
-- in the fragment.
anchorFromBlock :: HasHeader block => block -> Anchor block
anchorFromBlock :: forall block. HasHeader block => block -> Anchor block
anchorFromBlock block
b = SlotNo -> HeaderHash block -> BlockNo -> Anchor block
forall block. SlotNo -> HeaderHash block -> BlockNo -> Anchor block
Anchor SlotNo
sno HeaderHash block
hash BlockNo
bno
  where
    HeaderFields {
        headerFieldSlot :: forall k (b :: k). HeaderFields b -> SlotNo
headerFieldSlot    = SlotNo
sno
      , headerFieldBlockNo :: forall k (b :: k). HeaderFields b -> BlockNo
headerFieldBlockNo = BlockNo
bno
      , headerFieldHash :: forall k (b :: k). HeaderFields b -> HeaderHash b
headerFieldHash    = HeaderHash block
hash
      } = block -> HeaderFields block
forall b. HasHeader b => b -> HeaderFields b
getHeaderFields block
b

-- | Compute which 'Point' this anchor corresponds to
anchorToPoint :: Anchor block -> Point block
anchorToPoint :: forall block. Anchor block -> Point block
anchorToPoint Anchor block
AnchorGenesis   = Point block
forall {k} (block :: k). Point block
genesisPoint
anchorToPoint (Anchor SlotNo
s HeaderHash block
h BlockNo
_b) = SlotNo -> HeaderHash block -> Point block
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint SlotNo
s HeaderHash block
h

-- | Construct an anchor /from/ a point
--
-- In this case, we must also be given the 'BlockNo'. This only makes sense
-- for points that aren't genesis.
anchorFromPoint :: Point block -> BlockNo -> Anchor block
anchorFromPoint :: forall block. Point block -> BlockNo -> Anchor block
anchorFromPoint Point block
GenesisPoint BlockNo
_     = String -> Anchor block
forall a. HasCallStack => String -> a
error String
"anchorFromPoint: genesis point" -- TODO #4690
anchorFromPoint (BlockPoint SlotNo
s HeaderHash block
h) BlockNo
b = SlotNo -> HeaderHash block -> BlockNo -> Anchor block
forall block. SlotNo -> HeaderHash block -> BlockNo -> Anchor block
Anchor SlotNo
s HeaderHash block
h BlockNo
b

-- | Extract the 'BlockNo' from the anchor
--
-- NOTE: When the 'Anchor' is 'AnchorGenesis', this returns 'Origin'.
-- It does /not/ return 'genesisBlockNo', which is badly named, and is instead
-- the block number of the first block on the chain
-- (i.e., 'genesisPoint' and 'genesisBlockNo' don't go hand in hand!)
anchorToBlockNo :: Anchor block -> WithOrigin BlockNo
anchorToBlockNo :: forall block. Anchor block -> WithOrigin BlockNo
anchorToBlockNo Anchor block
AnchorGenesis    = WithOrigin BlockNo
forall t. WithOrigin t
Origin
anchorToBlockNo (Anchor SlotNo
_s HeaderHash block
_h BlockNo
b) = BlockNo -> WithOrigin BlockNo
forall t. t -> WithOrigin t
At BlockNo
b

-- | Extract the 'SlotNo' from the anchor
anchorToSlotNo :: Anchor block -> WithOrigin SlotNo
anchorToSlotNo :: forall block. Anchor block -> WithOrigin SlotNo
anchorToSlotNo Anchor block
AnchorGenesis    = WithOrigin SlotNo
forall t. WithOrigin t
Origin
anchorToSlotNo (Anchor SlotNo
s HeaderHash block
_h BlockNo
_b) = SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
At SlotNo
s

-- | Extract the hash from the anchor
--
-- Returns 'GenesisHash' if the anchor is 'AnchorGenesis'.
anchorToHash :: Anchor block -> ChainHash block
anchorToHash :: forall block. Anchor block -> ChainHash block
anchorToHash Anchor block
AnchorGenesis    = ChainHash block
forall {k} (b :: k). ChainHash b
GenesisHash
anchorToHash (Anchor SlotNo
_s HeaderHash block
h BlockNo
_b) = HeaderHash block -> ChainHash block
forall {k} (b :: k). HeaderHash b -> ChainHash b
BlockHash HeaderHash block
h

anchorToHeaderFields :: Anchor block -> WithOrigin (HeaderFields block)
anchorToHeaderFields :: forall block. Anchor block -> WithOrigin (HeaderFields block)
anchorToHeaderFields Anchor block
AnchorGenesis  = WithOrigin (HeaderFields block)
forall t. WithOrigin t
Origin
anchorToHeaderFields (Anchor SlotNo
s HeaderHash block
h BlockNo
b) = HeaderFields block -> WithOrigin (HeaderFields block)
forall t. t -> WithOrigin t
At (SlotNo -> BlockNo -> HeaderHash block -> HeaderFields block
forall k (b :: k).
SlotNo -> BlockNo -> HeaderHash b -> HeaderFields b
HeaderFields SlotNo
s BlockNo
b HeaderHash block
h)

-- | Translate 'Anchor' to 'Tip'
--
-- Right now this is in fact an isomorphism, but these two types are logically
-- independent.
anchorToTip :: (HeaderHash a ~ HeaderHash b) => Anchor a -> Tip b
anchorToTip :: forall a b. (HeaderHash a ~ HeaderHash b) => Anchor a -> Tip b
anchorToTip Anchor a
AnchorGenesis  = Tip b
forall {k} (b :: k). Tip b
TipGenesis
anchorToTip (Anchor SlotNo
s HeaderHash a
h BlockNo
b) = SlotNo -> HeaderHash b -> BlockNo -> Tip b
forall {k} (b :: k). SlotNo -> HeaderHash b -> BlockNo -> Tip b
Tip SlotNo
s HeaderHash a
HeaderHash b
h BlockNo
b

{-------------------------------------------------------------------------------
  AnchoredFragment
-------------------------------------------------------------------------------}

-- | An 'AnchoredFragment' is a fragment of a chain that is anchored somewhere
-- in that chain. The 'Anchor' corresponds to the block immediately before the
-- first, leftmost block in the fragment. The block corresponding to the anchor
-- is not present in the fragment. The anchor can be thought of as a left
-- exclusive bound.
--
-- For example, the following fragment is anchored at @a@ and contains @b1@,
-- @b2@, and @b3@, which is the head of the fragment.
--
-- > a ] b1 >: b2 >: b3
--
-- The fact that it is an /exclusive/ bound is particularly convenient when
-- dealing with Genesis. Genesis is the start of the chain, but not an actual
-- block, so we cannot use it an inclusive bound. However, there /is/ an
-- 'Anchor' that refers to Genesis ('AnchorGenesis'), which can be used as the
-- anchor, acting as an exclusive bound.
--
-- An 'AnchoredFragment' anchored at Genesis can thus be converted to a
-- 'Ouroboros.Network.Mock.Chain' ('fromAnchoredFragment'), containing all
-- blocks starting from Genesis.
--
-- Without an anchor point, an empty fragment wouldn't give us much more
-- information: is it empty because the whole chain is empty? Or, did we just
-- get an empty fragment that was split off from some later part of the chain?
type AnchoredFragment block = AnchoredSeq (WithOrigin SlotNo) (Anchor block) block

instance HasHeader block
      => Anchorable (WithOrigin SlotNo) (Anchor block) block where
  asAnchor :: block -> Anchor block
asAnchor = block -> Anchor block
forall block. HasHeader block => block -> Anchor block
anchorFromBlock
  getAnchorMeasure :: Proxy block -> Anchor block -> WithOrigin SlotNo
getAnchorMeasure Proxy block
_ = Anchor block -> WithOrigin SlotNo
forall block. Anchor block -> WithOrigin SlotNo
anchorToSlotNo

-- | Return the 'Point' corresponding to the anchor.
anchorPoint :: AnchoredFragment block -> Point block
anchorPoint :: forall block. AnchoredFragment block -> Point block
anchorPoint = Anchor block -> Point block
forall block. Anchor block -> Point block
anchorToPoint (Anchor block -> Point block)
-> (AnchoredFragment block -> Anchor block)
-> AnchoredFragment block
-> Point block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment block -> Anchor block
forall v a b. AnchoredSeq v a b -> a
anchor

-- | Return the 'BlocKno' corresponding to the anchor.
anchorBlockNo :: AnchoredFragment block -> WithOrigin BlockNo
anchorBlockNo :: forall block. AnchoredFragment block -> WithOrigin BlockNo
anchorBlockNo = Anchor block -> WithOrigin BlockNo
forall block. Anchor block -> WithOrigin BlockNo
anchorToBlockNo (Anchor block -> WithOrigin BlockNo)
-> (AnchoredFragment block -> Anchor block)
-> AnchoredFragment block
-> WithOrigin BlockNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment block -> Anchor block
forall v a b. AnchoredSeq v a b -> a
anchor

prettyPrint ::
     String
  -> (Point block -> String)
  -> (block -> String)
  -> AnchoredFragment block
  -> String
prettyPrint :: forall block.
String
-> (Point block -> String)
-> (block -> String)
-> AnchoredFragment block
-> String
prettyPrint String
nl Point block -> String
ppPoint = String
-> (Anchor block -> String)
-> (block -> String)
-> AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
-> String
forall a b v.
String
-> (a -> String) -> (b -> String) -> AnchoredSeq v a b -> String
AS.prettyPrint String
nl (Point block -> String
ppPoint (Point block -> String)
-> (Anchor block -> Point block) -> Anchor block -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Anchor block -> Point block
forall block. Anchor block -> Point block
anchorToPoint)

-- | \( O(n) \).
valid :: HasFullHeader block => AnchoredFragment block -> Bool
valid :: forall block. HasFullHeader block => AnchoredFragment block -> Bool
valid (Empty Anchor block
_) = Bool
True
valid (AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
af :> block
b) = AnchoredSeq (WithOrigin SlotNo) (Anchor block) block -> Bool
forall block. HasFullHeader block => AnchoredFragment block -> Bool
valid AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
af Bool -> Bool -> Bool
&& AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
-> block -> Bool
forall block.
HasFullHeader block =>
AnchoredFragment block -> block -> Bool
validExtension AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
af block
b

-- | Checks whether the first block @bSucc@ is a valid successor of the second
-- block @b@ identified by an 'Anchor'.
--
-- * The 'blockPrevHash' of the @bSucc@ must match that of @b@.
-- * The 'blockSlot' of @bSucc@ must be strictly larger than that of @b@.
-- * The 'blockNo' of @bSucc@ must be 1 greater than that of @b@.
--
-- This function does not check whether @bSucc@ satisfies 'blockInvariant'.
isValidSuccessorOf :: HasFullHeader block
                   => block  -- ^ @bSucc@
                   -> Anchor block  -- ^ @b@
                   -> Bool
isValidSuccessorOf :: forall block. HasFullHeader block => block -> Anchor block -> Bool
isValidSuccessorOf block
bSucc Anchor block
b = Either String () -> Bool
forall a b. Either a b -> Bool
isRight (Either String () -> Bool) -> Either String () -> Bool
forall a b. (a -> b) -> a -> b
$ block -> Anchor block -> Either String ()
forall block.
HasFullHeader block =>
block -> Anchor block -> Either String ()
isValidSuccessorOf' block
bSucc Anchor block
b

-- | Variation on 'isValidSuccessorOf' that provides more information
isValidSuccessorOf' :: HasFullHeader block
                    => block  -- ^ @bSucc@
                    -> Anchor block  -- ^ @b@
                    -> Either String ()
isValidSuccessorOf' :: forall block.
HasFullHeader block =>
block -> Anchor block -> Either String ()
isValidSuccessorOf' block
bSucc Anchor block
b
  | Anchor block -> ChainHash block
forall block. Anchor block -> ChainHash block
anchorToHash Anchor block
b ChainHash block -> ChainHash block -> Bool
forall a. Eq a => a -> a -> Bool
/= block -> ChainHash block
forall b. HasFullHeader b => b -> ChainHash b
blockPrevHash block
bSucc
  = String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ Context -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
        String
"prevHash ("
      , ChainHash block -> String
forall a. Show a => a -> String
show (block -> ChainHash block
forall b. HasFullHeader b => b -> ChainHash b
blockPrevHash block
bSucc)
      , String
") doesn't match hash of tip ("
      , ChainHash block -> String
forall a. Show a => a -> String
show (Anchor block -> ChainHash block
forall block. Anchor block -> ChainHash block
anchorToHash Anchor block
b)
      , String
") at "
      , CallStack -> String
prettyCallStack CallStack
HasCallStack => CallStack
callStack
      ]
    -- Note that this inequality would be strict, but for epoch
    -- boundary blocks, which occupy the same slot as a regular
    -- block.
  | Anchor block -> WithOrigin SlotNo
forall block. Anchor block -> WithOrigin SlotNo
anchorToSlotNo Anchor block
b 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
bSucc)
  = String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ Context -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
        String
"Slot of tip ("
      , WithOrigin SlotNo -> String
forall a. Show a => a -> String
show (Anchor block -> WithOrigin SlotNo
forall block. Anchor block -> WithOrigin SlotNo
anchorToSlotNo Anchor block
b)
      , String
") > slot ("
      , SlotNo -> String
forall a. Show a => a -> String
show (block -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot block
bSucc)
      , String
")"
      ]
  -- The block number of the next block cannot be less than that of the tip,
  -- or more than that of the tip plus 1. It /can/ be the same as the tip,
  -- in the case of EBBs.
  | BlockNo -> WithOrigin BlockNo
forall t. t -> WithOrigin t
At (block -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo block
bSucc) WithOrigin BlockNo -> WithOrigin BlockNo -> Bool
forall a. Ord a => a -> a -> Bool
< Anchor block -> WithOrigin BlockNo
forall block. Anchor block -> WithOrigin BlockNo
anchorToBlockNo Anchor block
b
  = String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ Context -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
        String
"BlockNo ("
      , BlockNo -> String
forall a. Show a => a -> String
show (block -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo block
bSucc)
      , String
") is less than BlockNo of tip ("
      , WithOrigin BlockNo -> String
forall a. Show a => a -> String
show (Anchor block -> WithOrigin BlockNo
forall block. Anchor block -> WithOrigin BlockNo
anchorToBlockNo Anchor block
b)
      , String
")"
      ]
  | block -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo block
bSucc BlockNo -> BlockNo -> Bool
forall a. Ord a => a -> a -> Bool
> BlockNo -> (BlockNo -> BlockNo) -> WithOrigin BlockNo -> BlockNo
forall b t. b -> (t -> b) -> WithOrigin t -> b
withOrigin (Word64 -> BlockNo
BlockNo Word64
0) BlockNo -> BlockNo
forall a. Enum a => a -> a
succ (Anchor block -> WithOrigin BlockNo
forall block. Anchor block -> WithOrigin BlockNo
anchorToBlockNo Anchor block
b)
  = String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ Context -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
        String
"BlockNo ("
      , BlockNo -> String
forall a. Show a => a -> String
show (block -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo block
bSucc)
      , String
") is greater than BlockNo of tip ("
      , WithOrigin BlockNo -> String
forall a. Show a => a -> String
show (Anchor block -> WithOrigin BlockNo
forall block. Anchor block -> WithOrigin BlockNo
anchorToBlockNo Anchor block
b)
      , String
") + 1"
      ]
  | Bool
otherwise
  = () -> Either String ()
forall a b. b -> Either a b
Right ()

-- | \( O(1) \).
validExtension :: HasFullHeader block => AnchoredFragment block -> block -> Bool
validExtension :: forall block.
HasFullHeader block =>
AnchoredFragment block -> block -> Bool
validExtension AnchoredFragment block
af block
bSucc =
    block -> Bool
forall b. HasFullHeader b => b -> Bool
blockInvariant block
bSucc Bool -> Bool -> Bool
&&
    block
bSucc block -> Anchor block -> Bool
forall block. HasFullHeader block => block -> Anchor block -> Bool
`isValidSuccessorOf` AnchoredFragment block -> Anchor block
forall v a b. Anchorable v a b => AnchoredSeq v a b -> a
headAnchor AnchoredFragment block
af

-- | \( O(1) \). When the fragment is empty, the anchor point is returned.
headPoint :: HasHeader block => AnchoredFragment block -> Point block
headPoint :: forall block.
HasHeader block =>
AnchoredFragment block -> Point block
headPoint = Anchor block -> Point block
forall block. Anchor block -> Point block
anchorToPoint (Anchor block -> Point block)
-> (AnchoredFragment block -> Anchor block)
-> AnchoredFragment block
-> Point block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment block -> Anchor block
forall v a b. Anchorable v a b => AnchoredSeq v a b -> a
headAnchor

-- | \( O(1) \). When the fragment is empty, the slot of the anchor point is
-- returned, which may be origin (no slot).
headSlot :: HasHeader block => AnchoredFragment block -> WithOrigin SlotNo
headSlot :: forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin SlotNo
headSlot = (Anchor block -> WithOrigin SlotNo)
-> (block -> WithOrigin SlotNo)
-> Either (Anchor block) block
-> WithOrigin SlotNo
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Anchor block -> WithOrigin SlotNo
forall block. Anchor block -> WithOrigin SlotNo
anchorToSlotNo (SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
At (SlotNo -> WithOrigin SlotNo)
-> (block -> SlotNo) -> block -> WithOrigin SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. block -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot) (Either (Anchor block) block -> WithOrigin SlotNo)
-> (AnchoredFragment block -> Either (Anchor block) block)
-> AnchoredFragment block
-> WithOrigin SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment block -> Either (Anchor block) block
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Either a b
head

-- | \( O(1) \). When the fragment is empty, the hash of the anchor point is
-- returned.
headHash :: HasHeader block => AnchoredFragment block -> ChainHash block
headHash :: forall block.
HasHeader block =>
AnchoredFragment block -> ChainHash block
headHash = (Anchor block -> ChainHash block)
-> (block -> ChainHash block)
-> Either (Anchor block) block
-> ChainHash block
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Anchor block -> ChainHash block
forall block. Anchor block -> ChainHash block
anchorToHash (HeaderHash block -> ChainHash block
forall {k} (b :: k). HeaderHash b -> ChainHash b
BlockHash (HeaderHash block -> ChainHash block)
-> (block -> HeaderHash block) -> block -> ChainHash block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. block -> HeaderHash block
forall b. HasHeader b => b -> HeaderHash b
blockHash) (Either (Anchor block) block -> ChainHash block)
-> (AnchoredFragment block -> Either (Anchor block) block)
-> AnchoredFragment block
-> ChainHash block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment block -> Either (Anchor block) block
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Either a b
head

-- | \( O(1) \). When the fragment is empty, the block number of the anchor
-- point is returned.
headBlockNo :: HasHeader block => AnchoredFragment block -> WithOrigin BlockNo
headBlockNo :: forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin BlockNo
headBlockNo = (Anchor block -> WithOrigin BlockNo)
-> (block -> WithOrigin BlockNo)
-> Either (Anchor block) block
-> WithOrigin BlockNo
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Anchor block -> WithOrigin BlockNo
forall block. Anchor block -> WithOrigin BlockNo
anchorToBlockNo (BlockNo -> WithOrigin BlockNo
forall t. t -> WithOrigin t
At (BlockNo -> WithOrigin BlockNo)
-> (block -> BlockNo) -> block -> WithOrigin BlockNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. block -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo) (Either (Anchor block) block -> WithOrigin BlockNo)
-> (AnchoredFragment block -> Either (Anchor block) block)
-> AnchoredFragment block
-> WithOrigin BlockNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment block -> Either (Anchor block) block
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Either a b
head

-- | \( O(1) \). When the fragment is empty, the anchor point is returned.
lastPoint :: HasHeader block => AnchoredFragment block -> Point block
lastPoint :: forall block.
HasHeader block =>
AnchoredFragment block -> Point block
lastPoint = (Anchor block -> Point block)
-> (block -> Point block)
-> Either (Anchor block) block
-> Point block
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Anchor block -> Point block
forall block. Anchor block -> Point block
anchorToPoint block -> Point block
forall block. HasHeader block => block -> Point block
blockPoint (Either (Anchor block) block -> Point block)
-> (AnchoredFragment block -> Either (Anchor block) block)
-> AnchoredFragment block
-> Point block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment block -> Either (Anchor block) block
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Either a b
last

-- | \( O(1) \). When the fragment is empty, the slot of the anchor point is
-- returned, which may be the origin and therefore have no slot.
lastSlot :: HasHeader block => AnchoredFragment block -> WithOrigin SlotNo
lastSlot :: forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin SlotNo
lastSlot = (Anchor block -> WithOrigin SlotNo)
-> (block -> WithOrigin SlotNo)
-> Either (Anchor block) block
-> WithOrigin SlotNo
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Anchor block -> WithOrigin SlotNo
forall block. Anchor block -> WithOrigin SlotNo
anchorToSlotNo (SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
At (SlotNo -> WithOrigin SlotNo)
-> (block -> SlotNo) -> block -> WithOrigin SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. block -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot) (Either (Anchor block) block -> WithOrigin SlotNo)
-> (AnchoredFragment block -> Either (Anchor block) block)
-> AnchoredFragment block
-> WithOrigin SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment block -> Either (Anchor block) block
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Either a b
last

-- | \( O(1) \). Add a block to the right of the anchored fragment.
--
-- Synonym for ':>'.
addBlock :: HasHeader block
         => block -> AnchoredFragment block -> AnchoredFragment block
addBlock :: forall block.
HasHeader block =>
block -> AnchoredFragment block -> AnchoredFragment block
addBlock block
b AnchoredFragment block
c = AnchoredFragment block
c AnchoredFragment block -> block -> AnchoredFragment block
forall v a b.
Anchorable v a b =>
AnchoredSeq v a b -> b -> AnchoredSeq v a b
:> block
b

-- | \( O(\log(\min(i,n-i)) \). If the 'Point' is within the bounds of the
-- 'AnchoredFragment' (see 'withinFragmentBounds'), roll back the anchored
-- fragment such that its head is the given point. In case the given point was
-- the anchor point, the returned anchored fragment will be empty.
--
-- In other words, remove blocks from the end of the 'AnchoredFragment' until
-- the given 'Point' is the head. If the given 'Point' is not within the
-- bounds of the 'AnchoredFragment', return 'Nothing'.
rollback :: HasHeader block
         => Point block -> AnchoredFragment block
         -> Maybe (AnchoredFragment block)
rollback :: forall block.
HasHeader block =>
Point block
-> AnchoredFragment block -> Maybe (AnchoredFragment block)
rollback Point block
p = WithOrigin SlotNo
-> (Either (Anchor block) block -> Bool)
-> AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
-> Maybe (AnchoredSeq (WithOrigin SlotNo) (Anchor block) block)
forall v a b.
Anchorable v a b =>
v
-> (Either a b -> Bool)
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b)
AS.rollback (Point block -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot Point block
p) ((Point block -> Point block -> Bool
forall a. Eq a => a -> a -> Bool
== Point block
p) (Point block -> Bool)
-> (Either (Anchor block) block -> Point block)
-> Either (Anchor block) block
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Anchor block -> Point block)
-> (block -> Point block)
-> Either (Anchor block) block
-> Point block
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Anchor block -> Point block
forall block. Anchor block -> Point block
anchorToPoint block -> Point block
forall block. HasHeader block => block -> Point block
blockPoint)

-- | \( O(o \log(\min(i,n-i))) \). Select a bunch of 'Point's based on offsets
-- from the head of the anchored fragment. This is used in the chain consumer
-- protocol as part of finding the intersection between a local and remote
-- chain.
--
-- The list of offsets must be increasing monotonically.
--
-- 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] ])
--
-- Only for offsets within the bounds of the anchored fragment will there be
-- points in the returned list.
--
-- __Note__: offset @n@, where @n@ equals the length of the anchored fragment,
-- corresponds to the anchor point. When the fragment is empty, offset 0 will
-- thus correspond to the anchor point.
selectPoints ::
     forall block. HasHeader block
  => [Int]
  -> AnchoredFragment block
  -> [Point block]
selectPoints :: forall block.
HasHeader block =>
[Int] -> AnchoredFragment block -> [Point block]
selectPoints [Int]
offsets =
    (Either (Anchor block) block -> Point block)
-> [Either (Anchor block) block] -> [Point block]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Anchor block -> Point block)
-> (block -> Point block)
-> Either (Anchor block) block
-> Point block
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Anchor block -> Point block
forall block. Anchor block -> Point block
anchorToPoint block -> Point block
forall block. HasHeader block => block -> Point block
blockPoint) ([Either (Anchor block) block] -> [Point block])
-> (AnchoredFragment block -> [Either (Anchor block) block])
-> AnchoredFragment block
-> [Point block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> AnchoredFragment block -> [Either (Anchor block) block]
forall v a b.
Anchorable v a b =>
[Int] -> AnchoredSeq v a b -> [Either a b]
AS.selectOffsets [Int]
offsets

-- | \( O(o * n) \). Specification of 'selectPoints'.
--
-- Use 'selectPoints', as it should be faster.
--
-- This function is used to verify whether 'selectPoints' behaves as expected.
selectPointsSpec :: HasHeader block
                => [Int] -> AnchoredFragment block -> [Point block]
selectPointsSpec :: forall block.
HasHeader block =>
[Int] -> AnchoredFragment block -> [Point block]
selectPointsSpec [Int]
offsets AnchoredFragment block
c =
    [ [Point block]
ps [Point block] -> Int -> Point block
forall a. HasCallStack => [a] -> Int -> a
!! Int
offset
    | let ps :: [Point block]
ps = (block -> Point block
forall block. HasHeader block => block -> Point block
blockPoint (block -> Point block) -> [block] -> [Point block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnchoredFragment block -> [block]
forall v a b. AnchoredSeq v a b -> [b]
toNewestFirst AnchoredFragment block
c) [Point block] -> [Point block] -> [Point block]
forall a. Semigroup a => a -> a -> a
<> [AnchoredFragment block -> Point block
forall block. AnchoredFragment block -> Point block
anchorPoint AnchoredFragment block
c]
          len :: Int
len = [Point block] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Point block]
ps
    , Int
offset <- [Int]
offsets
    , Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
    ]

-- | \( O(\log(\min(i,n-i)) \). Find the block after the given point. If the
-- given point is the anchor point, then the first block is returned (if there
-- is one).
successorBlock :: HasHeader block
               => Point block -> AnchoredFragment block -> Maybe block
successorBlock :: forall block.
HasHeader block =>
Point block -> AnchoredFragment block -> Maybe block
successorBlock Point block
p AnchoredFragment block
af
    | Point block
p Point block -> Point block -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredFragment block -> Point block
forall block. AnchoredFragment block -> Point block
anchorPoint AnchoredFragment block
af
    = (Anchor block -> Maybe block)
-> (block -> Maybe block)
-> Either (Anchor block) block
-> Maybe block
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe block -> Anchor block -> Maybe block
forall a b. a -> b -> a
const Maybe block
forall a. Maybe a
Nothing) block -> Maybe block
forall a. a -> Maybe a
Just (Either (Anchor block) block -> Maybe block)
-> Either (Anchor block) block -> Maybe block
forall a b. (a -> b) -> a -> b
$ AnchoredFragment block -> Either (Anchor block) block
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Either a b
last AnchoredFragment block
af
    | Bool
otherwise
    = case 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)
splitAfterPoint AnchoredFragment block
af Point block
p of
        Just (AnchoredFragment block
_, block
b :< AnchoredFragment block
_) -> block -> Maybe block
forall a. a -> Maybe a
Just block
b
        Maybe (AnchoredFragment block, AnchoredFragment block)
_otherwise       -> Maybe block
forall a. Maybe a
Nothing

-- | \( O(\log(\min(i,n-i)) \). Does the fragment contain a block with the given
-- point? The anchor point is ignored.
pointOnFragment :: HasHeader block
                => Point block -> AnchoredFragment block -> Bool
pointOnFragment :: forall block.
HasHeader block =>
Point block -> AnchoredFragment block -> Bool
pointOnFragment Point block
p = WithOrigin SlotNo
-> (block -> Bool)
-> AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
-> Bool
forall v a b.
Anchorable v a b =>
v -> (b -> Bool) -> AnchoredSeq v a b -> Bool
contains (Point block -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot Point block
p) ((Point block -> Point block -> Bool
forall a. Eq a => a -> a -> Bool
== Point block
p) (Point block -> Bool) -> (block -> Point block) -> block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. block -> Point block
forall block. HasHeader block => block -> Point block
blockPoint)

-- | \( O(n) \). Specification of 'pointOnFragment'.
--
-- Use 'pointOnFragment', as it should be faster.
--
-- This function is used to verify whether 'pointOnFragment' behaves as
-- expected.
pointOnFragmentSpec :: HasHeader block
                    => Point block -> AnchoredFragment block -> Bool
pointOnFragmentSpec :: forall block.
HasHeader block =>
Point block -> AnchoredFragment block -> Bool
pointOnFragmentSpec Point block
p = AnchoredSeq (WithOrigin SlotNo) (Anchor block) block -> Bool
go
    where
      -- Recursively search the fingertree from the right
      go :: AnchoredSeq (WithOrigin SlotNo) (Anchor block) block -> Bool
go (Empty Anchor block
_) = Bool
False
      go (AnchoredSeq (WithOrigin SlotNo) (Anchor block) 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 = Bool
True
                   | Bool
otherwise         = AnchoredSeq (WithOrigin SlotNo) (Anchor block) block -> Bool
go AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
c'

-- | \( O(\log(\min(i,n-i)) \). Is the point within the fragment bounds?
-- Either the point is the anchor point, or it corresponds to a block \"on\"
-- the fragment.
withinFragmentBounds :: HasHeader block
                     => Point block -> AnchoredFragment block -> Bool
withinFragmentBounds :: forall block.
HasHeader block =>
Point block -> AnchoredFragment block -> Bool
withinFragmentBounds Point block
p =
    WithOrigin SlotNo
-> (Either (Anchor block) block -> Bool)
-> AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
-> Bool
forall v a b.
Anchorable v a b =>
v -> (Either a b -> Bool) -> AnchoredSeq v a b -> Bool
withinBounds
      (Point block -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot Point block
p)
      ((Point block -> Point block -> Bool
forall a. Eq a => a -> a -> Bool
== Point block
p) (Point block -> Bool)
-> (Either (Anchor block) block -> Point block)
-> Either (Anchor block) block
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Anchor block -> Point block)
-> (block -> Point block)
-> Either (Anchor block) block
-> Point block
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Anchor block -> Point block
forall block. Anchor block -> Point block
anchorToPoint block -> Point block
forall block. HasHeader block => block -> Point block
blockPoint)

-- | \( O(p \log(\min(i,n-i)) \). Find the first 'Point' in the list of points
-- that is within the fragment bounds. Return 'Nothing' if none of them are.
findFirstPoint
  :: HasHeader block
  => [Point block]
  -> AnchoredFragment block
  -> Maybe (Point block)
findFirstPoint :: forall block.
HasHeader block =>
[Point block] -> AnchoredFragment block -> Maybe (Point block)
findFirstPoint [Point block]
ps AnchoredFragment block
c = (Point block -> Bool) -> [Point block] -> Maybe (Point block)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Point block -> AnchoredFragment block -> Bool
forall block.
HasHeader block =>
Point block -> AnchoredFragment block -> Bool
`withinFragmentBounds` AnchoredFragment block
c) [Point block]
ps

applyChainUpdate :: HasHeader block
                 => ChainUpdate block block
                 -> AnchoredFragment block
                 -> Maybe (AnchoredFragment block)
applyChainUpdate :: forall block.
HasHeader block =>
ChainUpdate block block
-> AnchoredFragment block -> Maybe (AnchoredFragment block)
applyChainUpdate (AddBlock block
b) AnchoredFragment block
c = AnchoredFragment block -> Maybe (AnchoredFragment block)
forall a. a -> Maybe a
Just (block -> AnchoredFragment block -> AnchoredFragment block
forall block.
HasHeader block =>
block -> AnchoredFragment block -> AnchoredFragment block
addBlock block
b AnchoredFragment block
c)
applyChainUpdate (RollBack Point block
p) AnchoredFragment block
c =       Point block
-> AnchoredFragment block -> Maybe (AnchoredFragment block)
forall block.
HasHeader block =>
Point block
-> AnchoredFragment block -> Maybe (AnchoredFragment block)
rollback Point block
p AnchoredFragment block
c

applyChainUpdates :: HasHeader block
                  => [ChainUpdate block block]
                  -> AnchoredFragment block
                  -> Maybe (AnchoredFragment block)
applyChainUpdates :: forall block.
HasHeader block =>
[ChainUpdate block block]
-> AnchoredFragment block -> Maybe (AnchoredFragment block)
applyChainUpdates []     AnchoredFragment block
c = AnchoredFragment block -> Maybe (AnchoredFragment block)
forall a. a -> Maybe a
Just AnchoredFragment block
c
applyChainUpdates (ChainUpdate block block
u:[ChainUpdate block block]
us) AnchoredFragment block
c = [ChainUpdate block block]
-> AnchoredFragment block -> Maybe (AnchoredFragment block)
forall block.
HasHeader block =>
[ChainUpdate block block]
-> AnchoredFragment block -> Maybe (AnchoredFragment block)
applyChainUpdates [ChainUpdate block block]
us (AnchoredFragment block -> Maybe (AnchoredFragment block))
-> Maybe (AnchoredFragment block) -> Maybe (AnchoredFragment block)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChainUpdate block block
-> AnchoredFragment block -> Maybe (AnchoredFragment block)
forall block.
HasHeader block =>
ChainUpdate block block
-> AnchoredFragment block -> Maybe (AnchoredFragment block)
applyChainUpdate ChainUpdate block block
u AnchoredFragment block
c


-- | \( O(\log(\min(i,n-i)) \). Split the 'AnchoredFragment' after the given
--  'Point'. Return 'Nothing' if given 'Point' is not within the fragment
--  bounds ('withinFragmentBounds').
--
-- The given 'Point' may be the anchor point of the fragment, in which case
-- the empty fragment with the given anchor point and the original fragment
-- are returned.
--
-- POSTCONDITION: when @Just (before, after) = splitAfterPoint f pt@, then:
--
-- * @anchorPoint before == anchorPoint f@
-- * @headPoint   before == pt@
-- * @anchorPoint after  == pt@
-- * @headPoint   after  == headPoint f@
-- * @join before after  == Just f@
splitAfterPoint
   :: forall block1 block2.
      (HasHeader block1, HeaderHash block1 ~ HeaderHash block2)
   => AnchoredFragment block1
   -> Point block2
   -> Maybe (AnchoredFragment block1, AnchoredFragment block1)
splitAfterPoint :: forall block1 block2.
(HasHeader block1, HeaderHash block1 ~ HeaderHash block2) =>
AnchoredFragment block1
-> Point block2
-> Maybe (AnchoredFragment block1, AnchoredFragment block1)
splitAfterPoint AnchoredFragment block1
af Point block2
p =
    WithOrigin SlotNo
-> (Either (Anchor block1) block1 -> Bool)
-> AnchoredFragment block1
-> Maybe (AnchoredFragment block1, AnchoredFragment block1)
forall v a b.
Anchorable v a b =>
v
-> (Either a b -> Bool)
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
splitAfterMeasure
      (Point block2 -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot Point block2
p)
      ((Point block1 -> Point block1 -> Bool
forall a. Eq a => a -> a -> Bool
== Point block2 -> Point block1
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint Point block2
p) (Point block1 -> Bool)
-> (Either (Anchor block1) block1 -> Point block1)
-> Either (Anchor block1) block1
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Anchor block1 -> Point block1)
-> (block1 -> Point block1)
-> Either (Anchor block1) block1
-> Point block1
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Anchor block1 -> Point block1
forall block. Anchor block -> Point block
anchorToPoint block1 -> Point block1
forall block. HasHeader block => block -> Point block
blockPoint)
      AnchoredFragment block1
af

-- | \( O(\log(\min(i,n-i)) \). Split the 'AnchoredFragment' before the given
--  'Point'. Return 'Nothing' if given 'Point' is not on the fragment
--  ('pointOnFragment').
--
-- This means that 'Nothing' is returned if the given 'Point' is the anchor
-- point of the fragment.
--
-- POSTCONDITION: joining ('join') the two fragments gives back the original
-- fragment.
--
-- POSTCONDITION: the last block (oldest) on the second fragment corresponds
-- to the given point.
splitBeforePoint
   :: forall block1 block2.
      (HasHeader block1, HeaderHash block1 ~ HeaderHash block2)
   => AnchoredFragment block1
   -> Point block2
   -> Maybe (AnchoredFragment block1, AnchoredFragment block1)
splitBeforePoint :: forall block1 block2.
(HasHeader block1, HeaderHash block1 ~ HeaderHash block2) =>
AnchoredFragment block1
-> Point block2
-> Maybe (AnchoredFragment block1, AnchoredFragment block1)
splitBeforePoint AnchoredFragment block1
af Point block2
p =
    WithOrigin SlotNo
-> (block1 -> Bool)
-> AnchoredFragment block1
-> Maybe (AnchoredFragment block1, AnchoredFragment block1)
forall v a b.
Anchorable v a b =>
v
-> (b -> Bool)
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
splitBeforeMeasure
      (Point block2 -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot Point block2
p)
      ((Point block1 -> Point block1 -> Bool
forall a. Eq a => a -> a -> Bool
== Point block2 -> Point block1
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint Point block2
p) (Point block1 -> Bool)
-> (block1 -> Point block1) -> block1 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. block1 -> Point block1
forall block. HasHeader block => block -> Point block
blockPoint)
      AnchoredFragment block1
af

-- | \( O(\log(\min(i,n-i)) \). Split the 'AnchoredFragment' at the given
-- slot.
--
-- POSTCONDITION: when @(before, after) = splitAtSlot s f@, then:
--
-- * @anchorPoint before == anchorPoint f@
-- * @headPoint   before == anchorPoint after@
-- * @headPoint   after  == headPoint f@
-- * @join before after  == Just f@
-- * @toOldestFirst before == filter ((< s) . blockSlot) (toOldestFirst f)@
-- * @toOldestFirst after == filter ((s <=) . blockSlot) (toOldestFirst f)@
splitAtSlot
   :: HasHeader block
   => SlotNo
   -> AnchoredFragment block
   -> (AnchoredFragment block, AnchoredFragment block)
splitAtSlot :: forall block.
HasHeader block =>
SlotNo
-> AnchoredFragment block
-> (AnchoredFragment block, AnchoredFragment block)
splitAtSlot = WithOrigin SlotNo
-> AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
-> (AnchoredSeq (WithOrigin SlotNo) (Anchor block) block,
    AnchoredSeq (WithOrigin SlotNo) (Anchor block) block)
forall v a b.
Anchorable v a b =>
v -> AnchoredSeq v a b -> (AnchoredSeq v a b, AnchoredSeq v a b)
splitAtMeasure (WithOrigin SlotNo
 -> AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
 -> (AnchoredSeq (WithOrigin SlotNo) (Anchor block) block,
     AnchoredSeq (WithOrigin SlotNo) (Anchor block) block))
-> (SlotNo -> WithOrigin SlotNo)
-> SlotNo
-> AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
-> (AnchoredSeq (WithOrigin SlotNo) (Anchor block) block,
    AnchoredSeq (WithOrigin SlotNo) (Anchor block) block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
At

-- | Select a slice of an anchored fragment between two points, inclusive.
--
-- Both points must exist on the chain, in order, or the result is @Nothing@.
--
sliceRange :: HasHeader block
           => AnchoredFragment block
           -> Point block
           -> Point block
           -> Maybe (AnchoredFragment block)
sliceRange :: forall block.
HasHeader block =>
AnchoredFragment block
-> Point block -> Point block -> Maybe (AnchoredFragment block)
sliceRange AnchoredFragment block
af Point block
from Point block
to
  | Just (AnchoredFragment block
_, AnchoredFragment block
af') <- 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)
splitBeforePoint AnchoredFragment block
af  Point block
from
  , Just (AnchoredFragment block
af'',AnchoredFragment block
_) <- 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)
splitAfterPoint  AnchoredFragment block
af' Point block
to
  = AnchoredFragment block -> Maybe (AnchoredFragment block)
forall a. a -> Maybe a
Just AnchoredFragment block
af''

  | Bool
otherwise
  = Maybe (AnchoredFragment block)
forall a. Maybe a
Nothing

-- | \( O(\log(\min(n_1, n_2))) \). Join two anchored fragments if the anchor
-- of the second fragment is the head (newest block) of the first fragment.
--
-- If the first fragment is empty, it can be joined if its anchor is the same
-- as the second fragment's anchor.
--
-- The returned fragment will have the same anchor as the first fragment.
join :: HasHeader block
     => AnchoredFragment block
     -> AnchoredFragment block
     -> Maybe (AnchoredFragment block)
join :: forall block.
HasHeader block =>
AnchoredFragment block
-> AnchoredFragment block -> Maybe (AnchoredFragment block)
join = (Either (Anchor block) block -> Anchor block -> Bool)
-> AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
-> AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
-> Maybe (AnchoredSeq (WithOrigin SlotNo) (Anchor block) block)
forall v a b.
Anchorable v a b =>
(Either a b -> a -> Bool)
-> AnchoredSeq v a b
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b)
AS.join ((Either (Anchor block) block -> Anchor block -> Bool)
 -> AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
 -> AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
 -> Maybe (AnchoredSeq (WithOrigin SlotNo) (Anchor block) block))
-> (Either (Anchor block) block -> Anchor block -> Bool)
-> AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
-> AnchoredSeq (WithOrigin SlotNo) (Anchor block) block
-> Maybe (AnchoredSeq (WithOrigin SlotNo) (Anchor block) block)
forall a b. (a -> b) -> a -> b
$ \Either (Anchor block) block
aOrB Anchor block
a ->
    (Anchor block -> Point block)
-> (block -> Point block)
-> Either (Anchor block) block
-> Point block
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Anchor block -> Point block
forall block. Anchor block -> Point block
anchorToPoint block -> Point block
forall block. HasHeader block => block -> Point block
blockPoint Either (Anchor block) block
aOrB Point block -> Point block -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor block -> Point block
forall block. Anchor block -> Point block
anchorToPoint Anchor block
a

-- | \( O(n_2 \log(n_1)) \). Look for the most recent intersection of two
-- 'AnchoredFragment's @c1@ and @c2@.
--
-- The fragments need not have the same anchor point.
--
-- If they intersect, i.e., share a common 'Point' (possibly the anchor
-- point), then return a tuple of:
--
-- * @p1@: the prefix of the first  fragment
-- * @p2@: the prefix of the second fragment
-- * @s1@: the suffix of the first  fragment
-- * @s2@: the suffix of the second fragment
--
-- @p1@ and @p2@ will have the same /head/ (possibly an anchor point), namely
-- the intersection point @i@. The original chain @c1@ can be obtained by
-- putting @s1@ after @p1@, similarly for @c2@: by putting @s2@ after @p2@:
--
-- @
-- Just c1 = 'join' p1 s1
-- Just c2 = 'join' p2 s2
-- @
--
-- Take for example the following two fragments that share blocks 4 and 5. The
-- two fragments are fragments of the same chain, but don't contain all blocks
-- of the original chain. The anchor points of the fragments are indicated
-- with an asterisk (*). The @-A@ and @-B@ suffixes denote that blocks are
-- part of a fork of the chain.
--
-- >
-- >
-- >     ┆ 1*┆
-- >     ├───┤
-- >     │ 2 │     ┆ 2*┆
-- >     ├───┤     ├───┤
-- >     │ 4 │     │ 4 │
-- >     ├───┤     ├───┤
-- >     │ 5 │     │ 5 │
-- > ────┼───┼─────┼───┼───
-- >     │ 6A│     │ 6B│
-- >     └───┘     ├───┤
-- >               │ 8B│
-- >               └───┘
-- >       c1        c2
--
-- The intersection of @c1@ and @c2@ is block 5 (the last 'Point' the two
-- fragments have in common) and we return the following fragments:
--
-- >
-- >
-- >     ┆ 1*┆
-- >     ├───┤
-- >     │ 2 │     ┆ 2*┆
-- >     ├───┤     ├───┤
-- >     │ 4 │     │ 4 │
-- >     ├───┤     ├───┤
-- >     │ 5 │     │ 5 │      ┆ 5*┆     ┆ 5*┆
-- > ────┴───┴─────┴───┴──────┼───┼─────┼───┼──
-- >                          │ 6A│     │ 6B│
-- >                          └───┘     ├───┤
-- >                                    │ 8B│
-- >                                    └───┘
-- > Just (p1,       p2,        s1,       s2)
--
-- The intersection point will be the anchor point of fragments @s1@ and @s2@.
-- Fragment @p1@ will have the same anchor as @c1@ and @p2@ will have the same
-- anchor as @c2@.
--
-- Note that an empty fragment can still intersect another fragment, as its
-- anchor point can still intersect the other fragment. In that case the
-- respective prefix and suffix are both equal to original empty fragment.
-- Additionally, two empty fragments intersect if their anchor points are
-- equal, in which case all prefixes and suffixes are equal to the empty
-- fragment with the anchor point in question.
intersect
    :: forall block1 block2.
       (HasHeader block1, HasHeader block2, HeaderHash block1 ~ HeaderHash block2)
    => AnchoredFragment block1
    -> AnchoredFragment block2
    -> Maybe (AnchoredFragment block1, AnchoredFragment block2,
              AnchoredFragment block1, AnchoredFragment block2)
intersect :: forall block1 block2.
(HasHeader block1, HasHeader block2,
 HeaderHash block1 ~ HeaderHash block2) =>
AnchoredFragment block1
-> AnchoredFragment block2
-> Maybe
     (AnchoredFragment block1, AnchoredFragment block2,
      AnchoredFragment block1, AnchoredFragment block2)
intersect AnchoredFragment block1
c1 AnchoredFragment block2
c2
    | AnchoredFragment block2 -> Int
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Int
length AnchoredFragment block2
c2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> AnchoredFragment block1 -> Int
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Int
length AnchoredFragment block1
c1
      -- Note that 'intersect' is linear in its second argument. It iterates
      -- over the elements in the second fragment, starting from the end,
      -- looking for a match in the first fragment (with a /O(log(n))/ cost).
      -- So by using the shortest fragment as the second argument, we get the
      -- same result with a lower cost than the other way around.
    = (\(AnchoredFragment block2
p2, AnchoredFragment block1
p1, AnchoredFragment block2
s2, AnchoredFragment block1
s1) -> (AnchoredFragment block1
p1, AnchoredFragment block2
p2, AnchoredFragment block1
s1, AnchoredFragment block2
s2)) ((AnchoredFragment block2, AnchoredFragment block1,
  AnchoredFragment block2, AnchoredFragment block1)
 -> (AnchoredFragment block1, AnchoredFragment block2,
     AnchoredFragment block1, AnchoredFragment block2))
-> Maybe
     (AnchoredFragment block2, AnchoredFragment block1,
      AnchoredFragment block2, AnchoredFragment block1)
-> Maybe
     (AnchoredFragment block1, AnchoredFragment block2,
      AnchoredFragment block1, AnchoredFragment block2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnchoredFragment block2
-> AnchoredFragment block1
-> Maybe
     (AnchoredFragment block2, AnchoredFragment block1,
      AnchoredFragment block2, AnchoredFragment block1)
forall block1 block2.
(HasHeader block1, HasHeader block2,
 HeaderHash block1 ~ HeaderHash block2) =>
AnchoredFragment block1
-> AnchoredFragment block2
-> Maybe
     (AnchoredFragment block1, AnchoredFragment block2,
      AnchoredFragment block1, AnchoredFragment block2)
intersect AnchoredFragment block2
c2 AnchoredFragment block1
c1

    | Point block1 -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot (AnchoredFragment block1 -> Point block1
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
headPoint AnchoredFragment block1
c1) WithOrigin SlotNo -> WithOrigin SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< Point block2 -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot (AnchoredFragment block2 -> Point block2
forall block. AnchoredFragment block -> Point block
anchorPoint AnchoredFragment block2
c2) Bool -> Bool -> Bool
||
      Point block2 -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot (AnchoredFragment block2 -> Point block2
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
headPoint AnchoredFragment block2
c2) WithOrigin SlotNo -> WithOrigin SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< Point block1 -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot (AnchoredFragment block1 -> Point block1
forall block. AnchoredFragment block -> Point block
anchorPoint AnchoredFragment block1
c1)
      -- If there is no overlap in slot numbers, there will be no overlap
    = Maybe
  (AnchoredFragment block1, AnchoredFragment block2,
   AnchoredFragment block1, AnchoredFragment block2)
forall a. Maybe a
Nothing

    | Bool
otherwise
    = AnchoredFragment block2
-> Maybe
     (AnchoredFragment block1, AnchoredFragment block2,
      AnchoredFragment block1, AnchoredFragment block2)
go AnchoredFragment block2
c2
  where
    go :: AnchoredFragment block2
       -> Maybe (AnchoredFragment block1, AnchoredFragment block2,
                 AnchoredFragment block1, AnchoredFragment block2)
    go :: AnchoredFragment block2
-> Maybe
     (AnchoredFragment block1, AnchoredFragment block2,
      AnchoredFragment block1, AnchoredFragment block2)
go (Empty Anchor block2
a2)
      | Just (AnchoredFragment block1
p1, AnchoredFragment block1
s1) <- AnchoredFragment block1
-> Point block2
-> Maybe (AnchoredFragment block1, AnchoredFragment block1)
forall block1 block2.
(HasHeader block1, HeaderHash block1 ~ HeaderHash block2) =>
AnchoredFragment block1
-> Point block2
-> Maybe (AnchoredFragment block1, AnchoredFragment block1)
splitAfterPoint AnchoredFragment block1
c1 (Anchor block2 -> Point block2
forall block. Anchor block -> Point block
anchorToPoint Anchor block2
a2)
      = (AnchoredFragment block1, AnchoredFragment block2,
 AnchoredFragment block1, AnchoredFragment block2)
-> Maybe
     (AnchoredFragment block1, AnchoredFragment block2,
      AnchoredFragment block1, AnchoredFragment block2)
forall a. a -> Maybe a
Just (AnchoredFragment block1
p1, Anchor block2 -> AnchoredFragment block2
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
Empty Anchor block2
a2, AnchoredFragment block1
s1, AnchoredFragment block2
c2)
      | Bool
otherwise
      = Maybe
  (AnchoredFragment block1, AnchoredFragment block2,
   AnchoredFragment block1, AnchoredFragment block2)
forall a. Maybe a
Nothing
    go (AnchoredFragment block2
c2' :> block2
b)
      | let pt :: Point block2
pt = block2 -> Point block2
forall block. HasHeader block => block -> Point block
blockPoint block2
b
      , Just (AnchoredFragment block1
p1, AnchoredFragment block1
s1) <- AnchoredFragment block1
-> Point block2
-> Maybe (AnchoredFragment block1, AnchoredFragment block1)
forall block1 block2.
(HasHeader block1, HeaderHash block1 ~ HeaderHash block2) =>
AnchoredFragment block1
-> Point block2
-> Maybe (AnchoredFragment block1, AnchoredFragment block1)
splitAfterPoint AnchoredFragment block1
c1 Point block2
pt
      , Just (AnchoredFragment block2
p2, AnchoredFragment block2
s2) <- AnchoredFragment block2
-> Point block2
-> Maybe (AnchoredFragment block2, AnchoredFragment block2)
forall block1 block2.
(HasHeader block1, HeaderHash block1 ~ HeaderHash block2) =>
AnchoredFragment block1
-> Point block2
-> Maybe (AnchoredFragment block1, AnchoredFragment block1)
splitAfterPoint AnchoredFragment block2
c2 Point block2
pt
        -- splitAfterPoint c2 pt cannot fail,
        -- since pt comes out of c2
      = (AnchoredFragment block1, AnchoredFragment block2,
 AnchoredFragment block1, AnchoredFragment block2)
-> Maybe
     (AnchoredFragment block1, AnchoredFragment block2,
      AnchoredFragment block1, AnchoredFragment block2)
forall a. a -> Maybe a
Just (AnchoredFragment block1
p1, AnchoredFragment block2
p2, AnchoredFragment block1
s1, AnchoredFragment block2
s2)
      | Bool
otherwise
      = AnchoredFragment block2
-> Maybe
     (AnchoredFragment block1, AnchoredFragment block2,
      AnchoredFragment block1, AnchoredFragment block2)
go AnchoredFragment block2
c2'

-- | \( O(n_2 \log(n_1)) \). Look for the most recent intersection point of
-- two 'AnchoredFragment's
--
-- The fragments need not have the same anchor point.
--
-- Reusing the example in the docstring of 'intersect': this function will
-- return the anchor point @5*@.
intersectionPoint
    :: (HasHeader block1, HasHeader block2, HeaderHash block1 ~ HeaderHash block2)
    => AnchoredFragment block1
    -> AnchoredFragment block2
    -> Maybe (Point block1)
intersectionPoint :: forall block1 block2.
(HasHeader block1, HasHeader block2,
 HeaderHash block1 ~ HeaderHash block2) =>
AnchoredFragment block1
-> AnchoredFragment block2 -> Maybe (Point block1)
intersectionPoint AnchoredFragment block1
c1 AnchoredFragment block2
c2 = case AnchoredFragment block1
c1 AnchoredFragment block1
-> AnchoredFragment block2
-> Maybe
     (AnchoredFragment block1, AnchoredFragment block2,
      AnchoredFragment block1, AnchoredFragment block2)
forall block1 block2.
(HasHeader block1, HasHeader block2,
 HeaderHash block1 ~ HeaderHash block2) =>
AnchoredFragment block1
-> AnchoredFragment block2
-> Maybe
     (AnchoredFragment block1, AnchoredFragment block2,
      AnchoredFragment block1, AnchoredFragment block2)
`intersect` AnchoredFragment block2
c2 of
    Just (AnchoredFragment block1
_, AnchoredFragment block2
_, AnchoredFragment block1
s1, AnchoredFragment block2
_) -> Point block1 -> Maybe (Point block1)
forall a. a -> Maybe a
Just (AnchoredFragment block1 -> Point block1
forall block. AnchoredFragment block -> Point block
anchorPoint AnchoredFragment block1
s1)
    Maybe
  (AnchoredFragment block1, AnchoredFragment block2,
   AnchoredFragment block1, AnchoredFragment block2)
Nothing            -> Maybe (Point block1)
forall a. Maybe a
Nothing

-- | \( O(n) \). Maps over the chain's blocks. This is not allowed to change the
-- block 'Point's, or it would create an invalid chain. The 'anchorPoint' is not
-- affected.
--
mapAnchoredFragment ::
     (HasHeader block2, HeaderHash block1 ~ HeaderHash block2)
  => (block1 -> block2)
  -> AnchoredFragment block1
  -> AnchoredFragment block2
mapAnchoredFragment :: forall block2 block1.
(HasHeader block2, HeaderHash block1 ~ HeaderHash block2) =>
(block1 -> block2)
-> AnchoredFragment block1 -> AnchoredFragment block2
mapAnchoredFragment = (Anchor block1 -> Anchor block2)
-> (block1 -> block2)
-> AnchoredSeq (WithOrigin SlotNo) (Anchor block1) block1
-> AnchoredSeq (WithOrigin SlotNo) (Anchor block2) block2
forall v2 a2 b2 a1 b1 v1.
Anchorable v2 a2 b2 =>
(a1 -> a2)
-> (b1 -> b2) -> AnchoredSeq v1 a1 b1 -> AnchoredSeq v2 a2 b2
bimap Anchor block1 -> Anchor block2
forall a b. (HeaderHash a ~ HeaderHash b) => Anchor a -> Anchor b
castAnchor