$100      uvar keydump-buf  \ buffer for dumping keys
    state2#   uvar vkey \ maximum size for session key
    state2#   uvar voutkey \ for keydump
    keysize   uvar keygendh
    keysize   uvar vpk
    keysize   uvar vsk
    tf_ctx_256 uvar tf-key

    keysize   uvar tf-out
    $10       uvar tf-hashout
    1 64s     uvar last-mykey
    cell      uvar keytmp-up
end-class keytmp-c

user-o keybuf \ storage for secure permanent keys

    gen>host "host" >delete +sig$ ;

\ Vault support code (generic and more compact)

\ principle: use Threefish_256.
\ block layout:
\ 1. 32 byte ephemeral key -> use for DHE.
\ 2. 16 byte IV, used for all blocks as incrementing tweak
\ 3. 16 byte hash, to check for success
\ 4. 32 byte each blocks, decrypted by DHE+tweak in ECB mode

: >vdhe ( addr -- )  sk@ drop swap tf-key tf_ctx_256-key ed-dh 2drop ;
: >viv  ( addr -- )  tf-key tf_ctx_256-tweak $10 move ;
: v-dec-loop ( addr u -- session-key u / 0 0 )
    over { chk } $10 /string  $C { mode }
    bounds U+DO
	tf-key I tf-out mode tf_decrypt_256
	c:0key tf-out keysize c:hash tf-hashout $10 c:hash@
	tf-hashout $10 chk over str= IF
	    tf-out keysize  unloop  EXIT  THEN
	tf-key tf_tweak256++
	4 to mode
    keysize +LOOP  0 0 ;
: v-dec$ ( addr u -- session-key u / 0 0 )
    over >vdhe keysize /string
    over >viv  $10 /string
    v-dec-loop ;

: vdhe ( -- )  vsk vpk ed-keypair  vpk keysize type ;
: viv  ( -- )  $10 rng$ 2dup type  tf-key tf_ctx_256-tweak swap move ;
: vsessionkey ( -- )
    keysize rng$ vkey state# move-rep
    c:0key vkey keysize c:hash tf-hashout $10 2dup c:hash@ type ;
: v-enc-loop ( keylist -- )
    [:  drop vsk swap tf-key tf_ctx_256-key ed-dh 2drop
	tf-key vkey tf-out $C tf_encrypt_256
	tf-out keysize type
	tf-key tf_tweak256++
    ;] $[]map ;
: v-enc-gen ( keylist -- )
    vdhe viv vsessionkey v-enc-loop ;
