inner.hoon 33 KB

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