-- |
-- Module      : Crypto.PubKey.ECDSA
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Elliptic Curve Digital Signature Algorithm, with the parameterized
-- curve implementations provided by module "Crypto.ECC".
--
-- Public/private key pairs can be generated using
-- 'curveGenerateKeyPair' or decoded from binary.
--
-- /WARNING:/ Only curve P-256 has constant-time implementation.
-- Signature operations with P-384 and P-521 may leak the private key.
--
-- Signature verification should be safe for all curves.
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Crypto.PubKey.ECDSA
    ( EllipticCurveECDSA (..)
    -- * Public keys
    , PublicKey
    , encodePublic
    , decodePublic
    , toPublic
    -- * Private keys
    , PrivateKey
    , encodePrivate
    , decodePrivate
    -- * Signatures
    , Signature(..)
    , signatureFromIntegers
    , signatureToIntegers
    -- * Generation and verification
    , signWith
    , signDigestWith
    , sign
    , signDigest
    , verify
    , verifyDigest
    ) where

import           Control.Monad

import           Crypto.ECC
import qualified Crypto.ECC.Simple.Types as Simple
import           Crypto.Error
import           Crypto.Hash
import           Crypto.Hash.Types
import           Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess)
import           Crypto.Internal.Imports
import           Crypto.Number.ModArithmetic (inverseFermat)
import qualified Crypto.PubKey.ECC.P256 as P256
import           Crypto.Random.Types

import           Data.Bits
import qualified Data.ByteArray as B
import           Data.Data

import           Foreign.Ptr (Ptr)
import           Foreign.Storable (peekByteOff, pokeByteOff)

-- | Represent a ECDSA signature namely R and S.
data Signature curve = Signature
    { forall curve. Signature curve -> Scalar curve
sign_r :: Scalar curve -- ^ ECDSA r
    , forall curve. Signature curve -> Scalar curve
sign_s :: Scalar curve -- ^ ECDSA s
    }

deriving instance Eq (Scalar curve) => Eq (Signature curve)
deriving instance Show (Scalar curve) => Show (Signature curve)

instance NFData (Scalar curve) => NFData (Signature curve) where
    rnf :: Signature curve -> ()
rnf (Signature Scalar curve
r Scalar curve
s) = Scalar curve -> ()
forall a. NFData a => a -> ()
rnf Scalar curve
r () -> () -> ()
forall a b. a -> b -> b
`seq` Scalar curve -> ()
forall a. NFData a => a -> ()
rnf Scalar curve
s () -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | ECDSA Public Key.
type PublicKey curve = Point curve

-- | ECDSA Private Key.
type PrivateKey curve = Scalar curve

-- | Elliptic curves with ECDSA capabilities.
class EllipticCurveBasepointArith curve => EllipticCurveECDSA curve where
    -- | Is a scalar in the accepted range for ECDSA
    scalarIsValid :: proxy curve -> Scalar curve -> Bool

    -- | Test whether the scalar is zero
    scalarIsZero :: proxy curve -> Scalar curve -> Bool
    scalarIsZero proxy curve
prx Scalar curve
s = Scalar curve
s Scalar curve -> Scalar curve -> Bool
forall a. Eq a => a -> a -> Bool
== CryptoFailable (Scalar curve) -> Scalar curve
forall a. CryptoFailable a -> a
throwCryptoError (proxy curve -> Integer -> CryptoFailable (Scalar curve)
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Integer -> CryptoFailable (Scalar curve)
forall (proxy :: * -> *).
proxy curve -> Integer -> CryptoFailable (Scalar curve)
scalarFromInteger proxy curve
prx Integer
0)

    -- | Scalar inversion modulo the curve order
    scalarInv :: proxy curve -> Scalar curve -> Maybe (Scalar curve)

    -- | Return the point X coordinate as a scalar
    pointX :: proxy curve -> Point curve -> Maybe (Scalar curve)

instance EllipticCurveECDSA Curve_P256R1 where
    scalarIsValid :: forall (proxy :: * -> *).
proxy Curve_P256R1 -> Scalar Curve_P256R1 -> Bool
scalarIsValid proxy Curve_P256R1
_ Scalar Curve_P256R1
s = Bool -> Bool
not (Scalar -> Bool
P256.scalarIsZero Scalar
Scalar Curve_P256R1
s)
                            Bool -> Bool -> Bool
