{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
module Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State (
ChainSyncClientHandle (..)
, ChainSyncJumpingJumperState (..)
, ChainSyncJumpingState (..)
, ChainSyncState (..)
, DisengagedInitState (..)
, DynamoInitState (..)
, JumpInfo (..)
, JumperInitState (..)
, ObjectorInitState (..)
) where
import Cardano.Slotting.Slot (SlotNo, WithOrigin)
import Data.Function (on)
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Typeable (Proxy (..), typeRep)
import GHC.Generics (Generic)
import Ouroboros.Consensus.Block (HasHeader, Header, Point)
import Ouroboros.Consensus.HeaderStateHistory (HeaderStateHistory)
import Ouroboros.Consensus.Ledger.SupportsProtocol
(LedgerSupportsProtocol)
import Ouroboros.Consensus.Node.GsmState (GsmState)
import Ouroboros.Consensus.Util.IOLike (IOLike, NoThunks (..), STM,
StrictTVar, Time)
import Ouroboros.Network.AnchoredFragment (AnchoredFragment,
headPoint)
data ChainSyncState blk = ChainSyncState {
forall blk. ChainSyncState blk -> AnchoredFragment (Header blk)
csCandidate :: !(AnchoredFragment (Header blk))
, forall blk. ChainSyncState blk -> Bool
csIdling :: !Bool
, forall blk. ChainSyncState blk -> StrictMaybe (WithOrigin SlotNo)
csLatestSlot :: !(StrictMaybe (WithOrigin SlotNo))
}
deriving stock ((forall x. ChainSyncState blk -> Rep (ChainSyncState blk) x)
-> (forall x. Rep (ChainSyncState blk) x -> ChainSyncState blk)
-> Generic (ChainSyncState blk)
forall x. Rep (ChainSyncState blk) x -> ChainSyncState blk
forall x. ChainSyncState blk -> Rep (ChainSyncState blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (ChainSyncState blk) x -> ChainSyncState blk
forall blk x. ChainSyncState blk -> Rep (ChainSyncState blk) x
$cfrom :: forall blk x. ChainSyncState blk -> Rep (ChainSyncState blk) x
from :: forall x. ChainSyncState blk -> Rep (ChainSyncState blk) x
$cto :: forall blk x. Rep (ChainSyncState blk) x -> ChainSyncState blk
to :: forall x. Rep (ChainSyncState blk) x -> ChainSyncState blk
Generic)
deriving anyclass instance (
HasHeader blk,
NoThunks (Header blk)
) => NoThunks (ChainSyncState blk)
data ChainSyncClientHandle m blk = ChainSyncClientHandle {
forall (m :: * -> *) blk. ChainSyncClientHandle m blk -> m ()
cschGDDKill :: !(m ())
, forall (m :: * -> *) blk.
ChainSyncClientHandle m blk -> GsmState -> Time -> STM m ()
cschOnGsmStateChanged :: !(GsmState -> Time -> STM m ())
, forall (m :: * -> *) blk.
ChainSyncClientHandle m blk -> StrictTVar m (ChainSyncState blk)
cschState :: !(StrictTVar m (ChainSyncState blk))
, forall (m :: * -> *) blk.
ChainSyncClientHandle m blk
-> StrictTVar m (ChainSyncJumpingState m blk)
cschJumping :: !(StrictTVar m (ChainSyncJumpingState m blk))
, forall (m :: * -> *) blk.
ChainSyncClientHandle m blk -> StrictTVar m (Maybe (JumpInfo blk))
cschJumpInfo :: !(StrictTVar m (Maybe (JumpInfo blk)))
}
deriving stock ((forall x.
ChainSyncClientHandle m blk -> Rep (ChainSyncClientHandle m blk) x)
-> (forall x.
Rep (ChainSyncClientHandle m blk) x -> ChainSyncClientHandle m blk)
-> Generic (ChainSyncClientHandle m blk)
forall x.
Rep (ChainSyncClientHandle m blk) x -> ChainSyncClientHandle m blk
forall x.
ChainSyncClientHandle m blk -> Rep (ChainSyncClientHandle m blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) blk x.
Rep (ChainSyncClientHandle m blk) x -> ChainSyncClientHandle m blk
forall (m :: * -> *) blk x.
ChainSyncClientHandle m blk -> Rep (ChainSyncClientHandle m blk) x
$cfrom :: forall (m :: * -> *) blk x.
ChainSyncClientHandle m blk -> Rep (ChainSyncClientHandle m blk) x
from :: forall x.
ChainSyncClientHandle m blk -> Rep (ChainSyncClientHandle m blk) x
$cto :: forall (m :: * -> *) blk x.
Rep (ChainSyncClientHandle m blk) x -> ChainSyncClientHandle m blk
to :: forall x.
Rep (ChainSyncClientHandle m blk) x -> ChainSyncClientHandle m blk
Generic)
deriving anyclass instance (
IOLike m,
HasHeader blk,
LedgerSupportsProtocol blk,
NoThunks (Header blk)
) => NoThunks (ChainSyncClientHandle m blk)
data DynamoInitState blk
=
DynamoStarting !(JumpInfo blk)
| DynamoStarted
deriving ((forall x. DynamoInitState blk -> Rep (DynamoInitState blk) x)
-> (forall x. Rep (DynamoInitState blk) x -> DynamoInitState blk)
-> Generic (DynamoInitState blk)
forall x. Rep (DynamoInitState blk) x -> DynamoInitState blk
forall x. DynamoInitState blk -> Rep (DynamoInitState blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (DynamoInitState blk) x -> DynamoInitState blk
forall blk x. DynamoInitState blk -> Rep (DynamoInitState blk) x
$cfrom :: forall blk x. DynamoInitState blk -> Rep (DynamoInitState blk) x
from :: forall x. DynamoInitState blk -> Rep (DynamoInitState blk) x
$cto :: forall blk x. Rep (DynamoInitState blk) x -> DynamoInitState blk
to :: forall x. Rep (DynamoInitState blk) x -> DynamoInitState blk
Generic)
deriving anyclass instance
( HasHeader blk,
LedgerSupportsProtocol blk,
NoThunks (Header blk)
) => NoThunks (DynamoInitState blk)
data ObjectorInitState
=
Starting
| Started
deriving ((forall x. ObjectorInitState -> Rep ObjectorInitState x)
-> (forall x. Rep ObjectorInitState x -> ObjectorInitState)
-> Generic ObjectorInitState
forall x. Rep ObjectorInitState x -> ObjectorInitState
forall x. ObjectorInitState -> Rep ObjectorInitState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObjectorInitState -> Rep ObjectorInitState x
from :: forall x. ObjectorInitState -> Rep ObjectorInitState x
$cto :: forall x. Rep ObjectorInitState x -> ObjectorInitState
to :: forall x. Rep ObjectorInitState x -> ObjectorInitState
Generic, Int -> ObjectorInitState -> ShowS
[ObjectorInitState] -> ShowS
ObjectorInitState -> String
(Int -> ObjectorInitState -> ShowS)
-> (ObjectorInitState -> String)
-> ([ObjectorInitState] -> ShowS)
-> Show ObjectorInitState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectorInitState -> ShowS
showsPrec :: Int -> ObjectorInitState -> ShowS
$cshow :: ObjectorInitState -> String
show :: ObjectorInitState -> String
$cshowList :: [ObjectorInitState] -> ShowS
showList :: [ObjectorInitState] -> ShowS
Show, Context -> ObjectorInitState -> IO (Maybe ThunkInfo)
Proxy ObjectorInitState -> String
(Context -> ObjectorInitState -> IO (Maybe ThunkInfo))
-> (Context -> ObjectorInitState -> IO (Maybe ThunkInfo))
-> (Proxy ObjectorInitState -> String)
-> NoThunks ObjectorInitState
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ObjectorInitState -> IO (Maybe ThunkInfo)
noThunks :: Context -> ObjectorInitState -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ObjectorInitState -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ObjectorInitState -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ObjectorInitState -> String
showTypeOf :: Proxy ObjectorInitState -> String
NoThunks)
data DisengagedInitState
=
Disengaging
| DisengagedDone
deriving ((forall x. DisengagedInitState -> Rep DisengagedInitState x)
-> (forall x. Rep DisengagedInitState x -> DisengagedInitState)
-> Generic DisengagedInitState
forall x. Rep DisengagedInitState x -> DisengagedInitState
forall x. DisengagedInitState -> Rep DisengagedInitState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DisengagedInitState -> Rep DisengagedInitState x
from :: forall x. DisengagedInitState -> Rep DisengagedInitState x
$cto :: forall x. Rep DisengagedInitState x -> DisengagedInitState
to :: forall x. Rep DisengagedInitState x -> DisengagedInitState
Generic, Int -> DisengagedInitState -> ShowS
[DisengagedInitState] -> ShowS
DisengagedInitState -> String
(Int -> DisengagedInitState -> ShowS)
-> (DisengagedInitState -> String)
-> ([DisengagedInitState] -> ShowS)
-> Show DisengagedInitState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DisengagedInitState -> ShowS
showsPrec :: Int -> DisengagedInitState -> ShowS
$cshow :: DisengagedInitState -> String
show :: DisengagedInitState -> String
$cshowList :: [DisengagedInitState] -> ShowS
showList :: [DisengagedInitState] -> ShowS
Show, Context -> DisengagedInitState -> IO (Maybe ThunkInfo)
Proxy DisengagedInitState -> String
(Context -> DisengagedInitState -> IO (Maybe ThunkInfo))
-> (Context -> DisengagedInitState -> IO (Maybe ThunkInfo))
-> (Proxy DisengagedInitState -> String)
-> NoThunks DisengagedInitState
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> DisengagedInitState -> IO (Maybe ThunkInfo)
noThunks :: Context -> DisengagedInitState -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> DisengagedInitState -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> DisengagedInitState -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy DisengagedInitState -> String
showTypeOf :: Proxy DisengagedInitState -> String
NoThunks)
data JumperInitState
=
FreshJumper
| StartedJumper
deriving ((forall x. JumperInitState -> Rep JumperInitState x)
-> (forall x. Rep JumperInitState x -> JumperInitState)
-> Generic JumperInitState
forall x. Rep JumperInitState x -> JumperInitState
forall x. JumperInitState -> Rep JumperInitState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JumperInitState -> Rep JumperInitState x
from :: forall x. JumperInitState -> Rep JumperInitState x
$cto :: forall x. Rep JumperInitState x -> JumperInitState
to :: forall x. Rep JumperInitState x -> JumperInitState
Generic, Int -> JumperInitState -> ShowS
[JumperInitState] -> ShowS
JumperInitState -> String
(Int -> JumperInitState -> ShowS)
-> (JumperInitState -> String)
-> ([JumperInitState] -> ShowS)
-> Show JumperInitState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JumperInitState -> ShowS
showsPrec :: Int -> JumperInitState -> ShowS
$cshow :: JumperInitState -> String
show :: JumperInitState -> String
$cshowList :: [JumperInitState] -> ShowS
showList :: [JumperInitState] -> ShowS
Show, Context -> JumperInitState -> IO (Maybe ThunkInfo)
Proxy JumperInitState -> String
(Context -> JumperInitState -> IO (Maybe ThunkInfo))
-> (Context -> JumperInitState -> IO (Maybe ThunkInfo))
-> (Proxy JumperInitState -> String)
-> NoThunks JumperInitState
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> JumperInitState -> IO (Maybe ThunkInfo)
noThunks :: Context -> JumperInitState -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> JumperInitState -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> JumperInitState -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy JumperInitState -> String
showTypeOf :: Proxy JumperInitState -> String
NoThunks)
data ChainSyncJumpingState m blk
=
Dynamo
!(DynamoInitState blk)
!(WithOrigin SlotNo)
|
Objector
!ObjectorInitState
!(JumpInfo blk)
!(Point (Header blk))
|
Disengaged DisengagedInitState
|
Jumper
!(StrictTVar m (Maybe (JumpInfo blk)))
!(ChainSyncJumpingJumperState blk)
deriving ((forall x.
ChainSyncJumpingState m blk -> Rep (ChainSyncJumpingState m blk) x)
-> (forall x.
Rep (ChainSyncJumpingState m blk) x -> ChainSyncJumpingState m blk)
-> Generic (ChainSyncJumpingState m blk)
forall x.
Rep (ChainSyncJumpingState m blk) x -> ChainSyncJumpingState m blk
forall x.
ChainSyncJumpingState m blk -> Rep (ChainSyncJumpingState m blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) blk x.
Rep (ChainSyncJumpingState m blk) x -> ChainSyncJumpingState m blk
forall (m :: * -> *) blk x.
ChainSyncJumpingState m blk -> Rep (ChainSyncJumpingState m blk) x
$cfrom :: forall (m :: * -> *) blk x.
ChainSyncJumpingState m blk -> Rep (ChainSyncJumpingState m blk) x
from :: forall x.
ChainSyncJumpingState m blk -> Rep (ChainSyncJumpingState m blk) x
$cto :: forall (m :: * -> *) blk x.
Rep (ChainSyncJumpingState m blk) x -> ChainSyncJumpingState m blk
to :: forall x.
Rep (ChainSyncJumpingState m blk) x -> ChainSyncJumpingState m blk
Generic)
deriving anyclass instance
( IOLike m,
HasHeader blk,
LedgerSupportsProtocol blk,
NoThunks (Header blk)
) => NoThunks (ChainSyncJumpingState m blk)
data JumpInfo blk = JumpInfo
{ forall blk. JumpInfo blk -> Point blk
jMostRecentIntersection :: !(Point blk)
, forall blk. JumpInfo blk -> AnchoredFragment (Header blk)
jOurFragment :: !(AnchoredFragment (Header blk))
, forall blk. JumpInfo blk -> AnchoredFragment (Header blk)
jTheirFragment :: !(AnchoredFragment (Header blk))
, :: !(HeaderStateHistory blk)
}
deriving ((forall x. JumpInfo blk -> Rep (JumpInfo blk) x)
-> (forall x. Rep (JumpInfo blk) x -> JumpInfo blk)
-> Generic (JumpInfo blk)
forall x. Rep (JumpInfo blk) x -> JumpInfo blk
forall x. JumpInfo blk -> Rep (JumpInfo blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (JumpInfo blk) x -> JumpInfo blk
forall blk x. JumpInfo blk -> Rep (JumpInfo blk) x
$cfrom :: forall blk x. JumpInfo blk -> Rep (JumpInfo blk) x
from :: forall x. JumpInfo blk -> Rep (JumpInfo blk) x
$cto :: forall blk x. Rep (JumpInfo blk) x -> JumpInfo blk
to :: forall x. Rep (JumpInfo blk) x -> JumpInfo blk
Generic)
instance (HasHeader (Header blk)) => Eq (JumpInfo blk) where
== :: JumpInfo blk -> JumpInfo blk -> Bool
(==) = Point (Header blk) -> Point (Header blk) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Point (Header blk) -> Point (Header blk) -> Bool)
-> (JumpInfo blk -> Point (Header blk))
-> JumpInfo blk
-> JumpInfo blk
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
headPoint (AnchoredFragment (Header blk) -> Point (Header blk))
-> (JumpInfo blk -> AnchoredFragment (Header blk))
-> JumpInfo blk
-> Point (Header blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JumpInfo blk -> AnchoredFragment (Header blk)
forall blk. JumpInfo blk -> AnchoredFragment (Header blk)
jTheirFragment
instance LedgerSupportsProtocol blk => NoThunks (JumpInfo blk) where
showTypeOf :: Proxy (JumpInfo blk) -> String
showTypeOf Proxy (JumpInfo blk)
_ = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy (JumpInfo blk) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(JumpInfo blk))
data ChainSyncJumpingJumperState blk
=
Happy JumperInitState !(Maybe (JumpInfo blk))
|
LookingForIntersection !(JumpInfo blk) !(JumpInfo blk)
|
FoundIntersection ObjectorInitState !(JumpInfo blk) !(Point (Header blk))
deriving ((forall x.
ChainSyncJumpingJumperState blk
-> Rep (ChainSyncJumpingJumperState blk) x)
-> (forall x.
Rep (ChainSyncJumpingJumperState blk) x
-> ChainSyncJumpingJumperState blk)
-> Generic (ChainSyncJumpingJumperState blk)
forall x.
Rep (ChainSyncJumpingJumperState blk) x
-> ChainSyncJumpingJumperState blk
forall x.
ChainSyncJumpingJumperState blk
-> Rep (ChainSyncJumpingJumperState blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x.
Rep (ChainSyncJumpingJumperState blk) x
-> ChainSyncJumpingJumperState blk
forall blk x.
ChainSyncJumpingJumperState blk
-> Rep (ChainSyncJumpingJumperState blk) x
$cfrom :: forall blk x.
ChainSyncJumpingJumperState blk
-> Rep (ChainSyncJumpingJumperState blk) x
from :: forall x.
ChainSyncJumpingJumperState blk
-> Rep (ChainSyncJumpingJumperState blk) x
$cto :: forall blk x.
Rep (ChainSyncJumpingJumperState blk) x
-> ChainSyncJumpingJumperState blk
to :: forall x.
Rep (ChainSyncJumpingJumperState blk) x
-> ChainSyncJumpingJumperState blk
Generic)
deriving anyclass instance
( HasHeader blk,
LedgerSupportsProtocol blk,
NoThunks (Header blk)
) => NoThunks (ChainSyncJumpingJumperState blk)