squid.fs 8.93 KB
Newer Older
Bernd Paysan's avatar
Bernd Paysan committed
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
\ net2o block chain and cryptographic asset transactions

\ Copyright (C) 2017   Bernd Paysan

\ This program is free software: you can redistribute it and/or modify
\ it under the terms of the GNU Affero General Public License as published by
\ the Free Software Foundation, either version 3 of the License, or
\ (at your option) any later version.

\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
\ GNU Affero General Public License for more details.

\ You should have received a copy of the GNU Affero General Public License
\ along with this program.  If not, see <http://www.gnu.org/licenses/>.

\ search for a key with a particular pubkey prefix

here kalign here - allot

here $140 erase
here $20 allot here $20 allot here $C0 allot
here $C0 allot
Constant pkt0 Constant bp8
Constant pk0 Constant sk0

: pk~ ( pk -- )  $1F + dup >r c@ $80 xor r> c! ;

Bernd Paysan's avatar
Bernd Paysan committed
30
ge25519-basepoint bp8 ge25519 move
Bernd Paysan's avatar
Bernd Paysan committed
31 32 33 34 35 36 37 38
bp8 bp8 bp8 ge25519+ \ *2
bp8 bp8 bp8 ge25519+ \ *4
bp8 bp8 bp8 ge25519+ \ *8

: next-key ( -- )
    pkt0 pkt0 bp8 ge25519+
    pk0 pkt0 ge25519-pack ;

Bernd Paysan's avatar
Bernd Paysan committed
39
: search-key-prefix ( l1 mask -- )
Bernd Paysan's avatar
Bernd Paysan committed
40
    sk0 gen-sk  sk0 pk0 sk>pk
Bernd Paysan's avatar
Bernd Paysan committed
41
    pk0 pk~  pkt0 pk0 ge25519-unpack- drop
Bernd Paysan's avatar
Bernd Paysan committed
42
    BEGIN  2dup pk0 be-ul@ and <> WHILE  next-key 8 u>64 sk0 64+!
Bernd Paysan's avatar
Bernd Paysan committed
43 44 45 46 47 48
	    msg( dup $FFFF and pk0 w@ = IF  '.' emit  THEN )
    REPEAT 2drop ;

\ wallet

\ The secret key for a wallet is just 128 bits, so you can write it down
Bernd Paysan's avatar
Bernd Paysan committed
49
\ The wallet keys are extracted from that secret key through keccak expansion
Bernd Paysan's avatar
Bernd Paysan committed
50 51 52 53
\ Secret keys generate pubkeys, which are binned found-first in the
\ ledger hypercube.

keccak# buffer: walletkey
Bernd Paysan's avatar
Bernd Paysan committed
54
$8 Value wallets# \ 8 wallet bits, dummy value for testing
Bernd Paysan's avatar
Bernd Paysan committed
55 56 57
Variable wallet[]

: >walletkey ( addr u -- )
Bernd Paysan's avatar
Bernd Paysan committed
58 59
    2>r 64#0 64dup 2r> walletkey keccak# c:tweakkey!
    walletkey c:key!  c:diffuse ;
Bernd Paysan's avatar
Bernd Paysan committed
60 61 62 63
: prng>pk ( -- )
    sk0 KEYSIZE c:prng
    sk0 sk-mask  sk0 pk0 sk>pk ;
: wallet-kp[]! ( -- flag )
Bernd Paysan's avatar
Bernd Paysan committed
64
    pk0 be-ul@ $20 wallets# - rshift
Bernd Paysan's avatar
Bernd Paysan committed
65 66 67 68
    dup wallet[] $[]@ d0= IF  sk0 KEYSIZE2 rot wallet[] $[]! true
    ELSE  drop false  THEN ;

: wallet-expand ( addr u -- )
Bernd Paysan's avatar
Bernd Paysan committed
69
    \G take a wallet key, and expand it to the pubkeys
Bernd Paysan's avatar
Bernd Paysan committed
70 71 72 73
    c:key@ >r
    >walletkey  0
    BEGIN
	prng>pk wallet-kp[]! -
Bernd Paysan's avatar
Bernd Paysan committed
74
	dup 1 wallets# lshift u>= UNTIL  drop
Bernd Paysan's avatar
Bernd Paysan committed
75
    r> c:key! ;
Bernd Paysan's avatar
Bernd Paysan committed
76

Bernd Paysan's avatar
Bernd Paysan committed
77 78 79 80 81
: .wallets ( -- ) \G print the wallet pubkeys
    1 wallets# lshift 0 U+DO
	I wallet[] $[]@ KEYSIZE /string over c@ hex. space 85type cr
    LOOP ;

Bernd Paysan's avatar
Bernd Paysan committed
82 83 84
\ payment handling

