-- |
-- Module      : Crypto.PubKey.Ed448
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
-- Ed448 support
--
-- Internally uses Decaf point compression to omit the cofactor
-- and implementation by Mike Hamburg.  Externally API and
-- data types are compatible with the encoding specified in RFC 8032.
--
{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Crypto.PubKey.Ed448
    ( SecretKey
    , PublicKey
    , Signature
    -- * Size constants
    , publicKeySize
    , secretKeySize
    , signatureSize
    -- * Smart constructors
    , signature
    , publicKey
    , secretKey
    -- * Methods
    , toPublic
    , sign
    , verify
    , generateSecretKey
    ) where

import           Data.Word
import           Foreign.C.Types
import           Foreign.Ptr

import           Crypto.Error
import           Crypto.Internal.ByteArray (ByteArrayAccess, Bytes,
                                            ScrubbedBytes, withByteArray)
import qualified Crypto.Internal.ByteArray as B
import           Crypto.Internal.Compat
import           Crypto.Internal.Imports
import           Crypto.Random

-- | An Ed448 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
$cshowsPrec :: Int -> SecretKey -> ShowS
showsPrec :: Int -> SecretKey -> ShowS
$cshow :: SecretKey -> String
show :: SecretKey -> String
$cshowList :: [SecretKey] -> ShowS
showList :: [SecretKey] -> ShowS
Show,SecretKey -> SecretKey -> Bool
(SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool) -> Eq SecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretKey -> SecretKey -> Bool
== :: SecretKey -> SecretKey -> Bool
$c/= :: SecretKey -> SecretKey -> Bool
/= :: SecretKey -> SecretKey -> Bool
Eq,SecretKey -> Int
(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
$clength :: SecretKey -> Int
length :: SecretKey -> Int
$cwithByteArray :: forall p a. SecretKey -> (Ptr p -> IO a) -> IO a
withByteArray :: forall p a. SecretKey -> (Ptr p -> IO a) -> IO a
$ccopyByteArrayToPtr :: forall p. SecretKey -> Ptr p -> IO ()
copyByteArrayToPtr :: forall p. SecretKey -> Ptr p -> IO ()
ByteArrayAccess,SecretKey -> ()
(SecretKey -> ()) -> NFData SecretKey
forall a. (a -> ()) -> NFData a
$crnf :: SecretKey -> ()
rnf :: SecretKey -> ()
NFData)

-- | An Ed448 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
$cshowsPrec :: Int -> PublicKey -> ShowS
showsPrec :: Int -> PublicKey -> ShowS
$cshow :: PublicKey -> String
show :: PublicKey -> String
$cshowList :: [PublicKey] -> ShowS
showList :: [PublicKey] -> ShowS
Show,PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
/= :: PublicKey -> PublicKey -> Bool
Eq,PublicKey -> Int
(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
$clength :: PublicKey -> Int
length :: PublicKey -> Int
$cwithByteArray :: forall p a. PublicKey -> (Ptr p -> IO a) -> IO a
withByteArray :: forall p a. PublicKey -> (Ptr p -> IO a) -> IO a
$ccopyByteArrayToPtr :: forall p. PublicKey -> Ptr p -> IO ()
copyByteArrayToPtr :: forall p. PublicKey -> Ptr p -> IO ()
ByteArrayAccess,PublicKey -> ()
(PublicKey -> ()) -> NFData PublicKey
forall a. (a -> ()) -> NFData a
$crnf :: PublicKey -> ()
rnf :: PublicKey -> ()
NFData)

-- | An Ed448 signature
newtype Signature = Signature Bytes
    deriving (Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signature -> ShowS
showsPrec :: Int -> Signature -> ShowS
$cshow :: Signature -> String
show :: Signature -> String
$cshowList :: [Signature] -> ShowS
showList :: [Signature] -> ShowS
Show,Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
/= :: Signature -> Signature -> Bool
Eq,Signature -> Int
(Signature -> Int)
-> (forall p a. Signature -> (Ptr p -> IO a) -> IO a)
-> (forall p. Signature -> Ptr p -> IO ())
-> ByteArrayAccess Signature
forall p. Signature -> 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. Signature -> (Ptr p -> IO a) -> IO a
$clength :: Signature -> Int
length :: Signature -> Int
$cwithByteArray :: forall p a. Signature -> (Ptr p -> IO a) -> IO a
withByteArray :: forall p a. Signature -> (Ptr p -> IO a) -> IO a
$ccopyByteArrayToPtr :: forall p. Signature -> Ptr p -> IO ()
copyByteArrayToPtr :: forall p. Signature -> Ptr p -> IO ()
ByteArrayAccess,Signature -> ()
(Signature -> ()) -> NFData Signature
forall a. (a -> ()) -> NFData a
$crnf :: Signature -> ()
rnf :: Signature -> ()
NFData)

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

-- | Try to build a secret key from a bytearray
secretKey :: ByteArrayAccess ba => ba -> CryptoFailable SecretKey
secretKey :: forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
secretKey ba
bs
    | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
secretKeySize = 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
$ ba
-> (Ptr Any -> IO (CryptoFailable SecretKey))
-> IO (CryptoFailable SecretKey)
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ba -> (Ptr p -> IO a) -> IO a
withByteArray ba
bs Ptr Any -> IO (CryptoFailable SecretKey)
forall {p}. p -> IO (CryptoFailable SecretKey)
initialize
    | Bool
otherwise                    = CryptoError -> CryptoFailable SecretKey
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SecretKeyStructureInvalid
  where
        initialize :: p -> IO (CryptoFailable SecretKey)
initialize p
inp = do
            Bool
valid <- p -> IO Bool
forall {m :: * -> *} {p}. Monad m => p -> m Bool
isValidPtr p
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
<$> ba -> (Ptr Any -> IO ()) -> IO ScrubbedBytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> IO bs2
B.copy ba
bs (\Ptr Any
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                else CryptoFailable SecretKey -> IO (CryptoFailable SecretKey)
forall a. a -> IO a
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
        isValidPtr :: p -> m Bool
isValidPtr p
_ =
            Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
{-# NOINLINE secretKey #-}

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

-- | Create a public key from a secret key
toPublic :: SecretKey -> PublicKey
toPublic :: SecretKey -> PublicKey
toPublic (SecretKey ScrubbedBytes
sec) = Bytes -> PublicKey
PublicKey (Bytes -> PublicKey)
-> ((Ptr PublicKey -> IO ()) -> Bytes)
-> (Ptr PublicKey -> IO ())
-> PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> (Ptr PublicKey -> IO ()) -> Bytes
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
publicKeySize ((Ptr PublicKey -> IO ()) -> PublicKey)
-> (Ptr PublicKey -> IO ()) -> PublicKey
forall a b. (a -> b) -> a -> b
$ \Ptr PublicKey
result ->
    ScrubbedBytes -> (Ptr SecretKey -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ScrubbedBytes -> (Ptr p -> IO a) -> IO a
withByteArray ScrubbedBytes
sec              ((Ptr SecretKey -> IO ()) -> IO ())
-> (Ptr SecretKey -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SecretKey
psec   ->
        Ptr PublicKey -> Ptr SecretKey -> IO ()
decaf_ed448_derive_public_key Ptr PublicKey
result Ptr SecretKey
psec
{-# NOINLINE toPublic #-}

-- | Sign a message using the key pair
sign :: ByteArrayAccess ba => SecretKey -> PublicKey -> ba -> Signature
sign :: forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
sign SecretKey
secret PublicKey
public ba
message =
    Bytes -> Signature
Signature (Bytes -> Signature) -> Bytes -> Signature
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Signature -> IO ()) -> Bytes
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
signatureSize ((Ptr Signature -> IO ()) -> Bytes)
-> (Ptr Signature -> IO ()) -> Bytes
forall a b. (a -> b) -> a -> b
$ \Ptr Signature
sig ->
        SecretKey -> (Ptr SecretKey -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. SecretKey -> (Ptr p -> IO a) -> IO a
withByteArray SecretKey
secret  ((Ptr SecretKey -> IO ()) -> IO ())
-> (Ptr SecretKey -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SecretKey
sec ->
        PublicKey -> (Ptr PublicKey -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. PublicKey -> (Ptr p -> IO a) -> IO a
withByteArray PublicKey
public  ((Ptr PublicKey -> IO ()) -> IO ())
-> (Ptr PublicKey -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PublicKey
pub ->
        ba -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ba -> (Ptr p -> IO a) -> IO a
withByteArray ba
message ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
msg ->
             Ptr Signature
-> Ptr SecretKey
-> Ptr PublicKey
-> Ptr Word8
-> CSize
-> Word8
-> Ptr Word8
-> Word8
-> IO ()
decaf_ed448_sign Ptr Signature
sig Ptr SecretKey
sec Ptr PublicKey
pub Ptr Word8
msg (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
msgLen) Word8
0 Ptr Word8
no_context Word8
0
  where
    !msgLen :: Int
msgLen = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
message

-- | Verify a message
verify :: ByteArrayAccess ba => PublicKey -> ba -> Signature -> Bool
verify :: forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
verify PublicKey
public ba
message Signature
signatureVal = IO Bool -> Bool
forall a. IO a -> a
unsafeDoIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    Signature -> (Ptr Signature -> IO Bool) -> IO Bool
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. Signature -> (Ptr p -> IO a) -> IO a
withByteArray Signature
signatureVal ((Ptr Signature -> IO Bool) -> IO Bool)
-> (Ptr Signature -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Signature
sig ->
    PublicKey -> (Ptr PublicKey -> IO Bool) -> IO Bool
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. PublicKey -> (Ptr p -> IO a) -> IO a
withByteArray PublicKey
public       ((Ptr PublicKey -> IO Bool) -> IO Bool)
-> (Ptr PublicKey -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr PublicKey
pub ->
    ba -> (Ptr Word8 -> IO Bool) -> IO Bool
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ba -> (Ptr p -> IO a) -> IO a
withByteArray ba
message      ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
msg -> do
      CInt
r <- Ptr Signature
-> Ptr PublicKey
-> Ptr Word8
-> CSize
-> Word8
-> Ptr Word8
-> Word8
-> IO CInt
decaf_ed448_verify Ptr Signature
sig Ptr PublicKey
pub Ptr Word8
msg (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
msgLen) Word8
0 Ptr Word8
no_context Word8
0
      Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0)
  where
    !msgLen :: Int
msgLen = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
message

-- | Generate a secret key
generateSecretKey :: MonadRandom m => m SecretKey
generateSecretKey :: forall (m :: * -> *). MonadRandom m => m SecretKey
generateSecretKey = ScrubbedBytes -> SecretKey
SecretKey (ScrubbedBytes -> SecretKey) -> m ScrubbedBytes -> m SecretKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ScrubbedBytes
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
secretKeySize

-- | A public key is 57 bytes
publicKeySize :: Int
publicKeySize :: Int
publicKeySize = Int
57

-- | A secret key is 57 bytes
secretKeySize :: Int
secretKeySize :: Int
secretKeySize = Int
57

-- | A signature is 114 bytes
signatureSize :: Int
signatureSize :: Int
signatureSize = Int
114

no_context :: Ptr Word8
no_context :: Ptr Word8
no_context = Ptr Word8
forall a. Ptr a
nullPtr -- not supported yet

foreign import ccall "crypton_decaf_ed448_derive_public_key"
    decaf_ed448_derive_public_key :: Ptr PublicKey -- public key
                                  -> Ptr SecretKey -- secret key
                                  -> IO ()

foreign import ccall "crypton_decaf_ed448_sign"
    decaf_ed448_sign :: Ptr Signature -- signature
                     -> Ptr SecretKey -- secret
                     -> Ptr PublicKey -- public
                     -> Ptr Word8     -- message
                     -> CSize         -- message len
                     -> Word8         -- prehashed
                     -> Ptr Word8     -- context
                     -> Word8         -- context len
                     -> IO ()

foreign import ccall "crypton_decaf_ed448_verify"
    decaf_ed448_verify :: Ptr Signature -- signature
                       -> Ptr PublicKey -- public
                       -> Ptr Word8     -- message
                       -> CSize         -- message len
                       -> Word8         -- prehashed
                       -> Ptr Word8     -- context
                       -> Word8         -- context len
                       -> IO CInt