: cmd> ( -- addr u )
    +zero16 \ add space for checksum
    cmd-resolve> ;

: cmd>nest ( -- addr u ) cmd> 2dup mykey-encrypt$ ;
: cmd>tmpnest ( -- addr u )
    cmd> 2dup tmpkey@ keysize umin
    key( ." tmpnest key: " 2dup 85type forth:cr ) encrypt$ ;
: cmd>encnest ( -- addr u )
    cmd> 2dup tmpkey@
    key( ." tmpnest key: " 2dup 85type forth:cr ) encrypt$ ;

: cmdnest ( addr u -- )  mykey-decrypt$
    IF  own-crypt-val do-nest  ELSE

: cmd> ( -- addr u )
    +zero16 \ add space for checksum
    cmd-resolve> ;

: cmd>nest ( -- addr u ) cmd> 2dup mykey-encrypt$ ;
: cmd>tmpnest ( -- addr u )
    cmd> 2dup tmpkey@ key|
    key( ." tmpnest key: " 2dup 85type forth:cr ) encrypt$ ;
: cmd>encnest ( -- addr u )
    cmd> 2dup tmpkey@
    key( ." tmpnest key: " 2dup 85type forth:cr ) encrypt$ ;

: cmdnest ( addr u -- )  mykey-decrypt$
    IF  own-crypt-val do-nest  ELSE

    $30 uvar sct2
    $30 uvar sct3
    $C0 uvar get0
    $C0 uvar get1
    $40 uvar hashtmp
    $40 uvar sigtmp
    $20 uvar pktmp

    keccak# uvar hstatetmp
    cell uvar task-id
end-class edbuf-c

: init-ed25519
    edbuf @ IF  task-id @ up@ = ?EXIT  THEN
    [: edbuf-c new edbuf ! ;] crypto-a with-allocater
................................................................................
    pk sigbuf $20 + $20 move
    sigbuf $40 >hash             \ z=hash(r,pk,message)
    sct1 hashtmp 64b>sc25519     \ sct1 is z
    sct2 sk raw>sc25519          \ sct2 is sk
    sct1 sct1 sct2 sc25519*
    sct1 sct1 sct3 sc25519+      \ s=z*sk+k
    sigbuf $20 + sct1 sc25519>32b

    clean-ed25519 sigbuf $40 ;   \ r,s

UValue no-ed-check?
0 to no-ed-check?

: ed-check? { sig pk -- flag }
    \G check a message: the keccak state contains the hash of the message.
    \G The unpacked pk is in get0, so this word can be used for batch checking.
    \G sig and pk need to be aligned properly, ed-verify does that alignment
    no-ed-check? IF  true  EXIT  THEN

    sig hashtmp $20 move  pk hashtmp $20 + $20 move
    hashtmp $40 c:shorthash hashtmp $40 c:hash@ \ z=hash(r+pk+message)
    sct2 hashtmp 64b>sc25519       \ sct2 is z
    sct3 sig $20 + raw>sc25519     \ sct3 is s
    get1 get0 sct2 sct3 ge25519*+  \ base*s-pk*z
    sigbuf $40 + get1 ge25519-pack \ =r

    sig sigbuf $40 + 32b= ;

: ed-verify ( sig pk -- flag ) \ message digest is in keccak state

    pktmp $20 move  sigtmp $40 move \ align inputs




    get0 pktmp ge25519-unpack- 0=  IF  false EXIT  THEN \ bad pubkey
    sigtmp pktmp ed-check? ;

: ed-quickcheck? { skh sk sig pk -- flag }
    \G quick check a message signed by ourself: the keccak state
    \G contains the hash of the message.
    c:key@ hstatetmp c:key# move \ we need this twice - move away
................................................................................
	\ quick check failed, do slow check
	\ old signatures had a different skh
	sct3 sig $20 + raw>sc25519     \ sct3 is s
	get1 get0 sct2 sct3 ge25519*+  \ base*s-pk*z
	sigbuf $40 + get1 ge25519-pack \ =r
	sig sigbuf $40 + 32b=
    THEN

    clean-ed25519 ;

: ed-quick-verify ( skh sk sig pk -- flag ) \ message digest is in keccak state
    pktmp $20 move  sigtmp $40 move \ align inputs
    get0 pktmp ge25519-unpack- 0=  IF  false EXIT  THEN \ bad pubkey
    sigtmp pktmp ed-quickcheck? ;

: ed-dh { sk pk dest -- secret len }
    pk pktmp $20 move
    get0 pktmp ge25519-unpack- 0= !!no-ed-key!!
    sct2 sk raw>sc25519

    $30 uvar sct2
    $30 uvar sct3
    $C0 uvar get0
    $C0 uvar get1
    $40 uvar hashtmp
    $40 uvar sigtmp
    $20 uvar pktmp
    $20 uvar sktmp
    keccak# uvar hstatetmp
    cell uvar task-id
end-class edbuf-c

: init-ed25519
    edbuf @ IF  task-id @ up@ = ?EXIT  THEN
    [: edbuf-c new edbuf ! ;] crypto-a with-allocater
