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

module Test.ThreadNet.PBFT (tests) where

import Cardano.Ledger.BaseTypes (nonZero, unNonZero)
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
    k <- NonZero Word64 -> SecurityParam
SecurityParam (NonZero Word64 -> SecurityParam)
-> Gen (NonZero 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) Gen Word64
-> (Word64 -> Maybe (NonZero Word64)) -> Gen (NonZero Word64)
forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` Word64 -> Maybe (NonZero Word64)
forall a. HasZero a => a -> Maybe (NonZero a)
nonZero

    testConfig <- arbitrary
    let TestConfig{numCoreNodes, numSlots} = testConfig

    nodeJoinPlan <- genNodeJoinPlan numCoreNodes numSlots
    pure $ TestSetup k testConfig 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
$ NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero (SecurityParam -> NonZero 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