-- |
-- Module      : Crypto.PubKey.EdDSA
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
-- EdDSA signature generation and verification, implemented in Haskell and
-- parameterized with elliptic curve and hash algorithm.  Only edwards25519 is
-- supported at the moment.
--
-- The module provides \"context\" and \"prehash\" variants defined in
-- <https://tools.ietf.org/html/rfc8032 RFC 8032>.
--
-- This implementation is most useful when wanting to customize the hash
-- algorithm.  See module "Crypto.PubKey.Ed25519" for faster Ed25519 with
-- SHA-512.
--
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
module Crypto.PubKey.EdDSA
    ( SecretKey
    , PublicKey
    , Signature
    -- * Curves with EdDSA implementation
    , EllipticCurveEdDSA(CurveDigestSize)
    , publicKeySize
    , secretKeySize
    , signatureSize
    -- * Smart constructors
    , signature
    , publicKey
    , secretKey
    -- * Methods
    , toPublic
    , sign
    , signCtx
    , signPh
    , verify
    , verifyCtx
    , verifyPh
    , generateSecretKey
    ) where

import           Data.Bits
import           Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, ScrubbedBytes, View)
import qualified Data.ByteArray as B
import           Data.ByteString (ByteString)
import           Data.Proxy

import           Crypto.ECC
import qualified Crypto.ECC.Edwards25519 as Edwards25519
import           Crypto.Error
import           Crypto.Hash (Digest)
import           Crypto.Hash.IO
import           Crypto.Random

import           GHC.TypeLits (KnownNat, Nat)

import           Crypto.Internal.Builder
import           Crypto.Internal.Compat
import           Crypto.Internal.Imports
import           Crypto.Internal.Nat (integralNatVal)

import           Foreign.Storable


-- API

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

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

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

-- | Elliptic curves with an implementation of EdDSA
class ( EllipticCurveBasepointArith curve
      , KnownNat (CurveDigestSize curve)
      ) => EllipticCurveEdDSA curve where

    -- | Size of the digest for this curve (in bytes)
    type CurveDigestSize curve :: Nat

    -- | Size of secret keys for this curve (in bytes)
    secretKeySize :: proxy curve -> Int

    -- hash with specified parameters
    hashWithDom :: (HashAlgorithm hash, ByteArrayAccess ctx, ByteArrayAccess msg)
                => proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes

    -- conversion between scalar, point and public key
    pointPublic :: proxy curve -> Point curve -> PublicKey curve hash
    publicPoint :: proxy curve -> PublicKey curve hash -> CryptoFailable (Point curve)
    encodeScalarLE :: ByteArray bs => proxy curve -> Scalar curve -> bs
    decodeScalarLE :: ByteArrayAccess bs => proxy curve -> bs -> CryptoFailable (Scalar curve)

    -- how to use bits in a secret key
    scheduleSecret :: ( HashAlgorithm hash
                      , HashDigestSize hash ~ CurveDigestSize curve
                      )
                   => proxy curve
                   -> hash
                   -> SecretKey curve
                   -> (Scalar curve, View Bytes)

-- | Size of public keys for this curve (in bytes)
publicKeySize :: EllipticCurveEdDSA curve => proxy curve -> Int
publicKeySize :: forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
publicKeySize proxy curve
prx = forall (proxy :: * -> *) curve.
EllipticCurveEdDSA curve =>
proxy curve -> Int
signatureSize proxy curve
prx forall a. Integral a => a -> a -> a
`div` Int
2

-- | Size of signatures for this curve (in bytes)
signatureSize :: forall proxy curve . EllipticCurveEdDSA curve
              => proxy curve -> Int
signatureSize :: forall (proxy :: * -> *) curve.
EllipticCurveEdDSA curve =>
proxy curve -> Int
signatureSize proxy curve
_ = forall (bitlen :: Nat) a (proxy :: Nat -> *).
(KnownNat bitlen, Num a) =>
proxy bitlen -> a
integralNatVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy (CurveDigestSize curve))


-- Constructors

-- | Try to build a public key from a bytearray
publicKey :: ( EllipticCurveEdDSA curve
             , HashAlgorithm hash
             , HashDigestSize hash ~ CurveDigestSize curve
             , ByteArrayAccess ba
             )
          => proxy curve -> hash -> ba -> CryptoFailable (PublicKey curve hash)
publicKey :: forall curve hash ba (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ba) =>
proxy curve -> hash -> ba -> CryptoFailable (PublicKey curve hash)
publicKey proxy curve
prx hash
_ ba
bs
    | forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs forall a. Eq a => a -> a -> Bool
== forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
publicKeySize proxy curve
prx =
        forall a. a -> CryptoFailable a
CryptoPassed (forall curve hash. Bytes -> PublicKey curve hash
PublicKey forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ba
bs)
    | Bool
otherwise =
        forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_PublicKeySizeInvalid

-- | Try to build a secret key from a bytearray
secretKey :: (EllipticCurveEdDSA curve, ByteArrayAccess ba)
          => proxy curve -> ba -> CryptoFailable (SecretKey curve)
secretKey :: forall curve ba (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess ba) =>
proxy curve -> ba -> CryptoFailable (SecretKey curve)
secretKey proxy curve
prx ba
bs
    | forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs forall a. Eq a => a -> a -> Bool
== forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
secretKeySize proxy curve
prx =
        forall a. a -> CryptoFailable a
CryptoPassed (forall curve. ScrubbedBytes -> SecretKey curve
SecretKey forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ba
bs)
    | Bool
otherwise                        =
        forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SecretKeyStructureInvalid

-- | Try to build a signature from a bytearray
signature :: ( EllipticCurveEdDSA curve
             , HashAlgorithm hash
             , HashDigestSize hash ~ CurveDigestSize curve
             , ByteArrayAccess ba
             )
          => proxy curve -> hash -> ba -> CryptoFailable (Signature curve hash)
signature :: forall curve hash ba (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ba) =>
proxy curve -> hash -> ba -> CryptoFailable (Signature curve hash)
signature proxy curve
prx hash
_ ba
bs
    | forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs forall a. Eq a => a -> a -> Bool
== forall (proxy :: * -> *) curve.
EllipticCurveEdDSA curve =>
proxy curve -> Int
signatureSize proxy curve
prx =
        forall a. a -> CryptoFailable a
CryptoPassed (forall curve hash. Bytes -> Signature curve hash
Signature forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ba
bs)
    | Bool
otherwise =
        forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_SecretKeyStructureInvalid


-- Conversions

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

-- | Create a public key from a secret key
toPublic :: ( EllipticCurveEdDSA curve
            , HashAlgorithm hash
            , HashDigestSize hash ~ CurveDigestSize curve
            )
         => proxy curve -> hash -> SecretKey curve -> PublicKey curve hash
toPublic :: forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve -> hash -> SecretKey curve -> PublicKey curve hash
toPublic proxy curve
prx hash
alg SecretKey curve
priv =
    let p :: Point curve
p = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Point curve
pointBaseSmul proxy curve
prx (forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve -> hash -> SecretKey curve -> Scalar curve
secretScalar proxy curve
prx hash
alg SecretKey curve
priv)
     in forall curve (proxy :: * -> *) hash.
EllipticCurveEdDSA curve =>
proxy curve -> Point curve -> PublicKey curve hash
pointPublic proxy curve
prx Point curve
p

secretScalar :: ( EllipticCurveEdDSA curve
                , HashAlgorithm hash
                , HashDigestSize hash ~ CurveDigestSize curve
                )
             => proxy curve -> hash -> SecretKey curve -> Scalar curve
secretScalar :: forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve -> hash -> SecretKey curve -> Scalar curve
secretScalar proxy curve
prx hash
alg SecretKey curve
priv = forall a b. (a, b) -> a
fst (forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve
-> hash -> SecretKey curve -> (Scalar curve, View Bytes)
scheduleSecret proxy curve
prx hash
alg SecretKey curve
priv)


-- EdDSA signature generation & verification

-- | Sign a message using the key pair
sign :: ( EllipticCurveEdDSA curve
        , HashAlgorithm hash
        , HashDigestSize hash ~ CurveDigestSize curve
        , ByteArrayAccess msg
        )
     => proxy curve -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash
sign :: forall curve hash msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve,
 ByteArrayAccess msg) =>
proxy curve
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
sign proxy curve
prx = forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signCtx proxy curve
prx Bytes
emptyCtx

-- | Verify a message
verify :: ( EllipticCurveEdDSA curve
          , HashAlgorithm hash
          , HashDigestSize hash ~ CurveDigestSize curve
          , ByteArrayAccess msg
          )
       => proxy curve -> PublicKey curve hash -> msg -> Signature curve hash -> Bool
verify :: forall curve hash msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve,
 ByteArrayAccess msg) =>
