summaryrefslogtreecommitdiff
path: root/dht/src/Crypto/XEd25519.hs
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