{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.Consensus.Genesis.Setup
  ( module Test.Consensus.Genesis.Setup.GenChains
  , castHeaderHash
  , forAllGenesisTest
  , honestImmutableTip
  , runGenesisTest
  , runGenesisTest'
  , selectedHonestChain
  ) where

import Control.Exception (throw)
import Control.Monad.Class.MonadAsync
  ( AsyncCancelled (AsyncCancelled)
  )
import Control.Monad.IOSim (IOSim, runSimStrictShutdown)
import Control.Tracer (debugTracer, traceWith)
import Data.Maybe (mapMaybe)
import Ouroboros.Consensus.Block.Abstract
  ( ChainHash (..)
  , ConvertRawHash
  , GetHeader
  , Header
  )
import Ouroboros.Consensus.Block.SupportsDiffusionPipelining
  ( BlockSupportsDiffusionPipelining
  )
import Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode)
import Ouroboros.Consensus.HardFork.Abstract
import Ouroboros.Consensus.Ledger.Basics (LedgerState)
import Ouroboros.Consensus.Ledger.Inspect (InspectLedger)
import Ouroboros.Consensus.Ledger.SupportsProtocol
  ( LedgerSupportsProtocol
  )
import Ouroboros.Consensus.MiniProtocol.ChainSync.Client
  ( ChainSyncClientException (..)
  )
import qualified Ouroboros.Consensus.Storage.ChainDB.Impl as ChainDB
import Ouroboros.Consensus.Storage.LedgerDB.API
  ( CanUpgradeLedgerTables
  )
import Ouroboros.Consensus.Util.Condense
import Ouroboros.Consensus.Util.IOLike (Exception, fromException)
import qualified Ouroboros.Network.AnchoredFragment as AF
import Ouroboros.Network.Driver.Limits
  ( ProtocolLimitFailure (ExceededTimeLimit)
  )
import Ouroboros.Network.Util.ShowProxy
import Test.Consensus.BlockTree (onTrunk)
import Test.Consensus.Genesis.Setup.Classifiers
  ( Classifiers (..)
  , ResultClassifiers (..)
  , ScheduleClassifiers (..)
  , classifiers
  , resultClassifiers
  , scheduleClassifiers
  )
import Test.Consensus.Genesis.Setup.GenChains
import Test.Consensus.PeerSimulator.Config ()
import Test.Consensus.PeerSimulator.Run
import Test.Consensus.PeerSimulator.StateView
import Test.Consensus.PeerSimulator.Trace
  ( traceLinesWith
  , tracerTestBlock
  )
import Test.Consensus.PointSchedule
import Test.Consensus.PointSchedule.NodeState (NodeState)
import Test.QuickCheck
import Test.Util.Orphans.IOLike ()
import Test.Util.QuickCheck (forAllGenRunShrinkCheck)
import Test.Util.TersePrinting (Terse)
import Test.Util.TestBlock (TestBlock)
import Test.Util.Tracer (recordingTracerM)
import Text.Printf (printf)

-- | Like 'runSimStrictShutdown' but fail when the main thread terminates if
-- there are other threads still running or blocked. If one is trying to follow
-- a strict thread clean-up policy then this helps testing for that.
runSimStrictShutdownOrThrow :: forall a. (forall s. IOSim s a) -> a
runSimStrictShutdownOrThrow :: forall a. (forall s. IOSim s a) -> a
runSimStrictShutdownOrThrow forall s. IOSim s a
action =
  case (forall s. IOSim s a) -> Either Failure a
forall a. (forall s. IOSim s a) -> Either Failure a
runSimStrictShutdown IOSim s a
forall s. IOSim s a
action of
    Left Failure
e -> Failure -> a
forall a e. (HasCallStack, Exception e) => e -> a
throw Failure
e
    Right a
x -> a
x

-- | Runs the given 'GenesisTest' and 'PointSchedule' and evaluates the given
-- property on the final 'StateView'.
runGenesisTest ::
  ( Condense (StateView blk)
  , CondenseList (NodeState blk)
  , ShowProxy blk
  , ShowProxy (Header blk)
  , ConfigSupportsNode blk
  , LedgerSupportsProtocol blk
  , ChainDB.SerialiseDiskConstraints blk
  , BlockSupportsDiffusionPipelining blk
  , InspectLedger blk
  , HasHardForkHistory blk
  , ConvertRawHash blk
  , CanUpgradeLedgerTables (LedgerState blk)
  , HasPointScheduleTestParams blk
  , Eq (Header blk)
  , Eq blk
  , Terse blk
  , Condense (NodeState blk)
  ) =>
  ProtocolInfoArgs blk ->
  SchedulerConfig ->
  GenesisTestFull blk ->
  RunGenesisTestResult blk
