add support for curve 25519
This commit is contained in:
parent
ec26f9a25b
commit
033b9ced81
@ -13,10 +13,13 @@ module Crypto.PubKey.Curve25519
|
|||||||
( SecretKey
|
( SecretKey
|
||||||
, PublicKey
|
, PublicKey
|
||||||
, DhSecret
|
, DhSecret
|
||||||
|
-- * Smart constructors
|
||||||
|
, dhSecret
|
||||||
|
, publicKey
|
||||||
|
, secretKey
|
||||||
-- * methods
|
-- * methods
|
||||||
, dh
|
, dh
|
||||||
, toPublic
|
, toPublic
|
||||||
, toSecret
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
@ -31,57 +34,80 @@ import Foreign.Storable
|
|||||||
|
|
||||||
import Crypto.Internal.Compat
|
import Crypto.Internal.Compat
|
||||||
|
|
||||||
-- e[0] &= 0xf8;
|
-- | A Curve25519 Secret key
|
||||||
-- e[31] &= 0x7f;
|
|
||||||
-- e[31] |= 40;
|
|
||||||
newtype SecretKey = SecretKey SecureMem
|
newtype SecretKey = SecretKey SecureMem
|
||||||
deriving (Show,Eq,Byteable)
|
deriving (Show,Eq,Byteable)
|
||||||
|
|
||||||
|
-- | A Curve25519 public key
|
||||||
newtype PublicKey = PublicKey ByteString
|
newtype PublicKey = PublicKey ByteString
|
||||||
deriving (Show,Eq,Byteable)
|
deriving (Show,Eq,Byteable)
|
||||||
|
|
||||||
newtype DhSecret = DhSecret ByteString
|
-- | A Curve25519 Diffie Hellman secret related to a
|
||||||
|
-- public key and a secret key.
|
||||||
|
newtype DhSecret = DhSecret SecureMem
|
||||||
deriving (Show,Eq,Byteable)
|
deriving (Show,Eq,Byteable)
|
||||||
|
|
||||||
basePoint :: PublicKey
|
-- | Try to build a public key from a bytearray
|
||||||
basePoint = PublicKey "\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"
|
publicKey :: Byteable bs => bs -> Either String PublicKey
|
||||||
|
publicKey bs
|
||||||
|
| byteableLength bs == 32 = Right $ PublicKey $ toBytes bs
|
||||||
|
| otherwise = Left "invalid public key size"
|
||||||
|
|
||||||
dh :: PublicKey -> SecretKey -> DhSecret
|
-- | Try to build a secret key from a bytearray
|
||||||
dh (PublicKey pub) (SecretKey sec) = DhSecret <$>
|
secretKey :: Byteable bs => bs -> Either String SecretKey
|
||||||
B.unsafeCreate 32 $ \result ->
|
secretKey bs
|
||||||
withSecureMemPtr sec $ \psec ->
|
|
||||||
withBytePtr pub $ \ppub ->
|
|
||||||
ccryptonite_curve25519 result psec ppub
|
|
||||||
|
|
||||||
toPublic :: SecretKey -> PublicKey
|
|
||||||
toPublic (SecretKey sec) = PublicKey <$>
|
|
||||||
B.unsafeCreate 32 $ \result ->
|
|
||||||
withSecureMemPtr sec $ \psec ->
|
|
||||||
withBytePtr basePoint $ \pbase ->
|
|
||||||
ccryptonite_curve25519 result psec pbase
|
|
||||||
|
|
||||||
toSecret :: Byteable bs => bs -> Either String SecretKey
|
|
||||||
toSecret bs
|
|
||||||
| byteableLength bs == 32 = unsafeDoIO $ do
|
| byteableLength bs == 32 = unsafeDoIO $ do
|
||||||
withBytePtr bs $ \inp -> do
|
withBytePtr bs $ \inp -> do
|
||||||
valid <- isValidPtr inp
|
valid <- isValidPtr inp
|
||||||
if valid
|
if valid
|
||||||
then Right . SecretKey <$> createSecureMem 32 (\sec -> B.memcpy sec inp 32)
|
then Right . SecretKey <$> createSecureMem 32 (\sec -> B.memcpy sec inp 32)
|
||||||
else return $ Left "invalid secret key"
|
else return $ Left "invalid secret key"
|
||||||
| otherwise = Left "secret key invalid size"
|
| otherwise = Left "secret key invalid size"
|
||||||
|
where
|
||||||
where isValidPtr :: Ptr Word8 -> IO Bool
|
-- e[0] &= 0xf8;
|
||||||
|
-- e[31] &= 0x7f;
|
||||||
|
-- e[31] |= 40;
|
||||||
|
isValidPtr :: Ptr Word8 -> IO Bool
|
||||||
isValidPtr inp = do
|
isValidPtr inp = do
|
||||||
b0 <- peekElemOff inp 0
|
b0 <- peekElemOff inp 0
|
||||||
b31 <- peekElemOff inp 31
|
b31 <- peekElemOff inp 31
|
||||||
|
return True
|
||||||
|
{-
|
||||||
return $ and [ testBit b0 0 == False
|
return $ and [ testBit b0 0 == False
|
||||||
, testBit b0 1 == False
|
, testBit b0 1 == False
|
||||||
, testBit b0 2 == False
|
, testBit b0 2 == False
|
||||||
, testBit b31 7 == False
|
, testBit b31 7 == False
|
||||||
, testBit b31 6 == True
|
, testBit b31 6 == True
|
||||||
]
|
]
|
||||||
|
-}
|
||||||
|
{-# NOINLINE secretKey #-}
|
||||||
|
|
||||||
--generateSecret :: IO ByteString
|
-- | Create a DhSecret from a bytearray object
|
||||||
|
dhSecret :: Byteable b => b -> Either String DhSecret
|
||||||
|
dhSecret bs
|
||||||
|
| byteableLength bs == 32 = Right $ DhSecret $ secureMemFromByteable bs
|
||||||
|
| otherwise = Left "invalid dh secret size"
|
||||||
|
|
||||||
|
basePoint :: PublicKey
|
||||||
|
basePoint = PublicKey "\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"
|
||||||
|
|
||||||
|
-- | Compute the Diffie Hellman secret from a public key and a secret key
|
||||||
|
dh :: PublicKey -> SecretKey -> DhSecret
|
||||||
|
dh (PublicKey pub) (SecretKey sec) = DhSecret <$> unsafeDoIO $
|
||||||
|
createSecureMem 32 $ \result ->
|
||||||
|
withSecureMemPtr sec $ \psec ->
|
||||||
|
withBytePtr pub $ \ppub ->
|
||||||
|
ccryptonite_curve25519 result psec ppub
|
||||||
|
{-# NOINLINE dh #-}
|
||||||
|
|
||||||
|
-- | Create a public key from a secret key
|
||||||
|
toPublic :: SecretKey -> PublicKey
|
||||||
|
toPublic (SecretKey sec) = PublicKey <$>
|
||||||
|
B.unsafeCreate 32 $ \result ->
|
||||||
|
withSecureMemPtr sec $ \psec ->
|
||||||
|
withBytePtr basePoint $ \pbase ->
|
||||||
|
ccryptonite_curve25519 result psec pbase
|
||||||
|
{-# NOINLINE toPublic #-}
|
||||||
|
|
||||||
foreign import ccall "cryptonite_curve25519_donna"
|
foreign import ccall "cryptonite_curve25519_donna"
|
||||||
ccryptonite_curve25519 :: Ptr Word8 -- ^ public
|
ccryptonite_curve25519 :: Ptr Word8 -- ^ public
|
||||||
|
|||||||
@ -62,7 +62,7 @@ Library
|
|||||||
, Crypto.Internal.Compat
|
, Crypto.Internal.Compat
|
||||||
Build-depends: base >= 4.5 && < 5
|
Build-depends: base >= 4.5 && < 5
|
||||||
, bytestring
|
, bytestring
|
||||||
, securemem
|
, securemem >= 0.1.7
|
||||||
, byteable
|
, byteable
|
||||||
, ghc-prim
|
, ghc-prim
|
||||||
ghc-options: -Wall -fwarn-tabs -optc-O3
|
ghc-options: -Wall -fwarn-tabs -optc-O3
|
||||||
|
|||||||
25
tests/KAT_Curve25519.hs
Normal file
25
tests/KAT_Curve25519.hs
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
module KAT_Curve25519 ( tests ) where
|
||||||
|
|
||||||
|
import qualified Crypto.PubKey.Curve25519 as Curve25519
|
||||||
|
import Data.Byteable
|
||||||
|
import Data.ByteString (ByteString)
|
||||||
|
|
||||||
|
import Test.Tasty
|
||||||
|
import Test.Tasty.HUnit
|
||||||
|
|
||||||
|
alicePrivate = either error id $ Curve25519.secretKey ("\x77\x07\x6d\x0a\x73\x18\xa5\x7d\x3c\x16\xc1\x72\x51\xb2\x66\x45\xdf\x4c\x2f\x87\xeb\xc0\x99\x2a\xb1\x77\xfb\xa5\x1d\xb9\x2c\x2a" :: ByteString)
|
||||||
|
alicePublic = either error id $ Curve25519.publicKey ("\x85\x20\xf0\x09\x89\x30\xa7\x54\x74\x8b\x7d\xdc\xb4\x3e\xf7\x5a\x0d\xbf\x3a\x0d\x26\x38\x1a\xf4\xeb\xa4\xa9\x8e\xaa\x9b\x4e\x6a" :: ByteString)
|
||||||
|
bobPrivate = either error id $ Curve25519.secretKey ("\x5d\xab\x08\x7e\x62\x4a\x8a\x4b\x79\xe1\x7f\x8b\x83\x80\x0e\xe6\x6f\x3b\xb1\x29\x26\x18\xb6\xfd\x1c\x2f\x8b\x27\xff\x88\xe0\xeb" :: ByteString)
|
||||||
|
bobPublic = either error id $ Curve25519.publicKey ("\xde\x9e\xdb\x7d\x7b\x7d\xc1\xb4\xd3\x5b\x61\xc2\xec\xe4\x35\x37\x3f\x83\x43\xc8\x5b\x78\x67\x4d\xad\xfc\x7e\x14\x6f\x88\x2b\x4f" :: ByteString)
|
||||||
|
aliceMultBob = "\x4a\x5d\x9d\x5b\xa4\xce\x2d\xe1\x72\x8e\x3b\xf4\x80\x35\x0f\x25\xe0\x7e\x21\xc9\x47\xd1\x9e\x33\x76\xf0\x9b\x3c\x1e\x16\x17\x42" :: ByteString
|
||||||
|
|
||||||
|
katTests :: [TestTree]
|
||||||
|
katTests =
|
||||||
|
[ testCase "0" (aliceMultBob @=? toBytes (Curve25519.dh alicePublic bobPrivate))
|
||||||
|
, testCase "1" (aliceMultBob @=? toBytes (Curve25519.dh bobPublic alicePrivate))
|
||||||
|
]
|
||||||
|
|
||||||
|
tests = testGroup "Curve25519"
|
||||||
|
[ testGroup "KATs" katTests
|
||||||
|
]
|
||||||
@ -18,6 +18,7 @@ import qualified KATSalsa
|
|||||||
import qualified KATHash
|
import qualified KATHash
|
||||||
import qualified KAT_HMAC
|
import qualified KAT_HMAC
|
||||||
import qualified KAT_PBKDF2
|
import qualified KAT_PBKDF2
|
||||||
|
import qualified KAT_Curve25519
|
||||||
import qualified KAT_Scrypt
|
import qualified KAT_Scrypt
|
||||||
import qualified KAT_RC4
|
import qualified KAT_RC4
|
||||||
import qualified KAT_Blowfish
|
import qualified KAT_Blowfish
|
||||||
@ -75,6 +76,7 @@ tests = testGroup "cryptonite"
|
|||||||
]
|
]
|
||||||
, KATHash.tests
|
, KATHash.tests
|
||||||
, KAT_HMAC.tests
|
, KAT_HMAC.tests
|
||||||
|
, KAT_Curve25519.tests
|
||||||
, KAT_PBKDF2.tests
|
, KAT_PBKDF2.tests
|
||||||
, KAT_Scrypt.tests
|
, KAT_Scrypt.tests
|
||||||
, KAT_RC4.tests
|
, KAT_RC4.tests
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user