inner.hoon 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834
  1. /= dk /apps/dumbnet/lib/types
  2. /= sp /common/stark/prover
  3. /= c-transact /common/tx-engine
  4. /= dumb-miner /apps/dumbnet/lib/miner
  5. /= dumb-admin /apps/dumbnet/lib/admin
  6. /= dumb-pending /apps/dumbnet/lib/pending
  7. /= dumb-derived /apps/dumbnet/lib/derived
  8. /= dumb-consensus /apps/dumbnet/lib/consensus
  9. /= mine /common/pow
  10. /= nv /common/nock-verifier
  11. /= zeke /common/zeke
  12. /= * /common/zoon
  13. /= * /common/wrapper
  14. ::
  15. :: Never use c-transact face, always use the lustar `t`
  16. :: alias, otherwise the blockchain constants set in the kernel
  17. :: will not be active.
  18. ::
  19. |%
  20. ++ moat (keep kernel-state:dk)
  21. ++ inner
  22. |_ k=kernel-state:dk
  23. +* min ~(. dumb-miner m.k constants.k)
  24. adm ~(. dumb-admin a.k)
  25. pen ~(. dumb-pending p.k constants.k)
  26. der ~(. dumb-derived d.k constants.k)
  27. con ~(. dumb-consensus c.k constants.k)
  28. ver ~(. nv stark-config.a.k)
  29. t ~(. c-transact constants.k)
  30. ::
  31. :: We should be calling the inner kernel load in case of update
  32. ++ load
  33. |= arg=kernel-state:dk
  34. arg
  35. ::
  36. ::TODO make referentially transparent by requiring event number in the scry path
  37. ++ peek
  38. |= arg=*
  39. ^- (unit (unit *))
  40. =/ pax ((soft path) arg)
  41. ?~ pax ~|(invalid-peek+pax !!)
  42. =/ =(pole) u.pax
  43. ?+ pole ~|(invalid-peek+pax !!)
  44. ::
  45. [%blocks ~]
  46. ^- (unit (unit (z-map block-id:t page:t)))
  47. ``(~(run by blocks.c.k) to-page:local-page:t)
  48. ::
  49. [%transactions ~]
  50. ^- (unit (unit (z-mip block-id:t tx-id:t tx:t)))
  51. ``txs.c.k
  52. ::
  53. [%raw-transactions ~]
  54. ^- (unit (unit (z-map tx-id:t raw-tx:t)))
  55. ``raw-txs.p.k
  56. ::
  57. :: For %block, %transaction, %raw-transaction, and %balance scries, the ID is
  58. :: passed as a base58 encoded string in the scry path.
  59. [%block bid=@ ~]
  60. ^- (unit (unit page:t))
  61. :: scry for a validated block (this does not look at pending state)
  62. =/ block-id (from-b58:hash:t bid.pole)
  63. `(bind (~(get z-by blocks.c.k) block-id) to-page:local-page:t)
  64. ::
  65. [%elders bid=@ peer-id=@ ~]
  66. :: get ancestor block IDs up to 24 deep for a given block
  67. ^- (unit (unit [page-number:t (list block-id:t)]))
  68. =/ block-id (from-b58:hash:t bid.pole)
  69. =/ elders (get-elders:con d.k block-id)
  70. ?~ elders
  71. [~ ~]
  72. ``u.elders
  73. ::
  74. [%transaction tid=@ ~]
  75. :: scry for a tx that has been included in a validated block
  76. ^- (unit (unit (z-map tx-id:t tx:t)))
  77. :- ~
  78. %- ~(get z-by txs.c.k)
  79. (from-b58:hash:t tid.pole)
  80. ::
  81. [%raw-transaction tid=@ ~]
  82. :: scry for a raw-tx
  83. ^- (unit (unit raw-tx:t))
  84. :- ~
  85. %- ~(get z-by raw-txs.p.k)
  86. (from-b58:hash:t tid.pole)
  87. ::
  88. [%heavy ~]
  89. ^- (unit (unit (unit block-id:t)))
  90. ``heaviest-block.c.k
  91. ::
  92. [%heavy-n pag=@ ~]
  93. ^- (unit (unit page:t))
  94. =/ num=(unit page-number:t)
  95. ((soft page-number:t) pag.pole)
  96. ?~ num
  97. ~
  98. =/ id=(unit block-id:t)
  99. (~(get z-by heaviest-chain.d.k) u.num)
  100. ?~ id
  101. [~ ~]
  102. `(bind (~(get z-by blocks.c.k) u.id) to-page:local-page:t)
  103. ::
  104. [%desk-hash ~]
  105. ^- (unit (unit (unit @uvI)))
  106. ``desk-hash.a.k
  107. ::
  108. [%mining-pubkeys ~]
  109. ^- (unit (unit (list [m=@ pks=(list @t)])))
  110. =/ locks=(list [m=@ pks=(list @t)])
  111. %+ turn ~(tap z-in pubkeys.m.k)
  112. |=(=lock:t (to-b58:lock:t lock))
  113. ``locks
  114. ::
  115. [%balance bid=@ ~]
  116. ^- (unit (unit (z-map nname:t nnote:t)))
  117. :- ~
  118. %- ~(get z-by balance.c.k)
  119. (from-b58:hash:t bid.pole)
  120. ::
  121. [%heaviest-block ~]
  122. ^- (unit (unit page:t))
  123. ?~ heaviest-block.c.k
  124. [~ ~]
  125. =/ heaviest-block (~(get z-by blocks.c.k) u.heaviest-block.c.k)
  126. ?~ heaviest-block ~
  127. ``(to-page:local-page:t u.heaviest-block)
  128. ::
  129. [%heavy-summary ~]
  130. ^- (unit (unit [(z-set lock:t) (unit page-summary:t)]))
  131. ?~ heaviest-block.c.k
  132. ``[pubkeys.m.k ~]
  133. =/ heaviest-block (~(get z-by blocks.c.k) u.heaviest-block.c.k)
  134. :+ ~ ~
  135. :- pubkeys.m.k
  136. ?~ heaviest-block
  137. ~
  138. `(to-page-summary:page:t (to-page:local-page:t u.heaviest-block))
  139. ==
  140. ::
  141. ++ poke
  142. |= [wir=wire eny=@ our=@ux now=@da dat=*]
  143. ^- [(list effect:dk) kernel-state:dk]
  144. |^
  145. =/ cause ((soft cause:dk) dat)
  146. ?~ cause
  147. ~> %slog.[0 [%leaf "error: badly formatted cause, should never occur"]]
  148. ~& ;;(@t -.dat)
  149. ~& ;;(@t -.+.dat)
  150. `k
  151. =/ cause u.cause
  152. ~& "inner dumbnet cause: {<[-.cause -.+.cause]>}"
  153. =^ effs k
  154. ?+ wir ~|("unsupported wire: {<wir>}" !!)
  155. [%poke src=?(%nc %timer %sys %miner %npc) ver=@ *]
  156. ?- -.cause
  157. %command (handle-command now p.cause)
  158. %fact (handle-fact wir eny our now p.cause)
  159. ==
  160. ::
  161. [%poke %libp2p ver=@ typ=?(%gossip %response) %peer-id =peer-id:dk *]
  162. ?> ?=(%fact -.cause)
  163. (handle-fact wir eny our now p.cause)
  164. ==
  165. :: possibly update timestamp on candidate block for mining
  166. =. m.k (update-timestamp:min now)
  167. effs^k
  168. ::
  169. :: +heard-genesis-block: check if block is a genesis block and decide whether to keep it
  170. ++ heard-genesis-block
  171. |= [wir=wire now=@da pag=page:t]
  172. ^- [(list effect:dk) kernel-state:dk]
  173. ?: (check-duplicate-block digest.pag)
  174. :: do nothing (idempotency), we already have block
  175. `k
  176. ::
  177. ?~ btc-data.c.k
  178. ~> %slog.[0 leaf+"btc-data not set, crashing"]
  179. !!
  180. ?. (genesis-test:page:t pag genesis-target:t u.btc-data.c.k genesis-seal.c.k)
  181. :: is not a genesis block, throw it out and inform the king. note this
  182. :: must be a %liar effect since genesis blocks have no powork and are
  183. :: thus cheap to make, so we cannot trust their block-id.
  184. [[(liar-effect wir %not-a-genesis-block)]~ k]
  185. :: heard valid genesis block
  186. ~> %slog.[0 leaf+"heard valid genesis block!"]
  187. (new-block now pag *tx-acc:t)
  188. ::
  189. ++ heard-block
  190. |= [wir=wire now=@da pag=page:t eny=@]
  191. ^- [(list effect:dk) kernel-state:dk]
  192. ?: =(*page-number:t height.pag)
  193. :: heard genesis block
  194. ~> %slog.[0 leaf+"heard genesis block"]
  195. (heard-genesis-block wir now pag)
  196. ?~ heaviest-block.c.k
  197. =/ peer-id=(unit @) (get-peer-id wir)
  198. ?~ peer-id
  199. :: received block before genesis from source other than libp2p
  200. `k
  201. ~> %slog.[0 [%leaf "no genesis block yet, requesting elders"]]
  202. :_ k
  203. [%request %block %elders digest.pag u.peer-id]~
  204. :: if we don't have parent and block claims to be heaviest
  205. :: request ancestors to catch up or handle reorg
  206. ?. (~(has z-by blocks.c.k) parent.pag)
  207. ?: %+ compare-heaviness:page:t pag
  208. (~(got z-by blocks.c.k) u.heaviest-block.c.k)
  209. =/ peer-id=(unit @) (get-peer-id wir)
  210. ?~ peer-id
  211. ~|("unsupported wire: {<wir>}" !!)
  212. =/ print-var
  213. %- trip
  214. ^- @t
  215. %^ cat 3
  216. 'potential reorg: requesting elders for heavier block: '
  217. (to-b58:hash:t digest.pag)
  218. ~> %slog.[0 [%leaf print-var]]
  219. :_ k
  220. [%request %block %elders digest.pag u.peer-id]~
  221. :: received block, don't have parent, isn't heaviest, ignore.
  222. `k
  223. :: yes, we have its parent
  224. ::
  225. :: do we already have this block?
  226. ?: (check-duplicate-block digest.pag)
  227. :: do nothing (idempotency), we already have block
  228. `k
  229. ::
  230. :: check to see if the .digest is valid. if it is not, we
  231. :: emit a %liar-peer. if it is, then any further %liar effects
  232. :: should be %liar-block-id. this tells the runtime that
  233. :: anybody who sends us this block id is a liar
  234. ?. (check-digest:page:t pag)
  235. ~> %slog.[0 leaf+"digest is not valid"]
  236. :_ k
  237. [(liar-effect wir %page-digest-invalid)]~
  238. ::
  239. :: since we know the digest is valid, we want to tell the runtime
  240. :: to start tracking that block-id.
  241. =/ block-effs=(list effect:dk)
  242. =/ =(pole) wir
  243. ?. ?=([%poke %libp2p ver=@ typ=?(%gossip %response) %peer-id =peer-id:dk *] pole)
  244. ~
  245. [%track %add digest.pag peer-id.pole]~
  246. ::
  247. :: %liar-block-id only says that anybody who sends us this
  248. :: block-id is a liar, but it doesn't (and can't) include the
  249. :: peer id. so it gets cross-referenced with the blocks being
  250. :: tracked to know who to ban.
  251. ::
  252. :: the crash case is when we get a bad block from the npc driver or
  253. :: from the kernel itself.
  254. =/ check-page-without-txs=(reason:dk ~)
  255. (validate-page-without-txs-da:con pag now)
  256. ?: ?=(%.n -.check-page-without-txs)
  257. :: block has bad data
  258. :_ k
  259. :: the order here matters since we want to add the block to tracking
  260. :: and then ban the peer who sent it. we do this instead of %liar-peer
  261. :: since its possible for another poke to be processed after %track %add
  262. :: but before %liar-block-id, so more peers may be added to tracking
  263. :: before %liar-block-id is processed.
  264. %+ snoc block-effs
  265. [%liar-block-id digest.pag +.check-page-without-txs]
  266. ::
  267. =/ pow-check=(reason:dk ~) (check-pow pag)
  268. ?: ?=(%.n -.pow-check)
  269. :_ k
  270. %+ snoc block-effs
  271. [%liar-block-id digest.pag +.pow-check]
  272. ::
  273. :: tell driver we have seen this block so don't send it back to the kernel again
  274. =. block-effs
  275. [[%seen %block digest.pag] block-effs]
  276. :: stop tracking block id as soon as we verify pow
  277. =. block-effs
  278. %+ snoc block-effs
  279. ^- effect:dk
  280. [%track %remove digest.pag]
  281. =^ missing-txs=(list tx-id:t) p.k
  282. (add-pending-block:pen pag)
  283. ?: !=(missing-txs *(list tx-id:t))
  284. ~> %slog.[0 leaf+"missing txs"]
  285. :: block has missing txs
  286. =. block-effs
  287. %+ weld block-effs
  288. %+ turn missing-txs
  289. |= =tx-id:t
  290. ^- effect:dk
  291. [%request %raw-tx %by-id tx-id]
  292. :_ k
  293. ?: %+ compare-heaviness:page:t pag
  294. (~(got z-by blocks.c.k) (need heaviest-block.c.k))
  295. ~> %slog.[0 %leaf^"gossip new heaviest block, have not validated txs yet"]
  296. :- [%gossip %heard-block pag]
  297. block-effs
  298. block-effs
  299. ::
  300. :: block has no missing transactions, so we check that its transactions
  301. :: are valid
  302. (process-block-with-txs now pag block-effs)
  303. ::
  304. :: +heard-elders: handle response to parent hashes request
  305. ++ heard-elders
  306. |= [wir=wire now=@da oldest=page-number:t ids=(list block-id:t)]
  307. ^- [(list effect:dk) kernel-state:dk]
  308. :: extract peer ID from wire
  309. =/ peer-id=(unit @) (get-peer-id wir)
  310. ?~ peer-id
  311. ~|("unsupported wire: {<wir>}" !!)
  312. =/ ids-lent (lent ids)
  313. ?: (gth ids-lent 24)
  314. :_ k
  315. [[%liar-peer u.peer-id %more-than-24-parent-hashes]~]
  316. ?. ?| =(oldest *page-number:t)
  317. =(ids-lent 24)
  318. ==
  319. ~> %slog.[0 %leaf^"bad elders: either oldest should be genesis or need 24 elders"]
  320. :: either oldest is genesis OR we must have received exactly 24 ids
  321. :_ k
  322. [[%liar-peer u.peer-id %less-than-24-parent-hashes]~]
  323. :: find highest block we have in the ancestor list
  324. =/ latest-known=(unit [=block-id:t =page-number:t])
  325. =/ height (dec (add oldest ids-lent))
  326. |-
  327. ?~ ids ~
  328. ?: =(height 0) ~
  329. ?: (~(has z-by blocks.c.k) i.ids)
  330. `[i.ids height]
  331. $(ids t.ids, height (dec height))
  332. ?~ latest-known
  333. ?: =(oldest *page-number:t)
  334. ?: =(~ heaviest-block.c.k)
  335. :: request genesis block because we don't have it yet
  336. :_ k
  337. [%request %block %by-height *page-number:t]~
  338. :: if we have differing genesis blocks, liar
  339. ~> %slog.[0 %leaf^"bad elders: differing genesis blocks"]
  340. :_ k
  341. [[%liar-peer u.peer-id %differing-genesis]~]
  342. :: request elders of oldest ancestor to catch up faster
  343. :: hashes are ordered newest>oldest
  344. =/ print-var
  345. "processed elders and asking for oldest: requesting elders"
  346. ~> %slog.[0 %leaf^print-var]
  347. :_ k
  348. [%request %block %elders (rear ids) u.peer-id]~
  349. =/ print-var
  350. %- trip
  351. %^ cat 3
  352. 'processed elders and found intersection: requesting next block '
  353. (scot %ud +(page-number.u.latest-known))
  354. ~> %slog.[0 %leaf^print-var]
  355. :: request next block after our highest known block
  356. :: this will trigger either catchup or reorg from this point
  357. :_ k
  358. [%request %block %by-height +(page-number.u.latest-known)]~
  359. ::
  360. ++ check-pow
  361. |= pag=page:t
  362. ^- (reason:dk ~)
  363. ?. check-pow-flag:t
  364. :: this case only happens during testing
  365. [%.y ~]
  366. ?~ pow.pag
  367. [%.n %pow-empty]
  368. ::
  369. :: validate that powork puzzle in the proof is correct.
  370. =/ check-pow-puzzle (check-pow-puzzle u.pow.pag pag)
  371. ?. -.check-pow-puzzle
  372. check-pow-puzzle
  373. ::
  374. :: validate the powork. this is done separately since the
  375. :: other checks are much cheaper.
  376. =/ pow-res=? (verify:ver u.pow.pag ~ eny)
  377. ?. pow-res
  378. [%.n %pow-failed-to-verify]
  379. [%.y ~]
  380. ::
  381. ++ check-duplicate-block
  382. |= digest=block-id:t
  383. ?| (~(has z-by blocks.c.k) digest)
  384. (~(has z-by pending-blocks.p.k) digest)
  385. ==
  386. ::
  387. ++ check-pow-puzzle
  388. |= [pow=proof:sp pag=page:t]
  389. ^- (reason:dk ~)
  390. ?: =((lent objects.pow) 0)
  391. [%.n %pow-objects-empty]
  392. =/ puzzle (snag 0 objects.pow)
  393. ?. ?=(%puzzle -.puzzle)
  394. [%.n %pow-puzzle-missing]
  395. ?. =((block-commitment:page:t pag) commitment.puzzle)
  396. [%.n %pow-commitment-invalid]
  397. ?. =(pow-len:t len.puzzle)
  398. [%.n %pow-length-invalid]
  399. [%.y ~]
  400. ::
  401. ++ heard-tx
  402. |= [wir=wire now=@da raw=raw-tx:t]
  403. ^- [(list effect:dk) kernel-state:dk]
  404. =/ id-b58 (to-b58:hash:t id.raw)
  405. ::
  406. :: check tx-id. this is the fastest check to do, so we try it first before
  407. :: calling validate:raw-tx (which also checks the id)
  408. ?. =((compute-id:raw-tx:t raw) id.raw)
  409. :_ k
  410. [(liar-effect wir %tx-id-invalid)]~
  411. ::
  412. :: do we already have raw-tx?
  413. ?: (~(has z-by raw-txs.p.k) id.raw)
  414. :: do nothing (idempotency), we already have it
  415. `k
  416. ::
  417. :: check if raw-tx is part of a pending block
  418. ::
  419. =/ tx-pending-blocks=(list block-id:t)
  420. ~(tap z-in (~(get z-ju tx-block.p.k) id.raw))
  421. ?: !=(*(list block-id:t) tx-pending-blocks)
  422. :: pending blocks are waiting on tx
  423. ?. (validate:raw-tx:t raw)
  424. :: raw-tx doesn't validate.
  425. :: remove blocks containing bad tx from pending state. note that since
  426. :: we already checked that the id of the transaction was valid, we
  427. :: won't accidentally throw out a block that contained a valid tx-id
  428. :: just because we received a tx that claimed the same id as the valid
  429. :: one.
  430. =. p.k
  431. %+ roll tx-pending-blocks
  432. |= [id=block-id:t pend=_p.k]
  433. (remove-pending-block:pen id)
  434. ::
  435. :_ k
  436. [(liar-effect wir %page-pending-raw-tx-invalid) ~]
  437. :: add to raw-txs map, remove from tx-block jug, remove from
  438. :: block-tx jug
  439. =. p.k (add-tx-in-pending-block:pen raw)
  440. (process-ready-blocks now raw)
  441. :: no pending blocks waiting on tx
  442. ::
  443. :: check if any inputs are absent in heaviest balance
  444. ?. (inputs-in-heaviest-balance:con raw)
  445. :: input(s) in tx not in balance, discard tx
  446. `k
  447. :: all inputs in balance
  448. ::
  449. :: check if any inputs are in spent-by
  450. ?: (inputs-in-spent-by:pen raw)
  451. :: inputs present in spent-by, discard tx
  452. `k
  453. :: inputs not present in spent-by
  454. ?. (validate:raw-tx:t raw)
  455. :: raw-tx doesn't validate.
  456. :_ k
  457. [(liar-effect wir %tx-inputs-not-in-spent-by-and-invalid)]~
  458. ::
  459. =. p.k
  460. (add-tx-not-in-pending-block:pen raw get-cur-height:con)
  461. ::
  462. :: next we would process blocks made ready by tx but we already
  463. :: determined that no pending blocks were waiting on this this,
  464. :: so we just tell the miner.
  465. =. m.k (heard-new-tx:min raw)
  466. :- ~[[%seen %tx id.raw]]
  467. k
  468. ::
  469. :: +process-ready-blocks: process blocks no longer waitings on txs
  470. ++ process-ready-blocks
  471. |= [now=@da raw=raw-tx:t]
  472. ^- [(list effect:dk) kernel-state:dk]
  473. :: .work contains block-ids for blocks that no longer have any
  474. :: missing transactions
  475. =/ work=(z-set block-id:t) find-ready-blocks:pen
  476. =^ eff k
  477. %+ roll ~(tap z-in work)
  478. |= [bid=block-id:t effs=(list effect:dk) k=_k]
  479. :: process the block, skipping the steps that we know its already
  480. :: done by the fact that it was in pending-blocks.p.k
  481. =^ new-effs k
  482. %^ process-block-with-txs now
  483. (to-page:local-page:t (~(got z-by pending-blocks.p.k) bid))
  484. :: if the block is bad, then tell the driver never to send it
  485. :: to us again
  486. ~[[%seen %block bid]]
  487. :: remove the block from pending blocks. at this point, its either
  488. :: been discarded by the kernel or lives in the consensus state
  489. =. p.k (remove-pending-block:pen bid)
  490. :: add the effects onto the list and return the updated kernel state
  491. [(weld new-effs effs) k]
  492. ::
  493. :: tell the miner about the new transaction. this might look strange
  494. :: informing it here, potentially after new blocks have been made ready
  495. :: by it, but this tx may be part of a reorg, so the processed blocks
  496. :: might not be the heaviest.
  497. =. m.k (heard-new-tx:min raw)
  498. ::
  499. eff^k
  500. ::
  501. ::
  502. ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  503. :: the remaining arms are used by both %heard-tx and %heard-block
  504. ::
  505. :: +process-block-with-txs: process a block that we have all txs for
  506. ::
  507. :: this is called along the codepath for both %heard-block and +heard-tx,
  508. :: since once we hear the last transaction we're waiting for in a given
  509. :: block, we immediately try to validate it. the genesis block does _not_
  510. :: go through here.
  511. ::
  512. :: bad-block-effs are effects which are passed through and emitted
  513. :: only if the block is bad. If the block is good then ++new-block
  514. :: emits effects and bad-block-effs is ignored.
  515. ++ process-block-with-txs
  516. |= [now=@da pag=page:t bad-block-effs=(list effect:dk)]
  517. ^- [(list effect:dk) kernel-state:dk]
  518. =/ digest-b58 (to-b58:hash:t digest.pag)
  519. ::
  520. :: if we do have all raw-txs, check if pag validates
  521. :: (i.e. transactions are valid and size isnt too big)
  522. =/ new-transfers=(reason:dk tx-acc:t)
  523. (validate-page-with-txs:con p.k pag)
  524. ?- -.new-transfers
  525. %.y
  526. (new-block now pag +.new-transfers)
  527. ::
  528. %.n
  529. :: did not validate, so we throw the block out and stop
  530. :: tracking it
  531. [bad-block-effs k]
  532. ==
  533. ::
  534. :: +new-block: update kernel state with new valid block.
  535. ++ new-block
  536. |= [now=@da pag=page:t acc=tx-acc:t]
  537. ^- [(list effect:dk) kernel-state:dk]
  538. ::
  539. :: page is validated, update consensus and derived state
  540. =. c.k (add-page:con pag acc now)
  541. =/ print-var
  542. %- trip
  543. ^- @t
  544. %+ rap 3
  545. :~ 'block ' (to-b58:hash:t digest.pag)
  546. ' added to validated blocks at ' (scot %u height.pag)
  547. ==
  548. ~> %slog.[0 %leaf^print-var]
  549. ::
  550. =/ effs=(list effect:dk)
  551. :: request block N+1 on each peer's heaviest chain
  552. :+ [%request %block %by-height +(height.pag)]
  553. :: tell driver we've seen this block so don't process it again
  554. [%seen %block digest.pag]
  555. ~
  556. ::
  557. =/ old-heavy heaviest-block.c.k
  558. =. c.k (update-heaviest:con pag)
  559. :: if block is the new heaviest block, gossip it to peers
  560. =? effs !=(old-heavy heaviest-block.c.k)
  561. ~> %slog.[0 %leaf^"new heaviest block!"]
  562. =/ span=span-effect:dk
  563. :+ %span %new-heaviest-chain
  564. ~['block_height'^n+height.pag 'heaviest_block_digest'^s+(to-b58:hash:t digest.pag)]
  565. :* [%gossip %heard-block pag]
  566. span
  567. effs
  568. ==
  569. :: refresh pending state
  570. =. p.k (refresh-after-new-block:pen c.k retain.a.k)
  571. ::
  572. :: tell the miner about the new block
  573. =. m.k (heard-new-block:min c.k p.k now)
  574. ::
  575. :: update derived state
  576. =. d.k (update:der c.k pag)
  577. ::
  578. effs^k
  579. ::
  580. :: +liar-effect: produce the appropriate liar effect
  581. ::
  582. :: this only produces the `%liar-peer` effect. the other possibilities
  583. :: are receiving a bad block or tx via the npc driver or from within
  584. :: the miner module or +do-genesis. in this case we just emit a
  585. :: warning and crash, since that means there's a bug.
  586. ++ liar-effect
  587. |= [wir=wire r=term]
  588. ^- effect:dk
  589. ?+ wir ~|("bad wire for liar effect! {<wir>}" !!)
  590. [%poke %libp2p ver=@ typ=?(%gossip %response) %peer-id id=@ *]
  591. [%liar-peer (need (get-peer-id wir)) r]
  592. ::
  593. [%poke %npc ver=@ *]
  594. ~| 'ATTN: received a bad block or tx via npc driver'
  595. !!
  596. ::
  597. [%poke %miner *]
  598. :: this indicates that the mining module built a bad block and then
  599. :: told the kernel about it. alternatively, +do-genesis produced
  600. :: a bad genesis block. this should never happen, it indicates
  601. :: a serious bug otherwise.
  602. ~| 'ATTN: miner or +do-genesis produced a bad block!'
  603. !!
  604. ==
  605. ::
  606. ++ get-peer-id
  607. |= wir=wire
  608. ^- (unit @)
  609. =/ =(pole) wir
  610. ?. ?=([%poke %libp2p ver=@ typ=?(%gossip %response) %peer-id id=@ *] pole)
  611. ~
  612. (some id.pole)
  613. ::
  614. ++ handle-command
  615. |= [now=@da =command:dk]
  616. ^- [(list effect:dk) kernel-state:dk]
  617. :: ~& "handling command: {<-.command>}"
  618. ?: &(?=(init-command:dk -.command) !init.a.k)
  619. :: kernel no longer in init phase, can't do command
  620. ~> %slog.[0 leaf+"kernel no longer in init phase, can't do init command"]
  621. `k
  622. ?: &(?=(non-init-command:dk -.command) init.a.k)
  623. :: kernel in init phase, can't perform command
  624. ~> %slog.[0 leaf+"kernel is in init phase, can't do non-init command"]
  625. `k
  626. |^
  627. ?- -.command
  628. %born
  629. do-born
  630. ::
  631. %mine
  632. do-mine
  633. ::
  634. %set-mining-key
  635. do-set-mining-key
  636. ::
  637. %set-mining-key-advanced
  638. do-set-mining-key-advanced
  639. ::
  640. %enable-mining
  641. do-enable-mining
  642. ::
  643. %timer
  644. do-timer
  645. ::
  646. %set-genesis-seal
  647. =. c.k (set-genesis-seal:con p.command)
  648. `k
  649. ::
  650. %genesis
  651. do-genesis
  652. ::
  653. %btc-data
  654. do-btc-data
  655. ::
  656. %init-stark-config
  657. `k(a produce-stark-config:adm)
  658. ::
  659. %set-constants
  660. `k(constants p.command)
  661. ==
  662. ::
  663. ++ do-born
  664. ^- [(list effect:dk) kernel-state:dk]
  665. ?> ?=([%born *] command)
  666. :: once born command is registered, the init phase is over
  667. :: note state update won't be registered unless poke is successful.
  668. =. k k(init.a %.n)
  669. :: do we have any blocks?
  670. ?~ heaviest-block.c.k
  671. :: no, request genesis block
  672. ?~ btc-data.c.k
  673. ~> %slog.[0 leaf+"No genesis parent btc block hash set, crashing"]
  674. !!
  675. :: requesting any genesis block, keeping first one we see.
  676. :: we do not request blocks by id so we can only request height 0
  677. :: blocks and throw out ones we aren't expecting
  678. ~> %slog.[0 leaf+"Requesting genesis block"]
  679. :_ k
  680. [%request %block %by-height *page-number:t]~
  681. :: yes, so get height N of heaviest block and request the block
  682. :: of height N+1
  683. =/ height=page-number:t
  684. +(height:(~(got z-by blocks.c.k) u.heaviest-block.c.k))
  685. ~> %slog.[0 leaf+"dumbnet born"]
  686. :_ k
  687. [%request %block %by-height height]~
  688. ::
  689. ++ do-mine
  690. ^- [(list effect:dk) kernel-state:dk]
  691. ?> ?=([%mine *] command)
  692. ?: =(*(z-set lock:t) pubkeys.m.k)
  693. ::~& "cannot mine without first setting pubkey with %set-mining-key"
  694. `k
  695. ?. mining.m.k
  696. `k
  697. =/ commit=block-commitment:t
  698. (block-commitment:page:t candidate-block.m.k)
  699. =. a.k produce-stark-config:adm
  700. =/ [prf=proof:sp dig=tip5-hash-atom:zeke]
  701. (prove-block:mine commit p.command stark-config.a.k)
  702. ?: %+ check-target:mine dig
  703. (~(got z-by targets.c.k) parent.candidate-block.m.k)
  704. =. m.k (set-pow:min prf)
  705. =. m.k set-digest:min
  706. ::
  707. (heard-block /poke/miner now candidate-block.m.k eny)
  708. `k
  709. ::
  710. ++ do-set-mining-key
  711. ^- [(list effect:dk) kernel-state:dk]
  712. ?> ?=([%set-mining-key *] command)
  713. =/ pk=schnorr-pubkey:t (from-b58:schnorr-pubkey:t p.command)
  714. =/ =lock:t (new:lock:t pk)
  715. =. m.k (set-pubkeys:min [lock]~)
  716. =. m.k (set-shares:min [lock 100]~)
  717. :: ~& > "pubkeys.m set to {<pubkeys.m.k>}"
  718. :: ~& > "shares.m set to {<shares.m.k>}"
  719. `k
  720. ::
  721. ++ do-set-mining-key-advanced
  722. ^- [(list effect:dk) kernel-state:dk]
  723. ?> ?=([%set-mining-key-advanced *] command)
  724. ?: (gth (lent p.command) 2)
  725. ~> %slog.[0 [%leaf "coinbase split for more than two locks not yet supported, doing nothing"]]
  726. `k
  727. ?~ p.command
  728. ~> %slog.[0 [%leaf "empty list of locks, doing nothing."]]
  729. `k
  730. ::
  731. =/ keys=(list lock:t)
  732. %+ turn p.command
  733. |= [s=@ m=@ ks=(list @t)]
  734. (from-b58:lock:t m ks)
  735. =/ shares=(list [lock:t @])
  736. %+ turn p.command
  737. |= [s=@ m=@ ks=(list @t)]
  738. [(from-b58:lock:t m ks) s]
  739. =. m.k (set-pubkeys:min keys)
  740. =. m.k (set-shares:min shares)
  741. :: ~& > "pubkeys.m set to {<pubkeys.m.k>}"
  742. :: ~& > "shares.m set to {<shares.m.k>}"
  743. `k
  744. ::
  745. ++ do-enable-mining
  746. ^- [(list effect:dk) kernel-state:dk]
  747. ?> ?=([%enable-mining *] command)
  748. ?. p.command
  749. ::~& > 'generation of candidate blocks disabled'
  750. =. m.k (set-mining:min p.command)
  751. `k
  752. ?: =(*(z-set lock:t) pubkeys.m.k)
  753. :: ~& >
  754. :: """
  755. :: generation of candidate blocks has not been enabled because mining pubkey
  756. :: is empty. set it with %set-mining-key then run %enable-mining again
  757. :: """
  758. `k
  759. ?: =(~ heaviest-block.c.k)
  760. ::~& >
  761. :: """
  762. :: generation of candidate blocks enabled. candidate block will be generated
  763. :: once a genesis block has been received.
  764. :: """
  765. =. m.k (set-mining:min p.command)
  766. `k
  767. ::~& > 'generation of candidate blocks enabled.'
  768. =. m.k (set-mining:min p.command)
  769. =. m.k (heard-new-block:min c.k p.k now)
  770. `k
  771. ::
  772. ++ do-timer
  773. ::TODO post-dumbnet: only rerequest transactions a max of once/twice (maybe an admin param)
  774. ^- [(list effect:dk) kernel-state:dk]
  775. ?> ?=([%timer *] command)
  776. ?: init.a.k
  777. :: kernel in init phase, command ignored
  778. `k
  779. =/ tx-req-effs=(list effect:dk)
  780. %+ turn ~(tap z-by find-pending-tx-ids:pen)
  781. |= =tx-id:t
  782. ^- effect:dk
  783. [%request %raw-tx %by-id tx-id]
  784. ::
  785. :: we always request the next heaviest block with each %timer event
  786. =/ heavy-height=page-number:t
  787. ?~ heaviest-block.c.k
  788. *page-number:t :: rerequest genesis block
  789. +(height:(~(got z-by blocks.c.k) u.heaviest-block.c.k))
  790. =/ effs=(list effect:dk)
  791. :- [%request %block %by-height heavy-height]
  792. tx-req-effs
  793. effs^k
  794. ::
  795. ++ do-genesis
  796. :: generates and emits a genesis block
  797. ^- [(list effect:dk) kernel-state:dk]
  798. ?> ?=([%genesis *] command)
  799. :: creating genesis block with template
  800. ~> %slog.[0 leaf+"create genesis block with template"]
  801. =/ =genesis-template:t
  802. (new:genesis-template:t p.command)
  803. =/ genesis-page=page:t
  804. (new-genesis:page:t genesis-template now)
  805. =. c.k (add-btc-data:con btc-hash.p.command)
  806. (heard-block /poke/miner now genesis-page eny)
  807. ::
  808. ++ do-btc-data
  809. ^- [(list effect:dk) kernel-state:dk]
  810. ?> ?=([%btc-data *] command)
  811. =. c.k (add-btc-data:con p.command)
  812. ~> %slog.[0 leaf+"received btc block hash, waiting to hear nockchain genesis block!"]
  813. `k
  814. --::+handle-command
  815. ::
  816. ++ handle-fact
  817. |= [wir=wire eny=@ our=@ux now=@da =fact:dk]
  818. ^- [(list effect:dk) kernel-state:dk]
  819. ?: init.a.k
  820. :: kernel in init phase, fact ignored
  821. `k
  822. ?- -.fact
  823. %heard-block
  824. (heard-block wir now p.fact eny)
  825. ::
  826. %heard-tx
  827. (heard-tx wir now p.fact)
  828. ::
  829. %heard-elders
  830. (heard-elders wir now p.fact)
  831. ==
  832. --:: +poke
  833. --:: +kernel
  834. --