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