1-- |
2-- Module      : Crypto.PubKey.Curve448
3-- License     : BSD-style
4-- Maintainer  : John Galt <jgalt@centromere.net>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- Curve448 support
9--
10-- Internally uses Decaf point compression to omit the cofactor
11-- and implementation by Mike Hamburg.  Externally API and
12-- data types are compatible with the encoding specified in RFC 7748.
13--
14{-# LANGUAGE GeneralizedNewtypeDeriving #-}
15module Crypto.PubKey.Curve448
16    ( SecretKey
17    , PublicKey
18    , DhSecret
19    -- * Smart constructors
20    , dhSecret
21    , publicKey
22    , secretKey
23    -- * Methods
24    , dh
25    , toPublic
26    , generateSecretKey
27    ) where
28
29import           Data.Word
30import           Foreign.Ptr
31
32import           Crypto.Error
33import           Crypto.Random
34import           Crypto.Internal.Compat
35import           Crypto.Internal.Imports
36import           Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes, Bytes, withByteArray)
37import qualified Crypto.Internal.ByteArray as B
38
39-- | A Curve448 Secret key
40newtype SecretKey = SecretKey ScrubbedBytes
41    deriving (Show,Eq,ByteArrayAccess,NFData)
42
43-- | A Curve448 public key
44newtype PublicKey = PublicKey Bytes
45    deriving (Show,Eq,ByteArrayAccess,NFData)
46
47-- | A Curve448 Diffie Hellman secret related to a
48-- public key and a secret key.
49newtype DhSecret = DhSecret ScrubbedBytes
50    deriving (Show,Eq,ByteArrayAccess,NFData)
51
52-- | Try to build a public key from a bytearray
53publicKey :: ByteArrayAccess bs => bs -> CryptoFailable PublicKey
54publicKey bs
55    | B.length bs == x448_bytes = CryptoPassed $ PublicKey $ B.copyAndFreeze bs (\_ -> return ())
56    | otherwise                 = CryptoFailed CryptoError_PublicKeySizeInvalid
57
58-- | Try to build a secret key from a bytearray
59secretKey :: ByteArrayAccess bs => bs -> CryptoFailable SecretKey
60secretKey bs
61    | B.length bs == x448_bytes = unsafeDoIO $
62        withByteArray bs $ \inp -> do
63            valid <- isValidPtr inp
64            if valid
65                then (CryptoPassed . SecretKey) <$> B.copy bs (\_ -> return ())
66                else return $ CryptoFailed CryptoError_SecretKeyStructureInvalid
67    | otherwise = CryptoFailed CryptoError_SecretKeySizeInvalid
68  where
69        isValidPtr :: Ptr Word8 -> IO Bool
70        isValidPtr _ =
71            return True
72{-# NOINLINE secretKey #-}
73
74-- | Create a DhSecret from a bytearray object
75dhSecret :: ByteArrayAccess b => b -> CryptoFailable DhSecret
76dhSecret bs
77    | B.length bs == x448_bytes = CryptoPassed $ DhSecret $ B.copyAndFreeze bs (\_ -> return ())
78    | otherwise                 = CryptoFailed CryptoError_SharedSecretSizeInvalid
79
80-- | Compute the Diffie Hellman secret from a public key and a secret key.
81--
82-- This implementation may return an all-zero value as it does not check for
83-- the condition.
84dh :: PublicKey -> SecretKey -> DhSecret
85dh (PublicKey pub) (SecretKey sec) = DhSecret <$>
86    B.allocAndFreeze x448_bytes $ \result ->
87    withByteArray sec           $ \psec   ->
88    withByteArray pub           $ \ppub   ->
89        decaf_x448 result ppub psec
90{-# NOINLINE dh #-}
91
92-- | Create a public key from a secret key
93toPublic :: SecretKey -> PublicKey
94toPublic (SecretKey sec) = PublicKey <$>
95    B.allocAndFreeze x448_bytes     $ \result ->
96    withByteArray sec               $ \psec   ->
97        decaf_x448_derive_public_key result psec
98{-# NOINLINE toPublic #-}
99
100-- | Generate a secret key.
101generateSecretKey :: MonadRandom m => m SecretKey
102generateSecretKey = SecretKey <$> getRandomBytes x448_bytes
103
104x448_bytes :: Int
105x448_bytes = 448 `quot` 8
106
107foreign import ccall "cryptonite_decaf_x448"
108    decaf_x448 :: Ptr Word8 -- ^ public
109               -> Ptr Word8 -- ^ basepoint
110               -> Ptr Word8 -- ^ secret
111               -> IO ()
112
113foreign import ccall "cryptonite_decaf_x448_derive_public_key"
114    decaf_x448_derive_public_key :: Ptr Word8 -- ^ public
115                                 -> Ptr Word8 -- ^ secret
116                                 -> IO ()
117