diff options
Diffstat (limited to 'Crypto/XEd25519.hs')
-rw-r--r-- | Crypto/XEd25519.hs | 193 |
1 files changed, 193 insertions, 0 deletions
diff --git a/Crypto/XEd25519.hs b/Crypto/XEd25519.hs new file mode 100644 index 0000000..1088347 --- /dev/null +++ b/Crypto/XEd25519.hs | |||
@@ -0,0 +1,193 @@ | |||
1 | module Crypto.XEd25519 where | ||
2 | |||
3 | import Control.Arrow | ||
4 | import Data.Bits | ||
5 | import Data.ByteArray as BA | ||
6 | import Data.Memory.PtrMethods (memCopy) | ||
7 | import Crypto.Hash | ||
8 | import Crypto.ECC.Edwards25519 | ||
9 | import Crypto.Error | ||
10 | import qualified Crypto.PubKey.Ed25519 as Ed25519 | ||
11 | import Foreign.Marshal | ||
12 | import Foreign.Ptr | ||
13 | import Foreign.Storable | ||
14 | import qualified Crypto.PubKey.Curve25519 as X25519 | ||
15 | |||
16 | import Crypto.XEd25519.FieldElement | ||
17 | -- import Crypto.Nonce | ||
18 | |||
19 | |||
20 | data SecretKey = SecretKey { secretScalar :: Scalar } | ||
21 | |||
22 | data PublicKey = PublicKey Ed25519.PublicKey | ||
23 | deriving Eq | ||
24 | |||
25 | -- type Nonce = Nonce32 | ||
26 | type Nonce = Bytes -- 32 bytes | ||
27 | |||
28 | newtype EncodedPoint = EncodedPoint Point | ||
29 | |||
30 | instance ByteArrayAccess SecretKey where | ||
31 | length _ = 32 | ||
32 | withByteArray (SecretKey scalar) = withByteArray (scalarEncode scalar :: Bytes) | ||
33 | |||
34 | instance ByteArrayAccess PublicKey where | ||
35 | length _ = 32 | ||
36 | withByteArray (PublicKey edpub) = withByteArray edpub | ||
37 | |||
38 | instance ByteArrayAccess EncodedPoint where | ||
39 | length _ = 32 | ||
40 | withByteArray (EncodedPoint pt) f = | ||
41 | withByteArray (pointEncode pt :: Bytes) f | ||
42 | |||
43 | |||
44 | data Signature = Signature EncodedPoint Scalar | ||
45 | |||
46 | instance ByteArrayAccess Signature where | ||
47 | length _ = 64 | ||
48 | withByteArray (Signature pt scalar) f = | ||
49 | withByteArray pt $ \ptptr -> do | ||
50 | withByteArray (SecretKey scalar) $ \scalarptr -> do | ||
51 | allocaBytes 64 $ \ptr -> do | ||
52 | memCopy ptr ptptr 32 | ||
53 | memCopy (ptr `plusPtr` 32) scalarptr 32 | ||
54 | f (castPtr ptr) | ||
55 | |||
56 | signatureDecode :: ByteArrayAccess ba => ba -> Maybe Signature | ||
57 | signatureDecode bs = do | ||
58 | let (ptbs,scbs) = BA.splitAt 32 ( BA.convert bs :: Bytes) | ||
59 | pt <- maybeCryptoError $ pointDecode ptbs | ||
60 | sc <- maybeCryptoError $ scalarDecodeLong scbs | ||
61 | return $ Signature (ge_p3_tobytes pt) sc | ||
62 | |||
63 | |||
64 | padding :: Bytes | ||
65 | padding = 0xFE `BA.cons` BA.replicate 31 0xFF | ||
66 | |||
67 | sign :: ByteArrayAccess dta => dta -> Nonce -> SecretKey -> PublicKey -> Signature | ||
68 | sign dta nonce sec pub = Signature rB s | ||
69 | where | ||
70 | rB = ge_p3_tobytes $ ge_scalarmult_base r | ||
71 | |||
72 | r = sc_reduce $ hashFinalize $ (`hashUpdate` padding) | ||
73 | >>> (`hashUpdate` sec) | ||
74 | >>> (`hashUpdate` dta) | ||
75 | >>> (`hashUpdate` nonce) $ hashInit | ||
76 | |||
77 | h = sc_reduce $ hashFinalize $ (`hashUpdate` rB) | ||
78 | >>> (`hashUpdate` pub) | ||
79 | >>> (`hashUpdate` dta) $ hashInit | ||
80 | |||
81 | -- s = r + ha (mod q) | ||
82 | s = sc_muladd h (secretScalar sec) r | ||
83 | |||
84 | |||
85 | |||
86 | ge_p3_tobytes :: Point -> EncodedPoint | ||
87 | ge_p3_tobytes = EncodedPoint | ||
88 | |||
89 | ge_scalarmult_base :: Scalar -> Point | ||
90 | ge_scalarmult_base = toPoint | ||
91 | |||
92 | sc_muladd :: Scalar -> Scalar -> Scalar -> Scalar | ||
93 | sc_muladd a b c = scalarAdd (scalarMul a b) c | ||
94 | |||
95 | sc_reduce :: Digest SHA512 -> Scalar | ||
96 | sc_reduce digest = x where CryptoPassed x = scalarDecodeLong digest -- ??? | ||
97 | |||
98 | -- Scalar is internally, at least on 64bit machines, represented as 5 | ||
99 | -- 56-bit words in little-endian order, each encoded as a Word64. | ||
100 | sc_neg :: Scalar -> Scalar | ||
101 | sc_neg = scalarMul sc_neg1 | ||
102 | |||
103 | verify :: ByteArrayAccess dta => PublicKey -> dta -> Signature -> Bool | ||
104 | verify pub dta signature = Ed25519.verify ed_pub dta ed_sig | ||
105 | where | ||
106 | CryptoPassed ed_pub = Ed25519.publicKey pub' | ||
107 | CryptoPassed ed_sig = Ed25519.signature signature' | ||
108 | |||
109 | -- Get the sign bit from the s part of the signature. | ||
110 | sign_bit = BA.index signature 63 .&. 0x80 | ||
111 | |||
112 | -- Set the sign bit to zero in the s part of the signature. | ||
113 | signature' :: Bytes | ||
114 | signature' = BA.copyAndFreeze signature $ \ptr -> do | ||
115 | let at63 = plusPtr ptr 63 | ||
116 | byte63 <- peek at63 | ||
117 | poke at63 $ byte63 .&. (0x7F `asTypeOf` sign_bit) | ||
118 | |||
119 | -- Restore the sign bit on the verification key, which should have 0 as its | ||
120 | -- current sign bit. | ||
121 | pub' :: Bytes | ||
122 | pub' = BA.copyAndFreeze pub $ \ptr -> do | ||
123 | let at31 = plusPtr ptr 31 | ||
124 | byte31 <- peek at31 | ||
125 | poke at31 $ (byte31 .&. 0x7F) .|. sign_bit | ||
126 | |||
127 | |||
128 | -- typedef crypto_int32 fe[10]; | ||
129 | -- | ||
130 | -- fe means field element. Here the field is \Z/(2^255-19). | ||
131 | -- An element t, entries t[0]...t[9], represents the integer | ||
132 | -- t[0]+2^26 t[1]+2^51 t[2]+2^77 t[3]+2^102 t[4]+...+2^230 t[9]. | ||
133 | -- Bounds on each t[i] vary depending on context. | ||
134 | |||
135 | -- mont_pub_to_ed_pub | ||
136 | toSigningKey :: X25519.PublicKey -> PublicKey | ||
137 | toSigningKey mont_pub0 = PublicKey ed_pub | ||
138 | where | ||
139 | -- Read the public key as a field element | ||
140 | mont_pub = fe_frombytes mont_pub0 | ||
141 | |||
142 | -- Convert the Montgomery public key to a twisted Edwards public key | ||
143 | fe_ONE = fe_1 | ||
144 | |||
145 | -- Calculate the parameters (u - 1) and (u + 1) | ||
146 | mont_pub_minus_one = fe_sub mont_pub fe_ONE | ||
147 | mont_pub_plus_one0 = fe_add mont_pub fe_ONE | ||
148 | |||
149 | -- Prepare inv(u + 1) | ||
150 | mont_pub_plus_one = fe_invert mont_pub_plus_one0 | ||
151 | |||
152 | -- Calculate y = (u - 1) * inv(u + 1) (mod p) | ||
153 | ed_pub0 = fe_mul mont_pub_minus_one mont_pub_plus_one | ||
154 | ed_pub = fe_tobytes ed_pub0 | ||
155 | |||
156 | -- mont_priv_to_ed_pair | ||
157 | toSigningKeyPair :: X25519.SecretKey -> (SecretKey,PublicKey) | ||
158 | toSigningKeyPair mont_priv0 = (SecretKey ed_priv, PublicKey ed_pub) | ||
159 | where | ||
160 | -- Prepare a buffer for the twisted Edwards private key | ||
161 | ed_priv1 = (throwCryptoError . scalarDecodeLong :: X25519.SecretKey -> Scalar) mont_priv0 | ||
162 | |||
163 | -- Get the twisted edwards public key, including the sign bit | ||
164 | ed_pub0 = ge_p3_tobytes $ ge_scalarmult_base ed_priv1 | ||
165 | |||
166 | -- Save the sign bit for later | ||
167 | sign_bit = (BA.index ed_pub0 31 `shiftR` 7) .&. 1 | ||
168 | |||
169 | -- Force the sign bit to zero | ||
170 | pub' :: Bytes | ||
171 | pub' = BA.copyAndFreeze ed_pub0 $ \ptr -> do | ||
172 | let at31 = plusPtr ptr 31 | ||
173 | byte31 <- peek at31 | ||
174 | poke at31 $ (byte31 .&. 0x7F) `asTypeOf` sign_bit | ||
175 | |||
176 | CryptoPassed ed_pub = Ed25519.publicKey pub' | ||
177 | |||
178 | |||
179 | -- Prepare the negated private key | ||
180 | ed_priv_neg = sc_neg ed_priv1 | ||
181 | |||
182 | -- Get the correct private key based on the sign stored above | ||
183 | ed_priv = if sign_bit/=0 then ed_priv_neg | ||
184 | else ed_priv1 | ||
185 | |||
186 | -- sc_zero = throwCryptoError $ scalarDecodeLong (b::Bytes) | ||
187 | -- where | ||
188 | -- b = BA.pack $ encodeLittleEndian $ 2^252 + 27742317777372353535851937790883648493 | ||
189 | |||
190 | sc_neg1 :: Scalar | ||
191 | sc_neg1 = throwCryptoError $ scalarDecodeLong (b::Bytes) | ||
192 | where | ||
193 | b = BA.pack $ encodeLittleEndian $ 2^252 + 27742317777372353535851937790883648492 | ||