-- |
-- 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.Internal.Compat
import           Crypto.Internal.Imports
import           Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes, Bytes, withByteArray)
import qualified Crypto.Internal.ByteArray as B
import           Crypto.Random

-- | A Curve25519 Secret key
newtype SecretKey = SecretKey ScrubbedBytes
    deriving (Int -> SecretKey -> ShowS
[SecretKey] -> ShowS
SecretKey -> String
(Int -> SecretKey -> ShowS)
-> (SecretKey -> String)
-> ([SecretKey] -> ShowS)
-> Show SecretKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecretKey] -> ShowS
$cshowList :: [SecretKey] -> ShowS
show :: SecretKey -> String
$cshow :: SecretKey -> String
showsPrec :: Int -> SecretKey -> ShowS
$cshowsPrec :: Int -> SecretKey -> ShowS
Show,SecretKey -> SecretKey -> Bool
(SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool) -> Eq SecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecretKey -> SecretKey -> Bool
$c/= :: SecretKey -> SecretKey -> Bool
== :: SecretKey -> SecretKey -> Bool
$c== :: SecretKey -> SecretKey -> Bool
Eq,SecretKey -> Int
SecretKey -> Ptr p -> IO ()
SecretKey -> (Ptr p -> IO a) -> IO a
(SecretKey -> Int)
-> (forall p a. SecretKey -> (Ptr p -> IO a) -> IO a)
-> (forall p. SecretKey -> Ptr p -> IO ())
-> ByteArrayAccess SecretKey
forall p. SecretKey -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. SecretKey -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: SecretKey -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. SecretKey -> Ptr p -> IO ()
withByteArray :: SecretKey -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. SecretKey -> (Ptr p -> IO a) -> IO a
length :: SecretKey -> Int
$clength :: SecretKey -> Int
ByteArrayAccess,SecretKey -> ()
(SecretKey -> ()) -> NFData SecretKey
forall a. (a -> ()) -> NFData a
rnf :: SecretKey -> ()
$crnf :: SecretKey -> ()
NFData)

-- | A Curve25519 public key
newtype PublicKey = PublicKey Bytes
    deriving (Int -> PublicKey -> ShowS
[PublicKey] -> ShowS
PublicKey -> String
(Int -> PublicKey -> ShowS)
-> (PublicKey -> String)
-> ([PublicKey] -> ShowS)
-> Show PublicKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKey] -> ShowS
$cshowList :: [PublicKey] -> ShowS
show :: PublicKey -> String
$cshow :: PublicKey -> String
showsPrec :: Int -> PublicKey -> ShowS
$cshowsPrec :: Int -> PublicKey -> ShowS
Show,PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c== :: PublicKey -> PublicKey -> Bool
Eq,PublicKey -> Int
PublicKey -> Ptr p -> IO ()
PublicKey -> (Ptr p -> IO a) -> IO a
(PublicKey -> Int)
-> (forall p a. PublicKey -> (Ptr p -> IO a) -> IO a)
-> (forall p. PublicKey -> Ptr p -> IO ())
-> ByteArrayAccess PublicKey
forall p. PublicKey -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. PublicKey -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: PublicKey -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. PublicKey -> Ptr p -> IO ()
withByteArray :: PublicKey -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. PublicKey -> (Ptr p -> IO a) -> IO a
length :: PublicKey -> Int
$clength :: PublicKey -> Int
ByteArrayAccess,PublicKey -> ()
(PublicKey -> ()) -> NFData PublicKey
forall a. (a -> ()) -> NFData a
rnf :: PublicKey -> ()
$crnf :: PublicKey -> ()
NFData)

-- | A Curve25519 Diffie Hellman secret related to a
-- public key and a secret key.
newtype DhSecret = DhSecret ScrubbedBytes
    deriving (Int -> DhSecret -> ShowS
[DhSecret] -> ShowS
DhSecret -> String
(Int -> DhSecret -> ShowS)
-> (DhSecret -> String) -> ([DhSecret] -> ShowS) -> Show DhSecret
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DhSecret] -> ShowS
$cshowList :: [DhSecret] -> ShowS
show :: DhSecret -> String
$cshow :: DhSecret -> String
showsPrec :: Int -> DhSecret -> ShowS
$cshowsPrec :: Int -> DhSecret -> ShowS
Show,DhSecret -> DhSecret -> Bool
(DhSecret -> DhSecret -> Bool)
-> (DhSecret -> DhSecret -> Bool) -> Eq DhSecret
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DhSecret -> DhSecret -> Bool
$c/= :: DhSecret -> DhSecret -> Bool
== :: DhSecret -> DhSecret -> Bool
$c== :: DhSecret -> DhSecret -> Bool
Eq,DhSecret -> Int
DhSecret -> Ptr p -> IO ()
DhSecret -> (Ptr p -> IO a) -> IO a
(DhSecret -> Int)
-> (forall p a. DhSecret -> (Ptr p -> IO a) -> IO a)
-> (forall p. DhSecret -> Ptr p -> IO ())
-> ByteArrayAccess DhSecret
forall p. DhSecret -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. DhSecret -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: DhSecret -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. DhSecret -> Ptr p -> IO ()
withByteArray :: DhSecret -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. DhSecret -> (Ptr p -> IO a) -> IO a
length :: DhSecret -> Int
$clength :: DhSecret -> Int
ByteArrayAccess,DhSecret -> ()
(DhSecret -> ()) -> NFData DhSecret
forall a. (a -> ()) -> NFData a
rnf :: DhSecret -> ()
$crnf :: DhSecret -> ()
NFData)