&& Scalar -> Scalar -> Ordering
P256.scalarCmp Scalar
Scalar Curve_P256R1
s Scalar
P256.scalarN Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT

    scalarIsZero :: forall (proxy :: * -> *).
proxy Curve_P256R1 -> Scalar Curve_P256R1 -> Bool
scalarIsZero proxy Curve_P256R1
_ = Scalar -> Bool
Scalar Curve_P256R1 -> Bool
P256.scalarIsZero

    scalarInv :: forall (proxy :: * -> *).
proxy Curve_P256R1
-> Scalar Curve_P256R1 -> Maybe (Scalar Curve_P256R1)
scalarInv proxy Curve_P256R1
_ Scalar Curve_P256R1
s = let inv :: Scalar
inv = Scalar -> Scalar
P256.scalarInvSafe Scalar
Scalar Curve_P256R1
s
                     in if Scalar -> Bool
P256.scalarIsZero Scalar
inv then Maybe Scalar
Maybe (Scalar Curve_P256R1)
forall a. Maybe a
Nothing else Scalar -> Maybe Scalar
forall a. a -> Maybe a
Just Scalar
inv

    pointX :: forall (proxy :: * -> *).
proxy Curve_P256R1
-> Point Curve_P256R1 -> Maybe (Scalar Curve_P256R1)
pointX proxy Curve_P256R1
_  = Point -> Maybe Scalar
Point Curve_P256R1 -> Maybe (Scalar Curve_P256R1)
P256.pointX

instance EllipticCurveECDSA Curve_P384R1 where
    scalarIsValid :: forall (proxy :: * -> *).
proxy Curve_P384R1 -> Scalar Curve_P384R1 -> Bool
scalarIsValid proxy Curve_P384R1
_ = Proxy SEC_p384r1 -> Scalar SEC_p384r1 -> Bool
forall c (proxy :: * -> *). Curve c => proxy c -> Scalar c -> Bool
ecScalarIsValid (Proxy SEC_p384r1
forall {k} (t :: k). Proxy t
Proxy :: Proxy Simple.SEC_p384r1)

    scalarIsZero :: forall (proxy :: * -> *).
proxy Curve_P384R1 -> Scalar Curve_P384R1 -> Bool
scalarIsZero proxy Curve_P384R1
_ = Scalar SEC_p384r1 -> Bool
Scalar Curve_P384R1 -> Bool
forall curve. Curve curve => Scalar curve -> Bool
ecScalarIsZero

    scalarInv :: forall (proxy :: * -> *).
proxy Curve_P384R1
-> Scalar Curve_P384R1 -> Maybe (Scalar Curve_P384R1)
scalarInv proxy Curve_P384R1
_ = Proxy SEC_p384r1 -> Scalar SEC_p384r1 -> Maybe (Scalar SEC_p384r1)
forall c (proxy :: * -> *).
Curve c =>
proxy c -> Scalar c -> Maybe (Scalar c)
ecScalarInv (Proxy SEC_p384r1
forall {k} (t :: k). Proxy t
Proxy :: Proxy Simple.SEC_p384r1)

    pointX :: forall (proxy :: * -> *).
proxy Curve_P384R1
-> Point Curve_P384R1 -> Maybe (Scalar Curve_P384R1)
pointX proxy Curve_P384R1
_  = Proxy SEC_p384r1 -> Point SEC_p384r1 -> Maybe (Scalar SEC_p384r1)
forall c (proxy :: * -> *).
Curve c =>
proxy c -> Point c -> Maybe (Scalar c)
ecPointX (Proxy SEC_p384r1
forall {k} (t :: k). Proxy t
Proxy :: Proxy Simple.SEC_p384r1)

instance EllipticCurveECDSA Curve_P521R1 where
    scalarIsValid :: forall (proxy :: * -> *).
