File: last-anchor-voters-def-and-init-and-next.lisp

package info (click to toggle)
acl2 8.6%2Bdfsg-2
  • links: PTS
  • area: main
  • in suites: trixie
  • size: 1,111,420 kB
  • sloc: lisp: 17,818,294; java: 125,359; python: 28,122; javascript: 23,458; cpp: 18,851; ansic: 11,569; perl: 7,678; xml: 5,591; sh: 3,976; makefile: 3,833; ruby: 2,633; yacc: 1,126; ml: 763; awk: 295; csh: 233; lex: 197; php: 178; tcl: 49; asm: 23; haskell: 17
file content (440 lines) | stat: -rw-r--r-- 19,221 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
; AleoBFT Library
;
; Copyright (C) 2024 Provable Inc.
;
; License: See the LICENSE file distributed with this library.
;
; Authors: Alessandro Coglio (www.alessandrocoglio.info)
;          Eric McCarthy (bendyarm on GitHub)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package "ALEOBFT-STAKE2")

(include-book "last-anchor-next")

(local (include-book "arithmetic-3/top" :dir :system))

(local (include-book "kestrel/built-ins/disable" :dir :system))
(local (acl2::disable-most-builtin-logic-defuns))
(local (acl2::disable-builtin-rewrite-rules-for-defaults))
(set-induction-depth-limit 0)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defxdoc+ last-anchor-voters-def-and-init-and-next
  :parents (correctness)
  :short "Invariant that the last committed anchor
          has at least a certain stake of successors:
          definition, establishment, and preservation."
  :long
  (xdoc::topstring
   (xdoc::p
    "When the last committed round is not 0,
     there is always an anchor at that round:
     see @(see last-anchor-present).
     Furthermore, that anchor always has successors
     whose total stake is more than @($f$),
     where @($f$) is introduced in @(tsee max-faulty-for-total).
     This total stake provodes the votes
     that are in fact necessary to commit that anchor.")
   (xdoc::p
    "Initially the last committed round is 0,
     so the invariant holds trivially.
     The only kind of events that changes the last committed anchor
     is @('commit'), whose preconditions establish the invariant.
     The only kinds of events that may change the successors
     are @('create') and @('accept'),
     which may add certificates to the DAG:
     this certificate may or may not be a successor,
     but if it is, it can only increase the voting stake, never decrease it.")
   (xdoc::p
    "Here we define the invariant,
     we prove that it holds in all initial states,
     and we prove that it is preserved by all transitions.
     Elsewhere we prove that
     the invariant holds in every reachable state."))
  :order-subtopics t
  :default-parent t)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define validator-last-anchor-voters-p ((vstate validator-statep))
  :guard (and (or (equal (validator-state->last vstate) 0)
                  (last-anchor vstate))
              (dag-has-committees-p (validator-state->dag vstate)
                                    (validator-state->blockchain vstate))
              (dag-in-committees-p (validator-state->dag vstate)
                                   (validator-state->blockchain vstate)))
  :returns (yes/no booleanp)
  :short "Check if a validator state satisfies the invariant."
  :long
  (xdoc::topstring
   (xdoc::p
    "Either the last committed round is 0,
     or the committee at the next round can be calculated
     and the total stake of the successors of the last anchor
     is more than @($f$),
     where @($f$) is the maximum stake of faulty validators in the committee.")
   (xdoc::p
    "The fact that the last anchor is present is in the guard,
     but in @(tsee last-anchor-voters-p) it is established
     from the previously proved invariant @(tsee last-anchor-present-p).
     The guard also includes conditions ensuring
     that the validator can calculate committees at all rounds with certificates
     (and in particular the comittee at the round just after the last committed,
     if the anchor has any successors),
     and that the authors of all the certificates in a round
     are members of the committee at that round
     (and in particular the successors of the anchor, if any,
     are members of the committee at their round);
     these guard conditions are established, in @(tsee last-anchor-voters-p),
     via previously proved invariants used as guards there."))
  (b* (((validator-state vstate) vstate)
       ((when (equal vstate.last 0)) t)
       (commtt (active-committee-at-round (1+ vstate.last) vstate.blockchain)))
    (and commtt
         (> (committee-members-stake (certificate-set->author-set
                                      (successors (last-anchor vstate)
                                                  vstate.dag))
                                     commtt)
            (committee-max-faulty-stake commtt))))
  :guard-hints
  (("Goal"
    :use ((:instance successors-subset-of-next-round
                     (cert (last-anchor vstate))
                     (dag (validator-state->dag vstate)))
          (:instance set::subset-transitive
                     (x (certificate-set->author-set
                         (successors (last-anchor vstate)
                                     (validator-state->dag vstate))))
                     (y (certificate-set->author-set
                         (certs-with-round (1+ (validator-state->last vstate))
                                           (validator-state->dag vstate))))
                     (z (committee-members
                         (active-committee-at-round
                          (1+ (validator-state->last vstate))
                          (validator-state->blockchain vstate))))))
    :in-theory (e/d (last-anchor-in-dag
                     certificate-set->author-set-monotone
                     certificate->round-of-last-anchor
                     round-in-committee-when-dag-in-committees-p)
                    (successors-subset-of-next-round))))
  :hooks (:fix))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-sk last-anchor-voters-p ((systate system-statep))
  :guard (and (last-anchor-present-p systate)
              (signer-quorum-p systate))
  :returns (yes/no booleanp)
  :short "Definition of the invariant:
          for each correct validator,
          if the last committed round is not 0,
          the last committed anchor has at least @($f+1$) successors,
          where @($f$) is the maximum number of faulty validators
          in the committee active at
          the round just after the last committed one."
  (forall (val)
          (implies (set::in val (correct-addresses systate))
                   (validator-last-anchor-voters-p
                    (get-validator-state val systate))))
  :guard-hints
  (("Goal" :in-theory (enable last-anchor-present-p-necc
                              dag-has-committees-p-when-signer-quorum-p
                              dag-in-committees-p-when-signer-quorum-p)))
  ///
  (fty::deffixequiv-sk last-anchor-voters-p
    :args ((systate system-statep))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defruled last-anchor-voters-p-when-init
  :short "Establishment of the invariant:
          the invariant holds in any initial state."
  :long
  (xdoc::topstring
   (xdoc::p
    "The last committed round is initially 0, so the proof is trivial."))
  (implies (system-initp systate)
           (last-anchor-voters-p systate))
  :enable (last-anchor-voters-p
           validator-last-anchor-voters-p
           system-initp
           system-validators-initp-necc
           validator-init))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defsection last-anchor-voters-p-of-next
  :short "Preservation of the invariant:
          if the invariant holds in a system state,
          it also holds in the next system state."
  :long
  (xdoc::topstring
   (xdoc::p
    "A @('create') or @('accept') event
     does not modify the last committed anchor.
     It may add certificates to the DAG,
     which may be successors of the last committed anchor,
     but since @(tsee successors) is monotone,
     the inequality of more than @($f$) voting stake is preserved.")
   (xdoc::p
    "A @('commit') event changes the last committed anchor,
     but its preconditions include the fact that
     the new anchor has more than @($f$) voting stake.
     Since our invariant is phrased in terms of successors certificates,
     we need a lemma that relates the stake of successors
     to the voting stake returned by @(tsee leader-stake-votes);
     this needs non-equivocation because @(tsee leader-stake-votes)
     would count the stake of equivocal certificates multiple times,
     while @(tsee certificate-set->author-set) applied to @('successors-loop')
     counts the stake of each author only once.
     Since the event also extends the blockchain,
     as in other proofs we need to show that the extension of the blockchain
     does not modify the committee active at the round of the successors.")
   (xdoc::p
    "An @('advance') event does not change
     the last committed anchor or the DAG,
     and thus the successors of the anchor."))

  ;; create:

  (defruled validator-last-anchor-voters-p-of-create-next
    (implies (and (system-committees-fault-tolerant-p systate)
                  (no-self-endorsed-p systate)
                  (signer-records-p systate)
                  (signer-quorum-p systate)
                  (unequivocal-dags-p systate)
                  (same-committees-p systate)
                  (last-anchor-present-p systate)
                  (create-possiblep cert systate)
                  (set::in val (correct-addresses systate))
                  (validator-last-anchor-voters-p
                   (get-validator-state val systate)))
             (validator-last-anchor-voters-p
              (get-validator-state val (create-next cert systate))))
    :use (:instance
          committee-members-stake-monotone
          (members1
           (certificate-set->author-set
            (successors
             (last-anchor
              (get-validator-state (certificate->author cert) systate))
             (validator-state->dag
              (get-validator-state (certificate->author cert) systate)))))
          (members2
           (certificate-set->author-set
            (successors
             (last-anchor
              (get-validator-state (certificate->author cert)
                                   (create-next cert systate)))
             (validator-state->dag
              (get-validator-state (certificate->author cert)
                                   (create-next cert systate))))))
          (commtt (active-committee-at-round
                   (1+ (validator-state->last
                        (get-validator-state (certificate->author cert)
                                             systate)))
                   (validator-state->blockchain
                    (get-validator-state (certificate->author cert)
                                         systate)))))
    :enable (validator-last-anchor-voters-p
             validator-state->dag-of-create-next
             successors-monotone
             certificate-set->author-set-monotone))

  (defruled last-anchor-voters-p-of-create-next
    (implies (and (last-anchor-voters-p systate)
                  (system-committees-fault-tolerant-p systate)
                  (no-self-endorsed-p systate)
                  (signer-records-p systate)
                  (signer-quorum-p systate)
                  (unequivocal-dags-p systate)
                  (same-committees-p systate)
                  (last-anchor-present-p systate)
                  (create-possiblep cert systate))
             (last-anchor-voters-p (create-next cert systate)))
    :enable (last-anchor-voters-p
             last-anchor-voters-p-necc
             validator-last-anchor-voters-p-of-create-next))

  ;; accept:

  (defruled validator-last-anchor-voters-p-of-accept-next
    (implies (and (system-committees-fault-tolerant-p systate)
                  (signer-quorum-p systate)
                  (unequivocal-signed-certs-p systate)
                  (unequivocal-dags-p systate)
                  (same-committees-p systate)
                  (last-anchor-present-p systate)
                  (accept-possiblep msg systate)
                  (messagep msg)
                  (set::in val (correct-addresses systate))
                  (validator-last-anchor-voters-p
                   (get-validator-state val systate)))
             (validator-last-anchor-voters-p
              (get-validator-state val (accept-next msg systate))))
    :use (:instance
          committee-members-stake-monotone
          (members1
           (certificate-set->author-set
            (successors
             (last-anchor
              (get-validator-state val systate))
             (validator-state->dag
              (get-validator-state val systate)))))
          (members2
           (certificate-set->author-set
            (successors
             (last-anchor
              (get-validator-state val (accept-next msg systate)))
             (validator-state->dag
              (get-validator-state val (accept-next msg systate))))))
          (commtt (active-committee-at-round
                   (1+ (validator-state->last
                        (get-validator-state val systate)))
                   (validator-state->blockchain
                    (get-validator-state val systate)))))
    :enable (validator-last-anchor-voters-p
             validator-state->dag-of-accept-next
             successors-monotone
             certificate-set->author-set-monotone))

  (defruled last-anchor-voters-p-of-accept-next
    (implies (and (last-anchor-voters-p systate)
                  (system-committees-fault-tolerant-p systate)
                  (signer-quorum-p systate)
                  (unequivocal-signed-certs-p systate)
                  (unequivocal-dags-p systate)
                  (same-committees-p systate)
                  (last-anchor-present-p systate)
                  (accept-possiblep msg systate)
                  (messagep msg))
             (last-anchor-voters-p (accept-next msg systate)))
    :enable (last-anchor-voters-p
             last-anchor-voters-p-necc
             validator-last-anchor-voters-p-of-accept-next))

  ;; advance:

  (defruled validator-last-anchor-voters-p-of-advance-next
    (implies (and (advance-possiblep val systate)
                  (set::in val1 (correct-addresses systate))
                  (validator-last-anchor-voters-p
                   (get-validator-state val1 systate)))
             (validator-last-anchor-voters-p
              (get-validator-state val1 (advance-next val systate))))
    :enable validator-last-anchor-voters-p)

  (defruled last-anchor-voters-p-of-advance-next
    (implies (and (last-anchor-voters-p systate)
                  (advance-possiblep val systate))
             (last-anchor-voters-p (advance-next val systate)))
    :enable (last-anchor-voters-p
             last-anchor-voters-p-necc
             validator-last-anchor-voters-p-of-advance-next))

  ;; commit

  (defruled stake-of-successors-loop-to-leader-stake-votes
    (implies (and (certificate-setp certs)
                  (certificate-set-unequivocalp certs)
                  (addressp prev)
                  (<= (set::cardinality (certificate-set->round-set certs)) 1))
             (equal (committee-members-stake
                     (certificate-set->author-set
                      (successors-loop certs prev))
                     commtt)
                    (leader-stake-votes prev certs commtt)))
    :induct t
    :enable (leader-stake-votes
             successors-loop
             in-of-successors-loop
             certificate-set->author-set-of-insert
             committee-members-stake-of-insert
             certificate-set-unequivocalp-when-subset
             set::expensive-rules
             certificate-set->author-set-monotone)
    :hints ('(:use
              (head-author-not-in-tail-authors-when-unequiv-and-all-same-round
               (:instance certificate-set->round-set-monotone
                          (certs1 (set::tail certs))
                          (certs2 certs))))))

  (defruled stake-of-successors-to-leader-stake-votes
    (implies (and (certificate-setp dag)
                  (certificate-set-unequivocalp dag))
             (equal (committee-members-stake
                     (certificate-set->author-set (successors cert dag))
                     commtt)
                    (leader-stake-votes
                     (certificate->author cert)
                     (certs-with-round
                      (1+ (certificate->round cert))
                      dag)
                     commtt)))
    :enable (successors
             stake-of-successors-loop-to-leader-stake-votes
             certificate-set-unequivocalp-when-subset
             cardinality-of-round-set-of-certs-with-round-leq-1))

  (defruled validator-last-anchor-voters-p-of-commit-next
    (implies (and (last-blockchain-round-p systate)
                  (ordered-even-p systate)
                  (unequivocal-dags-p systate)
                  (commit-possiblep val systate)
                  (addressp val)
                  (set::in val1 (correct-addresses systate))
                  (validator-last-anchor-voters-p
                   (get-validator-state val1 systate)))
             (validator-last-anchor-voters-p
              (get-validator-state val1 (commit-next val systate))))
    :enable (unequivocal-dags-p-necc-single
             active-committee-at-previous-round-when-at-round
             validator-last-anchor-voters-p
             commit-possiblep
             commit-next
             last-anchor
             get-validator-state-of-update-validator-state
             nfix
             active-committee-at-round-of-extend-blockchain-no-change
             blocks-ordered-even-p-of-extend-blockchain
             certificates-ordered-even-p-of-collect-anchors
             ordered-even-p-necc-fixing
             collect-anchors-above-last-committed-round
             last-blockchain-round-p-necc-fixing
             posp
             evenp
             stake-of-successors-to-leader-stake-votes))

  (defruled last-anchor-voters-p-of-commit-next
    (implies (and (last-anchor-voters-p systate)
                  (last-blockchain-round-p systate)
                  (ordered-even-p systate)
                  (unequivocal-dags-p systate)
                  (commit-possiblep val systate)
                  (addressp val))
             (last-anchor-voters-p (commit-next val systate)))
    :enable (last-anchor-voters-p
             last-anchor-voters-p-necc
             validator-last-anchor-voters-p-of-commit-next))

  ;; all events:

  (defruled last-anchor-voters-p-of-event-next
    (implies (and (last-anchor-voters-p systate)
                  (system-committees-fault-tolerant-p systate)
                  (last-blockchain-round-p systate)
                  (ordered-even-p systate)
                  (no-self-endorsed-p systate)
                  (signer-records-p systate)
                  (signer-quorum-p systate)
                  (unequivocal-signed-certs-p systate)
                  (unequivocal-dags-p systate)
                  (same-committees-p systate)
                  (last-anchor-present-p systate)
                  (event-possiblep event systate))
             (last-anchor-voters-p (event-next event systate)))
    :enable (event-possiblep
             event-next)))