proxy curve
-> PublicKey curve hash -> msg -> Signature curve hash -> Bool
verify proxy curve
prx = forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyCtx proxy curve
prx Bytes
emptyCtx

-- | Sign a message using the key pair under context @ctx@
signCtx :: ( EllipticCurveEdDSA curve
           , HashAlgorithm hash
           , HashDigestSize hash ~ CurveDigestSize curve
           , ByteArrayAccess ctx
           , ByteArrayAccess msg
           )
        => proxy curve -> ctx -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash
signCtx :: forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signCtx proxy curve
prx = forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signPhCtx proxy curve
prx Bool
False

-- | Verify a message under context @ctx@
verifyCtx :: ( EllipticCurveEdDSA curve
             , HashAlgorithm hash
             , HashDigestSize hash ~ CurveDigestSize curve
             , ByteArrayAccess ctx
             , ByteArrayAccess msg
             )
          => proxy curve -> ctx -> PublicKey curve hash -> msg -> Signature curve hash -> Bool
verifyCtx :: forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyCtx proxy curve
prx = forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyPhCtx proxy curve
prx Bool
False

-- | Sign a prehashed message using the key pair under context @ctx@
signPh :: ( EllipticCurveEdDSA curve
          , HashAlgorithm hash
          , HashDigestSize hash ~ CurveDigestSize curve
          , ByteArrayAccess ctx
          )
       => proxy curve -> ctx -> SecretKey curve -> PublicKey curve hash -> Digest prehash -> Signature curve hash
signPh :: forall curve hash ctx (proxy :: * -> *) prehash.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve,
 ByteArrayAccess ctx) =>
proxy curve
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> Digest prehash
-> Signature curve hash
signPh proxy curve
prx = forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signPhCtx proxy curve
prx Bool
True

-- | Verify a prehashed message under context @ctx@
verifyPh :: ( EllipticCurveEdDSA curve
            , HashAlgorithm hash
            , HashDigestSize hash ~ CurveDigestSize curve
            , ByteArrayAccess ctx
            )
         => proxy curve -> ctx -> PublicKey curve hash -> Digest prehash -> Signature curve hash -> Bool
verifyPh :: forall curve hash ctx (proxy :: * -> *) prehash.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve,
 ByteArrayAccess ctx) =>
proxy curve
-> ctx
-> PublicKey curve hash
-> Digest prehash
-> Signature curve hash
-> Bool
verifyPh proxy curve
prx = forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyPhCtx proxy curve
prx Bool
True

signPhCtx :: forall proxy curve hash ctx msg .
             ( EllipticCurveEdDSA curve
             , HashAlgorithm hash
             , HashDigestSize hash ~ CurveDigestSize curve
             , ByteArrayAccess ctx
             , ByteArrayAccess msg
             )
          => proxy curve -> Bool -> ctx -> SecretKey curve -> PublicKey curve hash -> msg -> Signature curve hash
signPhCtx :: forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
signPhCtx proxy curve
prx Bool
ph ctx
ctx SecretKey curve
priv PublicKey curve hash
pub msg
msg =
    let alg :: hash
alg  = forall a. HasCallStack => a
undefined :: hash
        (Scalar curve
s, View Bytes
prefix) = forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve
-> hash -> SecretKey curve -> (Scalar curve, View Bytes)
scheduleSecret proxy curve
prx hash
alg SecretKey curve
priv
        digR :: Bytes
digR = forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
hashWithDom proxy curve
prx hash
alg Bool
ph ctx
ctx (forall ba. ByteArrayAccess ba => ba -> Builder
bytes View Bytes
prefix) msg
msg
        r :: Scalar curve
r    = forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> Scalar curve
decodeScalarNoErr proxy curve
prx Bytes
digR
        pR :: Point curve
pR   = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Point curve
pointBaseSmul proxy curve
prx Scalar curve
r
        bsR :: Bytes
bsR  = forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> Point curve -> bs
encodePoint proxy curve
prx Point curve
pR
        sK :: Scalar curve
sK   = forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Bytes
-> msg
-> Scalar curve
getK proxy curve
prx Bool
ph ctx
ctx PublicKey curve hash
pub Bytes
bsR msg
msg
        sS :: Scalar curve
sS   = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
scalarAdd proxy curve
prx Scalar curve
r (forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
scalarMul proxy curve
prx Scalar curve
sK Scalar curve
s)
     in forall curve (proxy :: * -> *) hash.
EllipticCurveEdDSA curve =>
proxy curve
-> (Bytes, Point curve, Scalar curve) -> Signature curve hash
encodeSignature proxy curve
prx (Bytes
bsR, Point curve
pR, Scalar curve
sS)

