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

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

import Ouroboros.Consensus.Block.Abstract
  ( HasHeader
  , Header
  , HeaderHash
  )
import Ouroboros.Consensus.Util.Condense (Condense)
import Test.Consensus.Genesis.Setup
import Test.Consensus.Genesis.TestSuite
import qualified Test.Consensus.PeerSimulator.Tests.LinkedThreads as LinkedThreads
import qualified Test.Consensus.PeerSimulator.Tests.Rollback as Rollback
import qualified Test.Consensus.PeerSimulator.Tests.Timeouts as Timeouts
import Test.Tasty
import Test.Util.TestBlock (TestBlock)

tests :: TestTree
tests :: TestTree
tests = TestName -> [TestTree] -> TestTree
testGroup TestName
"PeerSimulator" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ 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.
(IssueTestBlock blk, HasHeader blk, HasHeader (Header blk),
 Condense (HeaderHash blk), Condense (Header blk), Eq blk) =>
TestSuite blk TestKey
testSuite

-- | Each value of this type uniquely corresponds to a basic functionality test.
data TestKey
  = LinkedThreads !LinkedThreads.TestKey
  | Rollback !Rollback.TestKey
  | Timeouts !Timeouts.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 ::
  ( IssueTestBlock blk
  , HasHeader blk
  , HasHeader (Header blk)
  , Condense (HeaderHash blk)
  , Condense (Header blk)
  , Eq blk
  ) =>
  TestSuite blk TestKey
testSuite :: forall blk.
(IssueTestBlock blk, HasHeader blk, HasHeader (Header blk),
 Condense (HeaderHash blk), Condense (Header blk), Eq 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
  LinkedThreads 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.
(IssueTestBlock blk, HasHeader blk, Eq blk) =>
TestSuite blk TestKey
LinkedThreads.testSuite TestKey
t
  Rollback 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.
(IssueTestBlock blk, HasHeader blk, HasHeader (Header blk),
 Eq blk) =>
TestSuite blk TestKey
Rollback.testSuite TestKey
t
  Timeouts 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.
(IssueTestBlock blk, HasHeader blk, HasHeader (Header blk),
 Condense (HeaderHash blk), Condense (Header blk)) =>
TestSuite blk TestKey
Timeouts.testSuite TestKey
t