{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}

module Ouroboros.Network.MockChain.ProducerState where

import           Ouroboros.Network.Block (HasFullHeader, castPoint,
                     genesisPoint)
import           Ouroboros.Network.MockChain.Chain (Chain, ChainUpdate (..),
                     HasHeader, HeaderHash, Point (..), blockPoint,
                     pointOnChain)
import qualified Ouroboros.Network.MockChain.Chain as Chain

import           Control.Exception (assert)
import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.Maybe (fromMaybe)



-- A @'ChainState'@ plus an associated set of followers/consumers of the chain.

data ChainProducerState block = ChainProducerState {
       ChainProducerState block -> Chain block
chainState     :: Chain block,
       ChainProducerState block -> FollowerStates block
chainFollowers :: FollowerStates block,
       ChainProducerState block -> FollowerId
nextFollowerId :: FollowerId
     }
  deriving (ChainProducerState block -> ChainProducerState block -> Bool
(ChainProducerState block -> ChainProducerState block -> Bool)
-> (ChainProducerState block -> ChainProducerState block -> Bool)
-> Eq (ChainProducerState block)
forall block.
(StandardHash block, Eq block) =>
ChainProducerState block -> ChainProducerState block -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainProducerState block -> ChainProducerState block -> Bool
$c/= :: forall block.
(StandardHash block, Eq block) =>
ChainProducerState block -> ChainProducerState block -> Bool
== :: ChainProducerState block -> ChainProducerState block -> Bool
$c== :: forall block.
(StandardHash block, Eq block) =>
ChainProducerState block -> ChainProducerState block -> Bool
Eq, FollowerId -> ChainProducerState block -> ShowS
[ChainProducerState block] -> ShowS
ChainProducerState block -> String
(FollowerId -> ChainProducerState block -> ShowS)
-> (ChainProducerState block -> String)
-> ([ChainProducerState block] -> ShowS)
-> Show (ChainProducerState block)
forall block.
(StandardHash block, Show block) =>
FollowerId -> ChainProducerState block -> ShowS
forall block.
(StandardHash block, Show block) =>
[ChainProducerState block] -> ShowS
forall block.
(StandardHash block, Show block) =>
ChainProducerState block -> String
forall a.
(FollowerId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainProducerState block] -> ShowS
$cshowList :: forall block.
(StandardHash block, Show block) =>
[ChainProducerState block] -> ShowS
show :: ChainProducerState block -> String
$cshow :: forall block.
(StandardHash block, Show block) =>
ChainProducerState block -> String
showsPrec :: FollowerId -> ChainProducerState block -> ShowS
$cshowsPrec :: forall block.
(StandardHash block, Show block) =>
FollowerId -> ChainProducerState block -> ShowS
Show)

-- | Followers are represented here as a relation.
--
type FollowerStates block = Map FollowerId (FollowerState block)