verifyPhCtx :: ( EllipticCurveEdDSA curve
               , HashAlgorithm hash
               , HashDigestSize hash ~ CurveDigestSize curve
               , ByteArrayAccess ctx
               , ByteArrayAccess msg
               )
            => proxy curve -> Bool -> ctx -> PublicKey curve hash -> msg -> Signature curve hash -> Bool
verifyPhCtx :: forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
verifyPhCtx proxy curve
prx Bool
ph ctx
ctx PublicKey curve hash
pub msg
msg Signature curve hash
sig =
    case CryptoFailable Bool
doVerify of
        CryptoPassed Bool
verified -> Bool
verified
        CryptoFailed CryptoError
_        -> Bool
False
  where
    doVerify :: CryptoFailable Bool
doVerify = do
        (Bytes
bsR, Point curve
pR, Scalar curve
sS) <- forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve,
 HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve
-> Signature curve hash
-> CryptoFailable (Bytes, Point curve, Scalar curve)
decodeSignature proxy curve
prx Signature curve hash
sig
        Point curve
nPub <- forall curve (proxy :: * -> *).
EllipticCurveArith curve =>
proxy curve -> Point curve -> Point curve
pointNegate proxy curve
prx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall curve (proxy :: * -> *) hash.
EllipticCurveEdDSA curve =>
proxy curve -> PublicKey curve hash -> CryptoFailable (Point curve)
publicPoint proxy curve
prx PublicKey curve hash
pub
        let sK :: Scalar curve
sK  = forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Bytes
-> msg
-> Scalar curve
getK proxy curve
prx Bool
ph ctx
ctx PublicKey curve hash
pub Bytes
bsR msg
msg
            pR' :: Point curve
pR' = forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve
-> Scalar curve -> Scalar curve -> Point curve -> Point curve
pointsSmulVarTime proxy curve
prx Scalar curve
sS Scalar curve
sK Point curve
nPub
        forall (m :: * -> *) a. Monad m => a -> m a
return (Point curve
pR forall a. Eq a => a -> a -> Bool
== Point curve
pR')

emptyCtx :: Bytes
emptyCtx :: Bytes
emptyCtx = forall a. ByteArray a => a
B.empty

getK :: forall proxy curve hash ctx msg .
        ( EllipticCurveEdDSA curve
        , HashAlgorithm hash
        , HashDigestSize hash ~ CurveDigestSize curve
        , ByteArrayAccess ctx
        , ByteArrayAccess msg
        )
     => proxy curve -> Bool -> ctx -> PublicKey curve hash -> Bytes -> msg -> Scalar curve
getK :: forall (proxy :: * -> *) curve hash ctx msg.
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Bytes
-> msg
-> Scalar curve
getK proxy curve
prx Bool
ph ctx
ctx (PublicKey Bytes
pub) Bytes
bsR msg
msg =
    let alg :: hash
alg  = forall a. HasCallStack => a
undefined :: hash
        digK :: Bytes
digK = forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
hashWithDom proxy curve
prx hash
alg Bool
ph ctx
ctx (forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
bsR forall a. Semigroup a => a -> a -> a
<> forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
pub) msg
msg
     in forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> Scalar curve
decodeScalarNoErr proxy curve
prx Bytes
digK

encodeSignature :: EllipticCurveEdDSA curve
                => proxy curve
                -> (Bytes, Point curve, Scalar curve)
                -> Signature curve hash
encodeSignature :: forall curve (proxy :: * -> *) hash.
EllipticCurveEdDSA curve =>
proxy curve
-> (Bytes, Point curve, Scalar curve) -> Signature curve hash
encodeSignature proxy curve
prx (Bytes
bsR, Point curve
_, Scalar curve
sS) = forall curve hash. Bytes -> Signature curve hash
Signature forall a b. (a -> b) -> a -> b
$ forall ba. ByteArray ba => Builder -> ba
buildAndFreeze forall a b. (a -> b) -> a -> b
$
    forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
bsR forall a. Semigroup a => a -> a -> a
<> forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
bsS forall a. Semigroup a => a -> a -> a
<> Int -> Builder
zero Int
len0
  where
    bsS :: Bytes
bsS  = forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArray bs) =>
proxy curve -> Scalar curve -> bs
encodeScalarLE proxy curve
prx Scalar curve
sS :: Bytes
    len0 :: Int
