{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}

module Test.Consensus.Genesis.Tests
  ( TestKey
  , testSuite
  , tests
  ) where

import Ouroboros.Consensus.Block.Abstract
  ( GetHeader
  , HasHeader
  , Header
  )
import Ouroboros.Consensus.Util.Condense (Condense)
import Test.Consensus.Genesis.Setup
import Test.Consensus.Genesis.TestSuite
import qualified Test.Consensus.Genesis.Tests.CSJ as CSJ
import qualified Test.Consensus.Genesis.Tests.DensityDisconnect as GDD
import qualified Test.Consensus.Genesis.Tests.LoE as LoE
import qualified Test.Consensus.Genesis.Tests.LoE.CaughtUp as LoE.CaughtUp
import qualified Test.Consensus.Genesis.Tests.LoP as LoP
import qualified Test.Consensus.Genesis.Tests.LongRangeAttack as LongRangeAttack
import qualified Test.Consensus.Genesis.Tests.Uniform as Uniform
import Test.Tasty
import Test.Util.TestBlock (TestBlock)

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"Genesis tests" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$
    [TestTree
GDD.tests, TestTree
LoE.CaughtUp.tests] -- Tests with distinctive mechanisms, not (yet) integrated into a 'TestSuite'
      [TestTree] -> [TestTree] -> [TestTree]
forall a. Semigroup a => a -> a -> a
<> forall blk key.
(Condense (StateView blk), CondenseList (NodeState blk),
 ShowProxy blk, ShowProxy (Header blk), ConfigSupportsNode blk,
 LedgerSupportsProtocol blk, LedgerSupportsPeras 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)) =>
TestSuite blk key -> [TestTree]
toTestTree @TestBlock TestSuite TestBlock TestKey
forall blk.
(HasHeader blk, GetHeader blk, IssueTestBlock blk,
 Condense (Header blk), Ord blk, Eq (Header blk)) =>
TestSuite blk TestKey
testSuite

-- | Each value of this type uniquely corresponds to a Genesis test.
data TestKey
  = Uniform !Uniform.TestKey
  | CSJ !CSJ.TestKey
  | GDD !GDD.TestKey
  | LongRangeAttack !LongRangeAttack.TestKey
  | LoE !LoE.TestKey
  | LoP !LoP.TestKey
  deriving stock (TestKey -> TestKey -> Bool
(TestKey -> TestKey -> Bool)
-> (TestKey -> TestKey -> Bool) -> Eq TestKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestKey -> TestKey -> Bool
== :: TestKey -> TestKey -> Bool
$c/= :: TestKey -> TestKey -> Bool
/= :: TestKey -> TestKey -> Bool
Eq, Eq TestKey
Eq TestKey =>
(TestKey -> TestKey -> Ordering)
-> (TestKey -> TestKey -> Bool)
-> (TestKey -> TestKey -> Bool)
-> (TestKey -> TestKey -> Bool)
-> (TestKey -> TestKey -> Bool)
-> (TestKey -> TestKey -> TestKey)
-> (TestKey -> TestKey -> TestKey)
-> Ord TestKey
TestKey -> TestKey -> Bool
TestKey -> TestKey -> Ordering
TestKey -> TestKey -> TestKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TestKey -> TestKey -> Ordering
compare :: TestKey -> TestKey -> Ordering
$c< :: TestKey -> TestKey -> Bool
< :: TestKey -> TestKey -> Bool
$c<= :: TestKey -> TestKey -> Bool
<= :: TestKey -> TestKey -> Bool
$c> :: TestKey -> TestKey -> Bool
> :: TestKey -> TestKey -> Bool
$c>= :: TestKey -> TestKey -> Bool
>= :: TestKey -> TestKey -> Bool
$cmax :: TestKey -> TestKey -> TestKey
max :: TestKey -> TestKey -> TestKey
$cmin :: TestKey -> TestKey -> TestKey
min :: TestKey -> TestKey -> TestKey
Ord, (forall x. TestKey -> Rep TestKey x)
-> (forall x. Rep TestKey x -> TestKey) -> Generic TestKey
forall x. Rep TestKey x -> TestKey
forall x. TestKey -> Rep TestKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TestKey -> Rep TestKey x
from :: forall x. TestKey -> Rep TestKey x
$cto :: forall x. Rep TestKey x -> TestKey
to :: forall x. Rep TestKey x -> TestKey
Generic)
  deriving [TestKey]