runGenesisTest :: forall blk.
(Condense (StateView blk), CondenseList (NodeState blk),
 ShowProxy blk, ShowProxy (Header blk), ConfigSupportsNode blk,
 LedgerSupportsProtocol blk, SerialiseDiskConstraints blk,
 BlockSupportsDiffusionPipelining blk, InspectLedger blk,
 HasHardForkHistory blk, ConvertRawHash blk,
 CanUpgradeLedgerTables (LedgerState blk),
 HasPointScheduleTestParams blk, Eq (Header blk), Eq blk, Terse blk,
 Condense (NodeState blk)) =>
ProtocolInfoArgs blk
-> SchedulerConfig
-> GenesisTestFull blk
-> RunGenesisTestResult blk
runGenesisTest ProtocolInfoArgs blk
protocolInfoArgs SchedulerConfig
schedulerConfig GenesisTestFull blk
genesisTest =
  (forall s. IOSim s (RunGenesisTestResult blk))
-> RunGenesisTestResult blk
forall a. (forall s. IOSim s a) -> a
runSimStrictShutdownOrThrow ((forall s. IOSim s (RunGenesisTestResult blk))
 -> RunGenesisTestResult blk)
-> (forall s. IOSim s (RunGenesisTestResult blk))
-> RunGenesisTestResult blk
forall a b. (a -> b) -> a -> b
$ do
    (recordingTracer, getTrace) <- IOSim s (Tracer (IOSim s) String, IOSim s [String])
forall (m :: * -> *) ev. Monad m => m (Tracer m ev, m [ev])
recordingTracerM
    let tracer = if SchedulerConfig -> Bool
scDebug SchedulerConfig
schedulerConfig then Tracer (IOSim s) String
forall (m :: * -> *). Applicative m => Tracer m String
debugTracer else Tracer (IOSim s) String
recordingTracer

    traceLinesWith tracer $ prettyGenesisTest prettyPointSchedule genesisTest

    rgtrStateView <-
      runPointSchedule protocolInfoArgs schedulerConfig genesisTest =<< tracerTestBlock tracer
    traceWith tracer (condense rgtrStateView)
    rgtrTrace <- unlines <$> getTrace

    pure $ RunGenesisTestResult{rgtrTrace, rgtrStateView}

-- | Variant of 'runGenesisTest' that also takes a property on the final
-- 'StateView' and returns a QuickCheck property. The trace is printed in case
-- of counter-example.
runGenesisTest' ::
  Testable prop =>
  SchedulerConfig ->
  GenesisTestFull TestBlock ->
  (StateView TestBlock -> prop) ->
  Property
runGenesisTest' :: forall prop.
Testable prop =>
SchedulerConfig
-> GenesisTestFull TestBlock
-> (StateView TestBlock -> prop)
-> Property
runGenesisTest' SchedulerConfig
schedulerConfig GenesisTestFull TestBlock
genesisTest StateView TestBlock -> prop
makeProperty = IO Property -> Property
forall prop. Testable prop => IO prop -> Property
idempotentIOProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
  protocolInfoArgs <- IO (ProtocolInfoArgs TestBlock)
forall blk.
HasPointScheduleTestParams blk =>
IO (ProtocolInfoArgs blk)
getProtocolInfoArgs
  let RunGenesisTestResult{rgtrTrace, rgtrStateView} =
        runGenesisTest protocolInfoArgs schedulerConfig genesisTest
  pure $ counterexample rgtrTrace $ makeProperty rgtrStateView