proxy Curve_P521R1 -> Scalar Curve_P521R1 -> Bool
scalarIsValid proxy Curve_P521R1
_ = Proxy SEC_p521r1 -> Scalar SEC_p521r1 -> Bool
forall c (proxy :: * -> *). Curve c => proxy c -> Scalar c -> Bool
ecScalarIsValid (Proxy SEC_p521r1
forall {k} (t :: k). Proxy t
Proxy :: Proxy Simple.SEC_p521r1)

    scalarIsZero :: forall (proxy :: * -> *).
proxy Curve_P521R1 -> Scalar Curve_P521R1 -> Bool
scalarIsZero proxy Curve_P521R1
_ = Scalar SEC_p521r1 -> Bool
Scalar Curve_P521R1 -> Bool
forall curve. Curve curve => Scalar curve -> Bool
ecScalarIsZero

    scalarInv :: forall (proxy :: * -> *).
proxy Curve_P521R1
-> Scalar Curve_P521R1 -> Maybe (Scalar Curve_P521R1)
scalarInv proxy Curve_P521R1
_ = Proxy SEC_p521r1 -> Scalar SEC_p521r1 -> Maybe (Scalar SEC_p521r1)
forall c (proxy :: * -> *).
Curve c =>
proxy c -> Scalar c -> Maybe (Scalar c)
ecScalarInv (Proxy SEC_p521r1
forall {k} (t :: k). Proxy t
Proxy :: Proxy Simple.SEC_p521r1)

    pointX :: forall (proxy :: * -> *).
proxy Curve_P521R1
-> Point Curve_P521R1 -> Maybe (Scalar Curve_P521R1)
pointX proxy Curve_P521R1
_  = Proxy SEC_p521r1 -> Point SEC_p521r1 -> Maybe (Scalar SEC_p521r1)
forall c (proxy :: * -> *).
Curve c =>
proxy c -> Point c -> Maybe (Scalar c)
ecPointX (Proxy SEC_p521r1
forall {k} (t :: k). Proxy t
Proxy :: Proxy Simple.SEC_p521r1)


-- | Create a signature from integers (R, S).
signatureFromIntegers :: EllipticCurveECDSA curve
                      => proxy curve -> (Integer, Integer) -> CryptoFailable (Signature curve)
signatureFromIntegers :: forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve
-> (Integer, Integer) -> CryptoFailable (Signature curve)
signatureFromIntegers proxy curve
prx (Integer
r, Integer
s) =
    (Scalar curve -> Scalar curve -> Signature curve)
-> CryptoFailable (Scalar curve)
-> CryptoFailable (Scalar curve)
-> CryptoFailable (Signature curve)
forall a b c.
(a -> b -> c)
-> CryptoFailable a -> CryptoFailable b -> CryptoFailable c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Scalar curve -> Scalar curve -> Signature curve
forall curve. Scalar curve -> Scalar curve -> Signature curve
Signature (proxy curve -> Integer -> CryptoFailable (Scalar curve)
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Integer -> CryptoFailable (Scalar curve)
forall (proxy :: * -> *).
proxy curve -> Integer -> CryptoFailable (Scalar curve)
scalarFromInteger proxy curve
prx Integer
r) (proxy curve -> Integer -> CryptoFailable (Scalar curve)
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Integer -> CryptoFailable (Scalar curve)
forall (proxy :: * -> *).
proxy curve -> Integer -> CryptoFailable (Scalar curve)
scalarFromInteger proxy curve
prx Integer
s)

-- | Get integers (R, S) from a signature.
--
-- The values can then be used to encode the signature to binary with
-- ASN.1.
signatureToIntegers :: EllipticCurveECDSA curve
                    => proxy curve -> Signature curve -> (Integer, Integer)
signatureToIntegers :: forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Signature curve -> (Integer, Integer)
signatureToIntegers proxy curve
prx Signature curve
sig =
    (proxy curve -> Scalar curve -> Integer
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Integer
forall (proxy :: * -> *). proxy curve -> Scalar curve -> Integer
scalarToInteger proxy curve
prx (Scalar curve -> Integer) -> Scalar curve -> Integer
forall a b. (a -> b) -> a -> b
$ Signature curve -> Scalar curve
forall curve. Signature curve -> Scalar curve
sign_r Signature curve
sig, proxy curve -> Scalar curve -> Integer
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Scalar curve -> Integer
forall (proxy :: * -> *). proxy curve -> Scalar curve -> Integer
scalarToInteger proxy curve
prx (Scalar curve -> Integer) -> Scalar curve -> Integer
forall a b. (a -> b) -> a -> b
$ Signature curve -> Scalar curve
forall curve. Signature curve -> Scalar curve
sign_s Signature curve
sig)

