1-- | 2-- Module : Crypto.PubKey.EdDSA 3-- License : BSD-style 4-- Maintainer : Olivier Chéron <olivier.cheron@gmail.com> 5-- Stability : experimental 6-- Portability : unknown 7-- 8-- EdDSA signature generation and verification, implemented in Haskell and 9-- parameterized with elliptic curve and hash algorithm. Only edwards25519 is 10-- supported at the moment. 11-- 12-- The module provides \"context\" and \"prehash\" variants defined in 13-- <https://tools.ietf.org/html/rfc8032 RFC 8032>. 14-- 15-- This implementation is most useful when wanting to customize the hash 16-- algorithm. See module "Crypto.PubKey.Ed25519" for faster Ed25519 with 17-- SHA-512. 18-- 19{-# LANGUAGE DataKinds #-} 20{-# LANGUAGE FlexibleContexts #-} 21{-# LANGUAGE GeneralizedNewtypeDeriving #-} 22{-# LANGUAGE OverloadedStrings #-} 23{-# LANGUAGE RankNTypes #-} 24{-# LANGUAGE ScopedTypeVariables #-} 25{-# LANGUAGE TypeFamilies #-} 26module Crypto.PubKey.EdDSA 27 ( SecretKey 28 , PublicKey 29 , Signature 30 -- * Curves with EdDSA implementation 31 , EllipticCurveEdDSA(CurveDigestSize) 32 , publicKeySize 33 , secretKeySize 34 , signatureSize 35 -- * Smart constructors 36 , signature 37 , publicKey 38 , secretKey 39 -- * Methods 40 , toPublic 41 , sign 42 , signCtx 43 , signPh 44 , verify 45 , verifyCtx 46 , verifyPh 47 , generateSecretKey 48 ) where 49 50import Data.Bits 51import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes, View) 52import qualified Data.ByteArray as B 53import Data.ByteString (ByteString) 54import Data.Proxy 55 56import Crypto.ECC 57import qualified Crypto.ECC.Edwards25519 as Edwards25519 58import Crypto.Error 59import Crypto.Hash (Digest) 60import Crypto.Hash.IO 61import Crypto.Random 62 63import GHC.TypeLits (KnownNat, Nat) 64 65import Crypto.Internal.Builder 66import Crypto.Internal.Compat 67import Crypto.Internal.Imports 68import Crypto.Internal.Nat (integralNatVal) 69 70import Foreign.Storable 71 72 73-- API 74 75-- | An EdDSA Secret key 76newtype SecretKey curve = SecretKey ScrubbedBytes 77 deriving (Show,Eq,ByteArrayAccess,NFData) 78 79-- | An EdDSA public key 80newtype PublicKey curve hash = PublicKey Bytes 81 deriving (Show,Eq,ByteArrayAccess,NFData) 82 83-- | An EdDSA signature 84newtype Signature curve hash = Signature Bytes 85 deriving (Show,Eq,ByteArrayAccess,NFData) 86 87-- | Elliptic curves with an implementation of EdDSA 88class ( EllipticCurveBasepointArith curve 89 , KnownNat (CurveDigestSize curve) 90 ) => EllipticCurveEdDSA curve where 91 92 -- | Size of the digest for this curve (in bytes) 93 type CurveDigestSize curve :: Nat 94 95 -- | Size of secret keys for this curve (in bytes) 96 secretKeySize :: proxy curve -> Int 97 98 -- hash with specified parameters 99 hashWithDom :: (HashAlgorithm hash, ByteArrayAccess ctx, ByteArrayAccess msg) 100 => proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes 101 102 -- conversion between scalar, point and public key 103 pointPublic :: proxy curve -> Point curve -> PublicKey curve hash 104 publicPoint :: proxy curve -> PublicKey curve hash -> CryptoFailable (Point curve) 105 encodeScalarLE :: ByteArray bs => proxy curve -> Scalar curve -> bs 106 decodeScalarLE :: ByteArrayAccess bs => proxy curve -> bs -> CryptoFailable (Scalar curve) 107 108 -- how to use bits in a secret key 109 scheduleSecret :: ( HashAlgorithm hash 110 , HashDigestSize hash ~ CurveDigestSize curve 111 ) 112 => proxy curve 113 -> hash 114 -> SecretKey curve 115 -> (Scalar curve, View Bytes) 116 117-- | Size of public keys for this curve (in bytes) 118publicKeySize :: EllipticCurveEdDSA curve => proxy curve -> Int 119publicKeySize prx = signatureSize prx `div` 2 120 121-- | Size of signatures for this curve (in bytes) 122signatureSize :: forall proxy curve . EllipticCurveEdDSA curve 123 => proxy curve -> Int 124signatureSize _ = integralNatVal (Proxy :: Proxy (CurveDigestSize curve)) 125 126 127-- Constructors 128 129-- | Try to build a public key from a bytearray 130publicKey :: ( EllipticCurveEdDSA curve 131 , HashAlgorithm hash 132 , HashDigestSize hash ~ CurveDigestSize curve 133 , ByteArrayAccess ba 134 ) 135 => proxy curve -> hash -> ba -> CryptoFailable (PublicKey curve hash) 136publicKey prx _ bs 137 | B.length bs == publicKeySize prx = 138 CryptoPassed (PublicKey $ B.convert bs) 139 | otherwise = 140 CryptoFailed CryptoError_PublicKeySizeInvalid 141 142-- | Try to build a secret key from a bytearray 143secretKey :: (EllipticCurveEdDSA curve, ByteArrayAccess ba) 144 => proxy curve -> ba -> CryptoFailable (SecretKey curve) 145secretKey prx bs 146 | B.length bs == secretKeySize prx = 147 CryptoPassed (SecretKey $ B.convert bs) 148 | otherwise = 149 CryptoFailed CryptoError_SecretKeyStructureInvalid 150 151-- | Try to build a signature from a bytearray 152signature :: ( EllipticCurveEdDSA curve 153 , HashAlgorithm hash 154 , HashDigestSize hash ~ CurveDigestSize curve 155 , ByteArrayAccess ba 156 ) 157 => proxy curve -> hash -> ba -> CryptoFailable (Signature curve hash) 158signature prx _ bs 159 | B.length bs == signatureSize prx = 160 CryptoPassed (Signature $ B.convert bs) 161 | otherwise = 162 CryptoFailed CryptoError_SecretKeyStructureInvalid 163 164 165-- Conversions 166 167-- | Generate a secret key 168generateSecretKey :: (EllipticCurveEdDSA curve, MonadRandom m) 169 => proxy curve -> m (SecretKey curve) 170generateSecretKey prx = SecretKey <$> getRandomBytes (secretKeySize prx) 171 172-- | Create a public key from a secret key 173toPublic :: ( EllipticCurveEdDSA curve 174 , HashAlgorithm hash 175 , HashDigestSize hash ~ CurveDigestSize curve 176 ) 177 => proxy curve -> hash -> SecretKey curve -> PublicKey curve hash 178toPublic prx alg priv = 179 let p = pointBaseSmul prx (secretScalar prx alg priv) 180 in pointPublic prx p 181 182secretScalar :: ( EllipticCurveEdDSA curve 183 , HashAlgorithm hash 184 , HashDigestSize hash ~ CurveDigestSize curve 185 ) 186 => proxy curve -> hash -> SecretKey curve -> Scalar curve 187secretScalar prx alg priv = fst (scheduleSecret prx alg priv) 188 189 190-- EdDSA signature generation & verification 191 192-- | Sign a message using the key pair 193sign :: ( EllipticCurveEdDSA curve 194 , HashAlgorithm hash 195 , HashDigestSize hash ~ CurveDigestSize curve 196 , ByteArrayAccess msg 197 ) 198 => proxy curve -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash 199sign prx = signCtx prx emptyCtx 200 201-- | Verify a message 202verify :: ( EllipticCurveEdDSA curve 203 , HashAlgorithm hash 204 , HashDigestSize hash ~ CurveDigestSize curve 205 , ByteArrayAccess msg 206 ) 207 => proxy curve -> PublicKey curve hash -> msg -> Signature curve hash -> Bool 208verify prx = verifyCtx prx emptyCtx 209 210-- | Sign a message using the key pair under context @ctx@ 211signCtx :: ( EllipticCurveEdDSA curve 212 , HashAlgorithm hash 213 , HashDigestSize hash ~ CurveDigestSize curve 214 , ByteArrayAccess ctx 215 , ByteArrayAccess msg 216 ) 217 => proxy curve -> ctx -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash 218signCtx prx = signPhCtx prx False 219 220-- | Verify a message under context @ctx@ 221verifyCtx :: ( EllipticCurveEdDSA curve 222 , HashAlgorithm hash 223 , HashDigestSize hash ~ CurveDigestSize curve 224 , ByteArrayAccess ctx 225 , ByteArrayAccess msg 226 ) 227 => proxy curve -> ctx -> PublicKey curve hash -> msg -> Signature curve hash -> Bool 228verifyCtx prx = verifyPhCtx prx False 229 230-- | Sign a prehashed message using the key pair under context @ctx@ 231signPh :: ( EllipticCurveEdDSA curve 232 , HashAlgorithm hash 233 , HashDigestSize hash ~ CurveDigestSize curve 234 , ByteArrayAccess ctx 235 ) 236 => proxy curve -> ctx -> SecretKey curve -> PublicKey curve hash -> Digest prehash -> Signature curve hash 237signPh prx = signPhCtx prx True 238 239-- | Verify a prehashed message under context @ctx@ 240verifyPh :: ( EllipticCurveEdDSA curve 241 , HashAlgorithm hash 242 , HashDigestSize hash ~ CurveDigestSize curve 243 , ByteArrayAccess ctx 244 ) 245 => proxy curve -> ctx -> PublicKey curve hash -> Digest prehash -> Signature curve hash -> Bool 246verifyPh prx = verifyPhCtx prx True 247 248signPhCtx :: forall proxy curve hash ctx msg . 249 ( EllipticCurveEdDSA curve 250 , HashAlgorithm hash 251 , HashDigestSize hash ~ CurveDigestSize curve 252 , ByteArrayAccess ctx 253 , ByteArrayAccess msg 254 ) 255 => proxy curve -> Bool -> ctx -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash 256signPhCtx prx ph ctx priv pub msg = 257 let alg = undefined :: hash 258 (s, prefix) = scheduleSecret prx alg priv 259 digR = hashWithDom prx alg ph ctx (bytes prefix) msg 260 r = decodeScalarNoErr prx digR 261 pR = pointBaseSmul prx r 262 bsR = encodePoint prx pR 263 sK = getK prx ph ctx pub bsR msg 264 sS = scalarAdd prx r (scalarMul prx sK s) 265 in encodeSignature prx (bsR, pR, sS) 266 267verifyPhCtx :: ( EllipticCurveEdDSA curve 268 , HashAlgorithm hash 269 , HashDigestSize hash ~ CurveDigestSize curve 270 , ByteArrayAccess ctx 271 , ByteArrayAccess msg 272 ) 273 => proxy curve -> Bool -> ctx -> PublicKey curve hash -> msg -> Signature curve hash -> Bool 274verifyPhCtx prx ph ctx pub msg sig = 275 case doVerify of 276 CryptoPassed verified -> verified 277 CryptoFailed _ -> False 278 where 279 doVerify = do 280 (bsR, pR, sS) <- decodeSignature prx sig 281 nPub <- pointNegate prx `fmap` publicPoint prx pub 282 let sK = getK prx ph ctx pub bsR msg 283 pR' = pointsSmulVarTime prx sS sK nPub 284 return (pR == pR') 285 286emptyCtx :: Bytes 287emptyCtx = B.empty 288 289getK :: forall proxy curve hash ctx msg . 290 ( EllipticCurveEdDSA curve 291 , HashAlgorithm hash 292 , HashDigestSize hash ~ CurveDigestSize curve 293 , ByteArrayAccess ctx 294 , ByteArrayAccess msg 295 ) 296 => proxy curve -> Bool -> ctx -> PublicKey curve hash -> Bytes -> msg -> Scalar curve 297getK prx ph ctx (PublicKey pub) bsR msg = 298 let alg = undefined :: hash 299 digK = hashWithDom prx alg ph ctx (bytes bsR <> bytes pub) msg 300 in decodeScalarNoErr prx digK 301 302encodeSignature :: EllipticCurveEdDSA curve 303 => proxy curve 304 -> (Bytes, Point curve, Scalar curve) 305 -> Signature curve hash 306encodeSignature prx (bsR, _, sS) = Signature $ buildAndFreeze $ 307 bytes bsR <> bytes bsS <> zero len0 308 where 309 bsS = encodeScalarLE prx sS :: Bytes 310 len0 = signatureSize prx - B.length bsR - B.length bsS 311 312decodeSignature :: ( EllipticCurveEdDSA curve 313 , HashDigestSize hash ~ CurveDigestSize curve 314 ) 315 => proxy curve 316 -> Signature curve hash 317 -> CryptoFailable (Bytes, Point curve, Scalar curve) 318decodeSignature prx (Signature bs) = do 319 let (bsR, bsS) = B.splitAt (publicKeySize prx) bs 320 pR <- decodePoint prx bsR 321 sS <- decodeScalarLE prx bsS 322 return (bsR, pR, sS) 323 324-- implementations are supposed to decode any scalar up to the size of the digest 325decodeScalarNoErr :: (EllipticCurveEdDSA curve, ByteArrayAccess bs) 326 => proxy curve -> bs -> Scalar curve 327decodeScalarNoErr prx = unwrap "decodeScalarNoErr" . decodeScalarLE prx 328 329unwrap :: String -> CryptoFailable a -> a 330unwrap name (CryptoFailed _) = error (name ++ ": assumption failed") 331unwrap _ (CryptoPassed x) = x 332 333 334-- Ed25519 implementation 335 336instance EllipticCurveEdDSA Curve_Edwards25519 where 337 type CurveDigestSize Curve_Edwards25519 = 64 338 secretKeySize _ = 32 339 340 hashWithDom _ alg ph ctx bss 341 | not ph && B.null ctx = digestDomMsg alg bss 342 | otherwise = digestDomMsg alg (dom <> bss) 343 where dom = bytes ("SigEd25519 no Ed25519 collisions" :: ByteString) <> 344 byte (if ph then 1 else 0) <> 345 byte (fromIntegral $ B.length ctx) <> 346 bytes ctx 347 348 pointPublic _ = PublicKey . Edwards25519.pointEncode 349 publicPoint _ = Edwards25519.pointDecode 350 encodeScalarLE _ = Edwards25519.scalarEncode 351 decodeScalarLE _ = Edwards25519.scalarDecodeLong 352 353 scheduleSecret prx alg priv = 354 (decodeScalarNoErr prx clamped, B.dropView hashed 32) 355 where 356 hashed = digest alg $ \update -> update priv 357 358 clamped :: Bytes 359 clamped = B.copyAndFreeze (B.takeView hashed 32) $ \p -> do 360 b0 <- peekElemOff p 0 :: IO Word8 361 b31 <- peekElemOff p 31 :: IO Word8 362 pokeElemOff p 31 ((b31 .&. 0x7F) .|. 0x40) 363 pokeElemOff p 0 (b0 .&. 0xF8) 364 365 366{- 367 Optimize hashing by limiting the number of roundtrips between Haskell and C. 368 Hash "update" functions do not use unsafe FFI call, so better concanetate 369 small fragments together and call the update function once. 370 371 Using the IO hash interface avoids context buffer copies. 372 373 Data type Digest is not used directly but converted to Bytes early. Any use of 374 withByteArray on the unpinned Digest backend would require copy through a 375 pinned trampoline. 376-} 377 378digestDomMsg :: (HashAlgorithm alg, ByteArrayAccess msg) 379 => alg -> Builder -> msg -> Bytes 380digestDomMsg alg bss bs = digest alg $ \update -> 381 update (buildAndFreeze bss :: Bytes) >> update bs 382 383digest :: HashAlgorithm alg 384 => alg 385 -> ((forall bs . ByteArrayAccess bs => bs -> IO ()) -> IO ()) 386 -> Bytes 387digest alg fn = B.convert $ unsafeDoIO $ do 388 mc <- hashMutableInitWith alg 389 fn (hashMutableUpdate mc) 390 hashMutableFinalize mc 391