-- | All-in-one helper that generates a 'GenesisTest' and a 'Peers
-- PeerSchedule', runs them with 'runGenesisTest', check whether the given
-- property holds on the resulting 'StateView'.
forAllGenesisTest ::
  forall blk prop.
  ( Testable prop
  , Condense (StateView blk)
  , CondenseList (NodeState blk)
  , ShowProxy blk
  , ShowProxy (Header blk)
  , ConfigSupportsNode blk
  , LedgerSupportsProtocol blk
  , ChainDB.SerialiseDiskConstraints blk
  , BlockSupportsDiffusionPipelining blk
  , InspectLedger blk
  , HasHardForkHistory blk
  , ConvertRawHash blk
  , CanUpgradeLedgerTables (LedgerState blk)
  , HasPointScheduleTestParams blk
  , Eq (Header blk)
  , Eq blk
  , Terse blk
  , Condense (NodeState blk)
  ) =>
  Gen (GenesisTestFull blk) ->
  SchedulerConfig ->
  (GenesisTestFull blk -> StateView blk -> [GenesisTestFull blk]) ->
  (GenesisTestFull blk -> StateView blk -> prop) ->
  Property
forAllGenesisTest :: forall blk prop.
(Testable prop, Condense (StateView blk),
 CondenseList (NodeState blk), ShowProxy blk,
 ShowProxy (Header blk), ConfigSupportsNode blk,
 LedgerSupportsProtocol blk, SerialiseDiskConstraints blk,
 BlockSupportsDiffusionPipelining blk, InspectLedger blk,
 HasHardForkHistory blk, ConvertRawHash blk,
 CanUpgradeLedgerTables (LedgerState blk),
 HasPointScheduleTestParams blk, Eq (Header blk), Eq blk, Terse blk,
 Condense (NodeState blk)) =>
Gen (GenesisTestFull blk)
-> SchedulerConfig
-> (GenesisTestFull blk -> StateView blk -> [GenesisTestFull blk])
-> (GenesisTestFull blk -> StateView blk -> prop)
-> Property
forAllGenesisTest Gen (GenesisTestFull blk)
generator SchedulerConfig
schedulerConfig GenesisTestFull blk -> StateView blk -> [GenesisTestFull blk]
shrinker GenesisTestFull blk -> StateView blk -> prop
mkProperty = IO Property -> Property
forall prop. Testable prop => IO prop -> Property
idempotentIOProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
  protocolInfoArgs <- IO (ProtocolInfoArgs blk)
forall blk.
HasPointScheduleTestParams blk =>
IO (ProtocolInfoArgs blk)
getProtocolInfoArgs
  pure $ forAllGenRunShrinkCheck generator (runGenesisTest protocolInfoArgs schedulerConfig) shrinker' $ \GenesisTestFull blk
genesisTest RunGenesisTestResult blk
result ->
    let cls :: Classifiers
cls = GenesisTestFull blk -> Classifiers
forall blk schedule.
HasHeader blk =>
GenesisTest blk schedule -> Classifiers
classifiers GenesisTestFull blk
genesisTest
        resCls :: ResultClassifiers
resCls = GenesisTestFull blk
-> RunGenesisTestResult blk -> ResultClassifiers
forall blk.
GenesisTestFull blk
-> RunGenesisTestResult blk -> ResultClassifiers
resultClassifiers GenesisTestFull blk
genesisTest RunGenesisTestResult blk
result
        schCls :: ScheduleClassifiers
schCls = GenesisTestFull blk -> ScheduleClassifiers
forall blk.
(HasHeader blk, Eq blk) =>
GenesisTestFull blk -> ScheduleClassifiers
scheduleClassifiers GenesisTestFull blk
genesisTest
        stateView :: StateView blk
stateView = RunGenesisTestResult blk -> StateView blk
forall blk. RunGenesisTestResult blk -> StateView blk
rgtrStateView RunGenesisTestResult blk
result
     in Bool -> String -> Property -> Property
forall prop. Testable prop => Bool -> String -> prop -> Property
classify (Classifiers -> Bool
allAdversariesSelectable Classifiers
cls) String
"All adversaries have more than k blocks after intersection"
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Property -> Property
forall prop. Testable prop => Bool -> String -> prop -> Property
classify
            (Classifiers -> Bool
allAdversariesForecastable Classifiers
cls)
            String
"All adversaries have at least 1 forecastable block after intersection"
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Property -> Property
forall prop. Testable prop => Bool -> String -> prop -> Property
classify
            (Classifiers -> Bool
allAdversariesKPlus1InForecast Classifiers
cls)
            String