-- | Try to build a public key from a bytearray
publicKey :: ByteArrayAccess bs => bs -> CryptoFailable PublicKey
publicKey :: bs -> CryptoFailable PublicKey
publicKey bs
bs
    | bs -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bs
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = PublicKey -> CryptoFailable PublicKey
forall a. a -> CryptoFailable a
CryptoPassed (PublicKey -> CryptoFailable PublicKey)
-> PublicKey -> CryptoFailable PublicKey
forall a b. (a -> b) -> a -> b
$ Bytes -> PublicKey
PublicKey (Bytes -> PublicKey) -> Bytes -> PublicKey
forall a b. (a -> b) -> a -> b
$ bs -> (Ptr Any -> IO ()) -> Bytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze bs
bs (\Ptr Any
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    | Bool
otherwise         = CryptoError -> CryptoFailable PublicKey
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_PublicKeySizeInvalid

-- | Try to build a secret key from a bytearray
secretKey :: ByteArrayAccess bs => bs -> CryptoFailable SecretKey
secretKey :: bs -> CryptoFailable SecretKey
secretKey bs
bs
    | bs -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bs
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = IO (CryptoFailable SecretKey) -> CryptoFailable SecretKey
forall a. IO a -> a
unsafeDoIO (IO (CryptoFailable SecretKey) -> CryptoFailable SecretKey)
-> IO (CryptoFailable SecretKey) -> CryptoFailable SecretKey
forall a b. (a -> b) -> a -> b
$ do
        bs
-> (Ptr Word8 -> IO (CryptoFailable SecretKey))
-> IO (CryptoFailable SecretKey)
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray bs
bs ((Ptr Word8 -> IO (CryptoFailable SecretKey))
 -> IO (CryptoFailable SecretKey))
-> (Ptr Word8 -> IO (CryptoFailable SecretKey))
-> IO (CryptoFailable SecretKey)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
inp -> do
            Bool
valid <- Ptr Word8 -> IO Bool
isValidPtr Ptr Word8
inp
            if Bool
valid
                then (SecretKey -> CryptoFailable SecretKey
forall a. a -> CryptoFailable a
CryptoPassed (SecretKey -> CryptoFailable SecretKey)
-> (ScrubbedBytes -> SecretKey)
-> ScrubbedBytes
-> CryptoFailable SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> SecretKey
SecretKey) (ScrubbedBytes -> CryptoFailable SecretKey)
-> IO ScrubbedBytes -> IO (CryptoFailable SecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> bs -> (Ptr Any -> IO ()) -> IO ScrubbedBytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> IO bs2
B.copy bs
bs (\Ptr Any
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                else CryptoFailable SecretKey -> IO (CryptoFailable SecretKey)
forall (m :: * -> *) a. Monad m => a -> m a
return (CryptoFailable SecretKey -> IO (CryptoFailable SecretKey))
-> CryptoFailable SecretKey -> IO (CryptoFailable SecretKey)
forall a b. (a -> b) -> a -> b
$ CryptoError -> CryptoFailable SecretKey
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SecretKeyStructureInvalid
    | Bool
otherwise = CryptoError -> CryptoFailable SecretKey
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SecretKeySizeInvalid
  where
        --  e[0] &= 0xf8;
        --  e[31] &= 0x7f;
        --  e[31] |= 40;
        isValidPtr :: Ptr Word8 -> IO Bool
        isValidPtr :: Ptr Word8 -> IO Bool
isValidPtr Ptr Word8
_ = do
            --b0  <- peekElemOff inp 0
            --b31 <- peekElemOff inp 31
            Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: b -> CryptoFailable DhSecret
dhSecret b
bs
    | b -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length b
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = DhSecret -> CryptoFailable DhSecret
forall a. a -> CryptoFailable a
CryptoPassed (DhSecret -> CryptoFailable DhSecret)
-> DhSecret -> CryptoFailable DhSecret
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> DhSecret
DhSecret (ScrubbedBytes -> DhSecret) -> ScrubbedBytes -> DhSecret
forall a b. (a -> b) -> a -> b
$ b -> (Ptr Any -> IO ()) -> ScrubbedBytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze b
bs (\Ptr Any
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    | Bool
otherwise         = CryptoError -> CryptoFailable DhSecret
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SharedSecretSizeInvalid

-- | Compute the Diffie Hellman secret from a public key and a secret key.
--
-- This implementation may return an all-zero value as it does not check for
-- the condition.
dh :: PublicKey -> SecretKey -> DhSecret
dh :: PublicKey -> SecretKey -> DhSecret
dh (PublicKey Bytes
pub) (SecretKey ScrubbedBytes
sec) = ScrubbedBytes -> DhSecret
DhSecret (ScrubbedBytes -> DhSecret)
-> ((Ptr Word8 -> IO ()) -> ScrubbedBytes)
-> (Ptr Word8 -> IO ())
-> DhSecret
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> (Ptr Word8 -> IO ()) -> ScrubbedBytes
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
32        ((Ptr Word8 -> IO ()) -> DhSecret)
-> (Ptr Word8 -> IO ()) -> DhSecret
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
result ->
    ScrubbedBytes -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray ScrubbedBytes
sec          ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
psec   ->
    Bytes -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray Bytes
pub          ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ppub   ->
        Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
ccryptonite_curve25519 Ptr Word8
result Ptr Word8
psec Ptr Word8
ppub
{-# NOINLINE dh #-}

-- | Create a public key from a secret key
toPublic :: SecretKey -> PublicKey
toPublic :: SecretKey -> PublicKey
toPublic (SecretKey ScrubbedBytes
sec) = Bytes -> PublicKey
PublicKey (Bytes -> PublicKey)
-> ((Ptr Word8 -> IO ()) -> Bytes)
-> (Ptr Word8 -> IO ())
-> PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> (Ptr Word8 -> IO ()) -> Bytes
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
32     ((Ptr Word8 -> IO ()) -> PublicKey)
-> (Ptr Word8 -> IO ()) -> PublicKey
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
result ->
    ScrubbedBytes -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray ScrubbedBytes
sec       ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
psec   ->
        Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
ccryptonite_curve25519 Ptr Word8
result Ptr Word8
psec Ptr Word8
forall a. Ptr a
basePoint
  where
        basePoint :: Ptr a
basePoint = Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
"\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 :: m SecretKey
generateSecretKey = ScrubbedBytes -> SecretKey
tweakToSecretKey (ScrubbedBytes -> SecretKey) -> m ScrubbedBytes -> m SecretKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ScrubbedBytes
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
  where
    tweakToSecretKey :: ScrubbedBytes -> SecretKey
    tweakToSecretKey :: ScrubbedBytes -> SecretKey
tweakToSecretKey ScrubbedBytes
bin = ScrubbedBytes -> SecretKey
SecretKey (ScrubbedBytes -> SecretKey) -> ScrubbedBytes -> SecretKey
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> (Ptr Word8 -> IO ()) -> ScrubbedBytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze ScrubbedBytes
bin ((Ptr Word8 -> IO ()) -> ScrubbedBytes)
-> (Ptr Word8 -> IO ()) -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
inp -> do
        Ptr Word8 -> Int -> (Word8 -> Word8) -> IO ()
modifyByte Ptr Word8
inp Int
0 (\Word8
e0 -> Word8
e0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xf8)
        Ptr Word8 -> Int -> (Word8 -> Word8) -> IO ()
modifyByte Ptr Word8
inp Int
31 (\Word8
e31 -> (Word8
e31 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7f) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x40)

    modifyByte :: Ptr Word8 -> Int -> (Word8 -> Word8) -> IO ()
    modifyByte :: Ptr Word8 -> Int -> (Word8 -> Word8) -> IO ()
modifyByte Ptr Word8
p Int
n Word8 -> Word8
f = Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p Int
n IO Word8 -> (Word8 -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
p Int
n (Word8 -> IO ()) -> (Word8 -> Word8) -> Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8
f

foreign import ccall "cryptonite_curve25519_donna"
    ccryptonite_curve25519 :: Ptr Word8 -- ^ public
                           -> Ptr Word8 -- ^ secret
                           -> Ptr Word8 -- ^ basepoint
                           -> IO ()