\ payments are handled in chat messages.  A payment is essentially
Bernd Paysan's avatar
Bernd Paysan committed
85
\ a dumb contract with some simple functions:
Bernd Paysan's avatar
Bernd Paysan committed
86 87 88 89 90 91 92
\
\ * source coins which is owned by the sender, will be taken out of the block chain
\ * sink coins (owned by sender or receiver), will be added to the block chain
\
\ Payments are atomic operations; they can involve more than one asset
\ transfer, but must be embedded within a signed chat message.
\
Bernd Paysan's avatar
Bernd Paysan committed
93 94 95
\ Payment offers are partially, the receiver needs to add a sink coin to get
\ control over the transferred value.  BlockChain payments are full.  Active
\ data of a full node is just the coins, not the contracts.
Bernd Paysan's avatar
Bernd Paysan committed
96
\
Bernd Paysan's avatar
Bernd Paysan committed
97 98 99 100 101 102
\ Exchange contracts may require that the receiver also needs to add a source
\ coin of a different asset type to make the transaction valid.  The contract
\ is signed by the source; handed in by the sink.  For each source, there must
\ be a contract in the transaction to be valid.  All sources and sinks must be
\ required by at least one of the contracts.  All balances must match.  Assets
\ must be in the list of accepted assets of the chain.
Bernd Paysan's avatar
Bernd Paysan committed
103 104 105 106
\
\ A coin is a 128 bit big endian number for the value, followed by the asset
\ type string, and the signature of its owner.

107
false Value sink?
Bernd Paysan's avatar
Bernd Paysan committed
108

Bernd Paysan's avatar
Bernd Paysan committed
109 110 111 112 113 114 115 116
scope{ net2o-base

\g 
\g ### payment commands ###
\g 

cmd-table $@ inherit-table pay-table

117 118 119
$20 net2o: pay-source ( $:source -- ) \g source, pk[+hash] for lookup
    \ existing sources always had a previous transaction
    \ new sources have only a pk and can only become a sink
120
    $> pay:source  false to sink? ;
121 122
+net2o: pay-sink ( n $:sig -- ) \g sink, signature
    \ sink that already exists as source number n in the contract
123 124 125 126 127 128 129 130
    64>n $> pay:sink  true to sink? ;
+net2o: pay-asset ( asset -- ) \g select global asset type
    64>n pay:asset  false to sink? ;
+net2o: pay-obligation ( $:enc-asset -- ) \g select per-contract obligation
    \ encrypted with the receiver's pubkey
    $> pay:obligation  false to sink? ;
+net2o: pay-amount ( 64amount -- ) \g add/subtract amount to current asset
    64>128 pay:amount  false to sink? ;
131
+net2o: pay-damount ( 128amount -- ) \g add/subtract 128 bit amount
132
    pay:amount  false to sink? ;
133
+net2o: pay-comment ( $:enc-comment -- ) \g comment, encrypted for selected key
134
    $> pay:comment  false to sink? ;
135 136
+net2o: pay-balance ( u -- ) \g select&balance asset
    \ a balance modifies the asset of the current active source
137 138 139
    64>n pay:balance  false to sink? ;
+net2o: pay-#source ( u -- ) \g select source
    64>n pay:#source  false to sink? ;
Bernd Paysan's avatar
Bernd Paysan committed
140

Bernd Paysan's avatar
Bernd Paysan committed
141
pay-table $save
Bernd Paysan's avatar
Bernd Paysan committed
142

Bernd Paysan's avatar
Bernd Paysan committed
143 144
}scope

Bernd Paysan's avatar
Bernd Paysan committed
145
\g 
Bernd Paysan's avatar
Bernd Paysan committed
146
\g ### Contracts ###
Bernd Paysan's avatar
Bernd Paysan committed
147
\g 
148 149 150
\g Contracts are state changes to wallets.  A serialized wallet is a contract
\g that contains all the changes from an empty wallet to fill it; it is not
\g checked for balance.
Bernd Paysan's avatar
Bernd Paysan committed
151
\g 
152 153 154 155 156 157
\g A dumb contract is checked for balance.  It consists of several selectors
\g (source/account, asset), transactions (amounts added or subtracted from an
\g asset), comments (encoded for the receiver, with a ephermeral pubkey as
\g start and a HMAC as end). Comments are fixed 64 bytes, either plain text or
\g hashes to files.  Transactions have to balance, which is facilitated with
\g the balance command, which balances the selected asset.
Bernd Paysan's avatar
Bernd Paysan committed
158
\g 
159 160 161
\g The signature of a contract signs the wallet's state (serialized in
\g normalized form) after the contract has been executed.  The current
\g contract's hash is part of the serialization.
Bernd Paysan's avatar
Bernd Paysan committed
162

