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

module Test.ThreadNet.LeaderSchedule (tests) where

import           Control.Monad (replicateM)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
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
import           Ouroboros.Consensus.Mock.Node ()
import           Ouroboros.Consensus.Mock.Node.PraosRule
import           Ouroboros.Consensus.Mock.Protocol.LeaderSchedule
import           Ouroboros.Consensus.Mock.Protocol.Praos
import           Ouroboros.Consensus.Node.ProtocolInfo
import           Ouroboros.Consensus.NodeId
import           Test.QuickCheck
import           Test.Tasty
import           Test.Tasty.QuickCheck
import           Test.ThreadNet.General
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 ()
import           Test.Util.Slots (NumSlots (..))

data TestSetup = TestSetup
  { TestSetup -> SecurityParam
setupK              :: SecurityParam
  , TestSetup -> TestConfig
setupTestConfig     :: TestConfig
  , TestSetup -> EpochSize
setupEpochSize      :: EpochSize
    -- ^ Note: we don't think this value actually matters, since this test
    -- overrides the leader schedule.
  , TestSetup -> NodeJoinPlan
setupNodeJoinPlan   :: NodeJoinPlan
  , TestSetup -> LeaderSchedule
setupLeaderSchedule :: LeaderSchedule
  , TestSetup -> SlotLength
setupSlotLength     :: SlotLength
  }
  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
      -- TODO k > 1 as a workaround for Issue #1511.
      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
2, Word64
10)
      EpochSize
epochSize  <- Word64 -> EpochSize
EpochSize     (Word64 -> EpochSize) -> Gen Word64 -> Gen EpochSize
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)
      SlotLength
slotLength <- Gen SlotLength
forall a. Arbitrary a => Gen a
arbitrary

      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
      LeaderSchedule
leaderSchedule <- SecurityParam
-> NumSlots -> NumCoreNodes -> NodeJoinPlan -> Gen LeaderSchedule
genLeaderSchedule SecurityParam
k NumSlots
numSlots NumCoreNodes
numCoreNodes NodeJoinPlan
nodeJoinPlan

      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
-> EpochSize
-> NodeJoinPlan
-> LeaderSchedule
-> SlotLength
-> TestSetup
TestSetup
        SecurityParam
k
        TestConfig
testConfig
        EpochSize
epochSize
        NodeJoinPlan
nodeJoinPlan
        LeaderSchedule
leaderSchedule
        SlotLength
slotLength

  -- TODO shrink

tests :: TestTree
tests :: TestTree
tests = String -> [TestTree] -> TestTree
testGroup String
"LeaderSchedule"
    [ 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_leader_schedule_convergence TestSetup
setup
    ]

