· 7 years ago · May 07, 2018, 02:34 PM
1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2module Hanyx.Crypto.Ed25519 where
3
4import Control.DeepSeq
5
6import Data.Bits
7import Data.ByteArray (ByteArrayAccess, Bytes, ScrubbedBytes,
8 View)
9import qualified Data.ByteArray as B
10import Data.Word
11
12import Foreign.Storable
13
14import Crypto.ECC.Edwards25519
15import Crypto.Error
16import Crypto.Hash
17import Crypto.Random
18
19
20-- | An Ed25519 Secret key
21newtype SecretKey = SecretKey ScrubbedBytes
22 deriving (Show,Eq,ByteArrayAccess,NFData)
23
24-- | An Ed25519 public key
25newtype PublicKey = PublicKey Bytes
26 deriving (Show,Eq,ByteArrayAccess,NFData)
27
28-- | An Ed25519 signature
29newtype Signature = Signature Bytes
30 deriving (Show,Eq,ByteArrayAccess,NFData)
31
32-- | Size of public keys
33publicKeySize :: Int
34publicKeySize = 32
35
36-- | Size of secret keys
37secretKeySize :: Int
38secretKeySize = 32
39
40-- | Size of signatures
41signatureSize :: Int
42signatureSize = 64
43
44
45-- Constructors
46
47-- | Try to build a public key from a bytearray
48publicKey :: ByteArrayAccess ba
49 => ba -> CryptoFailable PublicKey
50publicKey bs
51 | B.length bs == publicKeySize =
52 CryptoPassed (PublicKey $ B.convert bs)
53 | otherwise =
54 CryptoFailed CryptoError_PublicKeySizeInvalid
55
56-- | Try to build a secret key from a bytearray
57secretKey :: ByteArrayAccess ba
58 => ba -> CryptoFailable SecretKey
59secretKey bs
60 | B.length bs == secretKeySize =
61 CryptoPassed (SecretKey $ B.convert bs)
62 | otherwise =
63 CryptoFailed CryptoError_SecretKeyStructureInvalid
64
65-- | Try to build a signature from a bytearray
66signature :: ByteArrayAccess ba
67 => ba -> CryptoFailable Signature
68signature bs
69 | B.length bs == signatureSize =
70 CryptoPassed (Signature $ B.convert bs)
71 | otherwise =
72 CryptoFailed CryptoError_SecretKeyStructureInvalid
73
74
75-- Conversions
76
77-- | Generate a secret key
78generateSecretKey :: MonadRandom m => m SecretKey
79generateSecretKey = SecretKey <$> getRandomBytes secretKeySize
80
81-- | Create a public key from a secret key
82toPublic :: SecretKey -> PublicKey
83toPublic priv = pointPublic (toPoint $ secretScalar priv)
84
85-- | Create a scalar from an Ed25519 secret key
86secretScalar :: SecretKey -> Scalar
87secretScalar priv = fst (scheduleSecret priv)
88
89
90-- Ed25519 signature generation & verification
91--
92
93-- | Signs a message using a scalar and a point
94sign' :: ByteArrayAccess msg => Scalar -> Point -> msg -> Signature
95sign' a pnt msg =
96 let pk = pointEncode pnt :: Bytes
97 sk = scalarEncode a :: Bytes
98 rH = hashFinalize $ hashUpdate (hashUpdate hashInitWithDom sk) msg
99 r = decodeScalarNoErr rH
100 pR = toPoint r
101 sK = getK (pointPublic pnt) pR msg
102 sS = scalarAdd r (scalarMul sK a)
103 in encodeSignature (pR, sS)
104
105-- | Sign a message using the key pair
106sign :: ByteArrayAccess msg => SecretKey -> PublicKey -> msg -> Signature
107sign priv pub msg =
108 let (s, prefix) = scheduleSecret priv
109 digR = hashFinalize $ hashUpdate (hashUpdate hashInitWithDom prefix) msg
110 r = decodeScalarNoErr digR
111 pR = toPoint r
112 sK = getK pub pR msg
113 sS = scalarAdd r (scalarMul sK s)
114 in encodeSignature (pR, sS)
115
116-- | Verify a message
117verify :: ByteArrayAccess msg => PublicKey -> msg -> Signature -> Bool
118verify pub msg sig =
119 case doVerify of
120 CryptoPassed verified -> verified
121 CryptoFailed _ -> False
122 where
123 doVerify = do
124 (pR, sS) <- decodeSignature sig
125 nPub <- pointNegate `fmap` publicPoint pub
126 let sK = getK pub pR msg
127 pR' = pointsMulVarTime sS sK nPub
128 return (pR == pR')
129
130getK :: ByteArrayAccess msg => PublicKey -> Point -> msg -> Scalar
131getK pub pR msg =
132 let bsR = pointEncode pR :: Bytes
133 digK = hashFinalize $ hashUpdate (hashUpdate (hashUpdate hashInitWithDom bsR) pub) msg
134 in decodeScalarNoErr digK
135
136encodeSignature :: (Point, Scalar) -> Signature
137encodeSignature (pR, sS) =
138 let bsS = scalarEncode sS :: Bytes
139 len0 = signatureSize - publicKeySize - B.length bsS
140 in Signature $ B.concat [ pointEncode pR, bsS, B.zero len0 ]
141
142decodeSignature :: Signature -> CryptoFailable (Point, Scalar)
143decodeSignature (Signature bs) = do
144 let (bsR, bsS) = B.splitAt publicKeySize bs
145 pR <- pointDecode bsR
146 sS <- scalarDecodeLong bsS
147 return (pR, sS)
148
149-- implementation is supposed to decode any scalar up to the size of the digest
150decodeScalarNoErr :: ByteArrayAccess bs => bs -> Scalar
151decodeScalarNoErr = throwCryptoError . scalarDecodeLong
152
153decodePointNoErr :: ByteArrayAccess bs => bs -> Point
154decodePointNoErr = throwCryptoError . pointDecode
155
156type HashAlg = SHA512
157
158-- prepare hash context with specified parameters
159hashInitWithDom :: Context HashAlg
160hashInitWithDom = hashInitWith SHA512
161
162pointPublic :: Point -> PublicKey
163pointPublic = PublicKey . pointEncode
164
165publicPoint :: PublicKey -> CryptoFailable Point
166publicPoint = pointDecode
167
168-- how to use bits in a secret key
169scheduleSecret :: SecretKey -> (Scalar, View (Digest HashAlg))
170scheduleSecret priv = (decodeScalarNoErr clamped, B.dropView hashed 32)
171 where
172 hashed = hashWith SHA512 priv
173
174 clamped :: Bytes
175 clamped = B.copyAndFreeze (B.takeView hashed 32) $ \p -> do
176 b0 <- peekElemOff p 0 :: IO Word8
177 b31 <- peekElemOff p 31 :: IO Word8
178 pokeElemOff p 31 ((b31 .&. 0x7F) .|. 0x40)
179 pokeElemOff p 0 (b0 .&. 0xF8)