type FollowerId = Int
-- |
-- Producer keeps track of consumer chain.  The only information for a producer
-- to know is
--  * @'followerPoint'@: (some) intersection point of consumer's chain and
--    producer's chain;
--  * @'followerNext'@: information what to do on next instruction: either roll
--    forward from the intersection point or roll back to it.
--
-- The second piece of information is needed to distinguish the following two
-- cases:
--
--   * consumer chain is a subchain of the producer chain
--   * it is a fork.
--
-- Since consumer is following the producer chain, the producer has this
-- information at its end.  If producer updates its chain to use another fork it
-- may happen that the follower pointer is not on the new chain.  In this case the
-- producer will set @'RollBackTo'@ and find intersection of the two chains for
-- @'followerPoint'@.  And upon consumer's request will replay with
-- @'MsgRollBackward' 'followerPoint'@.  After sending this message, the  producer
-- assumes that the the consumer is following the protocol (i.e. will rollback
-- its chain) and will reset the @'followerNext'@ field to @'FollowerForwardFrom'@.
-- The second case: when the @'followerNext'@ is @'FollowerForwardFrom'@, then when
-- sending next instruction the producer will either:
--
--   * take the next block (or header) on its chain imediatelly folowing the
--     @'followerPoint'@, updtate @'followerPoint'@ to the point of the new value
--     and send @'MsgRollForward'@ with the new block (or header).
--   * if there is no block, which means that the consumer side and producer
--     side are synchornized, the producer will send @'MsgAwaitResponse'@ and
--     will wait until its chain is updated: either by a fork or by a new block.
--
-- In this implementation a map from @'FollowerId'@ to @'FollowerState'@ is shared
-- between all producers running on a single node; hence the unique identifier
-- @'FollowerId'@ for each follower: this is an implementation detail.
data FollowerState block = FollowerState {
       -- | Where the chain of the consumer and producer intersect. If the
       -- consumer is on the chain then this is the consumer's chain head,
       -- but if the consumer's chain is off the producer's chain then this is
       -- the point the consumer will need to rollback to.
       FollowerState block -> Point block
followerPoint :: Point block,

       -- | Where the will go next, roll back to the follower point, or roll
       -- forward from the follower point.
       FollowerState block -> FollowerNext
followerNext  :: FollowerNext
     }
  deriving (FollowerState block -> FollowerState block -> Bool
(FollowerState block -> FollowerState block -> Bool)
-> (FollowerState block -> FollowerState block -> Bool)
-> Eq (FollowerState block)
forall block.
StandardHash block =>
FollowerState block -> FollowerState block -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FollowerState block -> FollowerState block -> Bool
$c/= :: forall block.
StandardHash block =>
FollowerState block -> FollowerState block -> Bool
== :: FollowerState block -> FollowerState block -> Bool
$c== :: forall block.
StandardHash block =>
FollowerState block -> FollowerState block -> Bool
Eq, FollowerId -> FollowerState block -> ShowS
[FollowerState block] -> ShowS
FollowerState block -> String
(FollowerId -> FollowerState block -> ShowS)
-> (FollowerState block -> String)
-> ([FollowerState block] -> ShowS)
-> Show (FollowerState block)
forall block.
StandardHash block =>
FollowerId -> FollowerState block -> ShowS
forall block. StandardHash block => [FollowerState block] -> ShowS
forall block. StandardHash block => FollowerState block -> String
forall a.
(FollowerId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FollowerState block] -> ShowS
$cshowList :: forall block. StandardHash block => [FollowerState block] -> ShowS
show :: FollowerState block -> String
$cshow :: forall block. StandardHash block => FollowerState block -> String
showsPrec :: FollowerId -> FollowerState block -> ShowS
$cshowsPrec :: forall block.
StandardHash block =>
FollowerId -> FollowerState block -> ShowS
Show)

data FollowerNext = FollowerBackTo | FollowerForwardFrom
  deriving (FollowerNext -> FollowerNext -> Bool
(FollowerNext -> FollowerNext -> Bool)
-> (FollowerNext -> FollowerNext -> Bool) -> Eq FollowerNext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FollowerNext -> FollowerNext -> Bool
$c/= :: FollowerNext -> FollowerNext -> Bool
== :: FollowerNext -> FollowerNext -> Bool
$c== :: FollowerNext -> FollowerNext -> Bool
Eq, FollowerId -> FollowerNext -> ShowS
[FollowerNext] -> ShowS
FollowerNext -> String
(FollowerId -> FollowerNext -> ShowS)
-> (FollowerNext -> String)
-> ([FollowerNext] -> ShowS)
-> Show FollowerNext
forall a.
(FollowerId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FollowerNext] -> ShowS
$cshowList :: [FollowerNext] -> ShowS
show :: FollowerNext -> String
$cshow :: FollowerNext -> String
showsPrec :: FollowerId -> FollowerNext -> ShowS
$cshowsPrec :: FollowerId -> FollowerNext -> ShowS
Show)

--
-- Invariant
--