-- | Encode a public key into binary form, i.e. the uncompressed encoding
-- referenced from <https://tools.ietf.org/html/rfc5480 RFC 5480> section 2.2.
encodePublic :: (EllipticCurve curve, ByteArray bs)
             => proxy curve -> PublicKey curve -> bs
encodePublic :: forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> PublicKey curve -> bs
encodePublic = proxy curve -> Point curve -> bs
forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> Point curve -> bs
forall bs (proxy :: * -> *).
ByteArray bs =>
proxy curve -> Point curve -> bs
encodePoint

-- | Try to decode the binary form of a public key.
decodePublic :: (EllipticCurve curve, ByteArray bs)
             => proxy curve -> bs -> CryptoFailable (PublicKey curve)
decodePublic :: forall curve bs (proxy :: * -> *).
(EllipticCurve curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (PublicKey curve)
decodePublic = proxy curve -> bs -> 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

-- | Encode a private key into binary form, i.e. the @privateKey@ field
-- described in <https://tools.ietf.org/html/rfc5915 RFC 5915>.
encodePrivate :: (EllipticCurveECDSA curve, ByteArray bs)
              => proxy curve -> PrivateKey curve -> bs
encodePrivate :: forall curve bs (proxy :: * -> *).
(EllipticCurveECDSA curve, ByteArray bs) =>
proxy curve -> PrivateKey curve -> bs
encodePrivate = proxy curve -> Scalar curve -> bs
forall curve bs (proxy :: * -> *).
(EllipticCurveBasepointArith curve, ByteArray bs) =>
proxy curve -> Scalar curve -> bs
forall bs (proxy :: * -> *).
ByteArray bs =>
proxy curve -> Scalar curve -> bs
encodeScalar

-- | Try to decode the binary form of a private key.
decodePrivate :: (EllipticCurveECDSA curve, ByteArray bs)
              => proxy curve -> bs -> CryptoFailable (PrivateKey curve)
decodePrivate :: forall curve bs (proxy :: * -> *).
(EllipticCurveECDSA curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (PrivateKey curve)
decodePrivate = proxy curve -> bs -> CryptoFailable (Scalar curve)
forall curve bs (proxy :: * -> *).
(EllipticCurveBasepointArith curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
forall bs (proxy :: * -> *).
ByteArray bs =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
decodeScalar

-- | Create a public key from a private key.
toPublic :: EllipticCurveECDSA curve
         => proxy curve -> PrivateKey curve -> PublicKey curve
toPublic :: forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> PrivateKey curve -> PublicKey curve
toPublic = 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

-- | Sign digest using the private key and an explicit k scalar.
signDigestWith :: (EllipticCurveECDSA curve, HashAlgorithm hash)
               => proxy curve -> Scalar curve -> PrivateKey curve -> Digest hash -> Maybe (Signature curve)
signDigestWith :: forall curve hash (proxy :: * -> *).
(EllipticCurveECDSA curve, HashAlgorithm hash) =>
proxy curve
-> Scalar curve
-> Scalar curve
-> Digest hash
-> Maybe (Signature curve)
signDigestWith proxy curve
prx Scalar curve
k Scalar curve
d Digest hash
digest = do
    let z :: Scalar curve
z = proxy curve -> Digest hash -> Scalar curve
forall curve hash (proxy :: * -> *).
(EllipticCurveECDSA curve, HashAlgorithm hash) =>
proxy curve -> Digest hash -> Scalar curve
tHashDigest proxy curve
prx Digest hash
digest
        point :: Point curve
point = 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
k
    Scalar curve
r <- proxy curve -> Point curve -> Maybe (Scalar curve)
forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Point curve -> Maybe (Scalar curve)
forall (proxy :: * -> *).
proxy curve -> Point curve -> Maybe (Scalar curve)
pointX proxy curve
prx Point curve
point
    Scalar curve
kInv <- proxy curve -> Scalar curve -> Maybe (Scalar curve)
forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Scalar curve -> Maybe (Scalar curve)
forall (proxy :: * -> *).
proxy curve -> Scalar curve -> Maybe (Scalar curve)
scalarInv proxy curve
prx Scalar curve
k
    let s :: Scalar curve
s = 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
kInv (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
z (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
r Scalar curve
d))
    Bool -> Maybe () -> Maybe ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (proxy curve -> Scalar curve -> Bool
forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Scalar curve -> Bool
forall (proxy :: * -> *). proxy curve -> Scalar curve -> Bool
scalarIsZero proxy curve
prx Scalar curve
r Bool -> Bool -> Bool
|| proxy curve -> Scalar curve -> Bool
forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Scalar curve -> Bool
forall (proxy :: * -> *). proxy curve -> Scalar curve -> Bool
scalarIsZero proxy curve
prx Scalar curve
s) Maybe ()
forall a. Maybe a
Nothing
    Signature curve -> Maybe (Signature curve)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Signature curve -> Maybe (Signature curve))
-> Signature curve -> Maybe (Signature curve)
forall a b. (a -> b) -> a -> b
$ Scalar curve -> Scalar curve -> Signature curve
forall curve. Scalar curve -> Scalar curve -> Signature curve
Signature Scalar curve
r Scalar curve
s

-- | Sign message using the private key and an explicit k scalar.
signWith :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash)
         => proxy curve -> Scalar curve -> PrivateKey curve -> hash -> msg -> Maybe (Signature curve)
signWith :: forall curve msg hash (proxy :: * -> *).
(EllipticCurveECDSA curve, ByteArrayAccess msg,
 HashAlgorithm hash) =>
proxy curve
-> Scalar curve
-> Scalar curve
-> hash
-> msg
-> Maybe (Signature curve)
signWith proxy curve
prx Scalar curve
k Scalar curve
d hash
hashAlg msg
msg = proxy curve
-> Scalar curve
-> Scalar curve
-> Digest hash
-> Maybe (Signature curve)
forall curve hash (proxy :: * -> *).
(EllipticCurveECDSA curve, HashAlgorithm hash) =>
proxy curve
-> Scalar curve
-> Scalar curve
-> Digest hash
-> Maybe (Signature curve)
signDigestWith proxy curve
prx Scalar curve
k Scalar curve
d (hash -> msg -> Digest hash
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith hash
hashAlg msg
msg)

-- | Sign a digest using hash and private key.
signDigest :: (EllipticCurveECDSA curve, MonadRandom m, HashAlgorithm hash)
           => proxy curve -> PrivateKey curve -> Digest hash -> m (Signature curve)
signDigest :: forall curve (m :: * -> *) hash (proxy :: * -> *).
(EllipticCurveECDSA curve, MonadRandom m, HashAlgorithm hash) =>
proxy curve
-> PrivateKey curve -> Digest hash -> m (Signature curve)
signDigest proxy curve
prx PrivateKey curve
pk Digest hash
digest = do
    PrivateKey curve
k <- proxy curve -> m (PrivateKey curve)
forall curve (randomly :: * -> *) (proxy :: * -> *).
(EllipticCurve curve, MonadRandom randomly) =>
proxy curve -> randomly (Scalar curve)
forall (randomly :: * -> *) (proxy :: * -> *).
MonadRandom randomly =>
proxy curve -> randomly (PrivateKey curve)
curveGenerateScalar proxy curve
prx
    case proxy curve
-> PrivateKey curve
-> PrivateKey curve
-> Digest hash
-> Maybe (Signature curve)
forall curve hash (proxy :: * -> *).
(EllipticCurveECDSA curve, HashAlgorithm hash) =>
proxy curve
-> Scalar curve
-> Scalar curve
-> Digest hash
-> Maybe (Signature curve)
signDigestWith proxy curve
prx PrivateKey curve
k PrivateKey curve
pk Digest hash
digest of
        Maybe (Signature curve)
Nothing  -> proxy curve
-> PrivateKey curve -> Digest hash -> m (Signature curve)
forall curve (m :: * -> *) hash (proxy :: * -> *).
(EllipticCurveECDSA curve, MonadRandom m, HashAlgorithm hash) =>
proxy curve
-> PrivateKey curve -> Digest hash -> m (Signature curve)
signDigest proxy curve
prx PrivateKey curve
pk Digest hash
digest
        Just Signature curve
sig -> Signature curve -> m (Signature curve)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Signature curve
sig

-- | Sign a message using hash and private key.
sign :: (EllipticCurveECDSA curve, MonadRandom m, ByteArrayAccess msg, HashAlgorithm hash)
     => proxy curve -> PrivateKey curve -> hash -> msg -> m (Signature curve)
sign :: forall curve (m :: * -> *) msg hash (proxy :: * -> *).
(EllipticCurveECDSA curve, MonadRandom m, ByteArrayAccess msg,
 HashAlgorithm hash) =>
proxy curve
-> PrivateKey curve -> hash -> msg -> m (Signature curve)
sign proxy curve
prx PrivateKey curve
pk hash
hashAlg msg
msg = proxy curve
-> PrivateKey curve -> Digest hash -> m (Signature curve)
forall curve (m :: * -> *) hash (proxy :: * -> *).
(EllipticCurveECDSA curve, MonadRandom m, HashAlgorithm hash) =>
proxy curve
-> PrivateKey curve -> Digest hash -> m (Signature curve)
signDigest proxy curve
prx PrivateKey curve
pk (hash -> msg -> Digest hash
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith hash
hashAlg msg
msg)

-- | Verify a digest using hash and public key.
verifyDigest :: (EllipticCurveECDSA curve, HashAlgorithm hash)
       => proxy curve -> PublicKey curve -> Signature curve -> Digest hash -> Bool
verifyDigest :: forall curve hash (proxy :: * -> *).
(EllipticCurveECDSA curve, HashAlgorithm hash) =>
proxy curve
-> PublicKey curve -> Signature curve -> Digest hash -> Bool
verifyDigest proxy curve
prx PublicKey curve
q (Signature Scalar curve
r Scalar curve
s) Digest hash
digest
    | Bool -> Bool
not (proxy curve -> Scalar curve -> Bool
forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Scalar curve -> Bool
forall (proxy :: * -> *). proxy curve -> Scalar curve -> Bool
scalarIsValid proxy curve
prx Scalar curve
r) = Bool
False
    | Bool -> Bool
not (proxy curve -> Scalar curve -> Bool
forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Scalar curve -> Bool
forall (proxy :: * -> *). proxy curve -> Scalar curve -> Bool
scalarIsValid proxy curve
prx Scalar curve
s) = Bool
False
    | Bool
otherwise = Bool -> (Scalar curve -> Bool) -> Maybe (Scalar curve) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Scalar curve
r Scalar curve -> Scalar curve -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe (Scalar curve) -> Bool) -> Maybe (Scalar curve) -> Bool
forall a b. (a -> b) -> a -> b
$ do
        Scalar curve
