1-- | 2-- Module : Crypto.PubKey.Curve25519 3-- License : BSD-style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : unknown 7-- 8-- Curve25519 support 9-- 10{-# LANGUAGE GeneralizedNewtypeDeriving #-} 11{-# LANGUAGE MagicHash #-} 12{-# LANGUAGE ScopedTypeVariables #-} 13module Crypto.PubKey.Curve25519 14 ( SecretKey 15 , PublicKey 16 , DhSecret 17 -- * Smart constructors 18 , dhSecret 19 , publicKey 20 , secretKey 21 -- * Methods 22 , dh 23 , toPublic 24 , generateSecretKey 25 ) where 26 27import Data.Bits 28import Data.Word 29import Foreign.Ptr 30import Foreign.Storable 31import GHC.Ptr 32 33import Crypto.Error 34import Crypto.Internal.Compat 35import Crypto.Internal.Imports 36import Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes, Bytes, withByteArray) 37import qualified Crypto.Internal.ByteArray as B 38import Crypto.Random 39 40-- | A Curve25519 Secret key 41newtype SecretKey = SecretKey ScrubbedBytes 42 deriving (Show,Eq,ByteArrayAccess,NFData) 43 44-- | A Curve25519 public key 45newtype PublicKey = PublicKey Bytes 46 deriving (Show,Eq,ByteArrayAccess,NFData) 47 48-- | A Curve25519 Diffie Hellman secret related to a 49-- public key and a secret key. 50newtype DhSecret = DhSecret ScrubbedBytes 51 deriving (Show,Eq,ByteArrayAccess,NFData) 52 53-- | Try to build a public key from a bytearray 54publicKey :: ByteArrayAccess bs => bs -> CryptoFailable PublicKey 55publicKey bs 56 | B.length bs == 32 = CryptoPassed $ PublicKey $ B.copyAndFreeze bs (\_ -> return ()) 57 | otherwise = CryptoFailed CryptoError_PublicKeySizeInvalid 58 59-- | Try to build a secret key from a bytearray 60secretKey :: ByteArrayAccess bs => bs -> CryptoFailable SecretKey 61secretKey bs 62 | B.length bs == 32 = unsafeDoIO $ do 63 withByteArray bs $ \inp -> do 64 valid <- isValidPtr inp 65 if valid 66 then (CryptoPassed . SecretKey) <$> B.copy bs (\_ -> return ()) 67 else return $ CryptoFailed CryptoError_SecretKeyStructureInvalid 68 | otherwise = CryptoFailed CryptoError_SecretKeySizeInvalid 69 where 70 -- e[0] &= 0xf8; 71 -- e[31] &= 0x7f; 72 -- e[31] |= 40; 73 isValidPtr :: Ptr Word8 -> IO Bool 74 isValidPtr _ = do 75 --b0 <- peekElemOff inp 0 76 --b31 <- peekElemOff inp 31 77 return True 78{- 79 return $ and [ testBit b0 0 == False 80 , testBit b0 1 == False 81 , testBit b0 2 == False 82 , testBit b31 7 == False 83 , testBit b31 6 == True 84 ] 85-} 86{-# NOINLINE secretKey #-} 87 88-- | Create a DhSecret from a bytearray object 89dhSecret :: ByteArrayAccess b => b -> CryptoFailable DhSecret 90dhSecret bs 91 | B.length bs == 32 = CryptoPassed $ DhSecret $ B.copyAndFreeze bs (\_ -> return ()) 92 | otherwise = CryptoFailed CryptoError_SharedSecretSizeInvalid 93 94-- | Compute the Diffie Hellman secret from a public key and a secret key. 95-- 96-- This implementation may return an all-zero value as it does not check for 97-- the condition. 98dh :: PublicKey -> SecretKey -> DhSecret 99dh (PublicKey pub) (SecretKey sec) = DhSecret <$> 100 B.allocAndFreeze 32 $ \result -> 101 withByteArray sec $ \psec -> 102 withByteArray pub $ \ppub -> 103 ccryptonite_curve25519 result psec ppub 104{-# NOINLINE dh #-} 105 106-- | Create a public key from a secret key 107toPublic :: SecretKey -> PublicKey 108toPublic (SecretKey sec) = PublicKey <$> 109 B.allocAndFreeze 32 $ \result -> 110 withByteArray sec $ \psec -> 111 ccryptonite_curve25519 result psec basePoint 112 where 113 basePoint = Ptr "\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# 114{-# NOINLINE toPublic #-} 115 116-- | Generate a secret key. 117generateSecretKey :: MonadRandom m => m SecretKey 118generateSecretKey = tweakToSecretKey <$> getRandomBytes 32 119 where 120 tweakToSecretKey :: ScrubbedBytes -> SecretKey 121 tweakToSecretKey bin = SecretKey $ B.copyAndFreeze bin $ \inp -> do 122 modifyByte inp 0 (\e0 -> e0 .&. 0xf8) 123 modifyByte inp 31 (\e31 -> (e31 .&. 0x7f) .|. 0x40) 124 125 modifyByte :: Ptr Word8 -> Int -> (Word8 -> Word8) -> IO () 126 modifyByte p n f = peekByteOff p n >>= pokeByteOff p n . f 127 128foreign import ccall "cryptonite_curve25519_donna" 129 ccryptonite_curve25519 :: Ptr Word8 -- ^ public 130 -> Ptr Word8 -- ^ secret 131 -> Ptr Word8 -- ^ basepoint 132 -> IO () 133