"All adversaries have k+1 blocks in forecast window after intersection"
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Property -> Property
forall prop. Testable prop => Bool -> String -> prop -> Property
classify (Classifiers -> Bool
genesisWindowAfterIntersection Classifiers
cls) String
"Full genesis window after intersection"
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Property -> Property
forall prop. Testable prop => Bool -> String -> prop -> Property
classify (ScheduleClassifiers -> Bool
adversaryRollback ScheduleClassifiers
schCls) String
"An adversary did a rollback"
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Property -> Property
forall prop. Testable prop => Bool -> String -> prop -> Property
classify (ScheduleClassifiers -> Bool
honestRollback ScheduleClassifiers
schCls) String
"The honest peer did a rollback"
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Property -> Property
forall prop. Testable prop => Bool -> String -> prop -> Property
classify (ScheduleClassifiers -> Bool
allAdversariesEmpty ScheduleClassifiers
schCls) String
"All adversaries have empty schedules"
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Property -> Property
forall prop. Testable prop => Bool -> String -> prop -> Property
classify (ScheduleClassifiers -> Bool
allAdversariesTrivial ScheduleClassifiers
schCls) String
"All adversaries have trivial schedules"
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"Adversaries killed by LoP" [String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.1f%%" (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ ResultClassifiers -> Double
adversariesKilledByLoP ResultClassifiers
resCls]
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"Adversaries killed by GDD" [String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.1f%%" (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ ResultClassifiers -> Double
adversariesKilledByGDD ResultClassifiers
resCls]
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"Adversaries killed by Timeout" [String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.1f%%" (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ ResultClassifiers -> Double
adversariesKilledByTimeout ResultClassifiers
resCls]
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"Surviving adversaries" [String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.1f%%" (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ ResultClassifiers -> Double
adversariesSurvived ResultClassifiers
resCls]
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (RunGenesisTestResult blk -> String
forall blk. RunGenesisTestResult blk -> String
rgtrTrace RunGenesisTestResult blk
result)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ GenesisTestFull blk -> StateView blk -> prop
mkProperty GenesisTestFull blk
genesisTest StateView blk
stateView prop -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. StateView blk -> Property
forall {blk}. StateView blk -> Property
hasOnlyExpectedExceptions StateView blk
stateView
 where
  shrinker' :: GenesisTestFull blk