[TestKey] -> SmallKey TestKey
forall a. [a] -> SmallKey a
$callKeys :: [TestKey]
allKeys :: [TestKey]
SmallKey via Generically TestKey

testSuite ::
  ( HasHeader blk
  , GetHeader blk
  , IssueTestBlock blk
  , Condense (Header blk)
  , Ord blk
  , Eq (Header blk)
  ) =>
  TestSuite blk TestKey
testSuite :: forall blk.
(HasHeader blk, GetHeader blk, IssueTestBlock blk,
 Condense (Header blk), Ord blk, Eq (Header blk)) =>
TestSuite blk TestKey
testSuite = (TestKey -> TestSuiteData blk) -> TestSuite blk TestKey
forall key blk.
(Ord key, SmallKey key) =>
(key -> TestSuiteData blk) -> TestSuite blk key
mkTestSuite ((TestKey -> TestSuiteData blk) -> TestSuite blk TestKey)
-> (TestKey -> TestSuiteData blk) -> TestSuite blk TestKey
forall a b. (a -> b) -> a -> b
$ \case
  Uniform TestKey
t -> TestSuite blk TestKey -> TestKey -> TestSuiteData blk
forall key blk.
Ord key =>
TestSuite blk key -> key -> TestSuiteData blk
at TestSuite blk TestKey
forall blk.
(HasHeader blk, GetHeader blk, IssueTestBlock blk, Ord blk) =>
TestSuite blk TestKey
Uniform.testSuite TestKey
t
  CSJ TestKey
t -> TestSuite blk TestKey -> TestKey -> TestSuiteData blk
forall key blk.
Ord key =>
TestSuite blk key -> key -> TestSuiteData blk
at TestSuite blk TestKey
forall blk.
(HasHeader blk, HasHeader (Header blk), IssueTestBlock blk,
 Ord blk, Condense (Header blk), Eq (Header blk)) =>
TestSuite blk TestKey
CSJ.testSuite TestKey
t
  GDD TestKey
t -> TestSuite blk TestKey -> TestKey -> TestSuiteData blk
forall key blk.
Ord key =>
TestSuite blk key -> key -> TestSuiteData blk
at TestSuite blk TestKey
forall blk.
(HasHeader blk, IssueTestBlock blk, Ord blk) =>
TestSuite blk TestKey
GDD.testSuite TestKey
t
  LongRangeAttack TestKey
t -> TestSuite blk TestKey -> TestKey -> TestSuiteData blk
forall key blk.
Ord key =>
TestSuite blk key -> key -> TestSuiteData blk
at TestSuite blk TestKey
forall blk.
(HasHeader blk, GetHeader blk, IssueTestBlock blk) =>
TestSuite blk TestKey
LongRangeAttack.testSuite TestKey
t
  LoE TestKey
t -> TestSuite blk TestKey -> TestKey -> TestSuiteData blk
forall key blk.
Ord key =>
TestSuite blk key -> key -> TestSuiteData blk
at TestSuite blk TestKey
forall blk.
(HasHeader blk, HasHeader (Header blk), IssueTestBlock blk) =>
TestSuite blk TestKey
LoE.testSuite TestKey
t
  LoP TestKey
t -> TestSuite blk TestKey -> TestKey -> TestSuiteData blk
forall key blk.
Ord key =>
TestSuite blk key -> key -> TestSuiteData blk
at TestSuite blk TestKey
forall blk.
(HasHeader blk, HasHeader (Header blk), IssueTestBlock blk,
 Ord blk) =>
TestSuite blk TestKey
LoP.testSuite TestKey
t