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

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

-- | An EdDSA signature
newtype Signature curve hash = Signature Bytes
    deriving (Int -> Signature curve hash -> ShowS
[Signature curve hash] -> ShowS
Signature curve hash -> String
(Int -> Signature curve hash -> ShowS)
-> (Signature curve hash -> String)
-> ([Signature curve hash] -> ShowS)
-> Show (Signature curve hash)
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
$cshowsPrec :: forall curve hash. Int -> Signature curve hash -> ShowS
showsPrec :: Int -> Signature curve hash -> ShowS
$cshow :: forall curve hash. Signature curve hash -> String
show :: Signature curve hash -> String
$cshowList :: forall curve hash. [Signature curve hash] -> ShowS
showList :: [Signature curve hash] -> ShowS
Show,Signature curve hash -> Signature curve hash -> Bool
(Signature curve hash -> Signature curve hash -> Bool)
-> (Signature curve hash -> Signature curve hash -> Bool)
-> Eq (Signature curve hash)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall curve hash.
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
/= :: Signature curve hash -> Signature curve hash -> Bool
Eq,Signature curve hash -> Int
(Signature curve hash -> Int)
-> (forall p a. Signature curve hash -> (Ptr p -> IO a) -> IO a)
-> (forall p. Signature curve hash -> Ptr p -> IO ())
-> ByteArrayAccess (Signature curve hash)
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
$clength :: forall curve hash. Signature curve hash -> Int
length :: Signature curve hash -> Int
$cwithByteArray :: forall curve hash p a.
Signature curve hash -> (Ptr p -> IO a) -> IO a
withByteArray :: forall p a. Signature curve hash -> (Ptr p -> IO a) -> IO a
$ccopyByteArrayToPtr :: forall curve hash p. Signature curve hash -> Ptr p -> IO ()
copyByteArrayToPtr :: forall p. Signature curve hash -> Ptr p -> IO ()
ByteArrayAccess,Signature curve hash -> ()
(Signature curve hash -> ()) -> NFData (Signature curve hash)
forall a. (a -> ()) -> NFData a
forall curve hash. Signature curve hash -> ()
$crnf :: forall curve hash. Signature curve hash -> ()
rnf :: 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 = proxy curve -> Int
forall (proxy :: * -> *) curve.
EllipticCurveEdDSA curve =>
proxy curve -> Int
signatureSize proxy curve
prx Int -> Int -> Int
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
_ = Proxy (CurveDigestSize curve) -> Int
forall (bitlen :: Nat) a (proxy :: Nat -> *).
(KnownNat bitlen, Num a) =>
proxy bitlen -> a
integralNatVal (Proxy (CurveDigestSize curve)
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
    | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== proxy curve -> Int
forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
publicKeySize proxy curve
prx =
        PublicKey curve hash -> CryptoFailable (PublicKey curve hash)
forall a. a -> CryptoFailable a
CryptoPassed (Bytes -> PublicKey curve hash
forall curve hash. Bytes -> PublicKey curve hash
PublicKey (Bytes -> PublicKey curve hash) -> Bytes -> PublicKey curve hash
forall a b. (a -> b) -> a -> b
$ ba -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ba
bs)
    | Bool
otherwise =
        CryptoError -> CryptoFailable (PublicKey curve hash)
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
    | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== proxy curve -> Int
forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
forall (proxy :: * -> *). proxy curve -> Int
secretKeySize proxy curve
prx =
        SecretKey curve -> CryptoFailable (SecretKey curve)
forall a. a -> CryptoFailable a
CryptoPassed (ScrubbedBytes -> SecretKey curve
forall curve. ScrubbedBytes -> SecretKey curve
SecretKey (ScrubbedBytes -> SecretKey curve)
-> ScrubbedBytes -> SecretKey curve
forall a b. (a -> b) -> a -> b
$ ba -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ba
bs)
    | Bool
otherwise                        =
        CryptoError -> CryptoFailable (SecretKey curve)
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
    | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== proxy curve -> Int
forall (proxy :: * -> *) curve.
EllipticCurveEdDSA curve =>
proxy curve -> Int
signatureSize proxy curve
prx =
        Signature curve hash -> CryptoFailable (Signature curve hash)
forall a. a -> CryptoFailable a
CryptoPassed (Bytes -> Signature curve hash
forall curve hash. Bytes -> Signature curve hash
Signature (Bytes -> Signature curve hash) -> Bytes -> Signature curve hash
forall a b. (a -> b) -> a -> b
$ ba -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ba
bs)
    | Bool
otherwise =
        CryptoError -> CryptoFailable (Signature curve hash)
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 = ScrubbedBytes -> SecretKey curve
forall curve. ScrubbedBytes -> SecretKey curve
SecretKey (ScrubbedBytes -> SecretKey curve)
-> m ScrubbedBytes -> m (SecretKey curve)
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 (proxy curve -> Int
forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
forall (proxy :: * -> *). 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 = proxy curve -> Scalar curve -> Point curve
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Point curve
forall (proxy :: * -> *).
proxy curve -> Scalar curve -> Point curve
pointBaseSmul proxy curve
prx (proxy curve -> hash -> SecretKey curve -> Scalar curve
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 proxy curve -> Point curve -> PublicKey curve hash
forall curve (proxy :: * -> *) hash.
EllipticCurveEdDSA curve =>
proxy curve -> Point curve -> PublicKey curve hash
forall (proxy :: * -> *) hash.
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 = (Scalar curve, View Bytes) -> Scalar curve
forall a b. (a, b) -> a
fst (proxy curve
-> hash -> SecretKey curve -> (Scalar curve, View Bytes)
forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve
-> hash -> SecretKey curve -> (Scalar curve, View Bytes)
forall hash (proxy :: * -> *).
(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 = proxy curve
-> Bytes
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
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 = proxy curve
-> Bytes
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
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 = proxy curve
-> Bool
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> msg
-> Signature curve hash
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 = proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> msg
-> Signature curve hash
-> Bool
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 = proxy curve
-> Bool
-> ctx
-> SecretKey curve
-> PublicKey curve hash
-> Digest prehash
-> Signature curve hash
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 = proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Digest prehash
-> Signature curve hash
-> Bool
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  = hash
forall a. HasCallStack => a
undefined :: hash
        (Scalar curve
s, View Bytes
prefix) = proxy curve
-> hash -> SecretKey curve -> (Scalar curve, View Bytes)
forall curve hash (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash,
 HashDigestSize hash ~ CurveDigestSize curve) =>
proxy curve
-> hash -> SecretKey curve -> (Scalar curve, View Bytes)
forall hash (proxy :: * -> *).
(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 = proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
forall hash ctx msg (proxy :: * -> *).
(HashAlgorithm hash, ByteArrayAccess ctx, ByteArrayAccess msg) =>
proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
hashWithDom proxy curve
prx hash
alg Bool
ph ctx
ctx (View Bytes -> Builder
forall ba. ByteArrayAccess ba => ba -> Builder
bytes View Bytes
prefix) msg
msg
        r :: Scalar curve
r    = proxy curve -> Bytes -> Scalar curve
forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> Scalar curve
decodeScalarNoErr proxy curve
prx Bytes
digR
        pR :: Point curve
pR   = proxy curve -> Scalar curve -> Point curve
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Point curve
forall (proxy :: * -> *).
proxy curve -> Scalar curve -> Point curve
pointBaseSmul proxy curve
prx Scalar curve
r
        bsR :: Bytes
bsR  = proxy curve -> Point curve -> Bytes
forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> Point curve -> bs
forall bs (proxy :: * -> *).
ByteArray bs =>
proxy curve -> Point curve -> bs
encodePoint proxy curve
prx Point curve
pR
        sK :: Scalar curve
sK   = proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Bytes
-> msg
-> Scalar curve
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   = proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
forall (proxy :: * -> *).
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
scalarAdd proxy curve
prx Scalar curve
r (proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
forall (proxy :: * -> *).
proxy curve -> Scalar curve -> Scalar curve -> Scalar curve
scalarMul proxy curve
prx Scalar curve
sK Scalar curve
s)
     in proxy curve
-> (Bytes, Point curve, Scalar curve) -> Signature curve hash
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) <- proxy curve
-> Signature curve hash
-> CryptoFailable (Bytes, Point curve, Scalar curve)
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 <- proxy curve -> Point curve -> Point curve
forall curve (proxy :: * -> *).
EllipticCurveArith curve =>
proxy curve -> Point curve -> Point curve
forall (proxy :: * -> *). proxy curve -> Point curve -> Point curve
pointNegate proxy curve
prx (Point curve -> Point curve)
-> CryptoFailable (Point curve) -> CryptoFailable (Point curve)
forall a b. (a -> b) -> CryptoFailable a -> CryptoFailable b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` proxy curve -> PublicKey curve hash -> CryptoFailable (Point curve)
forall curve (proxy :: * -> *) hash.
EllipticCurveEdDSA curve =>
proxy curve -> PublicKey curve hash -> CryptoFailable (Point curve)
forall (proxy :: * -> *) hash.
proxy curve -> PublicKey curve hash -> CryptoFailable (Point curve)
publicPoint proxy curve
prx PublicKey curve hash
pub
        let sK :: Scalar curve
sK  = proxy curve
-> Bool
-> ctx
-> PublicKey curve hash
-> Bytes
-> msg
-> Scalar curve
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' = proxy curve
-> Scalar curve -> Scalar curve -> Point curve -> Point curve
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve
-> Scalar curve -> Scalar curve -> Point curve -> Point curve
forall (proxy :: * -> *).
proxy curve
-> Scalar curve -> Scalar curve -> Point curve -> Point curve
pointsSmulVarTime proxy curve
prx Scalar curve
sS Scalar curve
sK Point curve
nPub
        Bool -> CryptoFailable Bool
forall a. a -> CryptoFailable a
forall (m :: * -> *) a. Monad m => a -> m a
return (Point curve
pR Point curve -> Point curve -> Bool
forall a. Eq a => a -> a -> Bool
== Point curve
pR')

emptyCtx :: Bytes
emptyCtx :: Bytes
emptyCtx = Bytes
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  = hash
forall a. HasCallStack => a
undefined :: hash
        digK :: Bytes
digK = proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
forall curve hash ctx msg (proxy :: * -> *).
(EllipticCurveEdDSA curve, HashAlgorithm hash, ByteArrayAccess ctx,
 ByteArrayAccess msg) =>
proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
forall hash ctx msg (proxy :: * -> *).
(HashAlgorithm hash, ByteArrayAccess ctx, ByteArrayAccess msg) =>
proxy curve -> hash -> Bool -> ctx -> Builder -> msg -> Bytes
hashWithDom proxy curve
prx hash
alg Bool
ph ctx
ctx (Bytes -> Builder
forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
bsR Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bytes -> Builder
forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
pub) msg
msg
     in proxy curve -> Bytes -> Scalar curve
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) = Bytes -> Signature curve hash
forall curve hash. Bytes -> Signature curve hash
Signature (Bytes -> Signature curve hash) -> Bytes -> Signature curve hash
forall a b. (a -> b) -> a -> b
$ Builder -> Bytes
forall ba. ByteArray ba => Builder -> ba
buildAndFreeze (Builder -> Bytes) -> Builder -> Bytes
forall a b. (a -> b) -> a -> b
$
    Bytes -> Builder
forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
bsR Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bytes -> Builder
forall ba. ByteArrayAccess ba => ba -> Builder
bytes Bytes
bsS Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
zero Int
len0
  where
    bsS :: Bytes
bsS  = proxy curve -> Scalar curve -> Bytes
forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArray bs) =>
proxy curve -> Scalar curve -> bs
forall bs (proxy :: * -> *).
ByteArray bs =>
proxy curve -> Scalar curve -> bs
encodeScalarLE proxy curve
prx Scalar curve
sS :: Bytes
    len0 :: Int
len0 = proxy curve -> Int
forall (proxy :: * -> *) curve.
EllipticCurveEdDSA curve =>
proxy curve -> Int
signatureSize proxy curve
prx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length Bytes
bsR Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bytes -> Int
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) = Int -> Bytes -> (Bytes, Bytes)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt (proxy curve -> Int
forall curve (proxy :: * -> *).
EllipticCurveEdDSA curve =>
proxy curve -> Int
publicKeySize proxy curve
prx) Bytes
bs
    Point curve
pR <- proxy curve -> Bytes -> CryptoFailable (Point curve)
forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (Point curve)
forall bs (proxy :: * -> *).
ByteArray bs =>
proxy curve -> bs -> CryptoFailable (Point curve)
decodePoint proxy curve
prx Bytes
bsR
    Scalar curve
sS <- proxy curve -> Bytes -> CryptoFailable (Scalar curve)
forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
forall bs (proxy :: * -> *).
ByteArrayAccess bs =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
decodeScalarLE proxy curve
prx Bytes
bsS
    (Bytes, Point curve, Scalar curve)
-> CryptoFailable (Bytes, Point curve, Scalar curve)
forall a. a -> CryptoFailable a
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 = String -> CryptoFailable (Scalar curve) -> Scalar curve
forall a. String -> CryptoFailable a -> a
unwrap String
"decodeScalarNoErr" (CryptoFailable (Scalar curve) -> Scalar curve)
-> (bs -> CryptoFailable (Scalar curve)) -> bs -> Scalar curve
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy curve -> bs -> CryptoFailable (Scalar curve)
forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
forall bs (proxy :: * -> *).
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
_) = String -> a
forall a. HasCallStack => String -> a
error (String
name String -> ShowS
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
&& ctx -> Bool
forall a. ByteArrayAccess a => a -> Bool
B.null ctx
ctx = hash -> Builder -> msg -> Bytes
forall alg msg.
(HashAlgorithm alg, ByteArrayAccess msg) =>
alg -> Builder -> msg -> Bytes
digestDomMsg hash
alg Builder
bss
        | Bool
otherwise            = hash -> Builder -> msg -> Bytes
forall alg msg.
(HashAlgorithm alg, ByteArrayAccess msg) =>
alg -> Builder -> msg -> Bytes
digestDomMsg hash
alg (Builder
dom Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bss)
      where dom :: Builder
dom = ByteString -> Builder
forall ba. ByteArrayAccess ba => ba -> Builder
bytes (ByteString
"SigEd25519 no Ed25519 collisions" :: ByteString) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                  Word8 -> Builder
byte (if Bool
ph then Word8
1 else Word8
0) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                  Word8 -> Builder
byte (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ ctx -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ctx
ctx) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                  ctx -> Builder
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
_ = Bytes -> PublicKey Curve_Edwards25519 hash
forall curve hash. Bytes -> PublicKey curve hash
PublicKey (Bytes -> PublicKey Curve_Edwards25519 hash)
-> (Point -> Bytes) -> Point -> PublicKey Curve_Edwards25519 hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Bytes
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
_ = PublicKey Curve_Edwards25519 hash -> CryptoFailable Point
PublicKey Curve_Edwards25519 hash
-> CryptoFailable (Point 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
_ = Scalar -> bs
Scalar Curve_Edwards25519 -> bs
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
_ = bs -> CryptoFailable Scalar
bs -> CryptoFailable (Scalar 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 =
        (proxy Curve_Edwards25519 -> Bytes -> Scalar Curve_Edwards25519
forall curve bs (proxy :: * -> *).
(EllipticCurveEdDSA curve, ByteArrayAccess bs) =>
proxy curve -> bs -> Scalar curve
decodeScalarNoErr proxy Curve_Edwards25519
prx Bytes
clamped, Bytes -> Int -> View Bytes
forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.dropView Bytes
hashed Int
32)
      where
        hashed :: Bytes
hashed  = hash
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
forall alg.
HashAlgorithm alg =>
alg
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
digest hash
alg (((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
 -> Bytes)
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
forall a b. (a -> b) -> a -> b
$ \forall bs. ByteArrayAccess bs => bs -> IO ()
update -> SecretKey Curve_Edwards25519 -> IO ()
forall bs. ByteArrayAccess bs => bs -> IO ()
update SecretKey Curve_Edwards25519
priv

        clamped :: Bytes
        clamped :: Bytes
clamped = View Bytes -> (Ptr Word8 -> IO ()) -> Bytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> bs2
B.copyAndFreeze (Bytes -> Int -> View Bytes
forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.takeView Bytes
hashed Int
32) ((Ptr Word8 -> IO ()) -> Bytes) -> (Ptr Word8 -> IO ()) -> Bytes
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
                      Word8
b0  <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
p Int
0  :: IO Word8
                      Word8
b31 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
p Int
31 :: IO Word8
                      Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
p Int
31 ((Word8
b31 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x40)
                      Ptr Word8 -> Int -> Word8 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word8
p Int
0  (Word8
b0 Word8 -> Word8 -> Word8
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 = alg
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
forall alg.
HashAlgorithm alg =>
alg
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
digest alg
alg (((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
 -> Bytes)
-> ((forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ())
-> Bytes
forall a b. (a -> b) -> a -> b
$ \forall bs. ByteArrayAccess bs => bs -> IO ()
update ->
    Bytes -> IO ()
forall bs. ByteArrayAccess bs => bs -> IO ()
update (Builder -> Bytes
forall ba. ByteArray ba => Builder -> ba
buildAndFreeze Builder
bss :: Bytes) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> msg -> IO ()
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 = Digest alg -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest alg -> Bytes) -> Digest alg -> Bytes
forall a b. (a -> b) -> a -> b
$ IO (Digest alg) -> Digest alg
forall a. IO a -> a
unsafeDoIO (IO (Digest alg) -> Digest alg) -> IO (Digest alg) -> Digest alg
forall a b. (a -> b) -> a -> b
$ do
    MutableContext alg
mc <- alg -> IO (MutableContext alg)
forall alg. HashAlgorithm alg => alg -> IO (MutableContext alg)
hashMutableInitWith alg
alg
    (forall bs. ByteArrayAccess bs => bs -> IO ()) -> IO ()
fn (MutableContext alg -> bs -> IO ()
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
MutableContext a -> ba -> IO ()
hashMutableUpdate MutableContext alg
mc)
    MutableContext alg -> IO (Digest alg)
forall a. HashAlgorithm a => MutableContext a -> IO (Digest a)
hashMutableFinalize MutableContext alg
mc