................................................................................
    pk sigbuf $20 + $20 move
    sigbuf $40 >hash             \ z=hash(r,pk,message)
    sct1 hashtmp 64b>sc25519     \ sct1 is z
    sct2 sk raw>sc25519          \ sct2 is sk
    sct1 sct1 sct2 sc25519*
    sct1 sct1 sct3 sc25519+      \ s=z*sk+k
    sigbuf $20 + sct1 sc25519>32b
    hstatetmp c:key@ c:key# move \ restore state
    clean-ed25519 sigbuf $40 ;   \ r,s

UValue no-ed-check?
0 to no-ed-check?

: ed-check? { sig pk -- flag }
    \G check a message: the keccak state contains the hash of the message.
    \G The unpacked pk is in get0, so this word can be used for batch checking.
    \G sig and pk need to be aligned properly, ed-verify does that alignment
    no-ed-check? IF  true  EXIT  THEN
    c:key@ hstatetmp c:key# move   \ we need this to be preserved
    sig hashtmp $20 move  pk hashtmp $20 + $20 move
    hashtmp $40 c:shorthash hashtmp $40 c:hash@ \ z=hash(r+pk+message)
    sct2 hashtmp 64b>sc25519       \ sct2 is z
    sct3 sig $20 + raw>sc25519     \ sct3 is s
    get1 get0 sct2 sct3 ge25519*+  \ base*s-pk*z
    sigbuf $40 + get1 ge25519-pack \ =r
    hstatetmp c:key@ c:key# move   \ restore state again
    sig sigbuf $40 + 32b= ;


: sig>align ( sig pk -- )
    pktmp $20 move  sigtmp $40 move \ align inputs
    $0F sigtmp $3F + andc! ;

: ed-verify ( sig pk -- flag ) \ message digest is in keccak state
    sig>align
    get0 pktmp ge25519-unpack- 0=  IF  false EXIT  THEN \ bad pubkey
    sigtmp pktmp ed-check? ;

: ed-quickcheck? { skh sk sig pk -- flag }
    \G quick check a message signed by ourself: the keccak state
    \G contains the hash of the message.
    c:key@ hstatetmp c:key# move \ we need this twice - move away
................................................................................
	\ quick check failed, do slow check
	\ old signatures had a different skh
	sct3 sig $20 + raw>sc25519     \ sct3 is s
	get1 get0 sct2 sct3 ge25519*+  \ base*s-pk*z
	sigbuf $40 + get1 ge25519-pack \ =r
	sig sigbuf $40 + 32b=
    THEN
    hstatetmp c:key@ c:key# move \ restore state again
    clean-ed25519 ;

: ed-quick-verify ( skh sk sig pk -- flag ) \ message digest is in keccak state
    sig>align
    get0 pktmp ge25519-unpack- 0=  IF  false EXIT  THEN \ bad pubkey
    sigtmp pktmp ed-quickcheck? ;

: ed-dh { sk pk dest -- secret len }
    pk pktmp $20 move
    get0 pktmp ge25519-unpack- 0= !!no-ed-key!!
    sct2 sk raw>sc25519

net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest
    $> nest-sig ?dup-0=-IF
	handle-msg
   ELSE  replay-mode @ IF  drop 2drop
	ELSE  !!sig!!  THEN \ balk on all wrong signatures
    THEN ;
+net2o: msg-nestencsig ( $:enc[cmd]+sig -- ) \g decrypt, chech sig+nest
    $> dec-nest-sig ?dup-0=-IF
	handle-msg
   ELSE  replay-mode @ IF  drop 2drop
	ELSE  !!sig!!  THEN \ balk on all wrong signatures
    THEN ;

: msg-sig? ( addr u -- addr u' flag )
    skip-sig? @ IF   quicksig( pk-quick-sig? )else( pk-date? )
    ELSE  pk-sig?  THEN ;
' msg-sig? ' message  2dup

msging-class to start-req
msging-class to nest-sig
msg-class to start-req
msg-class to nest-sig

: msg-dec-sig? ( addr u -- addr' u' flag )
    msg-sig? dup  IF  drop
	2dup + pktmp keysize move \ move the pk to pktmp

	get0 pktmp ge25519-unpack- 0= !!no-ed-key!!
	msg-keys[] $@ bounds U+DO
	    2dup I $@ crypt-key-init $>align
	    2dup 0 c:decrypt+auth IF
		voutkey keysize c:hash@
		sct0 voutkey 32b>sc25519
		get1 get0 sct0 ge25519*
		tf-out get1 ge25519-pack
		$80 tf-out $1F + xorc!







		2nip true unloop  EXIT  THEN
	    2drop
	cell +LOOP
	false
    THEN ;

































' context-table is gen-table

also }scope

msging-table $save

................................................................................
    fs-inbuf $@len IF
	msg( ." Closing file " fs-path $@ .chat-file forth:cr )
	fs-flush
    THEN
; msgfs-class is fs-close
:noname ( perm -- )
    perm%msg and 0= !!msg-perm!!
; msgfs-class to fs-perm?
:noname ( -- date perm )
    64#0 0 ; msgfs-class is fs-get-stat
:noname ( date perm -- )
    drop 64drop ; msgfs-class is fs-set-stat
