Forge a block once every 20 seconds, no matter what
That way, we try to get closer to an actual block production pattern.
That way, we try to get closer to an actual block production pattern.
blockTime = 20 -- seconds
simulateTicks queue = forever $ do
threadDelay blockTime
transactions <- flushQueue queue []
let block = mkBlock transactions
allHandlers <- fmap chainHandler <$> readTVarIO nodes
forM_ allHandlers (`onRollForward` block)
flushQueue queue transactions = do
hasTx <- atomically $ tryReadTQueue queue
case hasTx of
Just tx -> do
let block = mkBlock tx
allHandlers <- fmap chainHandler <$> readTVarIO nodes
forM_ allHandlers (`onRollForward` block)
Nothing -> pure ()
flushQueue queue (tx:transactions)
Nothing -> pure transactions
-- | Find Cardano vkey corresponding to our Hydra vkey using signing keys lookup.
-- This is a bit cumbersome and a tribute to the fact the `HydraNode` itself has no
csk <- getVerificationKey . signingKey . snd <$> find ((== me) . deriveParty . fst) seedKeys
pure (csk, filter (/= csk) $ map (getVerificationKey . signingKey . snd) seedKeys)
mkBlock :: Ledger.ValidatedTx LedgerEra -> Util.Block
mkBlock ledgerTx =
mkBlock :: [Ledger.ValidatedTx LedgerEra] -> Util.Block
mkBlock transactions =
let header = (arbitrary :: Gen (Praos.Header StandardCrypto)) `generateWith` 42
body = TxSeq . StrictSeq.fromList $ [ledgerTx]
body = TxSeq . StrictSeq.fromList $ transactions
in BlockBabbage $ mkShelleyBlock $ Ledger.Block header body
-- TODO: unify with BehaviorSpec's ?