invChainProducerState :: HasFullHeader block => ChainProducerState block -> Bool
invChainProducerState :: ChainProducerState block -> Bool
invChainProducerState (ChainProducerState Chain block
c FollowerStates block
cflrst FollowerId
cfid) =
    Chain block -> Bool
forall block. HasFullHeader block => Chain block -> Bool
Chain.valid Chain block
c
 Bool -> Bool -> Bool
&& Chain block -> FollowerStates block -> Bool
forall block.
HasHeader block =>
Chain block -> FollowerStates block -> Bool
invFollowerStates Chain block
c FollowerStates block
cflrst
 Bool -> Bool -> Bool
&& (FollowerId -> Bool) -> [FollowerId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (FollowerId -> FollowerId -> Bool
forall a. Ord a => a -> a -> Bool
< FollowerId
cfid) (FollowerStates block -> [FollowerId]
forall k a. Map k a -> [k]
Map.keys FollowerStates block
cflrst)

invFollowerStates :: HasHeader block => Chain block -> FollowerStates block -> Bool
invFollowerStates :: Chain block -> FollowerStates block -> Bool
invFollowerStates Chain block
c FollowerStates block
flrst =
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Point block -> Chain block -> Bool
forall block. HasHeader block => Point block -> Chain block -> Bool
pointOnChain Point block
followerPoint Chain block
c | FollowerState{Point block
followerPoint :: Point block
followerPoint :: forall block. FollowerState block -> Point block
followerPoint} <- FollowerStates block -> [FollowerState block]
forall k a. Map k a -> [a]
Map.elems FollowerStates block
flrst ]

--
-- Operations
--


-- | Initialise @'ChainProducerState'@ with a given @'Chain'@ and empty list of
-- followers.
--
initChainProducerState :: Chain block -> ChainProducerState block
initChainProducerState :: Chain block -> ChainProducerState block
initChainProducerState Chain block
c = Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
forall block.
Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
ChainProducerState Chain block
c FollowerStates block
forall k a. Map k a
Map.empty FollowerId
0

-- | Get the recorded state of a chain consumer. The 'FollowerId' is assumed to
-- exist.
--
lookupFollower :: ChainProducerState block -> FollowerId -> FollowerState block
lookupFollower :: ChainProducerState block -> FollowerId -> FollowerState block
lookupFollower (ChainProducerState Chain block
_ FollowerStates block
cflrst FollowerId
_) FollowerId
fid = FollowerStates block
cflrst FollowerStates block -> FollowerId -> FollowerState block
forall k a. Ord k => Map k a -> k -> a
Map.! FollowerId
fid