' file-start-req msgfs-class is start-req

\ message composer

: group, ( addr u -- )
    $, msg-group ;
: <msg ( -- )
    \G start a msg block
    msg-group$ $@ group, message sign[ msg-start ;
: msg> ( -- )
    \G end a message block by adding a signature
    ]pksign ;
: msg-otr> ( -- )
    \G end a message block by adding a short-time signature
    now>otr ]pksign ;
: msg-log, ( -- addr u )
................................................................................
    \U away [<action>]      send string or "away from keyboard" as action
    \G away: send string or "away from keyboard" as action
    dup 0= IF  2drop
	away? IF  "I'm back"  ELSE  "Away from keyboard"  THEN
	away? 0= to away?
    THEN
    [: $, msg-action ;] send-avalanche ;


: /otr ( addr u -- )
    \U otr on|off|message   turn otr mode on/off (or one-shot)
    2dup s" on" str= >r
    2dup s" off" str= r@ or IF   2drop r> otr-mode !
	<info> ." === " otr-mode @ IF  ." enter"  ELSE  ." leave"  THEN
	."  otr mode ===" <default> forth:cr

net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest
    $> nest-sig ?dup-0=-IF
	handle-msg
   ELSE  replay-mode @ IF  drop 2drop
	ELSE  !!sig!!  THEN \ balk on all wrong signatures
    THEN ;







: msg-sig? ( addr u -- addr u' flag )
    skip-sig? @ IF   quicksig( pk-quick-sig? )else( pk-date? )
    ELSE  pk-sig?  THEN ;


\ encrypt+sign
\ features: signature verification only when key is known
\           identity only revealed when correctly decrypted





: modkey> ( dest -- )
    get0 over ge25519-unpack- 0= !!no-ed-key!!



    voutkey keysize c:hash@
    sct0 voutkey 32b>sc25519
    get1 get0 sct0 ge25519*
    dup get1 ge25519-pack
    $80 swap $1F + xorc! ;
: msg-dec-sig? ( addr u -- addr' u' flag )
    sigpksize# -
    msg-keys[] $@ bounds U+DO
	2dup I $@ decrypt$  IF
	    2over + sigpksize# over date-sig? nip nip  IF
		2dup + >r 2swap + r> sigpksize# move
		2dup + modkey>  sigpksize# +
		true unloop  EXIT  THEN  THEN
	2drop
    cell +LOOP
    sigpksize# +  false ;


\ generate an encryt+sign packet

: >modkey ( dstsk dstpk sk -- )
    voutkey keysize c:hash@
    sct0 voutkey 32b>sc25519
    sct1 sct0 sc25519/
    sct0 swap raw>sc25519
    sct2 sct0 sct1 sc25519*
    get0 sct2 ge25519*base
    get0 ge25519-pack
    sct2 sc25519>32b ;

: ]encpksig ( -- )
    +zero16 nest$ msg-keys[] dup $[]# 1- swap $[]@ encrypt$
    sigdate +date
    sktmp pktmp sk@ drop >modkey
    [:  pktmp keysize forth:type  sigdate datesize# forth:type
	sig-params 2drop sktmp pktmp ed-sign forth:type
	keysize forth:emit ;] ']sign ;

\ nest-sig for msg/msging classes

:noname ( addr u -- )
    2dup + 2 - c@ $F0 and
    case $80 of msg-dec-sig? endof
	drop  msg-sig?
	0 endcase ; ' message  2dup
msging-class is start-req
msging-class is nest-sig
msg-class is start-req
msg-class is nest-sig

' context-table is gen-table

also }scope

msging-table $save

................................................................................
    fs-inbuf $@len IF
	msg( ." Closing file " fs-path $@ .chat-file forth:cr )
	fs-flush
    THEN
; msgfs-class is fs-close
:noname ( perm -- )
    perm%msg and 0= !!msg-perm!!
; msgfs-class is fs-perm?
:noname ( -- date perm )
    64#0 0 ; msgfs-class is fs-get-stat
:noname ( date perm -- )
    drop 64drop ; msgfs-class is fs-set-stat
' file-start-req msgfs-class is start-req

\ message composer

: group, ( addr u -- )
    $, msg-group ;



: msg> ( -- )
    \G end a message block by adding a signature
    ]pksign ;
: msg-otr> ( -- )
    \G end a message block by adding a short-time signature
    now>otr ]pksign ;
: msg-log, ( -- addr u )
................................................................................
    \U away [<action>]      send string or "away from keyboard" as action
    \G away: send string or "away from keyboard" as action
    dup 0= IF  2drop
	away? IF  "I'm back"  ELSE  "Away from keyboard"  THEN
	away? 0= to away?
    THEN
    [: $, msg-action ;] send-avalanche ;
synonym /back /away

: /otr ( addr u -- )
    \U otr on|off|message   turn otr mode on/off (or one-shot)
    2dup s" on" str= >r
    2dup s" off" str= r@ or IF   2drop r> otr-mode !
	<info> ." === " otr-mode @ IF  ." enter"  ELSE  ." leave"  THEN
	."  otr mode ===" <default> forth:cr