len0 = forall (proxy :: * -> *) curve.
EllipticCurveEdDSA curve =>
proxy curve -> Int
signatureSize proxy curve
prx forall a. Num a => a -> a -> a
- forall ba. ByteArrayAccess ba => ba -> Int
B.length Bytes
bsR forall a. Num a => a -> a -> a
- forall ba. ByteArrayAccess ba => ba -> Int
B.length Bytes
bsS

decodeSignature :: ( EllipticCurveEdDSA curve
                   , HashDigestSize hash ~ CurveDigestSize curve
                   )
                => proxy curve
                -> Signature curve hash
                -> CryptoFailable (Bytes, Point curve, Scalar curve)
decodeSignature :: forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve,
 HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve
-> Signature curve hash
-> CryptoFailable (Bytes, Point curve, Scalar curve)
decodeSignature proxy curve
prx (Signature Bytes
bs) = do
    let (Bytes
bsR, Bytes
bsS) = forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt (forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
publicKeySize proxy curve
prx) Bytes
bs
    Point curve
pR <- forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (Point curve)
decodePoint proxy curve
prx Bytes
bsR
    Scalar curve
sS <- forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
decodeScalarLE proxy curve
prx Bytes
bsS
    forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
bsR, Point curve
pR, Scalar curve
sS)

-- implementations are supposed to decode any scalar up to the size of the digest
decodeScalarNoErr :: (EllipticCurveEdDSA curve, ByteArrayAccess bs)
                  => proxy curve -> bs -> Scalar curve
decodeScalarNoErr :: forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> Scalar curve
decodeScalarNoErr proxy curve
prx = forall a. String -> CryptoFailable a -> a
unwrap String
"decodeScalarNoErr" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
decodeScalarLE proxy curve
prx

unwrap :: String -> CryptoFailable a -> a
unwrap :: forall a. String -> CryptoFailable a -> a
unwrap String
name (CryptoFailed CryptoError
_) = forall a. HasCallStack => String -> a
error (String
name forall a. [a] -> [a] -> [a]
++ String
": assumption failed")
unwrap String
_    (CryptoPassed a
x) = a
x


-- Ed25519 implementation

instance EllipticCurveEdDSA Curve_Edwards25519 where
    type CurveDigestSize Curve_Edwards25519 = 64
    secretKeySize :: forall (proxy :: * -> *). proxy Curve_Edwards25519 -> Int
secretKeySize proxy Curve_Edwards25519
_ = Int
32

    hashWithDom :: forall hash ctx msg (proxy :: * -> *).
(HashAlgorithm hash, ByteArrayAccess ctx, ByteArrayAccess msg) =>
proxy Curve_Edwards25519
-> hash -> Bool -> ctx -> Builder -> msg -> Bytes
hashWithDom proxy Curve_Edwards25519
_ hash
alg Bool
ph ctx
ctx Builder
bss
        | Bool -> Bool
not Bool
ph Bool -> Bool -> Bool
&& forall a. ByteArrayAccess a => a -> Bool
B.null ctx
ctx = forall alg msg.
(HashAlgorithm alg, ByteArrayAccess msg) =>
alg -> Builder -> msg -> Bytes
digestDomMsg hash
alg Builder
bss
        | Bool
otherwise            = forall alg msg.
(HashAlgorithm alg, ByteArrayAccess msg) =>
alg -> Builder -> msg -> Bytes
digestDomMsg hash
alg (Builder
dom forall a. Semigroup a => a -> a -> a
<> Builder
bss)
      where dom :: Builder
dom = forall ba. ByteArrayAccess ba => ba -> Builder
bytes (ByteString
"SigEd25519 no Ed25519 collisions" :: ByteString) forall a. Semigroup a => a -> a -> a
<>
                  Word8 -> Builder
byte (if Bool
ph then Word8
1 else Word8
0) forall a. Semigroup a => a -> a -> a
<>
                  Word8 -> Builder
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Int
B.length ctx
ctx) forall a. Semigroup a => a -> a -> a
<>
                  forall ba. ByteArrayAccess ba => ba -> Builder
bytes ctx
ctx

    pointPublic :: forall (proxy :: * -> *) hash.
proxy Curve_Edwards25519
-> Point Curve_Edwards25519 -> PublicKey Curve_Edwards25519 hash
pointPublic proxy Curve_Edwards25519
_ = forall curve hash. Bytes -> PublicKey curve hash
PublicKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bs. ByteArray bs => Point -> bs
Edwards25519.pointEncode
    publicPoint :: forall (proxy :: * -> *) hash.
