summaryrefslogtreecommitdiff
path: root/src/Crypto/PubKey/Curve25519.hs
blob: 428786919fccb590e87f4f3c3474316f602d5a32 (plain)
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 ()