: v-enc$ ( keylist -- addr u )
    ['] v-enc-gen $tmp ;

\\\

debug: quicksig( \ quick check for sigs
debug: slurp( \ debug slurp&spit
debug: wallet( \ debug wallet stuff
debug: qr( \ qr code stuff
debug: deprecated( \ deprecated stuff
debug: unhandled( \ unhandled commands
debug: syncfile( \ synchronous file operations
debug: newvault( \ new style vault keys

-db profile( \ don't profile by default )
+db ipv6( \ ipv6 should be on by default )
+db ipv4( \ ipv4 should be on by default )
-db newvault( \ new vault disabled for now )
+db syncfile( \ disable async file operations for now )

\ key debugging task

: toggle ( addr -- )  dup @ 0= swap ! ;

0 Value debug-task

\c }

c-function raw>sc25519 expand_raw256_modm a a -- void ( sc char[32] -- )
c-function nb>sc25519 expand256_modm a a n -- void ( sc char[64] n -- )
c-function sc25519>32b contract256_modm a a -- void ( char[32] sc -- )
c-function sc25519* mul256_modm a a a -- void ( r x y -- )
c-function sc25519+ add256_modm a a a -- void ( r x y -- )
c-function sc25519/ invert256_modm a a -- void ( recip s -- )

c-function ge25519*base ge25519_scalarmult_base a a -- void ( ger x -- )
c-function ge25519-pack ge25519_pack a a -- void ( r ger -- )
c-function ge25519+ ge25519_add a a a -- void ( a a a -- )
c-function ge25519-unpack- ge25519_unpack_negative_vartime a a -- n ( r p -- flag )
c-function ge25519*+ ge25519_double_scalarmult_vartime a a a a -- void ( r p s1 s2 -- )
c-function ge25519*v ge25519_scalarmult_vartime a a a -- void ( r p s -- )

    \U keysearch|searchkey 85string1 .. 85stringn
    \G keysearch: search for keys prefixed with base85 strings,
    \G keysearch: and import them into the key chain
    ?get-me init-client
    keys>search search-keys insert-keys save-pubkeys
    ?cr keylist ;

: whoami ( -- )
    \U whoami
    \G whoami: print your own key
    ?get-me pk@ key>o ..key-list ;

: perm ( -- )
    \U perm @user1 .. @usern permissions ..
    \G perm: Change or set permissions. permission starts with
    \G perm: + for adding permissions
    \G perm: - for taking away permissions
    \G perm: = sets defaults, add or subtract permissions afterwards
    \G perm: no prefix for setting permissions exactly

\c   int flags=flags1;
\c   while(n>=64) {
\c     tf_decrypt_512(ctx, c, c, flags);
\c     flags=flags2; c+=8; n-=64;
\c     ctx->tweak[1] += !++(ctx->tweak[0]);
\c   }
\c }
\c void tf_tweak256_pp(struct tf_ctx_256 *ctx)
\c {
\c   ctx->tweak[1] += !++(ctx->tweak[0]);
\c }
\c void tf_tweak512_pp(struct tf_ctx_512 *ctx)
\c {
\c   ctx->tweak[1] += !++(ctx->tweak[0]);
\c }
\ -------===< structs >===--------
\ tf_ctx_256
begin-structure tf_ctx_256
    drop 0 40 +field tf_ctx_256-key
    drop 40 24 +field tf_ctx_256-tweak
    drop 64 end-structure
\ tf_ctx
begin-structure tf_ctx
    drop 0 72 +field tf_ctx-key
    drop 72 24 +field tf_ctx-tweak
    drop 96 end-structure

\ ------===< functions >===-------
c-function tf_encrypt tf_encrypt_512 a a a n -- void
c-function tf_decrypt tf_decrypt_512 a a a n -- void
c-function tf_encrypt_256 tf_encrypt_256 a a a n -- void
c-function tf_decrypt_256 tf_decrypt_256 a a a n -- void
c-function tf_encrypt_loop tf_encrypt_loop a a n n n -- void
c-function tf_decrypt_loop tf_decrypt_loop a a n n n -- void
c-function tf_tweak256++ tf_tweak256_pp a -- void
c-function tf_tweak512++ tf_tweak512_pp a -- void

+net2o: vault-auth ( $:auth -- )
    \g block authentication, 64 byte block
    c-state @ 7 <> !!no-data!!
    \ otherwise would expose some data
    $> v-kstate c:key> v-kstate $40 str= 0= !!vault-auth!!
    write-decrypt \ write a chunk out
    4 c-state xor! ; \ step back to allow fault-file
+net2o: vault-dhe-keys ( $:dhe+keys -- )  c-state @ !!inv-order!!
    $> v-dec$ 2dup d0= !!unknown-key!!  v-key state# move-rep
    3 c-state or! ;

vault-table $save
' context-table is gen-table

also }scope

$80 Constant min-align#

: vdhe, ( -- )   vsk vpk ed-keypair vpk keysize $, dhe ;
: vkeys, ( key-list -- )
    vaultkey $100 erase
    enc-mode @ $FF and $20 - rng$ vkey state# move-rep
    vkey( ." vkey key: " vkey state# 85type forth:cr )
    enc-mode @ dup ulit, vault-crypt 8 rshift $FF and >crypt
    [: [: drop vsk swap keygendh ed-dh 2>r
	    vkey vaultkey $10 + enc-mode @ $FF and $20 - move
	    vaultkey enc-mode @ $FF and 2r> encrypt$
	    vaultkey enc-mode @ $FF and forth:type ;] $[]map ;] $tmp
    $, vault-keys 0 >crypt ;
: vdhe-keys, ( key-list -- )
    v-enc$ $, vault-dhe-keys  0 >crypt ;
: vfile-in ( -- )
    enc-filename $@ enc-file $slurp-file ;
: vfile-pad ( -- )
    enc-file $@len dup >r vault-aligned enc-file $!len
    enc-file $@ r> /string dup enc-padding ! erase ;
: vfile-enc ( -- )
    vkey( ." vkey file: " vkey state# 85type forth:cr )

    0 >crypt
    vkey( ." vkey sig: " vkey state# 85type forth:cr )
    2dup vkey state# encrypt$ $, vault-sig ;

: encfile-rest ( key-list -- ) >vault >r
    code-buf$ cmdreset init-reply
    pk@ key| r@ $+[]! \ encrypt for ourself
    "v2o" 4cc,
    newvault( r> vdhe-keys, )else( vdhe, r> vkeys, )
    vfile, vsig,
    s" .v2o" enc-filename $+!
    enc-filename $@ [: >r cmd$ $@ r> write-file throw ;] new-file
    code0-buf dispose n:o> ;

: encrypt-file ( filename u key-list -- )
    >r enc-filename $! vfile-in r> encfile-rest ;