{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DerivingVia           #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MonoLocalBinds        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE ViewPatterns          #-}
{-| The UTXO state, kept in memory by the chain index.
-}
module Plutus.ChainIndex.UtxoState(
    UtxoState(..)
    , usTxUtxoData
    , usTip
    , UtxoIndex
    , utxoState
    , utxoBlockCount
    , tip
    , viewTip
    , pointLessThanTip
    -- * Extending the UTXO index
    , InsertUtxoPosition(..)
    , InsertUtxoSuccess(..)
    , InsertUtxoFailed(..)
    , insert
    -- * Rollbacks
    , RollbackFailed(..)
    , RollbackResult(..)
    , rollbackWith
    -- * Limit the UTXO index size
    , ReduceBlockCountResult(..)
    , reduceBlockCount
    , BlockCount (..)
    ) where

import Control.Lens (makeLenses, view)
import Data.Aeson (FromJSON, ToJSON)
import Data.FingerTree (FingerTree, Measured (..))
import Data.FingerTree qualified as FT
import Data.Function (on)
import Data.Monoid (Sum (..))
import Data.Semigroup.Generic (GenericSemigroupMonoid (..))
import GHC.Generics (Generic)
import Plutus.ChainIndex.ChainIndexError (InsertUtxoFailed (..), RollbackFailed (..))
import Plutus.ChainIndex.ChainIndexLog (InsertUtxoPosition (..))
import Plutus.ChainIndex.Types (Depth (..), Point (..), Tip (..), pointsToTip)
import Prettyprinter (Pretty (..))

-- | UTXO / ledger state, kept in memory. We are only interested in the UTXO set, everything else is stored
--   on disk. This is OK because we don't need to validate transactions when they come in.
data UtxoState a =
    UtxoState
        { UtxoState a -> a
_usTxUtxoData :: a -- One of 'TxUtxoBalance', 'TxOutBalance' or 'TxIdState'
        , UtxoState a -> Tip
_usTip        :: Tip -- ^ Tip of our chain sync client
        }
        deriving stock (UtxoState a -> UtxoState a -> Bool
(UtxoState a -> UtxoState a -> Bool)
-> (UtxoState a -> UtxoState a -> Bool) -> Eq (UtxoState a)
forall a. Eq a => UtxoState a -> UtxoState a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UtxoState a -> UtxoState a -> Bool
$c/= :: forall a. Eq a => UtxoState a -> UtxoState a -> Bool
== :: UtxoState a -> UtxoState a -> Bool
$c== :: forall a. Eq a => UtxoState a -> UtxoState a -> Bool
Eq, Int -> UtxoState a -> ShowS
[UtxoState a] -> ShowS
UtxoState a -> String
(Int -> UtxoState a -> ShowS)
-> (UtxoState a -> String)
-> ([UtxoState a] -> ShowS)
-> Show (UtxoState a)
forall a. Show a => Int -> UtxoState a -> ShowS
forall a. Show a => [UtxoState a] -> ShowS
forall a. Show a => UtxoState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UtxoState a] -> ShowS
$cshowList :: forall a. Show a => [UtxoState a] -> ShowS
show :: UtxoState a -> String
$cshow :: forall a. Show a => UtxoState a -> String
showsPrec :: Int -> UtxoState a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> UtxoState a -> ShowS
Show, (forall x. UtxoState a -> Rep (UtxoState a) x)
-> (forall x. Rep (UtxoState a) x -> UtxoState a)
-> Generic (UtxoState a)
forall x. Rep (UtxoState a) x -> UtxoState a
forall x. UtxoState a -> Rep (UtxoState a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (UtxoState a) x -> UtxoState a
forall a x. UtxoState a -> Rep (UtxoState a) x
$cto :: forall a x. Rep (UtxoState a) x -> UtxoState a
$cfrom :: forall a x. UtxoState a -> Rep (UtxoState a) x
Generic)
        deriving anyclass (Value -> Parser [UtxoState a]
Value -> Parser (UtxoState a)
(Value -> Parser (UtxoState a))
-> (Value -> Parser [UtxoState a]) -> FromJSON (UtxoState a)
forall a. FromJSON a => Value -> Parser [UtxoState a]
forall a. FromJSON a => Value -> Parser (UtxoState a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UtxoState a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [UtxoState a]
parseJSON :: Value -> Parser (UtxoState a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (UtxoState a)
FromJSON, [UtxoState a] -> Encoding
[UtxoState a] -> Value
UtxoState a -> Encoding
UtxoState a -> Value
(UtxoState a -> Value)
-> (UtxoState a -> Encoding)
-> ([UtxoState a] -> Value)
-> ([UtxoState a] -> Encoding)
-> ToJSON (UtxoState a)
forall a. ToJSON a => [UtxoState a] -> Encoding
forall a. ToJSON a => [UtxoState a] -> Value
forall a. ToJSON a => UtxoState a -> Encoding
forall a. ToJSON a => UtxoState a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UtxoState a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [UtxoState a] -> Encoding
toJSONList :: [UtxoState a] -> Value
$ctoJSONList :: forall a. ToJSON a => [UtxoState a] -> Value
toEncoding :: UtxoState a -> Encoding
$ctoEncoding :: forall a. ToJSON a => UtxoState a -> Encoding
toJSON :: UtxoState a -> Value
$ctoJSON :: forall a. ToJSON a => UtxoState a -> Value
ToJSON)

makeLenses ''UtxoState

deriving via (GenericSemigroupMonoid (UtxoState a)) instance Monoid a => Monoid (UtxoState a)

instance Semigroup a => Semigroup (UtxoState a) where
    (UtxoState a
ud Tip
tp) <> :: UtxoState a -> UtxoState a -> UtxoState a
<> (UtxoState a
ud' Tip
tp') =
        a -> Tip -> UtxoState a
forall a. a -> Tip -> UtxoState a
UtxoState (a
ud a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
ud') (Tip
tp Tip -> Tip -> Tip
forall a. Semigroup a => a -> a -> a
<> Tip
tp')

newtype BlockCount = BlockCount { BlockCount -> Int
getBlockCount :: Int }
  deriving (b -> BlockCount -> BlockCount
NonEmpty BlockCount -> BlockCount
BlockCount -> BlockCount -> BlockCount
(BlockCount -> BlockCount -> BlockCount)
-> (NonEmpty BlockCount -> BlockCount)
-> (forall b. Integral b => b -> BlockCount -> BlockCount)
-> Semigroup BlockCount
forall b. Integral b => b -> BlockCount -> BlockCount
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> BlockCount -> BlockCount
$cstimes :: forall b. Integral b => b -> BlockCount -> BlockCount
sconcat :: NonEmpty BlockCount -> BlockCount
$csconcat :: NonEmpty BlockCount -> BlockCount
<> :: BlockCount -> BlockCount -> BlockCount
$c<> :: BlockCount -> BlockCount -> BlockCount
Semigroup, Semigroup BlockCount
BlockCount
Semigroup BlockCount
-> BlockCount
-> (BlockCount -> BlockCount -> BlockCount)
-> ([BlockCount] -> BlockCount)
-> Monoid BlockCount
[BlockCount] -> BlockCount
BlockCount -> BlockCount -> BlockCount
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [BlockCount] -> BlockCount
$cmconcat :: [BlockCount] -> BlockCount
mappend :: BlockCount -> BlockCount -> BlockCount
$cmappend :: BlockCount -> BlockCount -> BlockCount
mempty :: BlockCount
$cmempty :: BlockCount
$cp1Monoid :: Semigroup BlockCount
Monoid) via (Sum Int)
type UtxoIndex a = FingerTree (BlockCount, UtxoState a) (UtxoState a)
instance Monoid a => Measured (BlockCount, UtxoState a) (UtxoState a) where
    measure :: UtxoState a -> (BlockCount, UtxoState a)
measure UtxoState a
u = (Int -> BlockCount
BlockCount Int
1, UtxoState a
u)

utxoState :: Monoid a => UtxoIndex a -> UtxoState a
utxoState :: UtxoIndex a -> UtxoState a
utxoState = (BlockCount, UtxoState a) -> UtxoState a
forall a b. (a, b) -> b
snd ((BlockCount, UtxoState a) -> UtxoState a)
-> (UtxoIndex a -> (BlockCount, UtxoState a))
-> UtxoIndex a
-> UtxoState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex a -> (BlockCount, UtxoState a)
forall v a. Measured v a => a -> v
measure

utxoBlockCount :: Monoid a => UtxoIndex a -> Int
utxoBlockCount :: UtxoIndex a -> Int
utxoBlockCount = BlockCount -> Int
getBlockCount (BlockCount -> Int)
-> (UtxoIndex a -> BlockCount) -> UtxoIndex a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockCount, UtxoState a) -> BlockCount
forall a b. (a, b) -> a
fst ((BlockCount, UtxoState a) -> BlockCount)
-> (UtxoIndex a -> (BlockCount, UtxoState a))
-> UtxoIndex a
-> BlockCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex a -> (BlockCount, UtxoState a)
forall v a. Measured v a => a -> v
measure

tip :: UtxoState a -> Tip
tip :: UtxoState a -> Tip
tip = Getting Tip (UtxoState a) Tip -> UtxoState a -> Tip
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Tip (UtxoState a) Tip
forall a. Lens' (UtxoState a) Tip
usTip

viewTip :: Monoid a => UtxoIndex a -> Tip
viewTip :: UtxoIndex a -> Tip
viewTip = UtxoState a -> Tip
forall a. UtxoState a -> Tip
tip (UtxoState a -> Tip)
-> (UtxoIndex a -> UtxoState a) -> UtxoIndex a -> Tip
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex a -> UtxoState a
forall a. Monoid a => UtxoIndex a -> UtxoState a
utxoState

instance Eq a => Ord (UtxoState a) where
    compare :: UtxoState a -> UtxoState a -> Ordering
compare = Tip -> Tip -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Tip -> Tip -> Ordering)
-> (UtxoState a -> Tip) -> UtxoState a -> UtxoState a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` UtxoState a -> Tip
forall a. UtxoState a -> Tip
tip

data InsertUtxoSuccess a =
    InsertUtxoSuccess
        { InsertUtxoSuccess a -> UtxoIndex a
newIndex       :: UtxoIndex a
        , InsertUtxoSuccess a -> InsertUtxoPosition
insertPosition :: InsertUtxoPosition
        }

instance Pretty (InsertUtxoSuccess a) where
  pretty :: InsertUtxoSuccess a -> Doc ann
pretty = \case
    InsertUtxoSuccess UtxoIndex a
_ InsertUtxoPosition
insertPosition -> InsertUtxoPosition -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty InsertUtxoPosition
insertPosition

-- | Insert a 'UtxoState' into the index
insert ::
       ( Monoid a
       , Eq a
       )
       => UtxoState a
       -> UtxoIndex a
       -> Either InsertUtxoFailed (InsertUtxoSuccess a)
insert :: UtxoState a
-> UtxoIndex a -> Either InsertUtxoFailed (InsertUtxoSuccess a)
insert   UtxoState{_usTip :: forall a. UtxoState a -> Tip
_usTip=Tip
TipAtGenesis} UtxoIndex a
_ = InsertUtxoFailed -> Either InsertUtxoFailed (InsertUtxoSuccess a)
forall a b. a -> Either a b
Left InsertUtxoFailed
InsertUtxoNoTip
insert s :: UtxoState a
s@UtxoState{_usTip :: forall a. UtxoState a -> Tip
_usTip= Tip
thisTip} UtxoIndex a
ix =
    -- This number will be made into a command line argument in a future PR.
    let (UtxoIndex a
before, UtxoIndex a
after) = ((BlockCount, UtxoState a) -> Bool)
-> UtxoIndex a -> (UtxoIndex a, UtxoIndex a)
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split ((UtxoState a
s UtxoState a -> UtxoState a -> Bool
forall a. Ord a => a -> a -> Bool
<=) (UtxoState a -> Bool)
-> ((BlockCount, UtxoState a) -> UtxoState a)
-> (BlockCount, UtxoState a)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockCount, UtxoState a) -> UtxoState a
forall a b. (a, b) -> b
snd) UtxoIndex a
ix
    in case UtxoState a -> Tip
forall a. UtxoState a -> Tip
tip (UtxoIndex a -> UtxoState a
forall a. Monoid a => UtxoIndex a -> UtxoState a
utxoState UtxoIndex a
after) of
        Tip
TipAtGenesis -> InsertUtxoSuccess a
-> Either InsertUtxoFailed (InsertUtxoSuccess a)
forall a b. b -> Either a b
Right (InsertUtxoSuccess a
 -> Either InsertUtxoFailed (InsertUtxoSuccess a))
-> InsertUtxoSuccess a
-> Either InsertUtxoFailed (InsertUtxoSuccess a)
forall a b. (a -> b) -> a -> b
$ InsertUtxoSuccess :: forall a. UtxoIndex a -> InsertUtxoPosition -> InsertUtxoSuccess a
InsertUtxoSuccess{newIndex :: UtxoIndex a
newIndex = UtxoIndex a
before UtxoIndex a -> UtxoState a -> UtxoIndex a
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
FT.|> UtxoState a
s, insertPosition :: InsertUtxoPosition
insertPosition = InsertUtxoPosition
InsertAtEnd}
        Tip
t | Tip
t Tip -> Tip -> Bool
forall a. Ord a => a -> a -> Bool
> Tip
thisTip -> InsertUtxoSuccess a
-> Either InsertUtxoFailed (InsertUtxoSuccess a)
forall a b. b -> Either a b
Right (InsertUtxoSuccess a
 -> Either InsertUtxoFailed (InsertUtxoSuccess a))
-> InsertUtxoSuccess a
-> Either InsertUtxoFailed (InsertUtxoSuccess a)
forall a b. (a -> b) -> a -> b
$ InsertUtxoSuccess :: forall a. UtxoIndex a -> InsertUtxoPosition -> InsertUtxoSuccess a
InsertUtxoSuccess{newIndex :: UtxoIndex a
newIndex = (UtxoIndex a
before UtxoIndex a -> UtxoState a -> UtxoIndex a
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
FT.|> UtxoState a
s) UtxoIndex a -> UtxoIndex a -> UtxoIndex a
forall a. Semigroup a => a -> a -> a
<> UtxoIndex a
after, insertPosition :: InsertUtxoPosition
insertPosition = InsertUtxoPosition
InsertBeforeEnd}
          | Bool
otherwise   -> InsertUtxoFailed -> Either InsertUtxoFailed (InsertUtxoSuccess a)
forall a b. a -> Either a b
Left  (InsertUtxoFailed -> Either InsertUtxoFailed (InsertUtxoSuccess a))
-> InsertUtxoFailed
-> Either InsertUtxoFailed (InsertUtxoSuccess a)
forall a b. (a -> b) -> a -> b
$ Tip -> InsertUtxoFailed
DuplicateBlock Tip
t

data RollbackResult a =
    RollbackResult
        { RollbackResult a -> Tip
newTip          :: Tip
        , RollbackResult a -> UtxoIndex a
rolledBackIndex :: UtxoIndex a
        }

-- | Perform a rollback on the utxo index, with a callback to calculate the new index.
rollbackWith
    :: Monoid a
    => (UtxoIndex a -> UtxoIndex a -> UtxoIndex a) -- ^ Calculate the new index given the index before and the index after the rollback point.
    -> Point
    -> UtxoIndex a
    -> Either RollbackFailed (RollbackResult a)
-- Forcing a re-synchronisation of the chain starting from genesis.
rollbackWith :: (UtxoIndex a -> UtxoIndex a -> UtxoIndex a)
-> Point -> UtxoIndex a -> Either RollbackFailed (RollbackResult a)
rollbackWith UtxoIndex a -> UtxoIndex a -> UtxoIndex a
f Point
PointAtGenesis UtxoIndex a
after =
    RollbackResult a -> Either RollbackFailed (RollbackResult a)
forall a b. b -> Either a b
Right (Tip -> UtxoIndex a -> RollbackResult a
forall a. Tip -> UtxoIndex a -> RollbackResult a
RollbackResult Tip
TipAtGenesis (UtxoIndex a -> UtxoIndex a -> UtxoIndex a
f UtxoIndex a
forall a. Monoid a => a
mempty UtxoIndex a
after))
-- Partial synchronisation, starting from a given block id.
rollbackWith UtxoIndex a -> UtxoIndex a -> UtxoIndex a
f Point
_ after :: UtxoIndex a
after@(UtxoIndex a -> Tip
forall a. Monoid a => UtxoIndex a -> Tip
viewTip -> Tip
TipAtGenesis) =
    RollbackResult a -> Either RollbackFailed (RollbackResult a)
forall a b. b -> Either a b
Right (Tip -> UtxoIndex a -> RollbackResult a
forall a. Tip -> UtxoIndex a -> RollbackResult a
RollbackResult Tip
TipAtGenesis (UtxoIndex a -> UtxoIndex a -> UtxoIndex a
f UtxoIndex a
forall a. Monoid a => a
mempty UtxoIndex a
after))
rollbackWith UtxoIndex a -> UtxoIndex a -> UtxoIndex a
f Point
targetPoint idx :: UtxoIndex a
idx@(UtxoIndex a -> Tip
forall a. Monoid a => UtxoIndex a -> Tip
viewTip -> Tip
currentTip)
    -- Already at the target point
    |  Point
targetPoint Point -> Tip -> Bool
`pointsToTip` Tip
currentTip =
        RollbackResult a -> Either RollbackFailed (RollbackResult a)
forall a b. b -> Either a b
Right RollbackResult :: forall a. Tip -> UtxoIndex a -> RollbackResult a
RollbackResult{newTip :: Tip
newTip=Tip
currentTip, rolledBackIndex :: UtxoIndex a
rolledBackIndex=UtxoIndex a
idx}
    -- The rollback happened sometime after the current tip.
    | Bool -> Bool
not (Point
targetPoint Point -> Tip -> Bool
`pointLessThanTip` Tip
currentTip) =
        RollbackFailed -> Either RollbackFailed (RollbackResult a)
forall a b. a -> Either a b
Left TipMismatch :: Tip -> Point -> RollbackFailed
TipMismatch{foundTip :: Tip
foundTip=Tip
currentTip, Point
targetPoint :: Point
targetPoint :: Point
targetPoint}
    | Bool
otherwise = do
        let (UtxoIndex a
before, UtxoIndex a
after) = ((BlockCount, UtxoState a) -> Bool)
-> UtxoIndex a -> (UtxoIndex a, UtxoIndex a)
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split ((Point
targetPoint Point -> Tip -> Bool
`pointLessThanTip`) (Tip -> Bool)
-> ((BlockCount, UtxoState a) -> Tip)
-> (BlockCount, UtxoState a)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoState a -> Tip
forall a. UtxoState a -> Tip
tip (UtxoState a -> Tip)
-> ((BlockCount, UtxoState a) -> UtxoState a)
-> (BlockCount, UtxoState a)
-> Tip
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockCount, UtxoState a) -> UtxoState a
forall a b. (a, b) -> b
snd) UtxoIndex a
idx

        case UtxoIndex a -> Tip
forall a. Monoid a => UtxoIndex a -> Tip
viewTip UtxoIndex a
before of
            Tip
TipAtGenesis -> RollbackFailed -> Either RollbackFailed (RollbackResult a)
forall a b. a -> Either a b
Left (RollbackFailed -> Either RollbackFailed (RollbackResult a))
-> RollbackFailed -> Either RollbackFailed (RollbackResult a)
forall a b. (a -> b) -> a -> b
$ Point -> RollbackFailed
OldPointNotFound Point
targetPoint
            Tip
oldTip | Point
targetPoint Point -> Tip -> Bool
`pointsToTip` Tip
oldTip ->
                       RollbackResult a -> Either RollbackFailed (RollbackResult a)
forall a b. b -> Either a b
Right RollbackResult :: forall a. Tip -> UtxoIndex a -> RollbackResult a
RollbackResult{newTip :: Tip
newTip=Tip
oldTip, rolledBackIndex :: UtxoIndex a
rolledBackIndex=UtxoIndex a -> UtxoIndex a -> UtxoIndex a
f UtxoIndex a
before UtxoIndex a
after}
                   | Bool
otherwise                        ->
                       RollbackFailed -> Either RollbackFailed (RollbackResult a)
forall a b. a -> Either a b
Left  TipMismatch :: Tip -> Point -> RollbackFailed
TipMismatch{foundTip :: Tip
foundTip=Tip
oldTip, targetPoint :: Point
targetPoint=Point
targetPoint}

data ReduceBlockCountResult a
    = BlockCountNotReduced
    | ReduceBlockCountResult
        { ReduceBlockCountResult a -> UtxoIndex a
reducedIndex  :: UtxoIndex a
        , ReduceBlockCountResult a -> UtxoState a
combinedState :: UtxoState a
        }

-- | Reduce the number of 'UtxoState's. The given number is the minimum, the index is reduced when it larger than twice that size.
-- The new index is prefixed with one 'UtxoState' that contains the combined state of the removed 'UtxoState's.
reduceBlockCount :: Monoid a => Depth -> UtxoIndex a -> ReduceBlockCountResult a
reduceBlockCount :: Depth -> UtxoIndex a -> ReduceBlockCountResult a
reduceBlockCount (Depth Int
minCount) UtxoIndex a
ix
    | UtxoIndex a -> Int
forall a. Monoid a => UtxoIndex a -> Int
utxoBlockCount UtxoIndex a
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
minCount = ReduceBlockCountResult a
forall a. ReduceBlockCountResult a
BlockCountNotReduced
    | Bool
otherwise =
        let (UtxoIndex a
old, UtxoIndex a
keep) = ((BlockCount, UtxoState a) -> Bool)
-> UtxoIndex a -> (UtxoIndex a, UtxoIndex a)
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (UtxoIndex a -> Int
forall a. Monoid a => UtxoIndex a -> Int
utxoBlockCount UtxoIndex a
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minCount)) (Int -> Bool)
-> ((BlockCount, UtxoState a) -> Int)
-> (BlockCount, UtxoState a)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockCount -> Int
getBlockCount (BlockCount -> Int)
-> ((BlockCount, UtxoState a) -> BlockCount)
-> (BlockCount, UtxoState a)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockCount, UtxoState a) -> BlockCount
forall a b. (a, b) -> a
fst) UtxoIndex a
ix
            combinedState :: UtxoState a
combinedState = UtxoIndex a -> UtxoState a
forall a. Monoid a => UtxoIndex a -> UtxoState a
utxoState UtxoIndex a
old
        in ReduceBlockCountResult :: forall a. UtxoIndex a -> UtxoState a -> ReduceBlockCountResult a
ReduceBlockCountResult
            { reducedIndex :: UtxoIndex a
reducedIndex = UtxoState a
combinedState UtxoState a -> UtxoIndex a -> UtxoIndex a
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
FT.<| UtxoIndex a
keep
            , combinedState :: UtxoState a
combinedState = UtxoState a
combinedState
            }

-- | Is the given point earlier than the provided tip. Yes, if the point is
-- the genersis point, no if the tip is the genesis point, otherwise, just
-- compare the slots.
pointLessThanTip :: Point -> Tip -> Bool
pointLessThanTip :: Point -> Tip -> Bool
pointLessThanTip Point
PointAtGenesis  Tip
_               = Bool
True
pointLessThanTip (Point Slot
pSlot BlockId
_) (Tip Slot
tSlot BlockId
_ BlockNumber
_) = Slot
pSlot Slot -> Slot -> Bool
forall a. Ord a => a -> a -> Bool
< Slot
tSlot
pointLessThanTip Point
_               Tip
TipAtGenesis    = Bool
False