{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}

module Test.ThreadNet.PBFT (tests) where

import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.BlockchainTime
import           Ouroboros.Consensus.Config.SecurityParam
import qualified Ouroboros.Consensus.HardFork.History as HardFork
import           Ouroboros.Consensus.Mock.Ledger.Block
import           Ouroboros.Consensus.Mock.Ledger.Block.PBFT
import           Ouroboros.Consensus.Mock.Node ()
import           Ouroboros.Consensus.Mock.Node.PBFT (MockPBftBlock,
                     blockForgingMockPBFT, protocolInfoMockPBFT)
import           Ouroboros.Consensus.Node.ProtocolInfo (NumCoreNodes (..))
import           Ouroboros.Consensus.NodeId
import           Ouroboros.Consensus.Protocol.PBFT
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Consensus.Util.Condense (condense)
import           Ouroboros.Network.Mock.Chain (foldChain)
import           Test.QuickCheck
import           Test.Tasty
import           Test.Tasty.QuickCheck
import           Test.ThreadNet.General
import           Test.ThreadNet.Network
import qualified Test.ThreadNet.Ref.PBFT as Ref
import           Test.ThreadNet.TxGen.Mock ()
import           Test.ThreadNet.Util
import           Test.ThreadNet.Util.HasCreator.Mock ()
import           Test.ThreadNet.Util.NodeJoinPlan
import           Test.ThreadNet.Util.NodeRestarts
import           Test.ThreadNet.Util.NodeToNodeVersion
import           Test.ThreadNet.Util.SimpleBlock
import           Test.Util.HardFork.Future (singleEraFuture)
import           Test.Util.Orphans.Arbitrary ()

data TestSetup = TestSetup
  { TestSetup -> SecurityParam
setupK            :: SecurityParam
  , TestSetup -> TestConfig
setupTestConfig   :: TestConfig
  , TestSetup -> NodeJoinPlan
setupNodeJoinPlan :: NodeJoinPlan
  }
  deriving (Int -> TestSetup -> ShowS
[TestSetup] -> ShowS
TestSetup -> String
(Int -> TestSetup -> ShowS)
-> (TestSetup -> String)
-> ([TestSetup] -> ShowS)
-> Show TestSetup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestSetup -> ShowS
showsPrec :: Int -> TestSetup -> ShowS
$cshow :: TestSetup -> String
show :: TestSetup -> String
$cshowList :: [TestSetup] -> ShowS
showList :: [TestSetup] -> ShowS
Show)

instance Arbitrary TestSetup where
  arbitrary :: Gen TestSetup
arbitrary = do
      SecurityParam
k <- Word64 -> SecurityParam
SecurityParam (Word64 -> SecurityParam) -> Gen Word64 -> Gen SecurityParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
10)

      TestConfig
testConfig <- Gen TestConfig
forall a. Arbitrary a => Gen a
arbitrary
      let TestConfig{NumCoreNodes
numCoreNodes :: NumCoreNodes
numCoreNodes :: TestConfig -> NumCoreNodes
numCoreNodes, NumSlots
numSlots :: NumSlots
numSlots :: TestConfig -> NumSlots
numSlots} = TestConfig
testConfig

      NodeJoinPlan
nodeJoinPlan <- NumCoreNodes -> NumSlots -> Gen NodeJoinPlan
genNodeJoinPlan NumCoreNodes
numCoreNodes NumSlots
numSlots
      TestSetup -> Gen TestSetup
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestSetup -> Gen TestSetup) -> TestSetup -> Gen TestSetup
forall a b. (a -> b) -> a -> b
$ SecurityParam -> TestConfig -> NodeJoinPlan -> TestSetup
TestSetup SecurityParam
k TestConfig
testConfig NodeJoinPlan
nodeJoinPlan

  -- TODO shrink