w <- proxy curve -> Scalar curve -> Maybe (Scalar curve)
forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Scalar curve -> Maybe (Scalar curve)
forall (proxy :: * -> *).
proxy curve -> Scalar curve -> Maybe (Scalar curve)
scalarInv proxy curve
prx Scalar curve
s
        let z :: Scalar curve
z  = proxy curve -> Digest hash -> Scalar curve
forall curve hash (proxy :: * -> *).
(EllipticCurveECDSA curve, HashAlgorithm hash) =>
proxy curve -> Digest hash -> Scalar curve
tHashDigest proxy curve
prx Digest hash
digest
            u1 :: Scalar curve
u1 = 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
z Scalar curve
w
            u2 :: Scalar curve
u2 = 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
r Scalar curve
w
            x :: PublicKey curve
x  = proxy curve
-> Scalar curve
-> Scalar curve
-> PublicKey curve
-> PublicKey curve
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve
-> Scalar curve -> Scalar curve -> Point curve -> Point curve
forall (proxy :: * -> *).
proxy curve
-> Scalar curve
-> Scalar curve
-> PublicKey curve
-> PublicKey curve
pointsSmulVarTime proxy curve
prx Scalar curve
u1 Scalar curve
u2 PublicKey curve
q
        proxy curve -> PublicKey curve -> Maybe (Scalar curve)