-- | Return 'True' when a follower with the given 'FollowerId' exists.
followerExists :: FollowerId -> ChainProducerState block -> Bool
followerExists :: FollowerId -> ChainProducerState block -> Bool
followerExists FollowerId
fid (ChainProducerState Chain block
_ FollowerStates block
cflrst FollowerId
_) = FollowerId
fid FollowerId -> FollowerStates block -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` FollowerStates block
cflrst

-- | Extract @'Chain'@ from @'ChainProducerState'@.
--
producerChain :: ChainProducerState block -> Chain block
producerChain :: ChainProducerState block -> Chain block
producerChain (ChainProducerState Chain block
c FollowerStates block
_ FollowerId
_) = Chain block
c

findFirstPoint :: HasHeader block
               => [Point block]
               -> ChainProducerState block
               -> Maybe (Point block)
findFirstPoint :: [Point block] -> ChainProducerState block -> Maybe (Point block)
findFirstPoint [Point block]
ps = [Point block] -> Chain block -> Maybe (Point block)
forall block.
HasHeader block =>
[Point block] -> Chain block -> Maybe (Point block)
Chain.findFirstPoint [Point block]
ps (Chain block -> Maybe (Point block))
-> (ChainProducerState block -> Chain block)
-> ChainProducerState block
-> Maybe (Point block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainProducerState block -> Chain block
forall block. ChainProducerState block -> Chain block
producerChain


-- | Add a new follower with the given intersection point and return the new
-- 'FollowerId'.
--
initFollower :: HasHeader block
             => Point block
             -> ChainProducerState block
             -> (ChainProducerState block, FollowerId)
initFollower :: Point block
-> ChainProducerState block
-> (ChainProducerState block, FollowerId)
initFollower Point block
point (ChainProducerState Chain block
c FollowerStates block
cflrst FollowerId
cfid) =
    Bool
-> (ChainProducerState block, FollowerId)
-> (ChainProducerState block, FollowerId)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Point block -> Chain block -> Bool
forall block. HasHeader block => Point block -> Chain block -> Bool
pointOnChain Point block
point Chain block
c) ((ChainProducerState block, FollowerId)
 -> (ChainProducerState block, FollowerId))
-> (ChainProducerState block, FollowerId)
-> (ChainProducerState block, FollowerId)
forall a b. (a -> b) -> a -> b
$
    (Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
forall block.
Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
ChainProducerState Chain block
c (FollowerId
-> FollowerState block
-> FollowerStates block
-> FollowerStates block
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FollowerId
cfid FollowerState block
flrst FollowerStates block
cflrst) (FollowerId -> FollowerId
forall a. Enum a => a -> a
succ FollowerId
cfid), FollowerId
cfid)
  where
    flrst :: FollowerState block
flrst = FollowerState :: forall block. Point block -> FollowerNext -> FollowerState block
FollowerState {
          followerPoint :: Point block
followerPoint = Point block
point,
          followerNext :: FollowerNext
followerNext  = FollowerNext
FollowerBackTo
        }


-- | Delete an existing follower. The 'FollowerId' is assumed to exist.
--
deleteFollower :: FollowerId -> ChainProducerState block -> ChainProducerState block
deleteFollower :: FollowerId -> ChainProducerState block -> ChainProducerState block
deleteFollower FollowerId
fid (ChainProducerState Chain block
c FollowerStates block
cflrst FollowerId
cfid) =
    Bool -> ChainProducerState block -> ChainProducerState block
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (FollowerId
fid FollowerId -> FollowerStates block -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` FollowerStates block
cflrst) (ChainProducerState block -> ChainProducerState block)
-> ChainProducerState block -> ChainProducerState block
forall a b. (a -> b) -> a -> b
$
    Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
forall block.
Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
ChainProducerState Chain block
c (FollowerId -> FollowerStates block -> FollowerStates block
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete FollowerId
fid FollowerStates block
cflrst) FollowerId
cfid


-- | Change the intersection point of a follower. This also puts it into
-- the 'FollowerBackTo' state.
--
updateFollower :: HasHeader block
               => FollowerId
               -> Point block    -- ^ new follower intersection point
               -> ChainProducerState block
               -> ChainProducerState block
updateFollower :: FollowerId
-> Point block
-> ChainProducerState block
-> ChainProducerState block
updateFollower FollowerId
fid Point block
point (ChainProducerState Chain block
c FollowerStates block
cflrst FollowerId
cnfid) =
    Bool -> ChainProducerState block -> ChainProducerState block
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Point block -> Chain block -> Bool
forall block. HasHeader block => Point block -> Chain block -> Bool
pointOnChain Point block
point Chain block
c) (ChainProducerState block -> ChainProducerState block)
-> ChainProducerState block -> ChainProducerState block
forall a b. (a -> b) -> a -> b
$
    Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
forall block.
Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
ChainProducerState Chain block
c ((FollowerState block -> FollowerState block)
-> FollowerId -> FollowerStates block -> FollowerStates block
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust FollowerState block -> FollowerState block
update FollowerId
fid FollowerStates block
cflrst) FollowerId
cnfid
  where
    update :: FollowerState block -> FollowerState block