tests :: TestTree
tests :: TestTree
tests = String -> [TestTree] -> TestTree
testGroup String
"PBFT" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$
    [ String -> (TestSetup -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"simple convergence" ((TestSetup -> Property) -> TestTree)
-> (TestSetup -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \TestSetup
setup ->
        TestSetup -> Property
prop_simple_pbft_convergence TestSetup
setup
    ]

prop_simple_pbft_convergence :: TestSetup -> Property
prop_simple_pbft_convergence :: TestSetup -> Property
prop_simple_pbft_convergence TestSetup
  { setupK :: TestSetup -> SecurityParam
setupK            = SecurityParam
k
  , setupTestConfig :: TestSetup -> TestConfig
setupTestConfig   = TestConfig
testConfig
  , setupNodeJoinPlan :: TestSetup -> NodeJoinPlan
setupNodeJoinPlan = NodeJoinPlan
nodeJoinPlan
  } =
    String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"Ref.PBFT result" [Result -> String
Ref.resultConstrName Result
refResult] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    Property
prop_asSimulated Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
    PropGeneralArgs
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
-> TestOutput
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
-> Property
forall blk.
(Condense blk, Condense (HeaderHash blk), Eq blk, RunNode blk) =>
PropGeneralArgs blk -> TestOutput blk -> Property
prop_general PropGeneralArgs
      { pgaBlockProperty :: SimpleBlock'
  SimpleMockCrypto
  (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
  (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
-> Property
pgaBlockProperty       = SimpleBlock'
  SimpleMockCrypto
  (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
  (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
-> Property
forall c ext ext'.
(SimpleCrypto c, Typeable ext, Typeable ext') =>
SimpleBlock' c ext ext' -> Property
prop_validSimpleBlock
      , pgaCountTxs :: SimpleBlock'
  SimpleMockCrypto
  (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
  (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
-> Word64
pgaCountTxs            = SimpleBlock'
  SimpleMockCrypto
  (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
  (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
-> Word64
forall c ext. SimpleBlock c ext -> Word64
countSimpleGenTxs
      , pgaExpectedCannotForge :: SlotNo
-> NodeId
-> WrapCannotForge
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
-> Bool
pgaExpectedCannotForge = NumCoreNodes
-> SlotNo
-> NodeId
-> WrapCannotForge
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
-> Bool
expectedCannotForge NumCoreNodes
numCoreNodes
      , pgaFirstBlockNo :: BlockNo
pgaFirstBlockNo        = BlockNo
0
      , pgaFixedMaxForkLength :: Maybe NumBlocks
pgaFixedMaxForkLength  =
          NumBlocks -> Maybe NumBlocks
forall a. a -> Maybe a
Just (NumBlocks -> Maybe NumBlocks) -> NumBlocks -> Maybe NumBlocks
forall a b. (a -> b) -> a -> b
$ Word64 -> NumBlocks
NumBlocks (Word64 -> NumBlocks) -> Word64 -> NumBlocks
forall a b. (a -> b) -> a -> b
$ case Result
refResult of
            Ref.Forked{} -> Word64
1
            Result
_            -> Word64
0
      , pgaFixedSchedule :: Maybe LeaderSchedule
pgaFixedSchedule       =
          LeaderSchedule -> Maybe LeaderSchedule
forall a. a -> Maybe a
Just (LeaderSchedule -> Maybe LeaderSchedule)
-> LeaderSchedule -> Maybe LeaderSchedule
forall a b. (a -> b) -> a -> b
$ NumCoreNodes -> NumSlots -> LeaderSchedule
roundRobinLeaderSchedule NumCoreNodes
numCoreNodes NumSlots
numSlots
      , pgaSecurityParam :: SecurityParam
pgaSecurityParam       = SecurityParam
k
      , pgaTestConfig :: TestConfig
pgaTestConfig          = TestConfig
testConfig
      , pgaTestConfigB :: TestConfigB
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
pgaTestConfigB         = TestConfigB
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
testConfigB
      }
      TestOutput
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
testOutput
  where
    TestConfig{NumCoreNodes
numCoreNodes :: TestConfig -> NumCoreNodes
numCoreNodes :: NumCoreNodes
numCoreNodes, NumSlots
numSlots :: TestConfig -> NumSlots
numSlots :: NumSlots
numSlots} = TestConfig
testConfig
    slotLength :: SlotLength
slotLength = Integer -> SlotLength
slotLengthFromSec Integer
1
    testConfigB :: TestConfigB
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
testConfigB = TestConfigB
      { forgeEbbEnv :: Maybe
  (ForgeEbbEnv
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)))
forgeEbbEnv = Maybe
  (ForgeEbbEnv
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)))
forall a. Maybe a
Nothing
      , future :: Future
future      = SlotLength -> EpochSize -> Future
singleEraFuture
          SlotLength
slotLength
          (Word64 -> EpochSize
EpochSize (Word64 -> EpochSize) -> Word64 -> EpochSize
forall a b. (a -> b) -> a -> b
$ SecurityParam -> Word64
maxRollbacks SecurityParam
k Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
10)
          -- The mock ledger doesn't really care, and neither does PBFT. We
          -- stick with the common @k * 10@ size for now.
      , messageDelay :: CalcMessageDelay
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
messageDelay = CalcMessageDelay
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
forall blk. CalcMessageDelay blk
noCalcMessageDelay
      , NodeJoinPlan
nodeJoinPlan :: NodeJoinPlan
nodeJoinPlan :: NodeJoinPlan
nodeJoinPlan
      , nodeRestarts :: NodeRestarts
nodeRestarts = NodeRestarts
noRestarts
      , txGenExtra :: TxGenExtra
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
txGenExtra   = ()
      , version :: (NodeToNodeVersion,
 BlockNodeToNodeVersion
   (SimpleBlock'
      SimpleMockCrypto
      (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
      (SimplePBftExt SimpleMockCrypto PBftMockCrypto)))
version      = Proxy
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
-> (NodeToNodeVersion,
    BlockNodeToNodeVersion
      (SimpleBlock'
         SimpleMockCrypto
         (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
         (SimplePBftExt SimpleMockCrypto PBftMockCrypto)))
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> (NodeToNodeVersion, BlockNodeToNodeVersion blk)
newestVersion (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @MockPBftBlock)
      }

    NumCoreNodes Word64
nn = NumCoreNodes
numCoreNodes

    sigThd :: PBftSignatureThreshold
sigThd = Double -> PBftSignatureThreshold
PBftSignatureThreshold (Double -> PBftSignatureThreshold)
-> Double -> PBftSignatureThreshold
forall a b. (a -> b) -> a -> b
$ (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
nn) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.1
    params :: PBftParams
params = SecurityParam
-> NumCoreNodes -> PBftSignatureThreshold -> PBftParams
PBftParams SecurityParam
k NumCoreNodes
numCoreNodes PBftSignatureThreshold
sigThd

    testOutput :: TestOutput
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
testOutput =
        TestConfig
-> TestConfigB
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
-> (forall (m :: * -> *).
    IOLike m =>
    TestConfigMB
      m
      (SimpleBlock'
         SimpleMockCrypto
         (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
         (SimplePBftExt SimpleMockCrypto PBftMockCrypto)))
-> TestOutput
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
forall blk.
(RunNode blk, TxGen blk, TracingConstraints blk, HasCallStack) =>
TestConfig
-> TestConfigB blk
-> (forall (m :: * -> *). IOLike m => TestConfigMB m blk)
-> TestOutput blk
runTestNetwork TestConfig
testConfig TestConfigB
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
testConfigB TestConfigMB
            { nodeInfo :: CoreNodeId
-> TestNodeInitialization
     m
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
nodeInfo = \CoreNodeId
nid -> ProtocolInfo
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
-> m [BlockForging
        m
        (SimpleBlock'
           SimpleMockCrypto
           (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
           (SimplePBftExt SimpleMockCrypto PBftMockCrypto))]
-> TestNodeInitialization
     m
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
forall blk (m :: * -> *).
ProtocolInfo blk
-> m [BlockForging m blk] -> TestNodeInitialization m blk
plainTestNodeInitialization
                                  (PBftParams
-> EraParams
-> ProtocolInfo
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
protocolInfoMockPBFT
                                    PBftParams
params
                                    (SecurityParam -> SlotLength -> EraParams
HardFork.defaultEraParams SecurityParam
k SlotLength
slotLength))
                                  ([BlockForging
   m
   (SimpleBlock'
      SimpleMockCrypto
      (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
      (SimplePBftExt SimpleMockCrypto PBftMockCrypto))]
-> m [BlockForging
        m
        (SimpleBlock'
           SimpleMockCrypto
           (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
           (SimplePBftExt SimpleMockCrypto PBftMockCrypto))]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([BlockForging
    m
    (SimpleBlock'
       SimpleMockCrypto
       (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
       (SimplePBftExt SimpleMockCrypto PBftMockCrypto))]
 -> m [BlockForging
         m
         (SimpleBlock'
            SimpleMockCrypto
            (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
            (SimplePBftExt SimpleMockCrypto PBftMockCrypto))])
-> [BlockForging
      m
      (SimpleBlock'
         SimpleMockCrypto
         (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
         (SimplePBftExt SimpleMockCrypto PBftMockCrypto))]
-> m [BlockForging
        m
        (SimpleBlock'
           SimpleMockCrypto
           (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
           (SimplePBftExt SimpleMockCrypto PBftMockCrypto))]
forall a b. (a -> b) -> a -> b
$ CoreNodeId
-> [BlockForging
      m
      (SimpleBlock'
         SimpleMockCrypto
         (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
         (SimplePBftExt SimpleMockCrypto PBftMockCrypto))]
forall (m :: * -> *).
Monad m =>
CoreNodeId
-> [BlockForging
      m
      (SimpleBlock'
         SimpleMockCrypto
         (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
         (SimplePBftExt SimpleMockCrypto PBftMockCrypto))]
blockForgingMockPBFT CoreNodeId
nid)
            , mkRekeyM :: Maybe
  (m (RekeyM
        m
        (SimpleBlock'
           SimpleMockCrypto
           (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
           (SimplePBftExt SimpleMockCrypto PBftMockCrypto))))
mkRekeyM = Maybe
  (m (RekeyM
        m
        (SimpleBlock'
           SimpleMockCrypto
           (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
           (SimplePBftExt SimpleMockCrypto PBftMockCrypto))))
forall a. Maybe a
Nothing
            }

    refResult :: Ref.Result
    refResult :: Result
refResult = HasCallStack => PBftParams -> NodeJoinPlan -> NumSlots -> Result
PBftParams -> NodeJoinPlan -> NumSlots -> Result
Ref.simulate PBftParams
params NodeJoinPlan
nodeJoinPlan NumSlots
numSlots

    prop_asSimulated :: Property
    prop_asSimulated :: Property
prop_asSimulated =
        String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Unexpected Nominal slots:") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$
        [ String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"In final chain of " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NodeId -> String
forall a. Condense a => a -> String
condense NodeId
nid) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
          String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"actual:   " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [SlotNo] -> String
forall a. Condense a => a -> String
condense [SlotNo]
actualSlots) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
          case Result
refResult of
            Ref.Forked NumSlots
_ Map CoreNodeId (Set SlotNo)
m        ->
              let expectedSlotss :: [[SlotNo]]
expectedSlotss =
                    case CoreNodeId -> Map CoreNodeId (Set SlotNo) -> Maybe (Set SlotNo)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CoreNodeId
cid Map CoreNodeId (Set SlotNo)
m of
                      Maybe (Set SlotNo)
Nothing -> String -> [[SlotNo]]
forall a. HasCallStack => String -> a
error String
"node missing from Ref.Forked"
                      Just Set SlotNo
ss -> (SlotNo -> [SlotNo]) -> [SlotNo] -> [[SlotNo]]
forall a b. (a -> b) -> [a] -> [b]
map (SlotNo -> [SlotNo] -> [SlotNo]
forall a. a -> [a] -> [a]
:[]) ([SlotNo] -> [[SlotNo]]) -> [SlotNo] -> [[SlotNo]]
forall a b. (a -> b) -> a -> b
$ Set SlotNo -> [SlotNo]
forall a. Set a -> [a]
Set.toList Set SlotNo
ss
              in
              String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
                (String
"expected: one of " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [[SlotNo]] -> String
forall a. Condense a => a -> String
condense [[SlotNo]]
expectedSlotss) (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
              [SlotNo]
actualSlots [SlotNo] -> [[SlotNo]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[SlotNo]]
expectedSlotss
            Result
Ref.Nondeterministic  -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True   -- TODO improve?
            Ref.Outcomes [Outcome]
outcomes ->
              let expectedSlots :: [SlotNo]
expectedSlots =
                    [ SlotNo
s | (Outcome
Ref.Nominal, SlotNo
s) <- [Outcome] -> [SlotNo] -> [(Outcome, SlotNo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Outcome]
outcomes [SlotNo
0..] ]
              in
              String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"expected: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [SlotNo] -> String
forall a. Condense a => a -> String
condense [SlotNo]
expectedSlots) (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
              [SlotNo]
actualSlots [SlotNo] -> [SlotNo] -> Bool
forall a. Eq a => a -> a -> Bool
== [SlotNo]
expectedSlots
        | (nid :: NodeId
nid@(CoreId CoreNodeId
cid), NodeOutput
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
no) <- Map
  NodeId
  (NodeOutput
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)))
-> [(NodeId,
     NodeOutput
       (SimpleBlock'
          SimpleMockCrypto
          (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
          (SimplePBftExt SimpleMockCrypto PBftMockCrypto)))]
forall k a. Map k a -> [(k, a)]
Map.toList Map
  NodeId
  (NodeOutput
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)))
testOutputNodes
        , let actualSlots :: [SlotNo]
actualSlots = NodeOutput
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
-> [SlotNo]
forall {b}. HasHeader b => NodeOutput b -> [SlotNo]
actualSlotsOf NodeOutput
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
no
        ]
      where
        TestOutput{Map
  NodeId
  (NodeOutput
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)))
testOutputNodes :: Map
  NodeId
  (NodeOutput
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)))
testOutputNodes :: forall blk. TestOutput blk -> Map NodeId (NodeOutput blk)
testOutputNodes} = TestOutput
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
testOutput

        actualSlotsOf :: NodeOutput b -> [SlotNo]
actualSlotsOf NodeOutput{Chain b
nodeOutputFinalChain :: Chain b
nodeOutputFinalChain :: forall blk. NodeOutput blk -> Chain blk
nodeOutputFinalChain} =
            (([SlotNo] -> [SlotNo]) -> b -> [SlotNo] -> [SlotNo])
-> ([SlotNo] -> [SlotNo]) -> Chain b -> [SlotNo] -> [SlotNo]
forall a b. (a -> b -> a) -> a -> Chain b -> a
foldChain ([SlotNo] -> [SlotNo]) -> b -> [SlotNo] -> [SlotNo]
forall {b} {c}.
HasHeader b =>
([SlotNo] -> c) -> b -> [SlotNo] -> c
snoc [SlotNo] -> [SlotNo]
forall a. a -> a
id Chain b
nodeOutputFinalChain [] :: [SlotNo]
          where
            snoc :: ([SlotNo] -> c) -> b -> [SlotNo] -> c
snoc [SlotNo] -> c
acc b
blk = [SlotNo] -> c
acc ([SlotNo] -> c) -> ([SlotNo] -> [SlotNo]) -> [SlotNo] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot b
blk SlotNo -> [SlotNo] -> [SlotNo]
forall a. a -> [a] -> [a]
:)

type Blk = SimpleBlock SimpleMockCrypto
             (SimplePBftExt SimpleMockCrypto PBftMockCrypto)

expectedCannotForge ::
     NumCoreNodes
  -> SlotNo
  -> NodeId
  -> WrapCannotForge Blk
  -> Bool
expectedCannotForge :: NumCoreNodes
-> SlotNo
-> NodeId
-> WrapCannotForge
     (SimpleBlock'
        SimpleMockCrypto
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
        (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
-> Bool
expectedCannotForge NumCoreNodes
_ SlotNo
_ NodeId
_ = \case
    WrapCannotForge PBftCannotForgeThresholdExceeded{} -> Bool
True
    WrapCannotForge
  (SimpleBlock'
     SimpleMockCrypto
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto)
     (SimplePBftExt SimpleMockCrypto PBftMockCrypto))
_                                                  -> Bool
False