prop_simple_leader_schedule_convergence :: TestSetup -> Property
prop_simple_leader_schedule_convergence :: TestSetup -> Property
prop_simple_leader_schedule_convergence TestSetup
  { setupK :: TestSetup -> SecurityParam
setupK              = SecurityParam
k
  , setupTestConfig :: TestSetup -> TestConfig
setupTestConfig     = TestConfig
testConfig
  , setupEpochSize :: TestSetup -> EpochSize
setupEpochSize      = EpochSize
epochSize
  , setupNodeJoinPlan :: TestSetup -> NodeJoinPlan
setupNodeJoinPlan   = NodeJoinPlan
nodeJoinPlan
  , setupLeaderSchedule :: TestSetup -> LeaderSchedule
setupLeaderSchedule = LeaderSchedule
schedule
  , setupSlotLength :: TestSetup -> SlotLength
setupSlotLength     = SlotLength
slotLength
  } =
    String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (Map
  NodeId
  (NodeOutput
     (SimpleBlock'
        SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt))
-> String
forall b.
(GetPrevHash b, HasCreator b) =>
Map NodeId (NodeOutput b) -> String
tracesToDot Map
  NodeId
  (NodeOutput
     (SimpleBlock'
        SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt))
testOutputNodes) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    PropGeneralArgs
  (SimpleBlock'
     SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
-> TestOutput
     (SimpleBlock'
        SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
-> Property
forall blk.
(Condense blk, Condense (HeaderHash blk), Eq blk, RunNode blk) =>
PropGeneralArgs blk -> TestOutput blk -> Property
prop_general PropGeneralArgs
      { pgaBlockProperty :: SimpleBlock' SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt
-> Property
pgaBlockProperty       = SimpleBlock' SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt
-> Property
forall c ext ext'.
(SimpleCrypto c, Typeable ext, Typeable ext') =>
SimpleBlock' c ext ext' -> Property
prop_validSimpleBlock
      , pgaCountTxs :: SimpleBlock' SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt
-> Word64
pgaCountTxs            = SimpleBlock' SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt
-> Word64
forall c ext. SimpleBlock c ext -> Word64
countSimpleGenTxs
      , pgaExpectedCannotForge :: SlotNo
-> NodeId
-> WrapCannotForge
     (SimpleBlock'
        SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
-> Bool
pgaExpectedCannotForge = SlotNo
-> NodeId
-> WrapCannotForge
     (SimpleBlock'
        SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
-> Bool
forall blk. SlotNo -> NodeId -> WrapCannotForge blk -> Bool
noExpectedCannotForges
      , pgaFirstBlockNo :: BlockNo
pgaFirstBlockNo        = BlockNo
0
      , pgaFixedMaxForkLength :: Maybe NumBlocks
pgaFixedMaxForkLength  = Maybe NumBlocks
forall a. Maybe a
Nothing
      , pgaFixedSchedule :: Maybe LeaderSchedule
pgaFixedSchedule       = LeaderSchedule -> Maybe LeaderSchedule
forall a. a -> Maybe a
Just LeaderSchedule
schedule
      , pgaSecurityParam :: SecurityParam
pgaSecurityParam       = SecurityParam
k
      , pgaTestConfig :: TestConfig
pgaTestConfig          = TestConfig
testConfig
      , pgaTestConfigB :: TestConfigB
  (SimpleBlock'
     SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
pgaTestConfigB         = TestConfigB
  (SimpleBlock'
     SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
testConfigB
      }
      TestOutput
  (SimpleBlock'
     SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
testOutput
  where
    TestConfig{NumCoreNodes
numCoreNodes :: TestConfig -> NumCoreNodes
numCoreNodes :: NumCoreNodes
numCoreNodes} = TestConfig
testConfig

    testConfigB :: TestConfigB
  (SimpleBlock'
     SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
testConfigB = TestConfigB
      { forgeEbbEnv :: Maybe
  (ForgeEbbEnv
     (SimpleBlock'
        SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt))
forgeEbbEnv  = Maybe
  (ForgeEbbEnv
     (SimpleBlock'
        SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt))
forall a. Maybe a
Nothing
      , future :: Future
future       = SlotLength -> EpochSize -> Future
singleEraFuture SlotLength
slotLength EpochSize
epochSize
      , messageDelay :: CalcMessageDelay
  (SimpleBlock'
     SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
messageDelay = CalcMessageDelay
  (SimpleBlock'
     SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
forall blk. CalcMessageDelay blk
noCalcMessageDelay
      , NodeJoinPlan
nodeJoinPlan :: NodeJoinPlan
nodeJoinPlan :: NodeJoinPlan
nodeJoinPlan
      , nodeRestarts :: NodeRestarts
nodeRestarts = NodeRestarts
noRestarts
      , txGenExtra :: TxGenExtra
  (SimpleBlock'
     SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
txGenExtra   = ()
      , version :: (NodeToNodeVersion,
 BlockNodeToNodeVersion
   (SimpleBlock'
      SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt))
version      = Proxy
  (SimpleBlock'
     SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
-> (NodeToNodeVersion,
    BlockNodeToNodeVersion
      (SimpleBlock'
         SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt))
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> (NodeToNodeVersion, BlockNodeToNodeVersion blk)
newestVersion (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @MockPraosRuleBlock)
      }

    -- this is entirely ignored because of the 'WithLeaderSchedule' combinator
    dummyF :: Double
dummyF = Double
0.5

    testOutput :: TestOutput
  (SimpleBlock'
     SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
testOutput@TestOutput{Map
  NodeId
  (NodeOutput
     (SimpleBlock'
        SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt))
testOutputNodes :: Map
  NodeId
  (NodeOutput
     (SimpleBlock'
        SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt))
testOutputNodes :: forall blk. TestOutput blk -> Map NodeId (NodeOutput blk)
testOutputNodes} =
        TestConfig
-> TestConfigB
     (SimpleBlock'
        SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
-> (forall (m :: * -> *).
    IOLike m =>
    TestConfigMB
      m
      (SimpleBlock'
         SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt))
-> TestOutput
     (SimpleBlock'
        SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
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 SimplePraosRuleExt SimplePraosRuleExt)
testConfigB TestConfigMB
            { nodeInfo :: CoreNodeId
-> TestNodeInitialization
     m
     (SimpleBlock'
        SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
nodeInfo = \CoreNodeId
nid ->
                ProtocolInfo
  (SimpleBlock'
     SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
-> m [BlockForging
        m
        (SimpleBlock'
           SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)]
-> TestNodeInitialization
     m
     (SimpleBlock'
        SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
forall blk (m :: * -> *).
ProtocolInfo blk
-> m [BlockForging m blk] -> TestNodeInitialization m blk
plainTestNodeInitialization
                  (NumCoreNodes
-> CoreNodeId
-> PraosParams
-> EraParams
-> LeaderSchedule
-> PraosEvolvingStake
-> ProtocolInfo
     (SimpleBlock'
        SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)
protocolInfoPraosRule
                    NumCoreNodes
numCoreNodes
                    CoreNodeId
nid
                    PraosParams
                    { praosSecurityParam :: SecurityParam
praosSecurityParam = SecurityParam
k
                    , praosSlotsPerEpoch :: Word64
praosSlotsPerEpoch = EpochSize -> Word64
unEpochSize EpochSize
epochSize
                    , praosLeaderF :: Double
praosLeaderF       = Double
dummyF
                    }
                    (SecurityParam -> SlotLength -> EraParams
HardFork.defaultEraParams SecurityParam
k SlotLength
slotLength)
                    LeaderSchedule
schedule
                    PraosEvolvingStake
emptyPraosEvolvingStake)
                  ([BlockForging
   m
   (SimpleBlock'
      SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)]
-> m [BlockForging
        m
        (SimpleBlock'
           SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [BlockForging
   m
   (SimpleBlock'
      SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)]
forall (m :: * -> *).
Monad m =>
[BlockForging
   m
   (SimpleBlock'
      SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)]
blockForgingPraosRule)
            , mkRekeyM :: Maybe
  (m (RekeyM
        m
        (SimpleBlock'
           SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)))
mkRekeyM = Maybe
  (m (RekeyM
        m
        (SimpleBlock'
           SimpleMockCrypto SimplePraosRuleExt SimplePraosRuleExt)))
forall a. Maybe a
Nothing
            }

{-------------------------------------------------------------------------------
  Dependent generation and shrinking of leader schedules
-------------------------------------------------------------------------------}

genLeaderSchedule :: SecurityParam
                  -> NumSlots
                  -> NumCoreNodes
                  -> NodeJoinPlan
                  -> Gen LeaderSchedule
genLeaderSchedule :: SecurityParam
-> NumSlots -> NumCoreNodes -> NodeJoinPlan -> Gen LeaderSchedule
genLeaderSchedule SecurityParam
k (NumSlots Word64
numSlots) NumCoreNodes
numCoreNodes NodeJoinPlan
nodeJoinPlan =
    (Gen LeaderSchedule
 -> (LeaderSchedule -> Bool) -> Gen LeaderSchedule)
-> (LeaderSchedule -> Bool)
-> Gen LeaderSchedule
-> Gen LeaderSchedule
forall a b c. (a -> b -> c) -> b -> a -> c
flip Gen LeaderSchedule
-> (LeaderSchedule -> Bool) -> Gen LeaderSchedule
forall a. Gen a -> (a -> Bool) -> Gen a
suchThat (SecurityParam -> NodeJoinPlan -> LeaderSchedule -> Bool
consensusExpected SecurityParam
k NodeJoinPlan
nodeJoinPlan) (Gen LeaderSchedule -> Gen LeaderSchedule)
-> Gen LeaderSchedule -> Gen LeaderSchedule
forall a b. (a -> b) -> a -> b
$ do
        [[CoreNodeId]]
leaders <- Int -> Gen [CoreNodeId] -> Gen [[CoreNodeId]]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
numSlots) (Gen [CoreNodeId] -> Gen [[CoreNodeId]])
-> Gen [CoreNodeId] -> Gen [[CoreNodeId]]
forall a b. (a -> b) -> a -> b
$ [(Int, Gen [CoreNodeId])] -> Gen [CoreNodeId]
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
            [ ( Int
4, Int -> Gen [CoreNodeId]
pick Int
0)
            , ( Int
2, Int -> Gen [CoreNodeId]
pick Int
1)
            , ( Int
1, Int -> Gen [CoreNodeId]
pick Int
2)
            , ( Int
1, Int -> Gen [CoreNodeId]
pick Int
3)
            ]
        LeaderSchedule -> Gen LeaderSchedule
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (LeaderSchedule -> Gen LeaderSchedule)
-> LeaderSchedule -> Gen LeaderSchedule
forall a b. (a -> b) -> a -> b
$ Map SlotNo [CoreNodeId] -> LeaderSchedule
LeaderSchedule (Map SlotNo [CoreNodeId] -> LeaderSchedule)
-> Map SlotNo [CoreNodeId] -> LeaderSchedule
forall a b. (a -> b) -> a -> b
$ [(SlotNo, [CoreNodeId])] -> Map SlotNo [CoreNodeId]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(SlotNo, [CoreNodeId])] -> Map SlotNo [CoreNodeId])
-> [(SlotNo, [CoreNodeId])] -> Map SlotNo [CoreNodeId]
forall a b. (a -> b) -> a -> b
$ [SlotNo] -> [[CoreNodeId]] -> [(SlotNo, [CoreNodeId])]
forall a b. [a] -> [b] -> [(a, b)]
zip [SlotNo
0..] [[CoreNodeId]]
leaders
  where
    pick :: Int -> Gen [CoreNodeId]
    pick :: Int -> Gen [CoreNodeId]
pick = [CoreNodeId] -> Int -> Gen [CoreNodeId]
go (NumCoreNodes -> [CoreNodeId]
enumCoreNodes NumCoreNodes
numCoreNodes)
      where
        go :: [CoreNodeId] -> Int -> Gen [CoreNodeId]
        go :: [CoreNodeId] -> Int -> Gen [CoreNodeId]
go []   Int
_ = [CoreNodeId] -> Gen [CoreNodeId]
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        go [CoreNodeId]
_    Int
0 = [CoreNodeId] -> Gen [CoreNodeId]
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        go [CoreNodeId]
nids Int
n = do
            CoreNodeId
nid <- [CoreNodeId] -> Gen CoreNodeId
forall a. HasCallStack => [a] -> Gen a
elements [CoreNodeId]
nids
            [CoreNodeId]
xs  <- [CoreNodeId] -> Int -> Gen [CoreNodeId]
go ((CoreNodeId -> Bool) -> [CoreNodeId] -> [CoreNodeId]
forall a. (a -> Bool) -> [a] -> [a]
filter (CoreNodeId -> CoreNodeId -> Bool
forall a. Eq a => a -> a -> Bool
/= CoreNodeId
nid) [CoreNodeId]
nids) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
            [CoreNodeId] -> Gen [CoreNodeId]
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CoreNodeId] -> Gen [CoreNodeId])
-> [CoreNodeId] -> Gen [CoreNodeId]
forall a b. (a -> b) -> a -> b
$ CoreNodeId
nid CoreNodeId -> [CoreNodeId] -> [CoreNodeId]
forall a. a -> [a] -> [a]
: [CoreNodeId]
xs

_shrinkLeaderSchedule :: NumSlots -> LeaderSchedule -> [LeaderSchedule]
_shrinkLeaderSchedule :: NumSlots -> LeaderSchedule -> [LeaderSchedule]
_shrinkLeaderSchedule (NumSlots Word64
numSlots) (LeaderSchedule Map SlotNo [CoreNodeId]
m) =
    [ Map SlotNo [CoreNodeId] -> LeaderSchedule
LeaderSchedule Map SlotNo [CoreNodeId]
m'
    | SlotNo
slot <- [SlotNo
0 .. Word64 -> SlotNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
numSlots SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
- SlotNo
1]
    , Map SlotNo [CoreNodeId]
m'   <- SlotNo -> Map SlotNo [CoreNodeId] -> [Map SlotNo [CoreNodeId]]
reduceSlot SlotNo
slot Map SlotNo [CoreNodeId]
m
    ]
  where
    reduceSlot :: SlotNo -> Map SlotNo [CoreNodeId] -> [Map SlotNo [CoreNodeId]]
    reduceSlot :: SlotNo -> Map SlotNo [CoreNodeId] -> [Map SlotNo [CoreNodeId]]
reduceSlot SlotNo
s Map SlotNo [CoreNodeId]
m' = [SlotNo
-> [CoreNodeId]
-> Map SlotNo [CoreNodeId]
-> Map SlotNo [CoreNodeId]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SlotNo
s [CoreNodeId]
xs Map SlotNo [CoreNodeId]
m' | [CoreNodeId]
xs <- [CoreNodeId] -> [[CoreNodeId]]
forall a. [a] -> [[a]]
reduceList ([CoreNodeId] -> [[CoreNodeId]]) -> [CoreNodeId] -> [[CoreNodeId]]
forall a b. (a -> b) -> a -> b
$ Map SlotNo [CoreNodeId]
m' Map SlotNo [CoreNodeId] -> SlotNo -> [CoreNodeId]
forall k a. Ord k => Map k a -> k -> a
Map.! SlotNo
s]

    reduceList :: [a] -> [[a]]
    reduceList :: forall a. [a] -> [[a]]
reduceList []       = []
    reduceList [a
_]      = []
    reduceList (a
x : [a]
xs) = [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [[a]]
forall a. [a] -> [[a]]
reduceList [a]
xs)