-> RunGenesisTestResult blk -> [GenesisTestFull blk]
shrinker' GenesisTestFull blk
gt = GenesisTestFull blk -> StateView blk -> [GenesisTestFull blk]
shrinker GenesisTestFull blk
gt (StateView blk -> [GenesisTestFull blk])
-> (RunGenesisTestResult blk -> StateView blk)
-> RunGenesisTestResult blk
-> [GenesisTestFull blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunGenesisTestResult blk -> StateView blk
forall blk. RunGenesisTestResult blk -> StateView blk
rgtrStateView
  hasOnlyExpectedExceptions :: StateView blk -> Property
hasOnlyExpectedExceptions StateView{[PeerSimulatorResult blk]
svPeerSimulatorResults :: [PeerSimulatorResult blk]
svPeerSimulatorResults :: forall blk. StateView blk -> [PeerSimulatorResult blk]
svPeerSimulatorResults} =
    [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$
      SomeException -> Property
isExpectedException
        (SomeException -> Property) -> [SomeException] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PeerSimulatorResult blk -> Maybe SomeException)
-> [PeerSimulatorResult blk] -> [SomeException]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
          (PeerSimulatorComponentResult blk -> Maybe SomeException
forall blk. PeerSimulatorComponentResult blk -> Maybe SomeException
pscrToException (PeerSimulatorComponentResult blk -> Maybe SomeException)
-> (PeerSimulatorResult blk -> PeerSimulatorComponentResult blk)
-> PeerSimulatorResult blk
-> Maybe SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSimulatorResult blk -> PeerSimulatorComponentResult blk
forall blk.
PeerSimulatorResult blk -> PeerSimulatorComponentResult blk
pseResult)
          [PeerSimulatorResult blk]
svPeerSimulatorResults
  isExpectedException :: SomeException -> Property
isExpectedException SomeException
exn
    | Just ChainSyncClientException
EmptyBucket <- Maybe ChainSyncClientException
forall e. Exception e => Maybe e
e = Property
true
    | Just ChainSyncClientException
DensityTooLow <- Maybe ChainSyncClientException
forall e. Exception e => Maybe e
e = Property
true
    | Just (ExceededTimeLimit StateToken st
_) <- Maybe ProtocolLimitFailure
forall e. Exception e => Maybe e
e = Property
true
    | Just AsyncCancelled
AsyncCancelled <- Maybe AsyncCancelled
forall e. Exception e => Maybe e
e = Property
true
    | Just CandidateTooSparse{} <- Maybe ChainSyncClientException
forall e. Exception e => Maybe e
e = Property
true
    | Bool
otherwise =
        String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
          (String
"Encountered unexpected exception: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
exn)
          Bool
False
   where
    e :: Exception e => Maybe e
    e :: forall e. Exception e => Maybe e
e = SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
exn
    true :: Property
true = Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True

-- | The 'StateView.svSelectedChain' produces an 'AnchoredFragment (Header blk)';
-- this function casts this type's hash to its instance, so that it can be used
-- for lookups on a 'BlockTree'.
castHeaderHash :: ChainHash (Header blk) -> ChainHash blk
castHeaderHash :: forall blk. ChainHash (Header blk) -> ChainHash blk
castHeaderHash = \case
  BlockHash HeaderHash (Header blk)
hash -> HeaderHash blk -> ChainHash blk
forall {k} (b :: k). HeaderHash b -> ChainHash b
BlockHash HeaderHash blk
HeaderHash (Header blk)
hash
  ChainHash (Header blk)
GenesisHash -> ChainHash blk
forall {k} (b :: k). ChainHash b
GenesisHash

-- | Check if the immutable tip of the selected chain of a 'GenesisTest' is honest.
-- In this setting, the immutable tip corresponds to the selected chain anchor
-- (see 'Ouroboros.Consensus.Storage.ChainDB.API.getCurrentChain') and
-- the honest chain is represented by the test 'BlockTree' trunk.
honestImmutableTip :: GetHeader blk => GenesisTestFull blk -> StateView blk -> Bool
honestImmutableTip :: forall blk.
GetHeader blk =>
GenesisTestFull blk -> StateView blk -> Bool
honestImmutableTip GenesisTest{BlockTree blk
gtBlockTree :: BlockTree blk
gtBlockTree :: forall blk schedule. GenesisTest blk schedule -> BlockTree blk
gtBlockTree} StateView{AnchoredFragment (Header blk)
svSelectedChain :: AnchoredFragment (Header blk)
svSelectedChain :: forall blk. StateView blk -> AnchoredFragment (Header blk)
svSelectedChain} =
  BlockTree blk -> Point (Header blk) -> Bool
forall blk.
GetHeader blk =>
BlockTree blk -> Point (Header blk) -> Bool
onTrunk BlockTree blk
gtBlockTree (Point (Header blk) -> Bool) -> Point (Header blk) -> Bool
forall a b. (a -> b) -> a -> b
$ AnchoredFragment (Header blk) -> Point (Header blk)
forall block. AnchoredFragment block -> Point block
AF.anchorPoint AnchoredFragment (Header blk)
svSelectedChain

-- | Check if the tip of the selected chain of a 'GenesisTest' is honest.
-- In this setting, the honest chain corresponds to the test 'BlockTree' trunk.
selectedHonestChain :: GetHeader blk => GenesisTestFull blk -> StateView blk -> Bool
selectedHonestChain :: forall blk.
GetHeader blk =>
GenesisTestFull blk -> StateView blk -> Bool
selectedHonestChain GenesisTest{BlockTree blk
gtBlockTree :: forall blk schedule. GenesisTest blk schedule -> BlockTree blk
gtBlockTree :: BlockTree blk
gtBlockTree} StateView{AnchoredFragment (Header blk)
svSelectedChain :: forall blk. StateView blk -> AnchoredFragment (Header blk)
svSelectedChain :: AnchoredFragment (Header blk)
svSelectedChain} =
  BlockTree blk -> Point (Header blk) -> Bool
forall blk.
GetHeader blk =>
BlockTree blk -> Point (Header blk) -> Bool
onTrunk BlockTree blk
gtBlockTree (Point (Header blk) -> Bool) -> Point (Header blk) -> Bool
forall a b. (a -> b) -> a -> b
$ AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint (AnchoredFragment (Header blk) -> Point (Header blk))
-> AnchoredFragment (Header blk) -> Point (Header blk)
forall a b. (a -> b) -> a -> b
$ AnchoredFragment (Header blk)
svSelectedChain