blob: 372f31a8cca52539672cb1ea19a627cfb810c915 (
plain)
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
|
module Crypto.XEd25519 where
import Control.Arrow
import Data.Bits
import Data.ByteArray as BA
import Data.Memory.PtrMethods (memCopy)
import Crypto.Hash
import Crypto.ECC.Edwards25519
import Crypto.Error
import qualified Crypto.PubKey.Ed25519 as Ed25519
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable
import qualified Crypto.PubKey.Curve25519 as X25519
import Crypto.XEd25519.FieldElement
import Crypto.Nonce
data SecretKey = SecretKey { secretScalar :: Scalar }
data PublicKey = PublicKey Ed25519.PublicKey
deriving Eq
type Nonce = Nonce32
newtype EncodedPoint = EncodedPoint Point
instance ByteArrayAccess SecretKey where
length _ = 32
withByteArray (SecretKey scalar) = withByteArray (scalarEncode scalar :: Bytes)
instance ByteArrayAccess PublicKey where
length _ = 32
withByteArray (PublicKey edpub) = withByteArray edpub
instance ByteArrayAccess EncodedPoint where
length _ = 32
withByteArray (EncodedPoint pt) f =
withByteArray (pointEncode pt :: Bytes) f
data Signature = Signature EncodedPoint Scalar
instance ByteArrayAccess Signature where
length _ = 64
withByteArray (Signature pt scalar) f =
withByteArray pt $ \ptptr -> do
withByteArray (SecretKey scalar) $ \scalarptr -> do
allocaBytes 64 $ \ptr -> do
memCopy ptr ptptr 32
memCopy (ptr `plusPtr` 32) scalarptr 32
f (castPtr ptr)
padding :: Bytes
padding = 0xFE `BA.cons` BA.replicate 31 0xFF
sign :: ByteArrayAccess dta => dta -> Nonce -> SecretKey -> PublicKey -> Signature
sign dta nonce sec pub = Signature rB s
where
rB = ge_p3_tobytes $ ge_scalarmult_base r
r = sc_reduce $ hashFinalize $ (`hashUpdate` padding)
>>> (`hashUpdate` sec)
>>> (`hashUpdate` dta)
>>> (`hashUpdate` nonce) $ hashInit
h = sc_reduce $ hashFinalize $ (`hashUpdate` rB)
>>> (`hashUpdate` pub)
>>> (`hashUpdate` dta) $ hashInit
-- s = r + ha (mod q)
s = sc_muladd h (secretScalar sec) r
ge_p3_tobytes :: Point -> EncodedPoint
ge_p3_tobytes = EncodedPoint
ge_scalarmult_base :: Scalar -> Point
ge_scalarmult_base = toPoint
sc_muladd :: Scalar -> Scalar -> Scalar -> Scalar
sc_muladd a b c = scalarAdd (scalarMul a b) c
sc_reduce :: Digest SHA512 -> Scalar
sc_reduce digest = x where CryptoPassed x = scalarDecodeLong digest -- ???
-- Scalar is internally, at least on 64bit machines, represented as 5
-- 56-bit words in little-endian order, each encoded as a Word64.
sc_neg :: Scalar -> Scalar
sc_neg = scalarMul sc_neg1
verify :: ByteArrayAccess dta => PublicKey -> dta -> Signature -> Bool
verify pub dta signature = Ed25519.verify ed_pub dta ed_sig
where
CryptoPassed ed_pub = Ed25519.publicKey pub'
CryptoPassed ed_sig = Ed25519.signature signature'
-- Get the sign bit from the s part of the signature.
sign_bit = BA.index signature 63 .&. 0x80
-- Set the sign bit to zero in the s part of the signature.
signature' :: Bytes
signature' = BA.copyAndFreeze signature $ \ptr -> do
let at63 = plusPtr ptr 63
byte63 <- peek at63
poke at63 $ byte63 .&. (0x7F `asTypeOf` sign_bit)
-- Restore the sign bit on the verification key, which should have 0 as its
-- current sign bit.
pub' :: Bytes
pub' = BA.copyAndFreeze pub $ \ptr -> do
let at31 = plusPtr ptr 31
byte31 <- peek at31
poke at31 $ (byte31 .&. 0x7F) .|. sign_bit
-- typedef crypto_int32 fe[10];
--
-- fe means field element. Here the field is \Z/(2^255-19).
-- An element t, entries t[0]...t[9], represents the integer
-- t[0]+2^26 t[1]+2^51 t[2]+2^77 t[3]+2^102 t[4]+...+2^230 t[9].
-- Bounds on each t[i] vary depending on context.
-- mont_pub_to_ed_pub
toSigningKey :: X25519.PublicKey -> PublicKey
toSigningKey mont_pub0 = PublicKey ed_pub
where
-- Read the public key as a field element
mont_pub = fe_frombytes mont_pub0
-- Convert the Montgomery public key to a twisted Edwards public key
fe_ONE = fe_1
-- Calculate the parameters (u - 1) and (u + 1)
mont_pub_minus_one = fe_sub mont_pub fe_ONE
mont_pub_plus_one0 = fe_add mont_pub fe_ONE
-- Prepare inv(u + 1)
mont_pub_plus_one = fe_invert mont_pub_plus_one0
-- Calculate y = (u - 1) * inv(u + 1) (mod p)
ed_pub0 = fe_mul mont_pub_minus_one mont_pub_plus_one
ed_pub = fe_tobytes ed_pub0
-- mont_priv_to_ed_pair
toSigningKeyPair :: X25519.SecretKey -> (SecretKey,PublicKey)
toSigningKeyPair mont_priv0 = (SecretKey ed_priv, PublicKey ed_pub)
where
-- Prepare a buffer for the twisted Edwards private key
ed_priv1 = (throwCryptoError . scalarDecodeLong :: X25519.SecretKey -> Scalar) mont_priv0
-- Get the twisted edwards public key, including the sign bit
ed_pub0 = ge_p3_tobytes $ ge_scalarmult_base ed_priv1
-- Save the sign bit for later
sign_bit = (BA.index ed_pub0 31 `shiftR` 7) .&. 1
-- Force the sign bit to zero
pub' :: Bytes
pub' = BA.copyAndFreeze ed_pub0 $ \ptr -> do
let at31 = plusPtr ptr 31
byte31 <- peek at31
poke at31 $ (byte31 .&. 0x7F) `asTypeOf` sign_bit
CryptoPassed ed_pub = Ed25519.publicKey pub'
-- Prepare the negated private key
ed_priv_neg = sc_neg ed_priv1
-- Get the correct private key based on the sign stored above
ed_priv = if sign_bit/=0 then ed_priv_neg
else ed_priv1
-- sc_zero = throwCryptoError $ scalarDecodeLong (b::Bytes)
-- where
-- b = BA.pack $ encodeLittleEndian $ 2^252 + 27742317777372353535851937790883648493
sc_neg1 :: Scalar
sc_neg1 = throwCryptoError $ scalarDecodeLong (b::Bytes)
where
b = BA.pack $ encodeLittleEndian $ 2^252 + 27742317777372353535851937790883648492
|