forall curve (proxy :: * -> *).
EllipticCurveECDSA curve =>
proxy curve -> Point curve -> Maybe (Scalar curve)
forall (proxy :: * -> *).
proxy curve -> PublicKey curve -> Maybe (Scalar curve)
pointX proxy curve
prx PublicKey curve
x
    -- Note: precondition q /= PointO is not tested because we assume
    -- point decoding never decodes point at infinity.

-- | Verify a signature using hash and public key.
verify :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash)
       => proxy curve -> hash -> PublicKey curve -> Signature curve -> msg -> Bool
verify :: forall curve msg hash (proxy :: * -> *).
(EllipticCurveECDSA curve, ByteArrayAccess msg,
 HashAlgorithm hash) =>
proxy curve
-> hash -> PublicKey curve -> Signature curve -> msg -> Bool
verify proxy curve
prx hash
hashAlg PublicKey curve
q Signature curve
sig msg
msg = proxy curve
-> PublicKey curve -> Signature curve -> Digest hash -> Bool
forall curve hash (proxy :: * -> *).
(EllipticCurveECDSA curve, HashAlgorithm hash) =>
proxy curve
-> PublicKey curve -> Signature curve -> Digest hash -> Bool
verifyDigest proxy curve
prx PublicKey curve
q Signature curve
sig (hash -> msg -> Digest hash
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith hash
hashAlg msg
msg)