proxy Curve_Edwards25519
-> PublicKey Curve_Edwards25519 hash
-> CryptoFailable (Point Curve_Edwards25519)
publicPoint proxy Curve_Edwards25519
_ = forall bs. ByteArrayAccess bs => bs -> CryptoFailable Point
Edwards25519.pointDecode
    encodeScalarLE :: forall bs (proxy :: * -> *).
ByteArray bs =>
proxy Curve_Edwards25519 -> Scalar Curve_Edwards25519 -> bs
encodeScalarLE proxy Curve_Edwards25519
_ = forall bs. ByteArray bs => Scalar -> bs
Edwards25519.scalarEncode
    decodeScalarLE :: forall bs (proxy :: * -> *).
ByteArrayAccess bs =>
proxy Curve_Edwards25519
-> bs -> CryptoFailable (Scalar Curve_Edwards25519)
decodeScalarLE proxy Curve_Edwards25519
_ = forall bs. ByteArrayAccess bs => bs -> CryptoFailable Scalar
Edwards25519.scalarDecodeLong

    scheduleSecret :: forall hash (proxy :: * -> *).
(HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize Curve_Edwards25519) =>
proxy Curve_Edwards25519
-> hash
-> SecretKey Curve_Edwards25519
-> (Scalar Curve_Edwards25519, View Bytes)
scheduleSecret proxy Curve_Edwards25519
prx hash
alg SecretKey Curve_Edwards25519
priv =
        (forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> Scalar curve
decodeScalarNoErr proxy Curve_Edwards25519
prx Bytes
clamped, forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.dropView Bytes
hashed Int
32)
      where
        hashed :: Bytes
hashed  = forall alg.
HashAlgorithm alg =>
alg
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
digest hash
alg forall a b. (a -> b) -> a -> b
$ \forall bs. ByteArrayAccess bs => bs -> IO ()
update -> forall bs. ByteArrayAccess bs => bs -> IO ()
update SecretKey Curve_Edwards25519
priv

        clamped :: Bytes
        clamped :: Bytes
clamped = forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze (forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.takeView Bytes
hashed Int
32) forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
                      Word8
b0  <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
p Int
0  :: IO Word8
                      Word8
b31 <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
p Int
31 :: IO Word8
                      forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
p Int
31 ((Word8
b31 forall a. Bits a => a -> a -> a
.&. Word8
0x7F) forall a. Bits a => a -> a -> a
.|. Word8
0x40)
                      forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
p Int
0  (Word8
b0 forall a. Bits a => a -> a -> a
.&. Word8
0xF8)


{-
  Optimize hashing by limiting the number of roundtrips between Haskell and C.
  Hash "update" functions do not use unsafe FFI call, so better concanetate
  small fragments together and call the update function once.

  Using the IO hash interface avoids context buffer copies.

  Data type Digest is not used directly but converted to Bytes early. Any use of
  withByteArray on the unpinned Digest backend would require copy through a
  pinned trampoline.
-}

digestDomMsg :: (HashAlgorithm alg, ByteArrayAccess msg)
             => alg -> Builder -> msg -> Bytes
digestDomMsg :: forall alg msg.
(HashAlgorithm alg, ByteArrayAccess msg) =>
alg -> Builder -> msg -> Bytes
digestDomMsg alg
alg Builder
bss msg
bs = forall alg.
HashAlgorithm alg =>
alg
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
digest alg
alg forall a b. (a -> b) -> a -> b
$ \forall bs. ByteArrayAccess bs => bs -> IO ()
update ->
    forall bs. ByteArrayAccess bs => bs -> IO ()
update (forall ba. ByteArray ba => Builder -> ba
buildAndFreeze Builder
bss :: Bytes) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall bs. ByteArrayAccess bs => bs -> IO ()
update msg
bs

digest :: HashAlgorithm alg
       => alg
       -> ((forall bs . ByteArrayAccess bs => bs -> IO ()) -> IO ())
       -> Bytes
digest :: forall alg.
HashAlgorithm alg =>
alg
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
digest alg
alg (forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ()
fn = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ do
    MutableContext alg
mc <- forall alg. HashAlgorithm alg => alg -> IO (MutableContext alg)
hashMutableInitWith alg
alg
    (forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ()
fn (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
MutableContext a -> ba -> IO ()
hashMutableUpdate MutableContext alg
mc)
    forall a. HashAlgorithm a => MutableContext a -> IO (Digest a)
hashMutableFinalize MutableContext alg
mc