julia_did_chialisp/issuer_key_functions.clsp at main · fizpawiz/julia_did_chialisp · GitHub

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
;; Copyright 2026 Julia.Social, Inc.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(mod (curried-args
      ; ISSUER-DID-LAUNCHER_ID
      ; ISSUER-KEY-PUZZLEHASH
      ; PUBLIC-KEY
      ; REVOCATION-BITFIELD-ROOT
      ; VALID-FROM
      ; VALID-TO
      ; MAX_EXPIRATION
      ; CRED-PROPERTY-HASH-ROOT
      ; MODE-1-PAYMENT-PUZZLEHASH
      ; MODE-1-PAYMENT-MOJOS
      spend-mode
      spend-mode-args)

  ; Management operations for the issuer key singleton: revocation bitfield updates (by key
  ; holder or owning DID) and melt.  Separate module from the main issuer_key spend path to
  ; reduce puzzle reveal size for the common case (credential attestation).

  (include *standard-cl-26*)
  (defun print (l x) (i (all "$print$" l x) x x))

  (include "condition_codes.clib")
  (include "curry_and_treehash.clib")
  (include "sha256tree.clib")

  (include "bitfield.clib")
  (include "did_puzzles.clib")

  ; use the issuer key to update the revocation bitfield
  (defun update-revocation-by-key (curried-args spend-mode-args)
    (assign
        ( issuer-did-launcher-id
          issuer-key-puzzlehash
          julia-did-puzzlehash
          my-launcher-id
          public-key
          revocation-bitfield-root
          valid-from
          valid-to
          max-expiration
          cred-property-hash-root
          mode-1-payment-puzzlehash
          mode-1-payment-mojos
        ) curried-args
        ( peers ; peers along path from leaf to root
          index
          current-leaf-hash
          new-leaf
        ) spend-mode-args
        fee-coin (r (r (r (r spend-mode-args)))) ; optional fee as tail of spend-mode-args
      (if (verify-tree revocation-bitfield-root index peers current-leaf-hash)
        (assign
            new-root (set-leaf index peers new-leaf)
            new-curried-args (list  issuer-did-launcher-id
                                    issuer-key-puzzlehash
                                    julia-did-puzzlehash
                                    my-launcher-id
                                    public-key
                                    new-root
                                    valid-from
                                    valid-to
                                    max-expiration
                                    cred-property-hash-root
                                    mode-1-payment-puzzlehash
                                    mode-1-payment-mojos)
            new-curried-args-hash (sha256tree new-curried-args)
            conditions (list
              (list AGG_SIG_PUZZLE public-key (sha256tree spend-mode-args))
              (list CREATE_COIN (issuer-key-curried-puzzlehash issuer-key-puzzlehash new-curried-args-hash)
                                1
                                (list issuer-did-launcher-id) ; hint
              )
              (list REMARK new-curried-args)
            )
          (if fee-coin
            (c (list ASSERT_CONCURRENT_SPEND (f fee-coin)) conditions)
            conditions
          )
        )
        (x 12) ; given merkle proof was not correct
      )
    )
  )

  ; use the issuer did coin to update the revocation bitfield
  (defun update-revocation-by-DID (curried-args spend-mode-args)
    (assign
        ( issuer-did-launcher-id
          issuer-key-puzzlehash
          julia-did-puzzlehash
          my-launcher-id
          public-key
          revocation-bitfield-root
          valid-from
          valid-to
          max-expiration
          cred-property-hash-root
          mode-1-payment-puzzlehash
          mode-1-payment-mojos
        ) curried-args
        ( peers ; peers along path from leaf to root
          index
          current-leaf-hash
          new-leaf
          did-curried-args-hash
        ) spend-mode-args
      (if (verify-tree revocation-bitfield-root index peers current-leaf-hash)
        (assign
            new-root (set-leaf index peers new-leaf)
            new-curried-args (list  issuer-did-launcher-id
                                    issuer-key-puzzlehash
                                    julia-did-puzzlehash
                                    my-launcher-id
                                    public-key
                                    new-root
                                    valid-from
                                    valid-to
                                    max-expiration
                                    cred-property-hash-root
                                    mode-1-payment-puzzlehash
                                    mode-1-payment-mojos)
            new-curried-args-hash (sha256tree new-curried-args)
          (list
            (list RECEIVE_MESSAGE 0x16 ; b010110 = sender puzzle, receiver puzzle & parent
                                  (concat "JDIDK" (sha256tree (list index new-leaf)))
                                  (julia-DID-coin-puzzlehash julia-did-puzzlehash issuer-did-launcher-id did-curried-args-hash))
            (list CREATE_COIN (issuer-key-curried-puzzlehash issuer-key-puzzlehash new-curried-args-hash)
                              1
                              (list issuer-did-launcher-id) ; hint
            )
            (list REMARK new-curried-args)
          )
        )
        (x 13) ; given merkle proof was not correct
      )
    )
  )

  ; Melt the entire issuer key coin, invalidating all credentials & claims signed with it.
  (defun melt (curried-args spend-mode-args)
    (assign
        ( issuer-did-launcher-id
          issuer-key-puzzlehash
          julia-did-puzzlehash
          my-launcher-id
          public-key
          revocation-bitfield-root
          valid-from
          valid-to
          max-expiration
          cred-property-hash-root
          mode-1-payment-puzzlehash
          mode-1-payment-mojos
        ) curried-args
        ( did-curried-args-hash
        ) spend-mode-args
      (list
        (list RECEIVE_MESSAGE 0x16 ; b010110 = sender puzzle, receiver puzzle & parent
                              "JDIDZ"
                              (julia-DID-coin-puzzlehash julia-did-puzzlehash issuer-did-launcher-id did-curried-args-hash))
        (list CREATE_COIN 0 ; puzzlehash ignored
                          -113)
      )
    )
  )

  (if (= spend-mode 2)
    (update-revocation-by-key curried-args spend-mode-args)
    (if (= spend-mode 3)
      (update-revocation-by-DID curried-args spend-mode-args)
      (if (= spend-mode 5)
        (melt curried-args spend-mode-args)
        (x 14) ; invalid spend mode
      )
    )
  )

)