update FollowerState block
flrst = FollowerState block
flrst { followerPoint :: Point block
followerPoint = Point block
point, followerNext :: FollowerNext
followerNext  = FollowerNext
FollowerBackTo }

-- | Switch chains and update followers; if a follower point falls out of the chain,
-- replace it with the intersection of both chains and put it in the
-- `FollowerBackTo` state, otherwise preserve follower state.
--
switchFork :: HasHeader block
           => Chain block
           -> ChainProducerState block
           -> ChainProducerState block
switchFork :: Chain block -> ChainProducerState block -> ChainProducerState block
switchFork Chain block
c (ChainProducerState Chain block
c' FollowerStates block
cflrst FollowerId
cfid) =
    Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
forall block.
Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
ChainProducerState Chain block
c (FollowerState block -> FollowerState block
update (FollowerState block -> FollowerState block)
-> FollowerStates block -> FollowerStates block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FollowerStates block
cflrst) FollowerId
cfid
  where
    ipoint :: Point block
ipoint = Point block -> Maybe (Point block) -> Point block
forall a. a -> Maybe a -> a
fromMaybe Point block
forall block. Point block
genesisPoint (Maybe (Point block) -> Point block)
-> Maybe (Point block) -> Point block
forall a b. (a -> b) -> a -> b
$ Chain block -> Chain block -> Maybe (Point block)
forall block.
HasHeader block =>
Chain block -> Chain block -> Maybe (Point block)
Chain.intersectChains Chain block
c Chain block
c'

    update :: FollowerState block -> FollowerState block
update flrst :: FollowerState block
flrst@FollowerState{Point block
followerPoint :: Point block
followerPoint :: forall block. FollowerState block -> Point block
followerPoint} =
      if Point block -> Chain block -> Bool
forall block. HasHeader block => Point block -> Chain block -> Bool
pointOnChain Point block
followerPoint Chain block
c
        then FollowerState block
flrst
        else FollowerState block
flrst { followerPoint :: Point block
followerPoint = Point block
ipoint, followerNext :: FollowerNext
followerNext = FollowerNext
FollowerBackTo }


-- | What a follower needs to do next. Should they move on to the next block or
-- do they need to roll back to a previous point on their chain. It also updates
-- the producer's state assuming that the follower follows its instruction.
--
followerInstruction :: HasHeader block
                    => FollowerId
                    -> ChainProducerState block
                    -> Maybe (ChainUpdate block block, ChainProducerState block)
followerInstruction :: FollowerId
-> ChainProducerState block
-> Maybe (ChainUpdate block block, ChainProducerState block)
followerInstruction FollowerId
fid cps :: ChainProducerState block
cps@(ChainProducerState Chain block
c FollowerStates block
cflrst FollowerId
cfid) =
    let FollowerState {Point block
followerPoint :: Point block
followerPoint :: forall block. FollowerState block -> Point block
followerPoint, FollowerNext
followerNext :: FollowerNext
followerNext :: forall block. FollowerState block -> FollowerNext
followerNext} = ChainProducerState block -> FollowerId -> FollowerState block
forall block.
ChainProducerState block -> FollowerId -> FollowerState block
lookupFollower ChainProducerState block
cps FollowerId
fid in
    case FollowerNext
followerNext of
      FollowerNext
FollowerForwardFrom ->
          Bool
-> Maybe (ChainUpdate block block, ChainProducerState block)
-> Maybe (ChainUpdate block block, ChainProducerState block)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Point block -> Chain block -> Bool
forall block. HasHeader block => Point block -> Chain block -> Bool
pointOnChain Point block
followerPoint Chain block
c) (Maybe (ChainUpdate block block, ChainProducerState block)
 -> Maybe (ChainUpdate block block, ChainProducerState block))
-> Maybe (ChainUpdate block block, ChainProducerState block)
-> Maybe (ChainUpdate block block, ChainProducerState block)
forall a b. (a -> b) -> a -> b
$
          case Point block -> Chain block -> Maybe block
