\ Interface to the ed25519 primitives from donna 23oct2013py
\ Copyright (C) 2013-2015 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/>.
\ The high level stuff is all in Forth
\ dummy load for Android
require rec-scope.fs
require unix/cpu.fs
fast-lib [IF]
require ed25519-donnafast.fs
[ELSE]
[IFDEF] android
s" libed25519prims.so" c-lib:open-path-lib drop
[THEN]
c-library ed25519_donna
"ed25519prims" add-lib
include ed25519-donnalib.fs
end-c-library
[THEN]
[IFUNDEF] class bye [THEN] \ stop here if libcompile only
: 32b>sc25519 32 nb>sc25519 ;
: 64b>sc25519 64 nb>sc25519 ;
$20 Constant KEYBYTES
user-o edbuf
object class
$60 uvar sigbuf
$30 uvar sct0
$30 uvar sct1
$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
up@ task-id ! ;
init-ed25519
: free-ed25519 ( -- )
edbuf @ ?dup-IF [: .dispose ;] crypto-a with-allocater THEN
edbuf off ;
:noname defers 'image edbuf off ; is 'image
: clean-ed25519 ( -- )
\g do this every time you computed using something secret
sct0 task-id over - erase ;
: sk-mask ( sk -- ) dup c@ $F8 and over c!
$1F + dup c@ $7F and $40 or swap c! ;
: gen-sk ( sk -- ) >r
\G generate a secret key with the right bits set and cleared
$20 rng$ r@ swap move r> sk-mask ;
: sk>pk ( sk pk -- )
\G convert a secret key to a public key
sct0 rot raw>sc25519
get0 sct0 ge25519*base
get0 ge25519-pack clean-ed25519 ;
: ed-keypair ( sk pk -- )
\G generate a keypair
over gen-sk sk>pk ;
: ed-keypairx { sk1 pkrev skc pkc -- }
sct2 sk1 raw>sc25519
pkrev sk-mask sct1 pkrev raw>sc25519
sk1 KEYBYTES erase pkrev KEYBYTES erase \ things we don't need anymore
sct2 sct2 sct1 sc25519*
skc sct2 sc25519>32b
skc pkc sk>pk ; \ this also cleans up temp stuff
: >hash ( addr u -- )
\G absorb a short string, perform a hash round
\G and output 64 bytes to hashtmp
c:shorthash hashtmp $40 c:hash@ ;
: ed-sign { skh sk pk -- sig u }
\G sign a message: the keccak state contains the hash of the message.
c:key@ hstatetmp c:key# move \ we need this twice - move away
skh $20 >hash \ gen "random number" from secret to hashtmp
hstatetmp c:key@ c:key# move \ restore state
sct3 hashtmp 64b>sc25519 \ sct3 is k
get0 sct3 ge25519*base \ get0 is r=k*base
sigbuf get0 ge25519-pack
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
skh $20 >hash \ gen "random number" from secret to hashtmp
hstatetmp c:key@ c:key# move \ restore state
sct3 hashtmp 64b>sc25519 \ sct3 is k
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
sct1 sk raw>sc25519 \ sct1 is sk
sct1 sct2 sct1 sc25519* \ sct1 is z*sk
sct3 sct3 sct1 sc25519+ \ sct3 is s=z*sk+k
sigbuf $40 + sct3 sc25519>32b
sigbuf $40 + sig $20 + 32b= ?dup-0=-IF
\ 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
get1 get0 sct2 ge25519*
dest get1 ge25519-pack
clean-ed25519 dest $20 $80 dest $1F + xorc! ;
: ed-dhx { offset sk pk dest -- secret len }
pk pktmp $20 move
get0 pktmp ge25519-unpack- 0= !!no-ed-key!!
sct2 sk raw>sc25519
offset pktmp $20 move
sct1 pktmp 32b>sc25519
sct2 sct2 sct1 sc25519*
get1 get0 sct2 ge25519*
dest get1 ge25519-pack
clean-ed25519 dest $20 $80 dest $1F + xorc! ;
\ : ed-dhv { sk pk dest -- secret len }
\ get0 pk ge25519-unpack- 0= !!no-ed-key!!
\ sct2 sk raw>sc25519
\ get1 get0 sct2 ge25519*v
\ dest get1 ge25519-pack
\ clean-ed25519 dest $20 $80 dest $1F + xorc! ;