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