forall block.
HasHeader block =>
Point block -> Chain block -> Maybe block
Chain.successorBlock Point block
followerPoint Chain block
c of
            -- There is no successor block because the follower is at the head
            Maybe block
Nothing -> Maybe (ChainUpdate block block, ChainProducerState block)
forall a. Maybe a
Nothing

            Just block
b -> (ChainUpdate block block, ChainProducerState block)
-> Maybe (ChainUpdate block block, ChainProducerState block)
forall a. a -> Maybe a
Just (block -> ChainUpdate block block
forall block a. a -> ChainUpdate block a
AddBlock block
b, ChainProducerState block
cps')
              where
                cps' :: ChainProducerState block
cps' = Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
forall block.
Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
ChainProducerState Chain block
c ((FollowerState block -> FollowerState block)
-> FollowerId -> FollowerStates block -> FollowerStates block
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust FollowerState block -> FollowerState block
setPoint FollowerId
fid FollowerStates block
cflrst) FollowerId
cfid
                setPoint :: FollowerState block -> FollowerState block
setPoint FollowerState block
flrst = FollowerState block
flrst { followerPoint :: Point block
followerPoint = block -> Point block
forall block. HasHeader block => block -> Point block
blockPoint block
b }

      FollowerNext
FollowerBackTo -> (ChainUpdate block block, ChainProducerState block)
-> Maybe (ChainUpdate block block, ChainProducerState block)
forall a. a -> Maybe a
Just (Point block -> ChainUpdate block block
forall block a. Point block -> ChainUpdate block a
RollBack Point block
followerPoint, ChainProducerState block
cps')
        where
          cps' :: ChainProducerState block
cps' = Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
forall block.
Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
ChainProducerState Chain block
c ((FollowerState block -> FollowerState block)
-> FollowerId -> FollowerStates block -> FollowerStates block
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust FollowerState block -> FollowerState block
forall block. FollowerState block -> FollowerState block
setForwardFrom FollowerId
fid FollowerStates block
cflrst) FollowerId
cfid
          setForwardFrom :: FollowerState block -> FollowerState block
setForwardFrom FollowerState block
flrst = FollowerState block
flrst { followerNext :: FollowerNext
followerNext = FollowerNext
FollowerForwardFrom }


-- | Add a block to the chain. It does not require any follower's state changes.
--
addBlock :: HasHeader block
         => block
         -> ChainProducerState block
         -> ChainProducerState block
addBlock :: block -> ChainProducerState block -> ChainProducerState block
addBlock block
b (ChainProducerState Chain block
c FollowerStates block
cflrst FollowerId
cfid) =
    Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
forall block.
Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
ChainProducerState (block -> Chain block -> Chain block
forall block.
HasHeader block =>
block -> Chain block -> Chain block
Chain.addBlock block
b Chain block
c) FollowerStates block
cflrst FollowerId
cfid


-- | Rollback producer chain. It requires to update follower states, since some
-- @'followerPoint'@s may not be on the new chain; in this case find intersection
-- of the two chains and set @'followerNext'@ to @'FollowerBackTo'@.
rollback :: (HasHeader block, HeaderHash block ~ HeaderHash block')
         => Point block'
         -> ChainProducerState block
         -> Maybe (ChainProducerState block)
rollback :: Point block'
-> ChainProducerState block -> Maybe (ChainProducerState block)
rollback Point block'
p (ChainProducerState Chain block
c FollowerStates block
cflrst FollowerId
cfid) = do
    Chain block
c' <- Point block -> Chain block -> Maybe (Chain block)
forall block.
HasHeader block =>
Point block -> Chain block -> Maybe (Chain block)
Chain.rollback (Point block' -> Point block
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint Point block'
p) Chain block
c
    ChainProducerState block -> Maybe (ChainProducerState block)
forall (m :: * -> *) a. Monad m => a -> m a
return (ChainProducerState block -> Maybe (ChainProducerState block))
-> ChainProducerState block -> Maybe (ChainProducerState block)
forall a b. (a -> b) -> a -> b
$ Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
forall block.
Chain block
-> FollowerStates block -> FollowerId -> ChainProducerState block
ChainProducerState Chain block
c' (FollowerState block -> FollowerState block
rollbackFollower (FollowerState block -> FollowerState block)
-> FollowerStates block -> FollowerStates block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FollowerStates block
cflrst) FollowerId
cfid
  where
    rollbackFollower :: FollowerState block -> FollowerState block
rollbackFollower flrst :: FollowerState block
flrst@FollowerState { followerPoint :: forall block. FollowerState block -> Point block
followerPoint = Point block
p' }
      | Point block -> Point block -> Chain block -> Bool
forall block.
HasHeader block =>
Point block -> Point block -> Chain block -> Bool
Chain.pointIsAfter Point block
p' (Point block' -> Point block
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint Point block'
p) Chain block
c
      = FollowerState block
flrst { followerPoint :: Point block
followerPoint = Point block' -> Point block
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint Point block'
p, followerNext :: FollowerNext
followerNext = FollowerNext
FollowerBackTo }
      | Bool
otherwise
      = FollowerState block
flrst

-- | Convenient function which combines both @'addBlock'@ and @'rollback'@.
--
applyChainUpdate :: (HasHeader block, HeaderHash block ~ HeaderHash block')
                 => ChainUpdate block' block
                 -> ChainProducerState block
                 -> Maybe (ChainProducerState block)
applyChainUpdate :: ChainUpdate block' block
-> ChainProducerState block -> Maybe (ChainProducerState block)
applyChainUpdate (AddBlock block
b) ChainProducerState block
c = ChainProducerState block -> Maybe (ChainProducerState block)
forall a. a -> Maybe a
Just (block -> ChainProducerState block -> ChainProducerState block
forall block.
HasHeader block =>
block -> ChainProducerState block -> ChainProducerState block
addBlock block
b ChainProducerState block
c)
applyChainUpdate (RollBack Point block'
p) ChainProducerState block
c =       Point block'
-> ChainProducerState block -> Maybe (ChainProducerState block)
forall block block'.
(HasHeader block, HeaderHash block ~ HeaderHash block') =>
Point block'
-> ChainProducerState block -> Maybe (ChainProducerState block)
rollback Point block'
p ChainProducerState block
c


-- | Apply a list of @'ChainUpdate'@s.
--
applyChainUpdates :: (HasHeader block, HeaderHash block ~ HeaderHash block')
                  => [ChainUpdate block' block]
                  -> ChainProducerState block
                  -> Maybe (ChainProducerState block)
applyChainUpdates :: [ChainUpdate block' block]
-> ChainProducerState block -> Maybe (ChainProducerState block)
applyChainUpdates []     ChainProducerState block
c = ChainProducerState block -> Maybe (ChainProducerState block)
forall a. a -> Maybe a
Just ChainProducerState block
c
applyChainUpdates (ChainUpdate block' block
u:[ChainUpdate block' block]
us) ChainProducerState block
c = [ChainUpdate block' block]
-> ChainProducerState block -> Maybe (ChainProducerState block)
forall block block'.
(HasHeader block, HeaderHash block ~ HeaderHash block') =>
[ChainUpdate block' block]
-> ChainProducerState block -> Maybe (ChainProducerState block)
applyChainUpdates [ChainUpdate block' block]
us (ChainProducerState block -> Maybe (ChainProducerState block))
-> Maybe (ChainProducerState block)
-> Maybe (ChainProducerState block)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChainUpdate block' block
-> ChainProducerState block -> Maybe (ChainProducerState block)
forall block block'.
(HasHeader block, HeaderHash block ~ HeaderHash block') =>
ChainUpdate block' block
-> ChainProducerState block -> Maybe (ChainProducerState block)
applyChainUpdate ChainUpdate block' block
u ChainProducerState block
c