-- | Truncate a digest based on curve order size.
tHashDigest :: (EllipticCurveECDSA curve, HashAlgorithm hash)
            => proxy curve -> Digest hash -> Scalar curve
tHashDigest :: forall curve hash (proxy :: * -> *).
(EllipticCurveECDSA curve, HashAlgorithm hash) =>
proxy curve -> Digest hash -> Scalar curve
tHashDigest proxy curve
prx (Digest Block Word8
digest) = CryptoFailable (Scalar curve) -> Scalar curve
forall a. CryptoFailable a -> a
throwCryptoError (CryptoFailable (Scalar curve) -> Scalar curve)
-> CryptoFailable (Scalar curve) -> Scalar curve
forall a b. (a -> b) -> a -> b
$ proxy curve -> Block Word8 -> CryptoFailable (Scalar curve)
forall curve bs (proxy :: * -> *).
(EllipticCurveBasepointArith curve, ByteArray bs) =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
forall bs (proxy :: * -> *).
ByteArray bs =>
proxy curve -> bs -> CryptoFailable (Scalar curve)
decodeScalar proxy curve
prx Block Word8
encoded
  where m :: Int
m      = proxy curve -> Int
forall curve (proxy :: * -> *).
EllipticCurveBasepointArith curve =>
proxy curve -> Int
forall (proxy :: * -> *). proxy curve -> Int
curveOrderBits proxy curve
prx
        d :: Int
d      = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Block Word8 -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length Block Word8
digest Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
        (Int
n, Int
r) = Int
m Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
8
        n' :: Int
n'     = if Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> Int
forall a. Enum a => a -> a
succ Int
n else Int
n

        encoded :: Block Word8
encoded
            | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
0    = Int -> Block Word8
forall ba. ByteArray ba => Int -> ba
B.zero (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Block Word8 -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length Block Word8
digest) Block Word8 -> Block Word8 -> Block Word8
forall bs. ByteArray bs => bs -> bs -> bs
`B.append` Block Word8
digest
            | Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Block Word8
digest
            | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Int -> Block Word8 -> Block Word8
forall bs. ByteArray bs => Int -> bs -> bs
B.take Int
n Block Word8
digest
            | Bool
otherwise = Block Word8 -> Block Word8
shiftBytes Block Word8
digest

        shiftBytes :: Block Word8 -> Block Word8
shiftBytes Block Word8
bs = Int -> (Ptr Word8 -> IO ()) -> Block Word8
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
n' ((Ptr Word8 -> IO ()) -> Block Word8)
-> (Ptr Word8 -> IO ()) -> Block Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dst ->
            Block Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. Block Word8 -> (Ptr p -> IO a) -> IO a
B.withByteArray Block Word8
bs ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src -> Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> IO ()
go Ptr Word8
dst Ptr Word8
src Word8
0 Int
0

        go :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> IO ()
        go :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> IO ()
