Skip to content
Permalink
Browse files

WIP debug

  • Loading branch information...
deepfire committed Jun 13, 2019
1 parent c79bbc4 commit d3fc00efcacd1a3cfc86e4b77819a5cc8625ec85
@@ -128,29 +128,6 @@ handleSimpleNode p CLI{..} (TopologyInfo myNodeId topologyFile) = do

withThreadRegistry $ \registry -> do

let callbacks :: NodeCallbacks IO (Block p)
callbacks = NodeCallbacks {
produceDRG = drgNew
, produceBlock = \proof els slot prevPoint prevBlockNo txs ussArgs -> do
let curNo :: BlockNo
curNo = succ prevBlockNo

prevHash :: ChainHash (Header p)
prevHash = castHash (pointHash prevPoint)

-- The transactions we get are consistent; the only reason not
-- to include all of them would be maximum block size, which
-- we ignore for now.
demoForgeBlock pInfoConfig
els
slot
curNo
prevHash
txs
ussArgs
proof
}

chainDB :: ChainDB IO (Block p) (Header p) <- ChainDB.openDB
(demoEncodePreHeader pInfoConfig) pInfoConfig pInfoInitLedger
demoGetHeader
@@ -167,6 +144,28 @@ handleSimpleNode p CLI{..} (TopologyInfo myNodeId topologyFile) = do
btime <- realBlockchainTime registry slotDuration systemStart
let tracer = contramap ((show myNodeId <> " | ") <>)
(Monitoring.toLogObject baseTracer)
callbacks :: NodeCallbacks IO (Block p)
callbacks = NodeCallbacks {
produceDRG = drgNew
, produceBlock = \proof els slot prevPoint prevBlockNo txs ussArgs -> do
let curNo :: BlockNo
curNo = succ prevBlockNo

prevHash :: ChainHash (Header p)
prevHash = castHash (pointHash prevPoint)

-- The transactions we get are consistent; the only reason not
-- to include all of them would be maximum block size, which
-- we ignore for now.
demoForgeBlock pInfoConfig
els
slot
curNo
prevHash
txs
ussArgs
proof
}
nodeParams = NodeParams
{ encoder = demoEncodePreHeader pInfoConfig
, tracer = tracer
@@ -164,6 +164,7 @@ library
typed-protocols,
io-sim-classes,
contra-tracer,
iohk-monitoring,

-- TODO: Ideally we'd refactor this so that this
-- only needs to live in the demo-playground
@@ -30,6 +30,7 @@ import Data.Coerce
import Data.Either (lefts, rights)
import Data.FingerTree (Measured (..))
import Data.Foldable (find)
import Data.Function ((&))
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
@@ -529,7 +530,7 @@ forgeByronDemoBlock
-> () -- ^ Leader proof (IsLeader)
-> m (ByronBlock ByronDemoConfig)
forgeByronDemoBlock cfg els curSlot curNo prevHash txs ussargs () = do
ouroborosPayload <- trace ("forging @ slot " <> show curSlot) $ mkPayload toCBOR cfg () preHeader
ouroborosPayload <- trace ("forging @ slot " <> show curSlot <> ", ussArgs: " <> show ussargs) $ mkPayload toCBOR cfg () preHeader
-- traceM $ "Forge block: " ++ show (forgeBlock ouroborosPayload)
-- processUSStimuli ussa

@@ -540,11 +541,13 @@ forgeByronDemoBlock cfg els curSlot curNo prevHash txs ussargs () = do
ByronLedgerState {..} = ledgerState els
CC.Block.ChainValidationState {..} = blsCurrent

usStimuli = promoteUSSArgs cvsUpdateState <$> ussargs
votes = lefts usStimuli
mProposal = case rights usStimuli of
[] -> Nothing
[p] -> Just p
usStimuliArgs = promoteUSSArgs cvsUpdateState <$> ussargs
votes = lefts usStimuliArgs &
if null votes then id
else trace $ "minting votes into a block: " <> show votes
mProposal = case trace "mProposal consideration" (rights usStimuliArgs) of
[] -> trace "No proposals this slot." Nothing
[p] -> trace ("minting proposal into a block: " <> show p) $ Just p
_ -> error "XXX: unhandled -- multiple pending proposals for block."

completeProposalBody :: CC.UPI.State -> USSArgs -> CC.Update.ProposalBody
@@ -586,7 +589,7 @@ forgeByronDemoBlock cfg els curSlot curNo prevHash txs ussargs () = do
CC.Block.bodyTxPayload = txPayload
, CC.Block.bodySscPayload = CC.Ssc.SscPayload
, CC.Block.bodyDlgPayload = Delegation.UnsafeAPayload [] ()
, CC.Block.bodyUpdatePayload = CC.Update.APayload mProposal votes ()
, CC.Block.bodyUpdatePayload = trace "bodyupdatepayload" $ CC.Update.APayload mProposal votes ()
}

proof :: CC.Block.Proof
@@ -44,6 +44,7 @@ import Codec.CBOR.Decoding (decodeListLenOf)
import Codec.CBOR.Encoding (encodeListLen)
import Codec.Serialise
import Control.Monad.Except
import Control.Tracer (Tracer)
import Crypto.Random (MonadRandom)
import qualified Data.ByteString.Lazy as BL
import Data.FingerTree (Measured (measure))
@@ -111,7 +111,7 @@ broadcastNetwork registry btime numCoreNodes pInfo initRNG numSlots = do
-- We ignore the transactions from the mempool (which will be
-- empty), and instead produce some random transactions
txs <- genTxs addrs (getUtxo l)
demoForgeBlock pInfoConfig
demoForgeBlock nullTracer pInfoConfig
slot
curNo
prevHash

0 comments on commit d3fc00e

Please sign in to comment.
You can’t perform that action at this time.