163 164
Variable SwapDragonChain# ( "hash" -- "contract" )
Variable SwapDragonKeys#  ( "pk" -- "hash+[asset,amount]*" )
165 166 167
\ Updates go to SwapDragonKeys'#; only one transaction per pk&cycle!
Variable SwapDragonKeys'#  ( "pk" -- "hash+[asset,amount]*" )
Variable $SwapAssets[] ( n -- asset u )
Bernd Paysan's avatar
Bernd Paysan committed
168 169

scope{ pay
170 171 172 173 174 175 176 177 178 179
$10 buffer: balance0
$10 cell+ buffer: new-asset

:noname { d: pk -- } \ pk[+hash]
    pk dup keysize = IF  [: type keysize spaces ;] $tmp  THEN
    sources[] dup $[]# to current-pk $+[]!
    pk key| SwapDragonKeys# #@
    2dup d0<> IF
	pk keysize /string 2over key| str= 0= !!squid-hash!!
	keysize /string
180
    THEN
181
    current-pk assets[] $[]!
182
; pay-class is source
183 184 185 186 187 188 189 190 191 192 193 194

: ?double-transaction ( hash u pk u -- hash u )
     SwapDragonKeys'# #@ 2dup d0= IF
	2drop
    ELSE \ you can check the same transaction twice
	2over str= 0= !!double-transaction!!
    THEN ;

:noname ( n -- )
    dup sources[] $[]# u>= !!inv-index!! to current-pk
; pay-class is #source

195
:noname ( n addr u -- )
196
    rot #source
197 198 199
    sigsize# <> !!no-sig!! { sig }
    cmdbuf$ over + sig umin over umax over - 2 - \ cmdbuf up to the sig string
    c:0key 2dup c:hash
200
    current-pk sources[] $[]@ dup 0= !!sink-cleared!! { d: pk+hash }
201 202
    pk+hash keysize /string
    2dup c:hash@ SwapDragonChain# #!
203 204
    !!FIXME!!
    \ missing here: normalize the sink's account, and calculate a hash over that
205 206 207
    sig sigsize# pk+hash drop pk-sig? !!sig!! 2drop
    [:  current-pk sources[] $[]@ keysize /string type
	current-pk assets[]  $[]@ type ;] $tmp
208 209 210
    pk+hash key| ?double-transaction
    pk+hash key| SwapDragonKeys'# #!
    current-pk sources[] $[]free
211
; pay-class is sink
Bernd Paysan's avatar
Bernd Paysan committed
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
:noname ( n -- )
    dup $SwapAssets[] $[]# u>= !!inv-index!!
    to current-asset
    current-asset balances[] $[]@ nip 0= IF
	balance0 $10 current-asset balances[] $[]!
    THEN
; pay-class is asset

: 128+!? ( 128x addr -- flag )
    dup >r 128@ 128+ r> over >r 128! r> 0< ;

:noname ( 128asset -- )
    64over 64over current-asset balances[] $[]@ drop 128+!? drop
    current-pk assets[] $[]@ bounds U+DO
	I @ current-asset = IF  I cell+ 128+!? !!insufficient-asset!!
	    UNLOOP  EXIT  THEN
    $10 cell+ +LOOP
    dup 0< !!insufficient-asset!!
    current-asset new-asset !  new-asset cell+ 128!
    new-asset $10 cell+ current-pk assets[] $[]+!
; pay-class is amount

:noname ( n -- ) asset
    64#0 64dup current-asset balances[] $[]@ drop 128@ 128- \ just a 128negate
    amount
; pay-class is balance

:noname ( -- )  sink? invert !!not-sunk!!
    balances[] $[]# 0 ?DO
	I balances[] $[]@ balance0 over str= 0= !!not-balanced!!
    LOOP
    sources[] $[]# 0 ?DO
	I sources[] $[]@ nip !!not-sunk!!
    LOOP
; pay-class is finalize

: update ( -- )
    SwapDragonKeys'#
    [: ( last -- ) >r r@ cell+ $@ r@ $@ SwapDragonKeys# #! ;] #map
    SwapDragonKeys'# #frees ;
Bernd Paysan's avatar
Bernd Paysan committed
253 254
}scope

255
\\\
Bernd Paysan's avatar
Bernd Paysan committed
256 257 258 259 260 261 262 263 264 265 266 267 268 269
Local Variables:
forth-local-words:
    (
     (("net2o:" "+net2o:") definition-starter (font-lock-keyword-face . 1)
      "[ \t\n]" t name (font-lock-function-name-face . 3))
     ("[a-z0-9]+(" immediate (font-lock-comment-face . 1)
      ")" nil comment (font-lock-comment-face . 1))
    )
forth-local-indent-words:
    (
     (("net2o:" "+net2o:") (0 . 2) (0 . 2) non-immediate)
    )
End:
[THEN]