go Ptr Word8
dst Ptr Word8
src !Word8
a Int
i
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n'   = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | Bool
otherwise = do
                Word8
b <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
                Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
i (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
unsafeShiftR Word8
b (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
unsafeShiftL Word8
a Int
r)
                Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> IO ()
go Ptr Word8
dst Ptr Word8
src Word8
b (Int -> Int
forall a. Enum a => a -> a
succ Int
i)


ecScalarIsValid :: Simple.Curve c => proxy c -> Simple.Scalar c -> Bool
ecScalarIsValid :: forall c (proxy :: * -> *). Curve c => proxy c -> Scalar c -> Bool
ecScalarIsValid proxy c
prx (Simple.Scalar Integer
s) = Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
n
  where n :: Integer
n = CurveParameters c -> Integer
forall curve. CurveParameters curve -> Integer
Simple.curveEccN (CurveParameters c -> Integer) -> CurveParameters c -> Integer
forall a b. (a -> b) -> a -> b
$ proxy c -> CurveParameters c
forall curve (proxy :: * -> *).
Curve curve =>
proxy curve -> CurveParameters curve
forall (proxy :: * -> *). proxy c -> CurveParameters c
Simple.curveParameters proxy c
prx

ecScalarIsZero :: forall curve . Simple.Curve curve
               => Simple.Scalar curve -> Bool
ecScalarIsZero :: forall curve. Curve curve => Scalar curve -> Bool
ecScalarIsZero (Simple.Scalar Integer
a) = Integer
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0

ecScalarInv :: Simple.Curve c
            => proxy c -> Simple.Scalar c -> Maybe (Simple.Scalar c)
ecScalarInv :: forall c (proxy :: * -> *).
Curve c =>
proxy c -> Scalar c -> Maybe (Scalar c)
ecScalarInv proxy c
prx (Simple.Scalar Integer
s)
    | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0    = Maybe (Scalar c)
forall a. Maybe a
Nothing
    | Bool
otherwise = Scalar c -> Maybe (Scalar c)
forall a. a -> Maybe a
Just (Scalar c -> Maybe (Scalar c)) -> Scalar c -> Maybe (Scalar c)
forall a b. (a -> b) -> a -> b
$ Integer -> Scalar c
forall curve. Integer -> Scalar curve
Simple.Scalar Integer
i
  where n :: Integer
n = CurveParameters c -> Integer
forall curve. CurveParameters curve -> Integer
Simple.curveEccN (CurveParameters c -> Integer) -> CurveParameters c -> Integer
forall a b. (a -> b) -> a -> b
$ proxy c -> CurveParameters c
forall curve (proxy :: * -> *).
Curve curve =>
proxy curve -> CurveParameters curve
forall (proxy :: * -> *). proxy c -> CurveParameters c
Simple.curveParameters proxy c
prx
        i :: Integer
i = Integer -> Integer -> Integer
inverseFermat Integer
s Integer
n

ecPointX :: Simple.Curve c
         => proxy c -> Simple.Point c -> Maybe (Simple.Scalar c)
ecPointX :: forall c (proxy :: * -> *).
Curve c =>
proxy c -> Point c -> Maybe (Scalar c)
ecPointX proxy c
_   Point c
Simple.PointO      = Maybe (Scalar c)
forall a. Maybe a
Nothing
ecPointX proxy c
prx (Simple.Point Integer
x Integer
_) = Scalar c -> Maybe (Scalar c)
forall a. a -> Maybe a
Just (Integer -> Scalar c
forall curve. Integer -> Scalar curve
Simple.Scalar (Integer -> Scalar c) -> Integer -> Scalar c
forall a b. (a -> b) -> a -> b
$ Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n)
  where n :: Integer
n = CurveParameters c -> Integer
forall curve. CurveParameters curve -> Integer
Simple.curveEccN (CurveParameters c -> Integer) -> CurveParameters c -> Integer
forall a b. (a -> b) -> a -> b
$ proxy c -> CurveParameters c
forall curve (proxy :: * -> *).
Curve curve =>
proxy curve -> CurveParameters curve
forall (proxy :: * -> *). proxy c -> CurveParameters c
Simple.curveParameters proxy c
prx